ASMB,A,B,L,C
      HED GENERAL OPERATING PROCEDURE 
      ORG 0 
      SUP 
* 
***************************************************** 
*  THIS IS THE 2100-21MX FLOATING POINT DIAGNOSTIC  * 
***************************************************** 
* 
*     GENERAL OPERATING PROCEDURE 
* 
*         A. LOAD THE DIAGNOSTIC CONFIGURATOR AND CONFIGURE IT. 
*         B. LOAD THE DIAGNOSTIC MAIN PROGRAM 
*         C. SET THE P-REGISTER TO 100B.
*         D. SET THE SWITCH REGISTER: 
*            IF SET, BIT
*                   15 = HALT AT END OF EACH TEST SECTION 
*                   14 = SUPPRESS ERROR HALTS 
*                   13 = LOOP ON THE LAST TEST SECTION
*                   12 = LOOP ON DIAGNOSTIC 
*                        (SUPPRESS OPERATOR INTERVENTION) 
*                   11 = SUPPRESS ERROR MESSAGES
*                   10 = SUPPRESS NON-ERROR MESSAGES
*                    9 = GO TO USER TEST SELECTION
*                           AT THE END OF THE PRESENT TEST SECTION
*                  8-0 = RESERVED 
* 
*            NOTE: STANDARD EXECUTION SHOULD BE WITH SW.REG.=0
* 
*         E. PRESS RUN. 
*         F. TO RESTART - LOAD ADDRESS 100B OR 2000B
*                             AND GO TO STEP D. 
* 
*         GENERAL COMPUTER HALTS
* 
*         1020XX    E OR H  000 TO 010
* 
*         CONTROL PROGRAM HALT MESSAGES 
* 
*         102077    END OF DIAG (A = PASS COUNT)
*         102076    END OF TEST (A = TEST NUMBER) 
*         102075    USER TEST SELECTION REQUEST 
*         102074    RESERVED
*         102073    RESERVED
*         102072    RESERVED
*         102071    RESERVED
*         102070    RESERVED
      HED LINKAGE AREA
A     EQU 0         A REGISTER REFERENCE
B     EQU 1         B REGISTER REFERENCE
SR    EQU 1         SWITCH REGISTER REFERENCE 
* 
* 
      ORG 100B
* 
      JMP CFIG,I    GO TO TEST EXECUTION. 
      BSS 1         FAST INPUT (PHOTO READER) 
SLOP  BSS 1         SLOW OUTPUT (LIST)
      BSS 1         FAST OUTPUT (DUMP OR PUNCH) 
      BSS 1         SLOW INPUT (KEYBOARD) 
      DEF FWAA      FIRST WORD OF AVBL. MEMORY
      BSS 1         LAST WORD OF AVBL. MEMORY 
      BSS 1         NOT USED (MAG TAPE) 
      BSS 1         1 MILL SEC TIME OUT COUNT 
      BSS 4         SELECT CODES FOR I/O
CPTO  BSS 1         COMPUTER TYPE/OPTIONS 
      BSS 1         USER CARD TYPE AND SELECT CODE
      BSS 1         MEMORY SIZE AND TYPE
      BSS 1         INTERNAL SWITCH REGISTER
      BSS 1         1 MILL SEC TIMER
      BSS 1         CONFIGURATOR SWITCH CK PTR
      BSS 1         INTEGER TO ASCII CONVERSION 
O2AS  BSS 1         OCTAL TO ASCII CONVERSION 
AS2N  BSS 1         ASCII CONVERSION
      OCT 101207    DIAGNOSTIC SERIAL NUMBER
FMTR  BSS 1         FORMATTER 
* 
*         CONTROL LINKAGE AND DATA REFERENCES 
* 
CFIG  DEF ZSTEX     ENTRY TO TEST.
MSGC  DEF ZMSGC     MESSAGE WITH NO HALT
ERMS  DEF ZERMS     ERROR MESSAGE 
TSTN  OCT 0         CURRENT TEST NUMBER 
STDA  OCT 77
STDB  NOP 
TSTP  DEF TESTS 
      SPC 3 
TESTS DEF TST00 
      DEF TST01 
      DEF TST02 
      DEF TST03 
      DEF TST04 
      DEF TST05 
M1    DEC -1
      HED DIAGNOSTIC DATA 
ZSAVA NOP 
ZSAVB NOP 
ZEOLC NOP 
ZTSTA NOP 
ZSINA NOP 
ZSINB NOP 
ZUINA NOP 
ZUINB NOP 
B7    OCT 7 
B60   OCT 60
B177  OCT 177 
BIT13 OCT 20000 
BIT12 OCT 10000 
BIT9  OCT 1000
HLT0  OCT 102000
ASCS0 OCT 20060 
ASC00 OCT 30060 
ZCFTT DEC -1
ZA.E  OCT 105 
ZIOAD NOP 
SAVEA NOP 
NOPT  NOP 
FIVE  OCT 5 
SAVED NOP 
HOLDD NOP 
FIXTT NOP 
BCCOM OCT 140000
CNTR  NOP 
TPNTR DEF *+1 
ACTA  NOP 
ACTB  NOP 
EXPA  NOP 
EXPB  NOP 
HA1   BSS 2 
HA2   BSS 2 
      OCT 247 
ACTOV NOP 
EXPOV NOP 
HOLDX NOP 
HOLDF NOP 
HOLDP NOP 
HOLD  NOP 
INDTS DEF HA2 
A1    NOP 
B1    NOP 
A2    NOP 
B2    NOP 
X2    NOP 
M25   DEC -25 
M33   DEC -33 
INF1  OCT 70000 
P200  OCT 200 
XSEXP OCT 77600 
M16   DEC -16 
      HED DIAGNOSTIC TEST CONSTANTS 
TABPT DEF *+1 
* 
* FIX TEST CONSTANTS
* 
*  NEGATIVE EXPONENT
* 
      OCT 40000,1,40000,1 
* 
*   EXPONENT=15 
* 
      OCT 40000,36,40000,36 
* 
*   EXPONENT TOO LARGE
* 
      OCT 40000,40,40000,40 
* 
* -1 FIX
* 
BIT15 OCT 100000,0,100000,0 
* 
*   0<X<-1
* 
      OCT 120000,0,120000,0 
* 
*   B#0 
* 
BIT14 OCT 40000,40000,40000,40000 
* 
* 
* FLT CONSTANTS 0-177777
* 
* 
* FAD-FSB CONSTANTS 
* 
* OPERAND EXP LARGER
* 
      OCT 40000,0,40000 
TWO   OCT 2 
* 
* OPERAND EXP NEGATIVE
* 
      OCT 40000,0,40000,3 
* 
* A & B EXP NEGATIVE
* 
      OCT 40000,3,40000,0 
* 
* BOTH EXP'S NEGATIVE 
* 
      OCT 40000,3,40000,3 
* 
* A & B MANTISSA LARGER 
* 
      OCT 60000,2,40000,2 
      OCT 40000,402,40000,2 
* 
* OPERAND MANTISSA LARGER 
* 
      OCT 40000,2,60000,2 
      OCT 40000,2,40000,402 
* 
* A & B EXP LARGER
* 
      OCT 40000,6,40000,2 
* 
* OPERAND EXP LARGER
* 
      OCT 40000,2,40000,6 
* 
*LARGEST POSITIVE EXP 
* 
      OCT 40000,376,1000,376
* 
* LARGEST NEG EXP 
* 
      OCT 40000,1,1000,1
* 
* SMALLEST NEG EXP
* 
      OCT 44444,377,11111 
B377  OCT 377 
* 
* MANTISSA ALL ONES NEG 
* 
      OCT 177777,177400,177777
MASKH OCT 177400
* 
* MANTISSA ALL ONES POSITIVE
* 
      OCT 77777,177400,77777,177400 
* 
* SWAMP OF OPERAND
* 
      OCT 55555,55376,22222,22316 
* 
* SWAMP OF A & B
* 
      OCT 22222,22200,55555,55230 
* 
* SWAMP NEG EXP 
* 
      OCT 111111,111377,133333,33201
* 
* .25 -.25 =0?
* 
      OCT 77777,175775,100000,6775
* 
* OVERFLOW ADD
* 
      OCT 37777,177776,40000,476
* 
* FMP-FDV CONSTANTS 
* 
* -1*-1=1 OR -1/-1=1
* 
      OCT 100000,0,100000,0 
* 
* -32,766*-32766=73.6E6 
* -32,766/-32,766=1 
* 
      OCT 100000,36,100000,36 
* 
* 1*1=1 OR 1/1=1
* 
      OCT 40000,2,40000,2 
* 
* 32767*32767=73.6E6 OR 32767/32767=1 
* 
NB15  OCT 77777,36,77777,36 
* 
* -32766*32767=-73.6E6 OR -32766/32767=-1 
* 
      OCT 100000,36,77777,36
      OCT 77777,36,100000,36
* 
* 1*1=1 OR 1/1=1
* 
      OCT 77777,77400,77777,177400
* 
* OVERFLOW ON FMP OR 1 ON FDV 
* 
      OCT 77777,177776,77777
M2    OCT 177776
* 
* ALL ONES-1
* 
      OCT 177777,177377,177777,177377 
* 
* 24 BIT ROLLOVER 
* 
      OCT 0,1,0 
ONE   OCT 1 
* 
* DIV BY ZERO 
* 
      OCT 0,0,0,0 
      OCT 110000,0,0,0
* 
* 
B247  OCT 247       END OF LIST.....
      SKP 
      HED DIAGNOSTIC SUBROUTINES
* 
* 
*         SWITCH REGISTER CHECK 
* 
SWRT  NOP 
      STA ZSAVA     SAVE A-REG. 
      JSB DEBON     GO DEBOUNCE SW.REG. 
      AND B         MASK OUT TEST BIT(S). 
      SZA,RSS       ANY SWITCHES UP?
      ISZ SWRT       NO! UPDATE RETURN TO P+2.
      LDA ZSAVA      YES! GET ORIGINAL A-REG. 
      JMP SWRT,I    RETURN. 
      SPC 3 
* SWITCH REGISTER DEBOUNCE ROUTINE
*  TO PREVENT OVERLAY OF A HALT BY A DEPRESSED DISPLAY REG. BIT.
* 
DEBON NOP 
      LIA SR        GET SWITCH REG. 
      STA SAVEA     SAVE SW.REG. SETTING. 
      CLE           FOR COMPUTER TYPE TEST. 
      LDA CPTO      GET COMPUTER TYPE WORD. 
      ADA BCCOM     E=0 IF 2115 OR 2116.
      CLA,SEZ,RSS   IS THIS A 2115 OR 2116? 
      JMP RESSW      YES! SKIP DEBOUNCE.
WAITS OTA SR        TRY TO CLEAR SW.REG.
      LIA SR        GET SW.REG. BACK. 
      SZA,RSS       IS OPERATOR PRESSING A SWITCH?
      JMP WAITO      NO! GO DO NEXT SW. REG. TEST.
      CLA,CLE        YES! SET DELAY MARKER. 
      JMP WAITS     WAIT UNTIL OPERATOR LETS GO.
WATM1 CLE           SET DELAY MARKER. 
WAITO CCA           SET TEST PATTERN. 
      OTA SR        ATTEMPT TO SET ALL SR BITS. 
      LIA SR        GET SR CONTENTS.
      ISZ A         IS OPERATOR CLEARING A SWITCH?
      JMP WATM1      YES! WAIT UNTIL HE LETS GO.
      SEZ           WAS A SW.REG. BIT PRESSED?
      JMP RESSW      NO! GO RESTORE SW.REG. 
      INA            YES! DELAY 
      SZA                  ABOUT
      JMP *-2               400 MS. 
      JMP WAITS     TRY TEST AGAIN. 
RESSW LDA SAVEA     RESTORE ORIGINAL SW.REG.
      OTA SR        RESTORE DISPLAY.
      JMP DEBON,I   RETURN. 
      SKP 
* ERROR COMPARES THE SOFTWARE AND FIRMWARE
*   RESULTS OF A FLOATING POINT INSTRUCTION 
*    AND REPORTS ANY DIFFERENCE AS AN ERROR.
* 
ERROR NOP 
      DST ACTA      SAVE ACTUAL RESULTS.
      LDA ASCS0     IF OVERFLOW IS SET
      SOC            SAVE AN ASCII ONE
      INA              ELSE SAVE A ZERO.
      STA ACTOV     SAVE OVERFLOW 
      STA ACTOP,I    STATE. 
      DLD ACTA      RESTORE ACTUAL DATA.
      CPA EXPA      DID RESULTS IN A-REG COMPARE? 
      RSS            YES! CHECK THE B-REG.
      JMP ERREP      NO! REPORT ERROR.
      LDB FIXTT     GET THE FIX TEST INDICATOR. 
      SZB           IS THIS THE FIX TEST? 
      JMP CLERB      YES! DON'T CHECK B.
      LDB ACTB       NO! RESTORE B. 
      CPB EXPB      DID RESULTS IN B COMPARE? 
      RSS            YES! CHECK OVERFLOW. 
      JMP ERREP      NO! REPORT ERROR.
      JMP CHKOV     GO CHECK OVERFLOW.
CLERB LDB EXPB      MAKE THE B RESULTS
      STB ACTB        THE SAME. 
CHKOV LDA ACTOV     GET ACTUAL OVERFLOW.
      CPA EXPOV     OVERFLOWS COMPARE?
      JMP ERROR,I    YES! RETURN. 
ERREP LDA ASC00      NO! PUT THE TEST NUMBER
      IOR TSTN            IN THE
      STA ERMSG+1             E00X MESSAGE. 
      LDA ERMSG     GET E0 OF EXXX MESSAGE. 
      ERA,CLE,ELA   CLEAR BIT 0.
      LDB ILINE     GET OPERAND ADDR. 
      SSB           IS IT INDIRECT? 
      IOR ONE        YES! MARK FOR IND. FAILURE.
      STA ERMSG     RESTORE EX INTO MESSAGE.
      LDA TSTN      GET TEST NUMBER.
      RAL           MULTIPLY BY 2.
      ADA INSTP     ADD IN INST. POINTER. 
      STA HOLDD     SAVE POINTER. 
      DLD HOLDD,I   GET ASCII INSTRUCTION.
      DST ERINT,I   PUT IT IN THE MESSAGE.
      LDA ACPNT     SET UP THE
      STA HOLDD      POINTERS 
      LDA TPNTR       FOR THE ERROR 
      STA SAVED         MESSAGE STRINGS AND DATA. 
STUFL LDA SAVED,I   GET EXPECTED AND ACTUAL DATA. 
      CPA B247      END OF DATA?
      JMP OUTLP      YES! EXIT. 
      CLE            NO! READY CONVERSION ROUTINE.
      LDB HOLDD,I   GET MESSAGE POINTER.
      JSB O2AS,I    PUT VALUE IN MESSAGE STRING.
      ISZ SAVED     UPDATE
      ISZ HOLDD      POINTERS.
      JMP STUFL     DO ANOTHER CONVERSION.
OUTLP DLD ACTA      RESTORE A & B.
      JSB ERMS,I    GO PRINT ERROR MESSAGE. 
      DEF ERMSG     ERROR MESSAGE POINTER.
      JMP ERROR,I   ERROR RETURN. 
      SKP 
* SAVRE SAVES THE RESULT OF A FLOATING POINT INSTRUCTION
* 
SAVRE NOP 
      DST EXPA      SAVE A AND B. 
      LDA ASCS0     IF OVERFLOW IS SET
      SOC            SAVE AN ASCII ONE
      INA               ELSE SAVE A 0 
      STA EXPOV         IN EXPOV
      STA EXPOP,I        AND MESSAGE. 
      JMP SAVRE,I   RETURN. 
      SPC 3 
*TOROT CHECKS A FLOATING POINT INSTRUCTION WITH 
* EACH OF 32 COMBINATIONS OF DATA (DERIVED BY 32 SHIFTS 
*  OF TWO 32 BIT WORDS) 
* 
TOROT NOP 
      LDA TOROT,I   GET THE SOFTWARE MACRO
      STA INLIN      AND PUT IT IN LINE.
      ISZ TOROT     GET THE MACRO OPERAND 
      LDA TOROT,I     AND PUT IT
      STA ILINE        IN LINE
      STA INLN2         TWICE.
      ISZ TOROT     GET THE FIRMWARE MACRO
      LDA TOROT,I    AND PUT IT IN
      STA INLN1       LINE. 
      LDA M33       GET THE ROTATE DATA CNTR
      STA CNTR       AND SAVE IT. 
      LDA TSTN      GET TEST NUMBER.
      CPA FIVE      IS THIS THE FDV TEST? 
      JMP ROTLP      YES! GO SHIFT DATA.
      DLD HA2       GET OPERAND DATA. 
      DST A2        SAVE IT FOR FP INSTRUCTION. 
      DLD HA1       GET A & B DATA. 
      JMP DFLOP     GO DO FP INSTRUCTION. 
ROTLP ISZ CNTR      UPDATE COUNT. LAST ROTATE?
      JMP DOTST      NO! DO NEXT PATTERN. 
DONRT ISZ TOROT      YES! UPDATE RETURN.
      JMP TOROT,I   RETURN. 
DOTST DLD HA2       GET OPERAND WORDS.
      RRR 1         DO A 32-BIT ROTATE. 
      JSB NON0      GO NORMALIZE NUMBER.
      DST A2        SAVE THE NEW
      DST HA2        OPERAND WORDS. 
      DLD HA1       GET A & B WORDS.
      RRR 1         DO A 32-BIT ROTATE. 
      JSB NON0      GO NORMALIZE NUMBER.
      DST HA1       SAVE THE NEW A & B
DFLOP DST A1         WORDS. 
INLIN JSB .FIX      EXECUTE SOFTWARE MACRO. 
ILINE NOP           OPERAND ADDR. PNTR. 
      JSB SAVRE     SAVE RESULTS. 
      DLD HA1       GET A & B FOR TEST. 
INLN1 OCT 105100    EXECUTE FIRMWARE MACRO. 
INLN2 NOP           OPERAND ADDR. PNTR. 
      JSB ERROR     CHECK FOR ERROR.
      LDA TSTN      IS THIS THE 
      CPA FIVE        FDV TEST? 
      RSS            YES! CHECK FOR 2ND DIV BY 0. 
      JMP ROTLP      NO! DO NEXT PATTERN. 
      DLD HA1       GET OPERAND.
      SZA           IS UPPER WORD 0?
      JMP ROTLP      NO! DO NEXT PATTERN. 
      SZB           IS LOWER WORD 0?
      JMP ROTLP      NO! DO NEXT PATTERN. 
      JMP DONRT      YES! EXIT SUBROUTINE.
      SKP 
* SDATA SETS THE START OF THE TEST DATA 
*  TABLE IN HOLDP.
* 
SDATA NOP 
      LDA TABPT     GET TABLE POINTER.
      STA HOLDP     SAVE IT.
      JMP SDATA,I   RETURN. 
      SPC 2 
* SETOP SETS UP THE A & B AND OPERAND VALUES TO 
*  BE USED WHEN EXECUTING A FLOATING POINT INSTRUCTION. 
* 
SETOP NOP 
      LDA HOLDP,I   GET A DATA PATTERN. 
      CPA B247      END OF LIST?
      JMP SETOP,I    YES! EXIT TEST.
      DLD HOLDP,I    NO! GET 32 BIT OPERAND.
      DST A2        SAVE IT IN THE
      DST HA2        TEST LOCATIONS.
      ISZ HOLDP     UPDATE DATA 
      ISZ HOLDP      TABLE POINTER. 
      DLD HOLDP,I   GET A & B VALUES. 
      DST A1        SAVE THEM IN THE
      DST HA1        TEST LOCATIONS.
      ISZ HOLDP     UPDATE THE DATA 
      ISZ HOLDP       TABLE POINTER.
      ISZ SETOP     UPDATE RETURN.
      JMP SETOP,I   RETURN. 
      SKP 
* NON0 NORMALIZES THE CONTENTS OF THE A-REG IF EXECUTING
*  THE FDV TEST(THIS IS NOT A NORMAL NORMALIZE IN THAT IT 
*   DOES NOT SHIFT TO NORMALIZE). NON0 ALSO ALLOWS ONLY A 
*    32 BIT ZERO WORD TO PASS IF NOT NORMALIZED.
* 
NON0  NOP 
      STA HOLDF     SAVE A-REG. 
      LDA TSTN      GET TEST NUMBER.
      CPA FIVE      IS THIS TEST 5? 
      JMP NORMZ      YES! GO NORMALIZE. 
      ARS           IS THIS 
      SZA,RSS        TEST 0 OR 1? 
      JMP EXNOR        YES! DON'T CHECK DATA. 
      LDA HOLDF        NO! RESTORE A-REG. 
      SZA           IS A-REG CLEAR? 
      JMP EXNOR      NO! GO RESTORE DATA. 
      SZB           IS B CLEAR? 
      INA,RSS         NO! MAKE A-REG NON-ZERO.
EXNOR LDA HOLDF     RESTORE A-REG.
      JMP NON0,I    EXIT. 
NORMZ LDA HOLDF 
      SZA           ALLOW A 
      JMP DONOR      DIVIDE 
      SZB,RSS          BY 
      JMP EXNOR        ZERO.
DONOR AND BCCOM     MASK TO BITS 15-14. 
      CPA BIT15     IS WORD=10.....?
      JMP EXNOR      YES! EXIT. 
      CPA BIT14     IS WORD=01.....?
      JMP EXNOR      YES! EXIT. 
      LDA BIT14     GET BIT 14. 
      XOR HOLDF     COVERT 11.. TO 10.. AND 
      JMP NON0,I       00.. TO 01.. 
      SPC 3 
CHNGO NOP 
      CLO           CLEAR OVF.
      SLA           WAS OVF SET?
      STO            YES! SET IT. 
      JMP CHNGO,I    RETURN.
      HED DIAGNOSTIC FLOATING POINT SUBROUTINES 
* FAD EXECUTES A FLOATING POINT ADD.
* 
.FAD  NOP           ENTRY FOR FLOATING ADD
      JSB UNPAK     GET ARGUMENTS UNPACKED
      JMP ADMUP     GO TO COMMON SECTION
      SPC 2 
* FSB EXECUTES A FL OATING POINT SUBTRACT 
* 
.FSB  NOP           ENTRY FOR FSB. EXIT FOR FAD/FSB.
      JSB UNPAK     GET ARGUMENTS UNPACKED. 
      LDA A2
      CMA           DOUBLE LENGTH TWO'S COMPLEMENT. 
      CMB,INB,SZB   IF LOW PART NOT ZERO, THEN ALL
      JMP OK          DONE. 
      SSA,INA,RSS   OTHERWISE BUMP A. IF A WAS NEGA-
      SSA,RSS        TIVE, AND REMAINS SO,
      JMP OK          THEN SHIFT
      RAR                IT DOWN &
      ISZ X2           BUMP THE EXPONENT. 
OK    STB B2        SAVE THE
      STA A2          OPERAND.
ADMUP ISZ .FSB      BUMP RETURN ADDRESS.
      LDA X2        COMPUTE EXPONENT DIFFERENCE.
AGAIN CMA,INA       IF ARGUMENT 1 IS
      ADA X1         LARGER,THEN GO 
      SSA,RSS        TO ADD 
      JMP ADDEM       SECTION.
      LDA A1        OTHERWISE,
      LDB A2
      STA A2         EXCHANGE 
      STB A1
      LDA B1          THE 
      LDB B2
      STA B2           ARGUMENTS. 
      STB B1
      LDA X1
      LDB X2
      STB X1
      STA X2
      JMP AGAIN 
ADDEM ADA M25       IF SHIFT COUNT IS 
      LDB B1         25 OR MORE,
      SSA,RSS         THEN IGNORE SMALLER ARGUMENT. 
      JMP TAKIT 
      CMA,CLE       GET SHIFT COUNT 
      ADA M25        AS NEGATIVE
      STA X2         AND STORE IN X2. 
      LDA A2        LOAD SMALLER
      LDB B2          MANTISSA. 
LOOP  ISZ X2        ANY MORE SHIFTS?
      JMP SHFT        YES! GO TO SHIFT SECTION. 
      ADB B1        ADD IN LOW PART.
      CLO 
      SEZ           IF LOW PART ADD OVERFLOWED THEN 
      CLE,INA        BUMP HIGH PART.
      SOS           IF NO OVERFLOW GO ADD 
      JMP *+5        IN HIGH PART.
      ADA A1        OTHERWISE ADD IN HIGH PART HERE.
      SSA,RSS       IF A BECOMES +, THEN A1<0 AND 
      JMP DONE      OVERFLOW IS OK? 
      JMP *+4       IF A<0, GO HANDLE THE OVERFLOW. 
      ADA A1        ADD IN HIGH PART. 
      SOS           OVERFLOW? 
      JMP DONE       NO! NUMBER OK. 
      ERA            YES! DO A
      ERB                32 BIT SHIFT.
      ISZ X1        BUMP EXPONENT.
      JMP DONE      GO NORMALIZE DATA.
      RSS 
TAKIT LDA A1        GET A-REG CONTENTS. 
DONE  JSB .PACK     GO NORMALIZE NUMBER.
X1    BSS 1 
      JMP .FSB,I    EXIT. 
SHFT  CLE,SLA,ARS   2 REGISTER
      CME            ARITHMETIC 
      ERB,CLE         SHIFT.
      JMP LOOP
UNPAK NOP           UNPACKING SECTION 
      STA A1        SAVE HIGH PART OF ARG1
      SZA,RSS       GET 
      CLB,INB        THE
      JSB .FLUN        EXPONENT.
      STB B1        SAVE LOW PART OF ARG1 
      STA X1        SAVE EXP. OF ARG1 
      LDA UNPAK     GET ADDRESS OF CALLING ROUTINE
      ADA M2        A=FAD OR FSB. 
      LDA 0,I       GET ADDRESS OF ARGUMENT.
      STA .FSB      STORE IN EXIT LOCATION. 
      LDA 0,I       GET 
      DLD 0,I        THE OPERAND. 
      STA A2        SAVE HIGH PART
      SZA,RSS       GET 
      CLB,INB        THE
      JSB .FLUN       EXPONENT. 
      STB B2        SAVE LOW PART 
      STA X2        SAVE EXP
      JMP UNPAK,I   RETURN. 
      SKP 
      SKP