<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$CONTROL MAP,CODE,USLINIT                                               00010000
<<FIRMWARESIM - MODULE 78>>                                             00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$THIRTY                                                                 00055000
$CONTROL SEGMENT=FIRMWARESIM1                                           00060000
BEGIN                                                                   00065000
            << >>                                                       00070000
            <<FIRMWARE SIMULATION ROUTINES ->>                          00075000
            <<  DOUBLE PRECISION: ADD       >>                          00080000
            <<                    SUBTRACT  >>                          00085000
            <<                    MULTIPLY  >>                          00090000
            <<                    DIVIDE    >>                          00095000
            <<                    COMPARE   >>                          00100000
            <<                    NEGATE    >>                          00105000
            <<  DECIMAL FIRMWARE: CVBD      >>                          00110000
            <<                    CVDB      >>                          00115000
            <<                    CVAD      >>                          00120000
            <<                    CVDA      >>                          00125000
            <<                    SRD       >>                          00130000
            <<                    NSLD      >>                          00135000
            <<                    SLD       >>                          00140000
            <<                    ADDD      >>                          00145000
            <<                    CMPD      >>                          00150000
            <<                    SUBD      >>                          00155000
            <<                    DMPY      >>                          00160000
            << >>                                                       00165000
                                                                        00170000
PROCEDURE GETPRIVMODE; OPTION PRIVILEGED,EXTERNAL;                      00175000
PROCEDURE ABORT(MODE,CODE,PARAM);                                       00180000
     VALUE MODE,CODE,PARAM;                                             00185000
     LOGICAL MODE,CODE,PARAM;                                           00190000
     OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                             00195000
PROCEDURE ININRETURN;                                                   00200000
OPTION EXTERNAL;                                                        00205000
                                                                        00210000
PROCEDURE DEC'SIM'TRAP(TRAPNUM);                                        00215000
VALUE TRAPNUM;INTEGER TRAPNUM;                                          00220000
OPTION PRIVILEGED,EXTERNAL;                                             00225000
                                                                        00230000
<<......................................................................00235000
.                                                                      .00240000
.                             EMATH                                    .00245000
.                                                                      .00250000
......................................................................>>00255000
PROCEDURE EMATH;                                                        00260000
OPTION PRIVILEGED,UNCALLABLE;                                           00265000
BEGIN                                                                   00270000
COMMENT PERFORMS DOUBLE PRECISION ARITHMETIC OPERATIONS:                00275000
          ADD,                                                          00280000
          SUBTRACT,                                                     00285000
          MULTIPLY,                                                     00290000
          DIVIDE;                                                       00295000
     DEFINE                                                             00300000
       LU=ASSEMBLE(LOAD Q+1;LDD Q+2)#,                                  00305000
       LV=ASSEMBLE(LOAD Q+4;LDD Q+5)#,                                  00310000
       SU=ASSEMBLE(STOR Q+3;STD Q+1)#,                                  00315000
       SV=ASSEMBLE(STOR Q+6;STD Q+4)#,                                  00320000
       LX=ASSEMBLE(LOAD Q-6,I;INCM Q-6;LDD Q-6,I;DECM Q-6)#,            00325000
       LY=ASSEMBLE(LOAD Q-5,I;INCM Q-5;LDD Q-5,I;DECM Q-5)#,            00330000
       LZ=ASSEMBLE(LOAD Q-4,I;INCM Q-4;LDD Q-4,I;DECM Q-4)#,            00335000
       SX=ASSEMBLE(INCM Q-6;STD Q-6,I;DECM Q-6;STOR Q-6,I)#,            00340000
       SY=ASSEMBLE(INCM Q-5;STD Q-5,I;DECM Q-5;STOR Q-5,I)#,            00345000
       SZ=ASSEMBLE(INCM Q-4;STD Q-4,I;DECM Q-4;STOR Q-4,I)#;            00350000
COMMENT DATA DECLARATIONS *********************************************;00355000
      INTEGER                                <<                       >>00360000
         U1         =Q+1,                    <<MSW(U)                 >>00365000
         U2         =Q+2,                    <<MIDDLE WORD OF U       >>00370000
         U3         =Q+3,                    <<LSW(U)                 >>00375000
         V1         =Q+4,                    <<MSW(V)                 >>00380000
         V2         =Q+5,                    <<MIDDLE WORD OF V       >>00385000
         V3         =Q+6,                    <<LSW(V)                 >>00390000
         SIGN       =Q+7,                    <<SIGN OF RESULT         >>00395000
         EXPU       =Q+8,                    <<EXPONENT(U)            >>00400000
         EXPV       =Q+9,                    <<EXPONENT(V)            >>00405000
          OPCODE     =Q+11,                                             00410000
         DELTAQ     =Q-0,                                               00415000
         MYSTAT     =Q-1,                                               00420000
         A          =S-0,                    <<                       >>00425000
         B          =S-1,                    <<GREAT                  >>00430000
         C          =S-2,                    <<   FOR                 >>00435000
         I          =U1,                     <<      PLAYING          >>00440000
         XREG       =X;                      <<         GAMES         >>00445000
      LOGICAL                                <<                       >>00450000
         LU1        =U1,                     <<                       >>00455000
         LU2        =U2,                     <<                       >>00460000
         LU3        =U3,                     <<                       >>00465000
         LV1        =V1,                     <<                       >>00470000
         LV2        =V2,                     <<                       >>00475000
         LV3        =V3,                     <<                       >>00480000
         OVFL       =Q+10;                   <<OVERFLOW INDICATOR>>     00485000
      DOUBLE                                 <<                       >>00490000
         BA         =S-1,                    <<                       >>00495000
         V1V2       =V1,                     <<IF YOU                 >>00500000
         V2V3       =V2,                     << CANT FIGURE           >>00505000
         U1U2       =U1,                     <<  THIS OUT, GO TO      >>00510000
         U2U3       =U2;                     <<   PROGRAMMERS SCHOOL  >>00515000
      DOUBLE POINTER                                                    00520000
         DZ         =Q-4;                                               00525000
      ENTRY                                                             00530000
         EADD,                               <<ADD ENTRY      Z _ X+Y >>00535000
         ESUB,                               <<SUBTRACT ENTRY Z _ X-Y >>00540000
         EMPY,                               <<MULTIPLY ENTRY Z _ X*Y >>00545000
         EDIV;                               <<DIVIDE ENTRY   Z _ X/Y >>00550000
      ARRAY                                  <<                       >>00555000
         STACK(*)   =Q-6;                    <<ERROR STACK MARKER LOC >>00560000
      SUBROUTINE ALLOCATE;                                              00565000
      COMMENT CLEANS UP STACK FROM INTERNAL INTERRUPT ROUTINE AND       00570000
              ALLOCATES LOCAL STORAGE                             ;     00575000
      BEGIN                                                             00580000
           XREG _ TOS;                       <<SAVE RETURN ADDRESS>>    00585000
           PUSH(S,Q);                                                   00590000
           TOS _ TOS - DELTAQ;                                          00595000
           ASSEMBLE(DUP);                                               00600000
           SET(Q);                           <<GO BACK 1 MARKER>>       00605000
           TOS _ TOS - TOS - 9;                                         00610000
           ASSEMBLE(SUBS 0);                                            00615000
          IF MYSTAT > 0 THEN                 <<USER MODE CALL>>         00620000
          BEGIN                                                         00625000
               PUSH(STATUS);                                            00630000
               ASSEMBLE(TRBC 0);             <<RESET PRIV.   >>         00635000
               SET(STATUS);                                             00640000
          END;                                                          00645000
           TOS_0D;                                                      00650000
           TOS _ XREG;                       <<RESET RETURN ADDRESS>>   00655000
      END;                                                              00660000
      SUBROUTINE UNPACK;                                                00665000
        BEGIN                           <<UNPACK U AND V. EXPONENTS     00670000
                                          ARE SHIFTED                   00675000
                                          RIGHT AND STORED IN EXPU,EXPV.00680000
                                          IMPLICIT BITS ARE SET         00685000
                                          AND FRACTIONS                 00690000
                                          ARE SHIFTED LEFT 2 BITS.      00695000
                                          SIGN _ U1 XOR U2>>            00700000
          TOS _ V1;                                                     00705000
          TOS _ U1;                                                     00710000
          ASSEMBLE(DDUP,XOR);                                           00715000
          SIGN _ TOS;                        <<BIT(0)=0 IF SAME SIGN>>  00720000
          EXPU _ A.(1:9);                    <<EXPON+256>>              00725000
          TOS _ TOS.(10:6);                  <<FRACTION>>               00730000
          ASSEMBLE(TSBC 9);                  <<SET IMPLICIT BIT>>       00735000
          U1 _ TOS;                                                     00740000
          EXPV _ A.(1:9);                    <<DITTO>>                  00745000
          TOS _ TOS.(10:6);                                             00750000
          ASSEMBLE(TSBC 9);                                             00755000
          V1 _ TOS;                                                     00760000
         LU; TOS_TOS&TASL(2); SU;                                       00765000
        END;   <<UNPACK>>                                               00770000
COMMENT ADD/SUBTRACT PART *********************************************;00775000
ESUB:                                        <<SUBTRACT ENTRY>>         00780000
      ALLOCATE;                                                         00785000
      OPCODE_%20401;                                                    00790000
      LZ;                                                               00795000
      ASSEMBLE(OR,FNEG;DEL);                 <<CHANG SIGN AND ADD>>     00800000
      @DZ _ @DZ + 1;                                                    00805000
      TOS _ DZ;                                                         00810000
      GO ADD;                                <<W _ U + (-V)>>           00815000
EADD:                                        <<ADD ENTRY>>              00820000
      ALLOCATE;                                                         00825000
      OPCODE_%20400;                                                    00830000
      LZ;                                                               00835000
ADD:    SV;                                                             00840000
      LY; SU;                                                           00845000
      TOS _ U1;                                                         00850000
      ASSEMBLE(TSBC 0);                      <<SIGN MSW(U)=SIGN MSW(V)>>00855000
      TOS _ V1;                              <<FOR COMPARISON>>         00860000
      ASSEMBLE(TSBC 0;                                                  00865000
               LCMP);                        <<COMPARE U1 WITH V1>>     00870000
      IF < THEN                                                         00875000
      BEGIN                                                             00880000
SWAP:          LU;                                                      00885000
               LV; SU;                                                  00890000
               SV;                                                      00895000
      END    <<SWAP>>                                                   00900000
      ELSE                                   <<U1 >= V1>>               00905000
      BEGIN                                                             00910000
           IF = THEN                                                    00915000
           BEGIN                                                        00920000
                TOS _ U2U3 - V2V3; DDEL;                                00925000
                IF NOCARRY THEN GO SWAP;                                00930000
           END;     <<U1 = V1>>                                         00935000
      END;   <<U1 >= V1>>                                               00940000
      TOS _ U1;                              <<SAVE SIGN OF RESULT>>    00945000
      LV; TOS_TOS&TASR(0);                                              00950000
      DDEL; DEL;                                                        00955000
      IF = THEN                                                         00960000
      BEGIN                                  <<V=0 SO ANSWER=U>>        00965000
           TOS _ U2U3;                                                  00970000
           XREG _ 0;                                                    00975000
           TOS _ TOS & TASR(0);                                         00980000
           GO TO CCA;                                                   00985000
      END;                                                              00990000
      UNPACK;                                <<UNPACK U AND V>>         00995000
      LV; TOS_TOS&TASL(2); SV;                                          01000000
      IF SIGN < 0 THEN                                                  01005000
      BEGIN                                  <<COMPLIMENT V>>           01010000
           TOS _ NOT LV1;                                               01015000
           V2V3 _ -V2V3;                                                01020000
           IF = THEN TOS _ TOS + 1;                                     01025000
           V1 _ TOS;                                                    01030000
      END;   <<SIGN < 0>>                                               01035000
      SIGN _ TOS;                            <<SIGN OF RESULT>>         01040000
      TOS _ EXPU;                            <<EXP+256>>                01045000
      EXPU _ EXPU + %400;                    <<EXP+512 FOR PACK>>       01050000
      TOS _ TOS - EXPV;                      <<SHIFT COUNT>>            01055000
      XREG _ A;                              <<FOR TASR>>               01060000
      IF TOS > 40 THEN                                                  01065000
      BEGIN                                  <<U MUCH GREATER>>         01070000
            TOS _ U1;                                                   01075000
            GO TO FINISHADD;                                            01080000
      END;                                                              01085000
      LV;                                                               01090000
      ASSEMBLE(TASR 0,X);                    <<LINE UP BINARY POINTS>>  01095000
      U2U3 _ TOS + U2U3;                     <<ADD U AND V>>            01100000
      IF CARRY THEN TOS _ TOS + 1;                                      01105000
      TOS _ TOS + U1;                                                   01110000
FINISHADD:                                                              01115000
      TOS _ U2U3;                            <<RESULT ON TOS>>          01120000
COMMENT PACKING PART **************************************************;01125000
PACK:                                                                   01130000
      XREG_0; XREG_XREG+1;   <<KLUDGE FOR TNSL ERROR IN MICROCODE>>     01135000
      TOS _ TOS & TNSL;                                                 01140000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             01145000
      TOS _ 0; TOS _ 4;                      <<DOUBLE 4>>               01150000
      ASSEMBLE(DADD);                        <<ROUND>>                  01155000
      IF CARRY THEN C _ C + 1;                                          01160000
      TOS _ TOS&TASR(3);                     <<SHIFT TO BIT 9>>         01165000
      ASSEMBLE(CAB);                         <<U1 ON TOS>>              01170000
      TOS _ EXPU;                            <<MOVE      >>             01175000
      TOS _ XREG;                            <<  EXPONENT>>             01180000
      TOS _ TOS + %400;                                                 01185000
      TOS _ TOS - TOS;                       <<    INTO  >>             01190000
      TOS _ TOS&LSL(6);                      <<      U1  >>             01195000
      TOS _ TOS + TOS;                                                  01200000
      ASSEMBLE(DUP,STAX);                    <<SAVE U1 FOR ERROR TEST>> 01205000
      IF SIGN < 0 THEN ASSEMBLE(TSBC 0)      <<SET SIGN BIT>>           01210000
                  ELSE ASSEMBLE(TRBC 0);                                01215000
      ASSEMBLE(CAB,CAB);                     <<ROTATE U1 BACK>>         01220000
      ASSEMBLE(DTST);                                                   01225000
      IF = THEN OVFL _ TRUE;                 << UNDERFLOW POSSIBLE >>   01230000
      TOS _ TOS & TASR(0);                                              01235000
CCA:  PUSH(STATUS);                                                     01240000
      TOS _ MYSTAT;                                                     01245000
      ASSEMBLE(XCH);                                                    01250000
      TOS . (6:2) _ TOS . (6:2);                                        01255000
      MYSTAT _ TOS;                                                     01260000
      SX;                                                               01265000
      TOS _ XREG;                                                       01270000
      IF < THEN                                                         01275000
      BEGIN                                                             01280000
           TOS _ TOS & LSL(1);                                          01285000
           IF < THEN                                                    01290000
UNDERF:    TOS _ 9 ELSE                                                 01295000
           TOS _ 8;                                                     01300000
ERROR:     IF MYSTAT.(2:1) = 1 THEN                                     01305000
           BEGIN                                                        01310000
                TOS_OPCODE;                                             01315000
                I _ 0;                                                  01320000
                <<MOVE CURRENT STACK MARKER ABOVE RESULT ADDR. (Q-6)>>  01325000
                WHILE (I _ I + 1) <= 3 DO STACK(I) _ STACK(I + 2);      01330000
                STACK(I) _ DELTAQ - 2;                         <<00.03>>01335000
            PUSH(Q);                                                    01340000
            TOS_TOS-2;                                                  01345000
            SET(Q);                                                     01350000
            GETPRIVMODE;                                                01355000
            XREG_TOS;                                                   01360000
            ABORT(%400,A,0);                                            01365000
           END ELSE MYSTAT . (4:1) _ 1;                                 01370000
           RETURN 3                                                     01375000
      END;                                                              01380000
      IF = AND OVFL THEN GO TO UNDERF;                                  01385000
      MYSTAT . (4:1) _0;                                                01390000
      RETURN 3;                                                         01395000
COMMENT MULTIPLY PART *************************************************;01400000
EMPY:                                        <<MULTIPLY ENTRY>>         01405000
      ALLOCATE;                                                         01410000
      OPCODE_%20402;                                                    01415000
      XREG _ 0;                                                         01420000
      LY; TOS_TOS&TASR(0);                                              01425000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             01430000
      SU;                                                               01435000
      LZ; TOS_TOS&TASR(0);                                              01440000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             01445000
      SV;                                                               01450000
      UNPACK;                                <<UNPACK U AND V>>         01455000
      EXPU _ EXPU + EXPV;                    <<RESULT EXPON + 512>>     01460000
      TOS _ U1; TOS _ V1;                                               01465000
      XREG _ A;                                                         01470000
      ASSEMBLE(LMPY,XCH);                    <<M,0_U1*V1>>              01475000
      TOS _ U2;                                                         01480000
      ASSEMBLE(LDXA,LMPY);                   <<L,J_U2*V1>>              01485000
      TOS _ U1; TOS _ V2;                                               01490000
      XREG _ A;                                                         01495000
      ASSEMBLE(LMPY,ZERO);                   <<K,I_U1*V2,PUSH 0>>       01500000
      TOS _ U2;                                                         01505000
      ASSEMBLE(LDXA,LMPY);                   <<H,E_U2*V2>>              01510000
      TOS _ U3; TOS _ V1;                                               01515000
      ASSEMBLE(LMPY);                        <<G,D_U3*V1>>              01520000
      TOS _ U1; TOS _ V3;                                               01525000
      XREG _ A;                                                         01530000
      ASSEMBLE(LMPY,ZERO);                   <<F,C_U1*V3,PUSH 0>>       01535000
      TOS _ U2;                                                         01540000
      ASSEMBLE(LDXA,LMPY;DEL,ZERO);          <<B_U2*V3,PUSH 0>>         01545000
      TOS _ U3; TOS _ V2;                                               01550000
      ASSEMBLE(LMPY,DEL);                    <<A_U3*V2>>                01555000
      ASSEMBLE(DADD,DADD;DADD,DADD);         <<CALCULATE LOW 2 WORDS>>  01560000
      XREG _ TOS;                            <<SAVE LSW>>               01565000
      IF CARRY THEN B _ B + 1;                                          01570000
      ASSEMBLE(DADD,DADD;DADD,LDXA);         <<CALC REST GET LSW>>      01575000
      TOS _ TOS & TASR(6);                   <<LOGICAL SHIFT>>          01580000
      ASSEMBLE(CAB,ZERO;                                                01585000
               DPF 0:6;                                                 01590000
               CAB,CAB);                     <<  SIX PLACES RIGHT>>     01595000
      GO PACK;                               <<PACK RESULT>>            01600000
COMMENT DIVIDE  PART **************************************************;01605000
EDIV:                                        <<DIVIDE ENTRY>>           01610000
      ALLOCATE;                                                         01615000
      OPCODE_%20403;                                                    01620000
      XREG _ 0;                                                         01625000
      LZ; TOS_TOS&TASR(0);                                              01630000
      IF = THEN                                                         01635000
      BEGIN                                  <<DIVIDE BY ZERO ERROR>>   01640000
         LY; SX;                                                        01645000
           MYSTAT . (6:2) _2;                                           01650000
           TOS _ 10;                                                    01655000
           GO TO ERROR;                                                 01660000
      END;                                                              01665000
      SV;                                                               01670000
      LY; TOS_TOS&TASR(0);                                              01675000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             01680000
      SU;                                                               01685000
      UNPACK;                                <<UNPACK U AND V>>         01690000
      LV; TOS_TOS&TASL(9);                                              01695000
      V2V3 _ TOS;                                                       01700000
      ASSEMBLE(TSBC 0);                                                 01705000
      V1 _ TOS;                                                         01710000
      EXPU _ EXPU - EXPV + %777;             <<ADJUST EXPON FOR PACK>>  01715000
      TOS _ U1U2;                                                       01720000
      TOS _ V1;                                                         01725000
      TOS _ U3;                                                         01730000
      ASSEMBLE(STAX,LDIV;                    <<U1U2/V1>>                01735000
               XCH,XAX);                     <<R1,Q1;R1,U3>>            01740000
      TOS _ V2;                                                         01745000
      ASSEMBLE(LDXA,LMPY;DSUB);              <<R1,U3,Q1*V2 ; R1 PRIME>> 01750000
      IF NOCARRY THEN                                                   01755000
      BEGIN                                  <<NEGATIVE REMAINDER>>     01760000
           TOS _ TOS + V1V2;                                            01765000
           XREG _ XREG - 1;                    <<SO Q1 IS TOO BIG>>     01770000
      END;                                                              01775000
      TOS _ 0; TOS _ XREG;                                              01780000
      TOS _ V3;                                                         01785000
      ASSEMBLE(LMPY,DSUB;                    <<R12,0-Q1*V3>>            01790000
               CAB,LDXA);                    <<R11,Q1>>                 01795000
      U1 _ TOS;                              <<STORE Q1>>               01800000
      IF NOCARRY THEN                                                   01805000
      BEGIN                                                             01810000
           TOS _ TOS - 1;                                               01815000
           IF NOCARRY THEN                                              01820000
           BEGIN                             <<NEGATIVE REMAINDER>>     01825000
                XREG _ TOS;                                             01830000
                TOS _ TOS + V2V3;                                       01835000
                TOS _ XREG;                                             01840000
                IF CARRY THEN TOS _ TOS + 1;                            01845000
                TOS _ TOS + V1;                                         01850000
                U1 _ U1 - 1;                                            01855000
           END;                                                         01860000
      END;                                                              01865000
      ASSEMBLE(ZROX,XBX);                    <<U3,0,UL,SAVE U4 IN X>>   01870000
      TOS _ V1;                                                         01875000
      ASSEMBLE(LDIV,CAB);                    <<Q21,R2T,U3>>             01880000
      TOS _ V1;                                                         01885000
      ASSEMBLE(LDIV,LDXA;                    <<Q21,Q22,R2,U+>>          01890000
               DXCH,DDUP);                   <<R2,U4,Q21,Q22,Q21,Q22>>  01895000
      U2U3 _ TOS; TOS _ V2;                  <<SAVE Q2 IN U2,V3>>       01900000
      ASSEMBLE(LMPY,CAB);                    <<U,L,Q21>>                01905000
      TOS _ V2;                                                         01910000
      ASSEMBLE(LMPY,XCH;                     <<R2,U4,V,L,A,0>>          01915000
               DADD,DSUB);                   <<R21,R22>>                01920000
      IF NOCARRY THEN                                                   01925000
      BEGIN                                  <<NEGATIVE REMAINDER>>     01930000
Q2LOOP:    TOS _ U2U3;                                                  01935000
           ASSEMBLE(DZRO,INCA;DSUB);         <<DEC Q2>>                 01940000
           U2U3 _ TOS;                                                  01945000
           TOS _ TOS + V1V2;                 <<ADD BACK V1V2>>          01950000
           IF NOCARRY THEN GO Q2LOOP;                                   01955000
      END;                                                              01960000
      TOS _ V3;                                                         01965000
      ASSEMBLE(STAX,ZERO);                                              01970000
      TOS _ U2U3;                                                       01975000
      ASSEMBLE(LDXA,LMPY;                    <<Q22*V3>>                 01980000
               CAB,LDXA;                     <<Q21*V3>>                 01985000
               LMPY,XCH;                                                01990000
               DADD,DSUB);                   <<R22,0-Q2*V3>>            01995000
      ASSEMBLE(CAB,STAX);                                               02000000
      IF NOCARRY THEN                                                   02005000
      BEGIN                                                             02010000
           XREG _ XREG - 1;                                             02015000
           IF NOCARRY THEN                                              02020000
           BEGIN                             <<NEGATIVE REMAINDER>>     02025000
                TOS _ V2V3; TOS _ V1;                                   02030000
                ASSEMBLE(ADAX,DADD);                                    02035000
                IF CARRY THEN XREG _ XREG + 1;                          02040000
                U3 _ U3 - 1;                                            02045000
           END;                                                         02050000
      END;                                   <<NOW HAVE U4,U5,X=U3>>    02055000
      ASSEMBLE(LDXA,CAB;CAB);                                           02060000
      TOS _ TOS & TASR(1);                   <<DIVIDE U3,U+,U5 BY 2>>   02065000
      ASSEMBLE(STAX,XCH);                                               02070000
      ASSEMBLE(TRBC 0);                                                 02075000
      ASSEMBLE(XCH);                                                    02080000
      TOS _ V1;                                                         02085000
      ASSEMBLE(LDIV,LDXA;                    <<Q3,R3,U5>>               02090000
               CAB,STAX);                    <<R3,U5,X=Q3>>             02095000
      TOS _ V2;                                                         02100000
      ASSEMBLE(LDXA,LMPY;DSUB);              <<R3,U5-Q3*V2>>            02105000
      IF NOCARRY THEN XREG _ XREG - 1;       <<Q3 TOO BIG>>             02110000
      TOS _ U1; TOS _ U3;                    <<LOAD Q1 AND Q2>>         02115000
      TOS _ XREG & LSL(1);                   <<Q1,Q2,Q3>>               02120000
      GO PACK;                                                          02125000
END <<EMATH>>;                                                          02130000
$PAGE                                                                   02135000
<<......................................................................02140000
.                                                                      .02145000
.                             ECMP                                     .02150000
.                                                                      .02155000
......................................................................>>02160000
PROCEDURE ECMP;                                                         02165000
OPTION PRIVILEGED,UNCALLABLE;                                           02170000
BEGIN                                                                   02175000
COMMENT PERFORMS DOUBLE PRECISION COMPARE, SETS CC=CCA;                 02180000
      INTEGER STATUS=Q-1,A=S-0;                                         02185000
      INTEGER POINTER U=Q-5,V=Q-4;           <<COMPARE  U:V>>           02190000
      DOUBLE POINTER DU=Q-5,DV=Q-4;                                     02195000
      INTEGER DELTAQ = Q-0;                                             02200000
      PUSH(Q);                                                          02205000
      TOS _ TOS - DELTAQ;                                               02210000
      SET(Q);                                <<BACKUP ONE MARKER>>      02215000
     IF STATUS > 0 THEN                      <<USER MODE CALL>>         02220000
     BEGIN                                                              02225000
          PUSH(STATUS);                                                 02230000
          ASSEMBLE(TRBC 0);                  <<RESET PRIV.   >>         02235000
          SET(STATUS);                                                  02240000
     END;                                                               02245000
      TOS _ U;                               <<LOAD MOST SIG. WORDS>>   02250000
      ASSEMBLE(DUP,STAX);                    <<SAVE MSW IN X>>          02255000
      TOS _ V;                                                          02260000
      ASSEMBLE(DDUP,XOR;DEL);                                           02265000
      IF < THEN                                                         02270000
      BEGIN                                  <<DIFFERENT SIGNS>>        02275000
           ASSEMBLE(DEL,TEST);               <<CHECK MSW(U)>>           02280000
           IF = THEN TOS _ TOS + 1;          <<CCG IF MSW(U)=0>>        02285000
      END <<DIFF. SIGNS>>                                               02290000
      ELSE                                                              02295000
      BEGIN                                  <<SAME SIGN>>              02300000
           @U _ @U + 1; @V _ @V + 1;         <<POINT TO LEAST SIG PART>>02305000
           TOS _ DU; TOS _ DV;               <<LOAD LOW 2 WORDS>>       02310000
           ASSEMBLE(DSUB,DXCH);              <<MSW(U AND V) ON TOP>>    02315000
           IF NOCARRY THEN TOS _ TOS + 1;                               02320000
           TOS _ TOS - TOS;                  <<FINISH THE 3-WORD SUB>>  02325000
           IF = THEN                                                    02330000
           BEGIN                             <<MSW(U-V)=0. CHECK REST>> 02335000
                TOS _ TOS & TASR(0);         <<SET 3-WORD CCA>>         02340000
                IF <> THEN TOS_TOS+1;        <<ANSWER REALLY > 0>>      02345000
           END;                                                         02350000
           ASSEMBLE(LDXA,DEL);               <<CHECK SIGN OF ARGS>>     02355000
           IF < THEN                         <<REVERSE U AND V>>        02360000
           BEGIN                                                        02365000
                TOS _ NOT TOS;                                          02370000
                IF <= THEN TOS _ TOS + 1;    <<CCE NOT VALID HERE>>     02375000
           END;                                                         02380000
           ASSEMBLE(TEST);                                              02385000
      END; <<SAME SIGN>>                                                02390000
      PUSH(STATUS);                                                     02395000
      TOS _ STATUS; ASSEMBLE(XCH);                                      02400000
      TOS . (6:2) _ TOS . (6:2);                                        02405000
      STATUS _ TOS;                                                     02410000
      RETURN 2;                                                         02415000
END <<ECMP>>;                                                           02420000
$PAGE                                                                   02425000
<<......................................................................02430000
.                                                                      .02435000
.                             ENEG                                     .02440000
.                                                                      .02445000
......................................................................>>02450000
PROCEDURE ENEG;                                                         02455000
OPTION PRIVILEGED,UNCALLABLE;                                           02460000
BEGIN                                                                   02465000
COMMENT PERFORMS DOUBLE PRECISION NEGATE;                               02470000
      INTEGER POINTER I=Q-4;                 <<FIRST WORD OF ARG>>      02475000
      DOUBLE POINTER D=Q-4;                  <<2ND AND 3RD WORDS>>      02480000
      INTEGER STATUS=Q-1,A=S-0;                                         02485000
      INTEGER DELTAQ = Q-0;                                             02490000
      PUSH(Q);                                                          02495000
      TOS _ TOS - DELTAQ;                                               02500000
      SET(Q);                                <<BACKUP ONE MARKER>>      02505000
      TOS _ STATUS;                                                     02510000
     IF > THEN                               <<USER MODE CALL>>         02515000
     BEGIN                                                              02520000
          PUSH(STATUS);                                                 02525000
          ASSEMBLE(TRBC 0);                  <<RESET PRIV.   >>         02530000
          SET(STATUS);                                                  02535000
     END;                                                               02540000
      TOS _ I;                                                          02545000
      @D _ @D+1;                                                        02550000
      TOS _ D;                                                          02555000
      @D _ @D-1;                                                        02560000
      ASSEMBLE(OR,FNEG;DEL);                 <<FIX MSW,DELETE REST>>    02565000
      I _ TOS;                                                          02570000
      PUSH(STATUS);                                                     02575000
      TOS . (6:2) _ TOS . (6:2);                                        02580000
      STATUS _ TOS;                                                     02585000
      RETURN 1;                                                         02590000
END <<ENEG>>;                                                           02595000
PROCEDURE QASL; OPTION PRIVILEGED,UNCALLABLE;                           02600000
     BEGIN                                                              02605000
       INTEGER                                                          02610000
         XREG      = X,                                                 02615000
         D         = Q-7,                                               02620000
         C         = Q-6,                                               02625000
         B         = Q-5,                                               02630000
         A         = Q-4,                                               02635000
         PARAM     = Q-4,                                               02640000
         MYSTAT    = Q-1,                                               02645000
         DELTAQ    = Q-0;                                               02650000
       DOUBLE                                                           02655000
         DD        = D,                                                 02660000
         DB        = B;                                                 02665000
         XREG_PARAM.(10:6);                                             02670000
         PUSH(Q);                                                       02675000
         TOS_TOS-DELTAQ;                                                02680000
         SET(Q);                                                        02685000
         TOS_MYSTAT;                                                    02690000
         IF > THEN                                                      02695000
          BEGIN                                                         02700000
           PUSH(STATUS);                                                02705000
           TOS.(0:1)_0;                                                 02710000
           SET(STATUS);                                                 02715000
          END;                                                          02720000
         TOS_DD;                                                        02725000
         TOS_0;                                                         02730000
         IF XREG > 15 THEN                                              02735000
          BEGIN                                                         02740000
           TOS_TOS&TASL(16);                                            02745000
           DDEL;                                                        02750000
           TOS_DB;                                                      02755000
           XREG_XREG-16;                                                02760000
           ASSEMBLE(TASL 0,X);                                          02765000
           TOS_0;                                                       02770000
           DB_TOS;                                                      02775000
          END                                                           02780000
         ELSE                                                           02785000
          BEGIN                                                         02790000
           ASSEMBLE(TASL 0,X);                                          02795000
           TOS_DB;                                                      02800000
           ASSEMBLE(TASL 0,X);                                          02805000
           ASSEMBLE(DXCH,OR;CAB,CAB);                                   02810000
           ASSEMBLE(DDUP);                                              02815000
           DB_TOS;                                                      02820000
           ASSEMBLE(OR;TASL 0;DEL);                                     02825000
          END;                                                          02830000
         DD_TOS;                                                        02835000
         PUSH(STATUS);                                                  02840000
         TOS.(6:2)_TOS.(6:2);                                           02845000
         MYSTAT_TOS;                                                    02850000
     END << QASL >>;                                                    02855000
PROCEDURE QASR; OPTION PRIVILEGED,UNCALLABLE;                           02860000
     BEGIN                                                              02865000
       INTEGER                                                          02870000
         XREG      = X,                                                 02875000
         D         = Q-7,                                               02880000
         C         = Q-6,                                               02885000
         B         = Q-5,                                               02890000
         A         = Q-4,                                               02895000
         PARAM     = Q-4,                                               02900000
         MYSTAT    = Q-1,                                               02905000
         DELTAQ    = Q-0;                                               02910000
       DOUBLE                                                           02915000
         DD        = D,                                                 02920000
         DB        = B;                                                 02925000
         XREG_PARAM.(10:6);                                             02930000
         PUSH(Q);                                                       02935000
         TOS_TOS-DELTAQ;                                                02940000
         SET(Q);                                                        02945000
         TOS_MYSTAT;                                                    02950000
         IF > THEN                                                      02955000
          BEGIN                                                         02960000
           PUSH(STATUS);                                                02965000
           TOS.(0:1)_0;                                                 02970000
           SET(STATUS);                                                 02975000
          END;                                                          02980000
          TOS_DD;                                                       02985000
         TOS_0;                                                         02990000
         IF XREG > 15 THEN                                              02995000
          BEGIN                                                         03000000
           TOS_TOS&TASR(16);                                            03005000
           TOS_B;                                                       03010000
           XREG_XREG-16;                                                03015000
           ASSEMBLE(TASR 0,X);                                          03020000
           DB_TOS;                                                      03025000
          END                                                           03030000
         ELSE                                                           03035000
          BEGIN                                                         03040000
           ASSEMBLE(TASR 0,X);                                          03045000
           TOS_DB;                                                      03050000
           ASSEMBLE(DLSR 0,X);                                          03055000
           ASSEMBLE(CAB,CAB;OR,XCH);                                    03060000
           ASSEMBLE(DDUP);                                              03065000
           DB_TOS;                                                      03070000
           ASSEMBLE(OR;TASL 0;DEL);                                     03075000
          END;                                                          03080000
         DD_TOS;                                                        03085000
         PUSH(STATUS);                                                  03090000
         TOS.(6:2)_TOS.(6:2);                                           03095000
         MYSTAT_TOS;                                                    03100000
     END << QASR >>;                                                    03105000
PROCEDURE DIMPY; OPTION PRIVILEGED,UNCALLABLE;                          03110000
     BEGIN                                                              03115000
       INTEGER                                                          03120000
         X         = X,                                                 03125000
         U1        = Q-7,                                               03130000
         U2        = Q-6,                                               03135000
         V1        = Q-5,                                               03140000
         V2        = Q-4,                                               03145000
         MYSTAT    = Q-1,                                               03150000
         DELTAQ    = Q-0;                                               03155000
       DOUBLE                                                           03160000
         DRES      = U1,                                                03165000
         U         = U1,                                                03170000
         REM       = V1,                                                03175000
         V         = V1;                                                03180000
       LOGICAL                                                          03185000
         SIGN      = Q+1,                                               03190000
         DENSIGN   = Q+2,                                               03195000
         OVFLOW    = Q+3,                                               03200000
         UOVFL     = Q+4,                                               03205000
         VOVFL     = Q+5,                                               03210000
         DIV       = Q+6;                                               03215000
       INTEGER                                                          03220000
       A         = S-0,                                                 03225000
         I         = SIGN,                                              03230000
         J         = DENSIGN,                                           03235000
         IDIV      = DIV;                                               03240000
       ARRAY                                                            03245000
         STACK(*)  = Q-6;                                               03250000
       ENTRY                                                            03255000
         DIDIV;                                                         03260000
         TOS_0;                                                         03265000
         GO MUL;                                                        03270000
DIDIV  :                                                                03275000
         TOS_1;                                                         03280000
MUL    :                                                                03285000
         X_TOS;                                                         03290000
        ASSEMBLE(PSDB);                                        <<01.03>>03295000
         PUSH(Q);                                                       03300000
         TOS_TOS_TOS-DELTAQ;                                            03305000
         SET(Q,S);                                                      03310000
        ASSEMBLE(PSEB);                                        <<01.03>>03315000
         TOS_0D;                                                        03320000
         TOS_0D;                                                        03325000
         TOS_0;                                                         03330000
         TOS_X;                                                         03335000
         TOS_MYSTAT;                                                    03340000
         IF > THEN                                                      03345000
          BEGIN                                                         03350000
           PUSH(STATUS);                                                03355000
           TOS.(0:1)_0;                                                 03360000
           SET(STATUS);                                                 03365000
          END;                                                          03370000
         TOS_U;                                                         03375000
         IF < THEN                                                      03380000
          BEGIN                                                         03385000
           ASSEMBLE(DNEG,DDUP);                                         03390000
           IF OVERFLOW THEN UOVFL_UOVFL+1;                              03395000
           U_TOS;                                                       03400000
           I_I+1;                                                       03405000
           J_J+1;                                                       03410000
          END;                                                          03415000
         TOS_V;                                                         03420000
         IF < THEN                                                      03425000
          BEGIN                                                         03430000
           ASSEMBLE(DNEG);                                              03435000
           IF OVERFLOW THEN VOVFL_VOVFL+1;                              03440000
           I_I+1;                                                       03445000
           V_TOS;                                                       03450000
          END ELSE DDEL;                                                03455000
DIVIDE : IF DIV THEN BEGIN                                              03460000
           IF VOVFL THEN BEGIN DDEL;                                    03465000
            IF UOVFL THEN BEGIN TOS_0D; TOS_TOS+1; TOS_0D; END ELSE     03470000
             BEGIN TOS_0D; TOS_U; IF DENSIGN THEN ASSEMBLE(DNEG) END;   03475000
            REM_TOS; GO RSLT;                                           03480000
           END ELSE IF UOVFL AND V=1D THEN BEGIN IF NOT SIGN            03485000
           THEN OVFLOW_TRUE; REM_0D; GO RSLT END; TOS_V;                03490000
           IF = THEN BEGIN TOS_4; GO DIVZERO END;                       03495000
           ASSEMBLE(DCMP);                                              03500000
           IF <= AND NOT UOVFL THEN                                     03505000
            BEGIN                                                       03510000
             TOS_0D;                                                    03515000
             IF U=V THEN                                                03520000
              BEGIN TOS_TOS+1; TOS_0D END                               03525000
             ELSE                                                       03530000
              TOS_U;                                                    03535000
            END                                                         03540000
           ELSE                                                         03545000
            BEGIN                                                       03550000
             IF V1 = 0 THEN                                             03555000
              BEGIN                                                     03560000
               TOS_U;                                                   03565000
               ASSEMBLE(ZERO,CAB);                                      03570000
               TOS_V2;                                                  03575000
               ASSEMBLE(LDIV,CAB);                                      03580000
               TOS_V2;                                                  03585000
               ASSEMBLE(LDIV,ZERO;XCH);                                 03590000
              END                                                       03595000
             ELSE                                                       03600000
              BEGIN                                                     03605000
               TOS_0;                                                   03610000
               TOS_U1;                                                  03615000
               TOS_V1;                                                  03620000
               ASSEMBLE(LDIV,STBX);                                     03625000
               TOS_U2;                                                  03630000
               ASSEMBLE(CAB);                                           03635000
               TOS_V2;                                                  03640000
               ASSEMBLE(LMPY,DSUB);                                     03645000
               WHILE NOCARRY DO                                         03650000
                BEGIN                                                   03655000
                 X_X-1;                                                 03660000
                 TOS_TOS+V;                                             03665000
                END;                                                    03670000
               ASSEMBLE(ZERO,LDXA;DXCH);                                03675000
              END;                                                      03680000
           END;                                                         03685000
           IF DENSIGN THEN ASSEMBLE(DNEG);                              03690000
           REM_TOS;                                                     03695000
           GO STORE;                                                    03700000
          END;                                                          03705000
MULTIPLY:                                                               03710000
         IF UOVFL THEN BEGIN DDEL; IF V=0D THEN TOS_0D ELSE             03715000
          IF V=1D THEN TOS_U ELSE GO OVFL; GO RSLT END                  03720000
         ELSE IF VOVFL THEN BEGIN DDEL; IF U=0D THEN TOS_0D ELSE        03725000
          IF U=1D THEN TOS_V ELSE GO OVFL; GO RSLT END;                 03730000
         TOS_V2;                                                        03735000
         ASSEMBLE(DUP,CAB;LMPY,XCH;DXCH,LMPY);                          03740000
         TOS_V1; TOS_U2;                                                03745000
         ASSEMBLE(LMPY,DADD;CAB,ZERO;XCH,DADD;ZERO,CAB);                03750000
         TOS_U1;                                                        03755000
         TOS_V1;                                                        03760000
         ASSEMBLE(LMPY,DADD);                                           03765000
         IF TOS <> 0D THEN OVFLOW_TRUE;                                 03770000
         ASSEMBLE(XCH);                                                 03775000
STORE  :                                                                03780000
         ASSEMBLE(DTST);                                                03785000
         IF < THEN OVFLOW_TRUE;                                         03790000
         IF SIGN THEN ASSEMBLE(DNEG);                                   03795000
RSLT   :                                                                03800000
         ASSEMBLE(DTST);                                                03805000
         DRES_TOS;                                                      03810000
         PUSH(STATUS);                                                  03815000
         TOS.(6:2)_TOS.(6:2);                                           03820000
         TOS.(4:1)_0;                                                   03825000
         MYSTAT_TOS;                                                    03830000
         IF NOT OVFLOW THEN GO OUT;                                     03835000
OVFL   :                                                                03840000
         TOS_1;                                                         03845000
DIVZERO:                                                                03850000
         IF LOGICAL(MYSTAT.(2:1)) THEN                                  03855000
          BEGIN                                                         03860000
           IF DIV THEN TOS_%20571 ELSE                                  03865000
            BEGIN                                                       03870000
             TOS_%20570;                                                03875000
             I_0;                                                       03880000
             WHILE (I_I+1)<=3 DO STACK(I)_STACK(I+2);                   03885000
             STACK(I)_DELTAQ-2;                                         03890000
             PUSH(Q);                                                   03895000
             TOS_TOS-2;                                                 03900000
             SET(Q);                                                    03905000
            END;                                                        03910000
           GETPRIVMODE;                                                 03915000
           X_TOS;                                                       03920000
           ABORT(%400,A,0);                                             03925000
          END ELSE MYSTAT.(4:1)_1;                                      03930000
OUT    :                                                                03935000
         IF DIV THEN RETURN ELSE RETURN 2;                              03940000
     END;                                                               03945000
PROCEDURE QNEG; OPTION PRIVILEGED,UNCALLABLE;                           03950000
     BEGIN                                                              03955000
       INTEGER POINTER                                                  03960000
         U         = Q-4;                                               03965000
       DOUBLE POINTER                                                   03970000
         RU        = U;                                                 03975000
       INTEGER                                                          03980000
         MYSTAT    = Q-1,                                               03985000
         DELTAQ    = Q-0;                                               03990000
         PUSH(Q);                                                       03995000
         TOS_TOS-DELTAQ;                                                04000000
         SET(Q);                                                        04005000
         TOS_MYSTAT;                                                    04010000
         IF > THEN                                                      04015000
          BEGIN                                                         04020000
           PUSH(STATUS);                                                04025000
           TOS.(0:1)_0;                                                 04030000
           SET(STATUS);                                                 04035000
          END;                                                          04040000
         TOS_RU;                                                        04045000
         TOS_RU(1);                                                     04050000
         ASSEMBLE(OR,OR;FNEG,DEL);                                      04055000
         U_TOS;                                                         04060000
         PUSH(STATUS);                                                  04065000
         TOS.(6:2)_TOS.(6:2);                                           04070000
         MYSTAT_TOS;                                                    04075000
         RETURN 1;                                                      04080000
     END << QNEG >>;                                                    04085000
PROCEDURE QCMP; OPTION PRIVILEGED,UNCALLABLE;                           04090000
     BEGIN                                                              04095000
       INTEGER POINTER                                                  04100000
         U         = Q-5,                                               04105000
         V         = Q-4;                                               04110000
       DOUBLE POINTER                                                   04115000
         A         = S-0,                                               04120000
         B         = S-1;                                               04125000
       INTEGER                                                          04130000
         MYSTAT    = Q-1,                                               04135000
         DELTAQ    = Q-0;                                               04140000
       REAL POINTER                                                     04145000
         RU        = U,                                                 04150000
         RV        = V;                                                 04155000
         PUSH(Q);                                                       04160000
         TOS_TOS-DELTAQ;                                                04165000
         SET(Q);                                                        04170000
         TOS_MYSTAT;                                                    04175000
         IF > THEN                                                      04180000
          BEGIN                                                         04185000
           PUSH(STATUS);                                                04190000
           TOS.(0:1)_0;                                                 04195000
           SET(STATUS);                                                 04200000
          END;                                                          04205000
         IF RU = RV THEN                                                04210000
          BEGIN                                                         04215000
           ASSEMBLE(LDD U);                                             04220000
           IF U < 0 THEN ASSEMBLE(XCH);                                 04225000
           TOS_B(1)-A(1);                                               04230000
           IF <> THEN                                                   04235000
            BEGIN                                                       04240000
             IF NOCARRY THEN TOS_-1 ELSE TOS_1;                         04245000
             DEL                                                        04250000
            END;                                                        04255000
           DDEL; DDEL;                                                  04260000
          END;                                                          04265000
         PUSH(STATUS);                                                  04270000
         TOS.(6:2)_TOS.(6:2);                                           04275000
         MYSTAT_TOS;                                                    04280000
         RETURN 2;                                                      04285000
     END << QCMP >>;                                                    04290000
PROCEDURE QMATH; OPTION PRIVILEGED,UNCALLABLE;                          04295000
     BEGIN                                                              04300000
       INTEGER                                                          04305000
         U1        = Q+1,                                               04310000
         U2        = Q+2,                                               04315000
         U3        = Q+3,                                               04320000
         U4        = Q+4,                                               04325000
         V1        = Q+5,                                               04330000
         V2        = Q+6,                                               04335000
         V3        = Q+7,                                               04340000
         V4        = Q+8,                                               04345000
         TOSA      = Q+9,                                               04350000
         EXPU      = Q+10,                                              04355000
         EXPV      = Q+11,                                              04360000
         ESAVE     = Q+12,                                              04365000
         XSAVE     = Q+18,                                              04370000
         OPCODE    = Q+19,                                              04375000
         XREG      = X,                                                 04380000
         DELTAQ    = Q-0,                                               04385000
         MYSTAT    = Q-1,                                               04390000
         A         = S-0,                                               04395000
         B         = S-1,                                               04400000
         C         = S-2,                                               04405000
         S4        = S-4,                                               04410000
         S5        = S-5,                                               04415000
         S9        = S-9,                                               04420000
         S10       = S-10;                                              04425000
       DOUBLE                                                           04430000
         V1V2      = V1,                                                04435000
         V2V3      = V2,                                                04440000
         V3V4      = V3,                                                04445000
         U1U2      = U1,                                                04450000
         U2U3      = U2,                                                04455000
         U3U4      = U3,                                                04460000
         DSAVE     = Q+13;                                              04465000
       ARRAY                                                            04470000
         STACK(*)  = Q-6;                                               04475000
       EQUATE                                                           04480000
         PARAMETERS= 19;                                                04485000
       LOGICAL                                                          04490000
         SIGN      = Q+15,                                              04495000
         DIFSIGN   = Q+16,                                              04500000
         OVFL      = Q+17;                                              04505000
       DOUBLE POINTER                                                   04510000
         X         = Q-6,                                               04515000
         Y         = Q-5,                                               04520000
         Z         = Q-4;                                               04525000
       REAL POINTER                                                     04530000
         RX        = Q-6,                                               04535000
         RY        = Q-5,                                               04540000
         RZ        = Q-4;                                               04545000
       DEFINE                                                           04550000
         QTST      = ASSEMBLE(LDD S-3;LDD S-3); QTSTDEL#,               04555000
         QTSTEQUAL = ASSEMBLE(LDD S-3;OR;TASL 0;DEL)#,                  04560000
         QTSTDEL   = ASSEMBLE(OR;TASL 0;DEL,DDEL)#;                     04565000
       ENTRY                                                            04570000
         QADD,                                                          04575000
         QSUB,                                                          04580000
         QMPY,                                                          04585000
         QDIV;                                                          04590000
SUBROUTINE QASL;                                                        04595000
     BEGIN                                                              04600000
         ESAVE_TOS;                                                     04605000
         TOSA_TOS;                                                      04610000
         ASSEMBLE(TASL 0,X);                                            04615000
         TOS_0;                                                         04620000
         TOS_TOSA;                                                      04625000
         ASSEMBLE(DLSL 0,X);                                            04630000
         ASSEMBLE(CAB,CAB;OR,XCH);                                      04635000
         TOS_ESAVE;                                                     04640000
     END << QASL >>;                                                    04645000
SUBROUTINE QASR;                                                        04650000
     BEGIN                                                              04655000
         ESAVE_TOS;                                                     04660000
         ASSEMBLE(DLSR 0,X);                                            04665000
         DSAVE_TOS;                                                     04670000
         TOS_0;                                                         04675000
         ASSEMBLE(TASR 0,X);                                            04680000
         TOS_DSAVE;                                                     04685000
         ASSEMBLE(CAB,CAB;OR,XCH);                                      04690000
         TOS_ESAVE;                                                     04695000
     END << QASR >>;                                                    04700000
SUBROUTINE ALLOCATE;                                                    04705000
     BEGIN                                                              04710000
         XREG_TOS;                                                      04715000
         PUSH(Q);                                                       04720000
         TOS_TOS_TOS-DELTAQ;                                            04725000
         SET(Q);                                                        04730000
         TOS_TOS+PARAMETERS;                                            04735000
         SET(S);                                                        04740000
         OVFL_0; XSAVE_0;                                               04745000
         IF MYSTAT > 0 THEN                                             04750000
          BEGIN                                                         04755000
           PUSH(STATUS);                                                04760000
           TOS.(0:1)_0;                                                 04765000
           SET(STATUS);                                                 04770000
          END;                                                          04775000
         TOS_XREG;                                                      04780000
     END << ALLOCATE >>;                                                04785000
SUBROUTINE UNPACK;                                                      04790000
     BEGIN                                                              04795000
         TOS_S4;                                                        04800000
         TOS_S9;                                                        04805000
         ASSEMBLE(DDUP,DDUP;XOR);                                       04810000
         TOS_TOS.(0:1);                                                 04815000
         DIFSIGN_TOS;                                                   04820000
         EXPU_TOS.(1:9);                                                04825000
         EXPV_TOS.(1:9);                                                04830000
         TOS.(9:1)_1;                                                   04835000
         S10_TOS.(9:7);                                                 04840000
         TOS.(9:1)_1;                                                   04845000
         S5_TOS.(9:7);                                                  04850000
     END << UNPACK >>;                                                  04855000
QMPY   :                                                                04860000
         ALLOCATE;                                                      04865000
         OPCODE_%20413;                                                 04870000
         TOS_Y;                                                         04875000
         TOS_Y(1);                                                      04880000
         QTST;                                                          04885000
         IF = THEN GO CCA;                                              04890000
         TOS_Z;                                                         04895000
         TOS_Z(1);                                                      04900000
         QTST;                                                          04905000
         IF = THEN GO CCA;                                              04910000
         UNPACK;                                                        04915000
         V3V4_TOS;                                                      04920000
         V1V2_TOS;                                                      04925000
         U3U4_TOS;                                                      04930000
         U1U2_TOS;                                                      04935000
         EXPU_EXPU+EXPV;                                                04940000
         TOS_U1;                                                        04945000
         XREG_TOS_V1;                                                   04950000
         ASSEMBLE(LMPY,ZERO);                                           04955000
         TOS_U2;                                                        04960000
         ASSEMBLE(LDXA,LMPY);                                           04965000
         TOS_U1;                                                        04970000
         XREG_TOS_V2;                                                   04975000
         ASSEMBLE(LMPY,ZERO);                                           04980000
         TOS_U2;                                                        04985000
         ASSEMBLE(LDXA,LMPY);                                           04990000
         TOS_U3;                                                        04995000
         TOS_V1;                                                        05000000
         ASSEMBLE(LMPY);                                                05005000
         TOS_U1;                                                        05010000
         XREG_TOS_V3;                                                   05015000
         ASSEMBLE(LMPY,ZERO);                                           05020000
         TOS_U2;                                                        05025000
         ASSEMBLE(LDXA,LMPY);                                           05030000
         TOS_U3;                                                        05035000
         TOS_V2;                                                        05040000
         ASSEMBLE(LMPY);                                                05045000
         TOS_U4;                                                        05050000
         TOS_V1;                                                        05055000
         ASSEMBLE(LMPY);                                                05060000
         TOS_U1;                                                        05065000
         XREG_TOS_V4;                                                   05070000
         ASSEMBLE(LMPY,ZERO);                                           05075000
         TOS_U2;                                                        05080000
         ASSEMBLE(LDXA,LMPY);                                           05085000
         TOS_U3;                                                        05090000
         TOS_V3;                                                        05095000
         ASSEMBLE(LMPY);                                                05100000
         TOS_U4;                                                        05105000
         TOS_V2;                                                        05110000
         ASSEMBLE(LMPY,DADD);                                           05115000
         IF CARRY THEN S4_S4+1;                                         05120000
         ASSEMBLE(DADD);                                                05125000
         IF CARRY THEN C_C+1;                                           05130000
         ASSEMBLE(DEL,DADD;DADD,DADD);                                  05135000
         IF CARRY THEN S4_S4+1;                                         05140000
         ASSEMBLE(DADD);                                                05145000
         IF CARRY THEN C_C+1;                                           05150000
         U4_TOS;                                                        05155000
         ASSEMBLE(DADD,DADD;DADD);                                      05160000
         IF CARRY THEN C_C+1;                                           05165000
         U3_TOS;                                                        05170000
         ASSEMBLE(DADD,DADD;DADD);                                      05175000
         TOS_U3U4;                                                      05180000
         XREG_4;                                                        05185000
         QASR;                                                          05190000
         GO PACK;                                                       05195000
QDIV   :                                                                05200000
         ALLOCATE;                                                      05205000
         OPCODE_%20412;                                                 05210000
         TOS_Y;                                                         05215000
         TOS_Y(1);                                                      05220000
         QTSTEQUAL;                                                     05225000
         IF = THEN GO CCA;                                              05230000
         TOS_Z;                                                         05235000
         TOS_Z(XREG);                                                   05240000
         QTSTEQUAL;                                                     05245000
         IF = THEN                                                      05250000
          BEGIN                                                         05255000
           ASSEMBLE(DDEL,DDEL);                                         05260000
           QTST;                                                        05265000
           PUSH(STATUS);                                                05270000
           TOS_TOS.(6:2);                                               05275000
           TOS_MYSTAT;                                                  05280000
           ASSEMBLE(XCH);                                               05285000
           TOS.(6:2)_TOS;                                               05290000
           MYSTAT_TOS;                                                  05295000
           X(XREG)_TOS; X_TOS;                                          05300000
           TOS_10;                                                      05305000
           GO ERROR;                                                    05310000
          END;                                                          05315000
         UNPACK;                                                        05320000
         XREG_9;                                                        05325000
         QASL;                                                          05330000
         V3V4_TOS;                                                      05335000
         V2_TOS;                                                        05340000
         TOS.(0:1)_1;                                                   05345000
         V1_TOS;                                                        05350000
         EXPU_EXPU-EXPV+%777;                                           05355000
         XREG_8;                                                        05360000
         QASL;                                                          05365000
         U3U4_TOS;                                                      05370000
         U1U2_TOS;                                                      05375000
         TOS_U1U2;                                                      05380000
         TOS_V1;                                                        05385000
         ASSEMBLE(LDIV,XCH);                                            05390000
         XREG_U3;                                                       05395000
         ASSEMBLE(XAX,LDXA);                                            05400000
         TOS_V2;                                                        05405000
         ASSEMBLE(LMPY,DSUB);                                           05410000
         WHILE NOCARRY DO                                               05415000
          BEGIN                                                         05420000
           XREG_XREG-1;                                                 05425000
           TOS_TOS+V1V2;                                                05430000
          END;                                                          05435000
         TOS_U4;                                                        05440000
         TOS_V3;                                                        05445000
         ASSEMBLE(LDXA,LMPY;DSUB);                                      05450000
         IF NOCARRY THEN                                                05455000
          BEGIN                                                         05460000
           C_C-1;                                                       05465000
           IF NOCARRY THEN                                              05470000
            BEGIN                                                       05475000
             TOS_TOS+V2V3;                                              05480000
             ASSEMBLE(CAB);                                             05485000
             IF CARRY THEN TOS_TOS+1;                                   05490000
             TOS_TOS+V1;                                                05495000
             XREG_XREG-1;                                               05500000
             ASSEMBLE(CAB,CAB);                                         05505000
            END;                                                        05510000
          END;                                                          05515000
         TOS_0;                                                         05520000
         TOS_V4;                                                        05525000
         ASSEMBLE(LDXA,LMPY;DSUB);                                      05530000
         IF NOCARRY THEN                                                05535000
          BEGIN                                                         05540000
           ASSEMBLE(DXCH);                                              05545000
           TOS_TOS-1D;                                                  05550000
           IF NOCARRY THEN                                              05555000
            BEGIN                                                       05560000
             ASSEMBLE(DXCH);                                            05565000
             TOS_TOS+V3V4;                                              05570000
             ASSEMBLE(DXCH);                                            05575000
             IF CARRY THEN TOS_TOS+1D;                                  05580000
             TOS_TOS+V1V2;                                              05585000
             XREG_XREG-1;                                               05590000
            END;                                                        05595000
           ASSEMBLE(DXCH);                                              05600000
          END;                                                          05605000
         ASSEMBLE(LDXA);                                                05610000
         U1_TOS;                                                        05615000
         ASSEMBLE(DXCH);                                                05620000
         TOS_V1;                                                        05625000
         OVFL_0;                                                        05630000
         ASSEMBLE(LDIV,XCH;STAX,CAB);                                   05635000
         IF OVERFLOW THEN OVFL_1;                                       05640000
         TOS_V2;                                                        05645000
         IF OVFL THEN ASSEMBLE(DUP,LDXA;LMPY,DELB) ELSE                 05650000
         ASSEMBLE(LDXA,LMPY);                                           05655000
         ASSEMBLE(DSUB);                                                05660000
         WHILE NOCARRY DO                                               05665000
          BEGIN                                                         05670000
           XREG_XREG-1;                                                 05675000
           IF NOCARRY THEN OVFL_0;                                      05680000
           TOS_TOS+V1V2;                                                05685000
          END;                                                          05690000
         ASSEMBLE(CAB);                                                 05695000
         TOS_V3;                                                        05700000
         IF OVFL THEN ASSEMBLE(DUP,LDXA;LMPY,DELB) ELSE                 05705000
         ASSEMBLE(LDXA,LMPY);                                           05710000
         ASSEMBLE(DSUB);                                                05715000
         IF NOCARRY THEN                                                05720000
          BEGIN                                                         05725000
           C_C-1;                                                       05730000
           IF NOCARRY THEN                                              05735000
            BEGIN                                                       05740000
             TOS_TOS+V2V3;                                              05745000
             ASSEMBLE(CAB);                                             05750000
             IF CARRY THEN TOS_TOS+1;                                   05755000
             TOS_TOS+V1;                                                05760000
             XREG_XREG-1;                                               05765000
             ASSEMBLE(CAB,CAB);                                         05770000
             IF NOCARRY THEN OVFL_0;                                    05775000
            END;                                                        05780000
          END;                                                          05785000
         IF OVFL THEN BEGIN OVFL_0; U1_U1+1 END;                        05790000
         ASSEMBLE(LDXA);                                                05795000
         U2_TOS;                                                        05800000
         XREG_V1;                                                       05805000
         ASSEMBLE(XAX,LDIV;XCH,XAX);                                    05810000
         IF OVERFLOW THEN OVFL_1;                                       05815000
         TOS_V2;                                                        05820000
         IF OVFL THEN ASSEMBLE(DUP,LDXA;LMPY,DELB) ELSE                 05825000
         ASSEMBLE(LDXA,LMPY);                                           05830000
         ASSEMBLE(DSUB);                                                05835000
         WHILE NOCARRY DO                                               05840000
          BEGIN                                                         05845000
           XREG_XREG-1;                                                 05850000
           IF NOCARRY THEN OVFL_0;                                      05855000
           TOS_TOS+V1V2;                                                05860000
          END;                                                          05865000
         IF OVFL THEN BEGIN OVFL_0; U1U2_U1U2+1D END;                   05870000
         ASSEMBLE(LDXA);                                                05875000
         U3_TOS;                                                        05880000
         TOS_V1;                                                        05885000
         ASSEMBLE(LDIV,DEL);                                            05890000
         IF OVERFLOW THEN U3_U3+1;                                      05895000
         U4_TOS;                                                        05900000
         TOS_U1U2;                                                      05905000
         IF OVERFLOW THEN TOS_TOS+1D;                                   05910000
         TOS_U3U4;                                                      05915000
         XREG_6;                                                        05920000
         QASR;                                                          05925000
         GO PACK;                                                       05930000
QSUB   :                                                                05935000
         ALLOCATE; OPCODE_%20411;                                       05940000
         TOS_RZ;                                                        05945000
         TOS_RZ(1);                                                     05950000
         ASSEMBLE(OR,OR;FNEG,DEL);                                      05955000
         TOS_RZ;                                                        05960000
         DELB;                                                          05965000
         V1V2_TOS;                                                      05970000
         GO ADD;                                                        05975000
QADD   :                                                                05980000
         ALLOCATE;                                                      05985000
         OPCODE_%20410;                                                 05990000
         V1V2_RZ;                                                       05995000
ADD    :                                                                06000000
         TOS_Y&DLSL(1)&DLSR(1);                                         06005000
         TOS_V1V2&DLSL(1)&DLSR(1);                                      06010000
         ASSEMBLE(DCMP);                                                06015000
         IF > THEN                                                      06020000
          BEGIN                                                         06025000
NOSWAP :                                                                06030000
           TOS_RY;                                                      06035000
           TOS_RY(1);                                                   06040000
           TOS_V1V2;                                                    06045000
           TOS_RZ(1);                                                   06050000
          END ELSE                                                      06055000
         IF < THEN                                                      06060000
          BEGIN                                                         06065000
SWAP   :                                                                06070000
           TOS_V1V2;                                                    06075000
           TOS_RZ(1);                                                   06080000
           TOS_RY;                                                      06085000
           TOS_RY(1);                                                   06090000
          END                                                           06095000
         ELSE                                                           06100000
          BEGIN                                                         06105000
           TOS_Y(1)-Z(1);                                               06110000
           DDEL;                                                        06115000
           IF NOCARRY THEN GO SWAP ELSE GO NOSWAP;                      06120000
          END;                                                          06125000
         QTSTEQUAL;                                                     06130000
         IF = THEN                                                      06135000
          BEGIN                                                         06140000
           DDEL;                                                        06145000
           DDEL;                                                        06150000
           QTST;                                                        06155000
           GO CCA;                                                      06160000
          END;                                                          06165000
         ASSEMBLE(LOAD S-7);                                            06170000
         SIGN_TOS.(0:1);                                                06175000
         UNPACK;                                                        06180000
         XREG_2;                                                        06185000
         QASL;                                                          06190000
         V3V4_TOS;                                                      06195000
         V1V2_TOS;                                                      06200000
         QASL;                                                          06205000
         U3U4_TOS;                                                      06210000
         U1U2_TOS;                                                      06215000
         IF DIFSIGN THEN                                                06220000
          BEGIN                                                         06225000
           TOS_-V1V2;                                                   06230000
           V3V4_-V3V4;                                                  06235000
           IF <> THEN TOS_TOS-1D;                                       06240000
           V1V2_TOS;                                                    06245000
          END;                                                          06250000
         DIFSIGN_SIGN;                                                  06255000
         TOS_EXPU;                                                      06260000
         EXPU_EXPU+%400;                                                06265000
         XREG_TOS_TOS-EXPV;                                             06270000
         IF TOS > 56 THEN                                               06275000
          BEGIN                                                         06280000
           TOS_U1U2;                                                    06285000
           GO FINISHADD;                                                06290000
          END;                                                          06295000
         TOS_V1V2;                                                      06300000
         TOS_V3V4;                                                      06305000
         IF XREG < 16 THEN QASR ELSE                                    06310000
          BEGIN                                                         06315000
           ASSEMBLE(XCH);                                               06320000
           TOSA_TOS;                                                    06325000
           TOS_TOS&TASR(16);                                            06330000
           TOS_TOSA;                                                    06335000
           XREG_XREG-16;                                                06340000
           ASSEMBLE(TASR 0,X);                                          06345000
          END;                                                          06350000
         U3U4_TOS+U3U4;                                                 06355000
         IF CARRY THEN TOS_TOS+1D;                                      06360000
         TOS_TOS+U1U2;                                                  06365000
FINISHADD:                                                              06370000
         TOS_U3U4;                                                      06375000
PACK   :                                                                06380000
         ASSEMBLE(LDD S-3;XCH,ZROX);                                    06385000
         IF = THEN                                                      06390000
          BEGIN                                                         06395000
           DEL;                                                         06400000
           IF TOS.(0:6) = 0 THEN                                        06405000
            BEGIN                                                       06410000
             TOS_TOS&TNSL;                                              06415000
             XREG_XREG+16;                                              06420000
             ASSEMBLE(DXCH,XCH;DEL,CAB;CAB,ZERO);                       06425000
             IF XREG = 58 THEN GO CCA ELSE GO SAVEX;                    06430000
            END;                                                        06435000
          END ELSE DDEL;                                                06440000
         TOSA_TOS;                                                      06445000
         TOS_TOS&TNSL;                                                  06450000
         TOS_0;                                                         06455000
         TOS_TOSA;                                                      06460000
         ASSEMBLE(DLSL 0,X);                                            06465000
         ASSEMBLE(CAB,CAB;OR,XCH);                                      06470000
SAVEX  :                                                                06475000
         XSAVE_XREG;                                                    06480000
         TOS_TOS+4D;                                                    06485000
         IF CARRY THEN                                                  06490000
          ASSEMBLE(DXCH,DZRO;INCA,DADD;DXCH);                           06495000
         XREG_3;                                                        06500000
         QASR;                                                          06505000
         TOS_(EXPU-XSAVE-%400)&LSL(6);                                  06510000
         ASSEMBLE(LOAD S-4;ADD,DUP);                                    06515000
         XSAVE_TOS;                                                     06520000
         IF DIFSIGN THEN TOS.(0:1)_1 ELSE TOS.(0:1)_0;                  06525000
         ASSEMBLE(STOR S-4);                                            06530000
         TOS_TOS&TASL(0);                                               06535000
         IF = THEN OVFL_TRUE;                                           06540000
         QTST;                                                          06545000
CCA    :                                                                06550000
         PUSH(STATUS);                                                  06555000
         TOS_MYSTAT;                                                    06560000
         ASSEMBLE(XCH);                                                 06565000
         TOS.(6:2)_TOS.(6:2);                                           06570000
         MYSTAT_TOS;                                                    06575000
         X(1)_TOS;                                                      06580000
         X_TOS;                                                         06585000
         TOS_XSAVE;                                                     06590000
         IF < THEN                                                      06595000
          BEGIN                                                         06600000
           TOS_TOS&LSL(1);                                              06605000
           IF < THEN                                                    06610000
UNDERF :   TOS_9 ELSE TOS_8;                                            06615000
           TOS_MYSTAT; TOS_0;                                           06620000
           IF DIFSIGN THEN TOS_TOS+1;                                   06625000
           TOS.(6:2)_TOS;                                               06630000
           MYSTAT_TOS;                                                  06635000
ERROR  :   IF LOGICAL(MYSTAT.(2:1)) THEN                                06640000
            BEGIN                                                       06645000
             TOS_OPCODE;                                                06650000
             U1_0;                                                      06655000
             WHILE(U1_U1+1)<=3 DO STACK(U1)_STACK(U1+2);                06660000
             STACK(U1)_DELTAQ-2;                                        06665000
             PUSH(Q);                                                   06670000
             TOS_TOS-2;                                                 06675000
             SET(Q);                                                    06680000
             GETPRIVMODE; XREG_TOS;                                     06685000
             ABORT(%400,A,0);                                           06690000
            END ELSE MYSTAT.(4:1)_1;                                    06695000
           RETURN 3;                                                    06700000
          END;                                                          06705000
         IF = AND OVFL THEN GO UNDERF;                                  06710000
         MYSTAT.(4:1)_0;                                                06715000
         RETURN 3;                                                      06720000
     END << QMATH >>;                                                   06725000
$PAGE                                                                   06730000
<<......................................................................06735000
.                                                                      .06740000
.                             CVBD                                     .06745000
.                                                                      .06750000
......................................................................>>06755000
                                                                        06760000
                                                                        06765000
$CONTROL SEGMENT=FIRMWARESIM2                                  <<01820>>06770000
PROCEDURE CVBD;                                                         06775000
OPTION PRIVILEGED,UNCALLABLE;                                           06780000
                                                                        06785000
COMMENT: CONVERTS BINARY SOURCE TO DECIMAL DIGITS;                      06790000
                                                                        06795000
BEGIN                                                                   06800000
INTEGER CC,         <<TEMPORARY STORAGE FOR CONDITION CODE>>            06805000
        TARGETDIGS=Q-11,     <<USERS OP2 DIGITS>>                       06810000
        SOURCEWORDS=Q-9,     <<USERS OP1 WORDS>>                        06815000
        SDEC=Q-3,            <<EXTRACTED FROM INSTRUCTION>>             06820000
        XREG=X;                                                         06825000
LOGICAL DCNT,                <<COUNTER FOR DECIMAL DIGITS>>             06830000
        SAVETOP,             <<FOR SAVING TARGET NSD>>                  06835000
        DECOVERFLOW:=FALSE,  <<TRUE IF DECIMAL OVERFLOW HAS OCURRED>>   06840000
        INSTR=Q-4,           <<THE INSTRUCTION CODE>>                   06845000
        SIGN,                <<TRUE IF NEGATIVE>>                       06850000
        STATUSWORD=Q-6;      <<WHERE CONDITION CODE IS>>                06855000
BYTE ARRAY DOP(0:15);        <<LOCAL DECIMAL RESULT>>                   06860000
ARRAY BINOP(0:5);            <<LOCAL STORAGE FOR SOURCE>>               06865000
POINTER SOURCE=Q-10;         <<WHERE BINARY RESULT GOES>>               06870000
DOUBLE POINTER DSOURCE=SOURCE, DOSOURCE,                                06875000
               DBINOP=BINOP,  DOBINOP;                                  06880000
BYTE POINTER TARGET=Q-12;    <<WHERE DECIMAL SOURCE IS>>                06885000
                                                                        06890000
                                                                        06895000
SUBROUTINE DOVERFLOW;                                                   06900000
                                                                        06905000
<<IF RESULT OVERFLOWS, THE RESULT OPERAND IS EXIAMINED FOR              06910000
  ALL ZEROS.  IF THIS IS FOUND TO BE THE CASE, THE CONDITION            06915000
  CODE IS CHANGED TO CCE, AND THE SIGN IS CHANGED TO +>>                06920000
                                                                        06925000
BEGIN                                                                   06930000
TOS:=TARGET(TARGETDIGS&LSR(1)); <<GET SIGN BYTE>>                       06935000
TOS:=TOS LAND %360; <<ISOLATE FIRST DIGIT>>                             06940000
CC:=0;                                                                  06945000
IF TOS<>0 THEN CC:=1; <<NONZERO DIGIT FOUND>>                           06950000
WHILE (XREG:=XREG-1)>=0 DO <<EXAMINE THE REST OF RESULT>>               06955000
  IF INTEGER(TARGET(XREG))<>0 THEN CC:=1;                               06960000
IF CC=0 THEN <<NO NONZERO DIGITS>>                                      06965000
  BEGIN                                                                 06970000
    TARGET(TARGETDIGS&LSR(1)):=%(2)1100; <<PLUS SIGN>>                  06975000
    TOS:=STATUSWORD LAND %176377; <<SET CCE>>                           06980000
    TOS:=TOS LOR %1000;                                                 06985000
    STATUSWORD:=TOS;                                                    06990000
  END;                                                                  06995000
IF NOT(LOGICAL(TARGETDIGS)) THEN                                        07000000
  TARGET := (LOGICAL(TARGET) LAND %17) LOR (SAVETOP LAND %360);         07005000
DEC'SIM'TRAP(11); <<OVERFLOW>>                                          07010000
END <<DOVERFLOW>>;                                                      07015000
                                                                        07020000
                                                                        07025000
IF INTEGER(STATUSWORD)>=0 THEN <<TURN OFF PRIVILEGED MODE>>             07030000
  BEGIN                                                                 07035000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    07040000
  END;                                                                  07045000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                07050000
SDEC:=IF INSTR.(11:1) THEN 4 ELSE 2;                                    07055000
SIGN:=FALSE;                                                            07060000
IF 1<=SOURCEWORDS<=6 THEN                                               07065000
  BEGIN                                                                 07070000
    BINOP:=0; MOVE BINOP(1):=BINOP,(5); <<ZERO BINOP>>                  07075000
    IF 1<=TARGETDIGS<=28 THEN                                           07080000
      BEGIN                                                             07085000
        @DOSOURCE:=@SOURCE(-1); @DOBINOP:=@BINOP(-1);                   07090000
        IF INTEGER(SOURCE)>=0 THEN                                      07095000
          MOVE BINOP:=SOURCE,(SOURCEWORDS)                              07100000
        ELSE <<DO NEGATE WHILE MOVING>>                                 07105000
          BEGIN                                                         07110000
            CASE * SOURCEWORDS-1 OF                                     07115000
              BEGIN                                                     07120000
                <<1 WORD NEGATE>>                                       07125000
                BINOP:=-SOURCE;                                         07130000
                <<2 WORD NEGATE>>                                       07135000
                DBINOP:=-DSOURCE;                                       07140000
                <<3 WORD NEGATE>>                                       07145000
                BEGIN                                                   07150000
                  TOS:=0;                                               07155000
                  DOBINOP(XREG):=-DOSOURCE(1);                          07160000
                  IF <> THEN ASSEMBLE(DECA);                            07165000
                  BINOP:=-SOURCE+TOS;                                   07170000
                END;                                                    07175000
                <<4 WORD NEGATE>>                                       07180000
                BEGIN                                                   07185000
                  TOS:=0D;                                              07190000
                  DBINOP(XREG):=-DSOURCE(1);                            07195000
                  IF <> THEN ASSEMBLE(DECA,DECB);                       07200000
                  DBINOP:=-DSOURCE+TOS;                                 07205000
                END;                                                    07210000
                <<5 WORD NEGATE>>                                       07215000
                BEGIN                                                   07220000
                  ASSEMBLE(DZRO,ZERO);                                  07225000
                  DOBINOP(XREG):=-DOSOURCE(2);                          07230000
                  IF <> THEN ASSEMBLE(DECA,DECB;DDUP);                  07235000
                  DOBINOP(XREG):=-DOSOURCE(1)+TOS;                      07240000
                  ASSEMBLE(DTST);                                       07245000
                  IF = THEN IF DOBINOP(XREG)<>0D THEN ASSEMBLE(DECA);   07250000
                  BINOP:=-SOURCE+TOS;                                   07255000
                END;                                                    07260000
                <<SIX WORD NEGATE>>                                     07265000
                BEGIN                                                   07270000
                  ASSEMBLE(DZRO,DZRO);                                  07275000
                  DBINOP(XREG):=-DSOURCE(2);                            07280000
                  IF <> THEN ASSEMBLE(DECA,DECB;DDUP);                  07285000
                  DBINOP(XREG):=-DSOURCE(1)+TOS;                        07290000
                  ASSEMBLE(DTST);                                       07295000
                  IF = THEN IF DBINOP(XREG)<>0D THEN                    07300000
                    ASSEMBLE(DECA,DECB);                                07305000
                  DBINOP:=-DSOURCE+TOS;                                 07310000
                END;                                                    07315000
              END <<CASE>>;                                             07320000
            SIGN:=TRUE;                                                 07325000
          END;                                                          07330000
        CC:=IF INTEGER(SOURCE)<0 THEN 2                                 07335000
        ELSE IF DBINOP<>0D OR DBINOP(1)<>0D OR DBINOP(2)<>0D THEN       07340000
             1 ELSE 0;                                                  07345000
        TOS:=%(2)1100;  <<GET PLUS SIGN>>                               07350000
        IF SIGN THEN TOS:=TOS+1;  <<IF NEGATIVE, THEN MINUS>>           07355000
        DCNT:=IF LOGICAL(TOS:=TARGETDIGS) THEN TOS ELSE TOS+1;          07360000
LOOP:                                                                   07365000
        TOS:=0;                                                         07370000
        XREG:=0;                                                        07375000
        WHILE XREG<SOURCEWORDS DO <<DIVIDE EACH SORD BY 10>>            07380000
          BEGIN                                                         07385000
            TOS:=BINOP(XREG);                                           07390000
            TOS:=10;                                                    07395000
            ASSEMBLE(LDIV,XCH);                                         07400000
            BINOP(XREG):=TOS;                                           07405000
            XREG:=XREG+1;                                               07410000
          END;                                                          07415000
        IF DCNT THEN <<PACK TWO DIGITS/BYTE & STORE>>                   07420000
          BEGIN                                                         07425000
            XREG:=DCNT&LSR(1);                                          07430000
            DOP(XREG):=TOS&LSL(4) LOR TOS;                              07435000
          END;                                                          07440000
        DCNT:=DCNT-1;                                                   07445000
        IF (DCNT=1) AND NOT(LOGICAL(TARGETDIGS)) OR                     07450000
           (DCNT=0) AND     LOGICAL(TARGETDIGS)  THEN                   07455000
               <<ALL VALID DIGITS ALREADY GENERATED>>                   07460000
          BEGIN                                                         07465000
            XREG:=-1;                                                   07470000
            WHILE XREG<SOURCEWORDS-1 DO                                 07475000
              IF BINOP(XREG:=XREG+1)<>0 THEN DECOVERFLOW:=TRUE;         07480000
          END;                                                          07485000
        IF INTEGER(DCNT)>0 THEN GO TO LOOP;                             07490000
        IF NOT(LOGICAL(TARGETDIGS)) THEN DOP:=LOGICAL(DOP) LAND %17;    07495000
        SAVETOP := TARGET;                                              07500000
        MOVE TARGET:=DOP,(LOGICAL(TARGETDIGS+2)&LSR(1));                07505000
        TOS:=STATUSWORD LAND %176377; <<ZERO CC>>                       07510000
        IF CC=2 <<MINUS>> THEN TOS:=TOS LOR %400                        07515000
        ELSE IF CC=0 THEN TOS:=TOS LOR %1000;                           07520000
        STATUSWORD:=TOS;                                                07525000
        IF DECOVERFLOW THEN DOVERFLOW; <<DECIMAL OVERFLOW>>             07530000
        IF NOT(LOGICAL(TARGETDIGS)) THEN                                07535000
          TARGET:=(LOGICAL(TARGET) LAND %17)LOR(SAVETOP LAND %360);     07540000
      END                                                               07545000
    ELSE IF NOT (0<=TARGETDIGS<=28) THEN DEC'SIM'TRAP(15);              07550000
  END                                                                   07555000
ELSE IF NOT (0<=SOURCEWORDS<=6) THEN DEC'SIM'TRAP(14);                  07560000
TOS:=%031400+SDEC;                                                      07565000
<<EXIT OVER USERS STACK MARKER>>                                        07570000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            07575000
ASSEMBLE(XEQ 0);                                                        07580000
END <<CVBD>>;                                                           07585000
$PAGE                                                                   07590000
<<......................................................................07595000
.                                                                      .07600000
.                             CVDB                                     .07605000
.                                                                      .07610000
......................................................................>>07615000
PROCEDURE CVDB;                                                         07620000
OPTION PRIVILEGED,UNCALLABLE;                                           07625000
                                                                        07630000
COMMENT: CONVERTS DECIMAL DIGITS TO BINARY WORDS;                       07635000
                                                                        07640000
BEGIN                                                                   07645000
INTEGER LOCLEN,         <<LOCAL SOURCE LENGTH>>                         07650000
        SOURCEDIGS=Q-9, <<USER'S SOURCE LENTGTH>>                       07655000
        SDEC=Q-3,                                                       07660000
         CC,          <<TEMP STORAGE FOR CONDITION CODE>>               07665000
         XREG=X;                                                        07670000
LOGICAL STATUSWORD=Q-6,  <<WHERE CC IS KEPT>>                           07675000
        AREG = S-0,                                                     07680000
        SAVESOURCE,    <<FOR SAVING SOURCE NON-SIG DIGIT>>              07685000
        INSTR=Q-4;       <<MACHINE INSTRUCTION CODE>>                   07690000
DOUBLE DBIN1=Q+4, DBIN2=Q+6, DBIN3=Q+8;                                 07695000
INTEGER BIN1=DBIN1, BIN2=DBIN1+1, BIN3=DBIN2,                           07700000
        BIN4=DBIN2+1, BIN5=DBIN3, BIN6=DBIN3+1;                         07705000
BYTE ARRAY DIGITS(*)=S-2;                                               07710000
POINTER TARGET=Q-11;     <<WHERE BINARY RESULT GOES>>                   07715000
BYTE POINTER SOURCE=Q-10; <<WHERE DECIMAL SOURCE IS>>                   07720000
DOUBLE POINTER DRESULT=TARGET;                                          07725000
<<TURN OFF TRAPS, AND GET USER MODE>>                                   07730000
PUSH(STATUS);                                                           07735000
IF INTEGER(STATUSWORD)>=0 THEN TOS:=TOS LAND %77777; <<OFF PRIV MODE>>  07740000
TOS:=TOS LAND %157777; <<TURN OFF TRAPS>>                               07745000
SET(STATUS);                                                            07750000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                07755000
SDEC:=IF INSTR.(11:1) THEN 3 ELSE 2;                                    07760000
IF 1<=SOURCEDIGS<=28 THEN                                               07765000
  BEGIN                                                                 07770000
        TOS := SOURCE;                                                  07775000
        IF NOT(LOGICAL(SOURCEDIGS)) THEN SOURCE := AREG LAND %17;       07780000
        SAVESOURCE := TOS;                                              07785000
        ASSEMBLE(DZRO,DZRO;DZRO); <<ZERO LOCAL STORAGE>>                07790000
        LOCLEN:=IF LOGICAL((TOS:=SOURCEDIGS)) THEN TOS ELSE TOS+1;      07795000
        TOS:=SOURCE&LSL(8) ;  <<GET FIRST 2 DECIMAL DIGITS>>            07800000
        TOS:=LOGICAL(SOURCE(1)) LOR TOS; <<FIRST 4 DIGTS>>              07805000
        DO                                                              07810000
          BEGIN                                                         07815000
            TOS:=0;                                                     07820000
            TOS:=TOS&DCSL(4);                                           07825000
            ASSEMBLE(DUP);                                              07830000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    07835000
              BEGIN                                                     07840000
              SOURCE := SAVESOURCE;                                     07845000
              DEC'SIM'TRAP(13);  <<TRAP>>                               07850000
              END;                                                      07855000
            BIN6:=BIN6*10+TOS;                                          07860000
            IF XREG=LOCLEN THEN GO TO PROCESSIGN;                       07865000
          END                                                           07870000
        UNTIL (XREG:=XREG+1)>4;                                         07875000
        TOS:=SOURCE(2)&LSL(8);                                          07880000
        TOS:=LOGICAL(SOURCE(XREG+1)) LOR TOS; <<NEXT 4 DIGITS>>         07885000
        XREG:=5; <<FIFTH DIGIT>>                                        07890000
        DO <<CONVERT TWO WORDS>>                                        07895000
          BEGIN                                                         07900000
            TOS:=0;                                                     07905000
            TOS:=TOS&DCSL(4);                                           07910000
            ASSEMBLE(DUP);                                              07915000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    07920000
              BEGIN                                                     07925000
              SOURCE := SAVESOURCE;                                     07930000
              DEC'SIM'TRAP(13);  <<TRAP>>                               07935000
              END;                                                      07940000
            ASSEMBLE(ZERO,XCH);                                         07945000
            TOS:=DBIN3;                                                 07950000
            ASSEMBLE(DLSL 1;DDUP; DLSL 2; DADD,DADD);                   07955000
                   <<MULTIPLIES BY 10>>                                 07960000
            DBIN3:=TOS;                                                 07965000
            IF XREG=LOCLEN THEN GO TO PROCESSIGN;                       07970000
          END                                                           07975000
        UNTIL (XREG:=XREG+1)>8;                                         07980000
        ASSEMBLE(DZRO,ZERO); <<ZERO LOCAL STORAGE>>                     07985000
        MOVE DIGITS:=SOURCE(4),(6);<<MOVE NEXT 12 DIGITS ONTO STACK>>   07990000
        ASSEMBLE(XCH,CAB);                                              07995000
        XREG:=9;                                                        08000000
        DO   <<CONVERT 4 WORD RESULT>>                                  08005000
          BEGIN                                                         08010000
            TOS:=0;                                                     08015000
            TOS:=TOS&DCSL(4);                                           08020000
            ASSEMBLE(DUP);                                              08025000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    08030000
              BEGIN                                                     08035000
              SOURCE := SAVESOURCE;                                     08040000
              DEC'SIM'TRAP(13);  <<TRAP>>                               08045000
              END;                                                      08050000
            ASSEMBLE(ZERO,XCH);                                         08055000
            TOS:=BIN6;                                                  08060000
            TOS:=10;                                                    08065000
            ASSEMBLE(LMPY,DADD);                                        08070000
            BIN6:=TOS;                                                  08075000
            ASSEMBLE(DZRO,CAB);                                         08080000
            TOS:=BIN5;                                                  08085000
            TOS:=10;                                                    08090000
            ASSEMBLE(LMPY,DADD);                                        08095000
            BIN5:=TOS;                                                  08100000
            TOS:=DBIN2;                                                 08105000
            ASSEMBLE(DLSL 1; DDUP; DLSL 2; DADD,DADD);                  08110000
            DBIN2:=TOS;                                                 08115000
            IF XREG=12 OR XREG=16 THEN DEL;                             08120000
             IF XREG=LOCLEN THEN GO TO PROCESSIGN;                      08125000
          END                                                           08130000
        UNTIL (XREG:=XREG+1)>18;                                        08135000
        ASSEMBLE(DZRO,ZERO);<<TEN MORE DIGITS>>                         08140000
        MOVE DIGITS:=SOURCE(9),(6);                                     08145000
        ASSEMBLE(XCH,CAB);                                              08150000
        XREG:=18;                                                       08155000
        WHILE XREG<LOCLEN DO <<6 WORD RESULT>>                          08160000
          BEGIN                                                         08165000
            TOS:=0;                                                     08170000
            TOS:=TOS&DCSL(4);                                           08175000
            ASSEMBLE(DUP);                                              08180000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    08185000
              BEGIN                                                     08190000
              SOURCE := SAVESOURCE;                                     08195000
              DEC'SIM'TRAP(13);  <<TRAP>>                               08200000
              END;                                                      08205000
            ASSEMBLE(ZERO,XCH);                                         08210000
            TOS:=BIN6;                                                  08215000
            TOS:=10;                                                    08220000
            ASSEMBLE(LMPY,DADD);                                        08225000
            BIN6:=TOS;                                                  08230000
            ASSEMBLE(ZERO,XCH);                                         08235000
            TOS:=BIN5;                                                  08240000
            TOS:=10;                                                    08245000
            ASSEMBLE(LMPY,DADD);                                        08250000
            BIN5:=TOS;                                                  08255000
            ASSEMBLE(ZERO,XCH);                                         08260000
            TOS:=BIN4;                                                  08265000
            TOS:=10;                                                    08270000
            ASSEMBLE(LMPY,DADD);                                        08275000
            BIN4:=TOS;                                                  08280000
            ASSEMBLE(DZRO,CAB);                                         08285000
            TOS:=BIN3;                                                  08290000
            TOS:=10;                                                    08295000
            ASSEMBLE(LMPY,DADD);                                        08300000
            BIN3:=TOS;                                                  08305000
            TOS:=DBIN1;                                                 08310000
            ASSEMBLE(DLSL 1; DDUP; DLSL 2; DADD,DADD);                  08315000
            DBIN1:=TOS;                                                 08320000
            IF (XREG=21) OR (XREG=25) THEN DEL;                         08325000
            XREG:=XREG+1;                                               08330000
          END;                                                          08335000
PROCESSIGN:                                                             08340000
        XREG:=LOGICAL(XREG)&LSR(1);                                     08345000
        TOS:=LOGICAL(SOURCE(XREG)) LAND %17; <<SIGN DIGIT>>             08350000
        IF TOS=%(2)1101 THEN <<NEGATIVE>>                               08355000
          BEGIN                                                         08360000
            ASSEMBLE(DZRO,DZRO);                                        08365000
            DBIN3:=-DBIN3;                                              08370000
            IF <> THEN ASSEMBLE(DECA,DECB;DDUP);                        08375000
            DBIN2:=-DBIN2+TOS;                                          08380000
            ASSEMBLE(DTST);                                             08385000
            IF = THEN IF DBIN2<>0D THEN ASSEMBLE(DECA,DECB);            08390000
            DBIN1:=-DBIN1+TOS;                                          08395000
          END;                                                          08400000
        CC:=IF BIN1<0 THEN 2 ELSE IF DBIN3<>0D OR                       08405000
            DBIN2<>0D OR DBIN1<>0D THEN 1 ELSE 0;                       08410000
        IF SOURCEDIGS<=4 THEN <<ONE WORD>>                              08415000
          TARGET:=BIN6                                                  08420000
        ELSE IF SOURCEDIGS<=9 THEN <<TWO WORDS>>                        08425000
          DRESULT:=DBIN3                                                08430000
        ELSE <<4 OR 6 WORD RESULT>>                                     08435000
          BEGIN                                                         08440000
            TOS:=@TARGET;                                               08445000
            IF SOURCEDIGS<=18 THEN <<4 WORDS>>                          08450000
              BEGIN                                                     08455000
                TOS:=@DBIN2; TOS:=4;                                    08460000
              END                                                       08465000
            ELSE <<6 WORD RESULT>>                                      08470000
              BEGIN                                                     08475000
                TOS:=@DBIN1; TOS:=6;                                    08480000
              END;                                                      08485000
            ASSEMBLE(MOVE);                                             08490000
          END;                                                          08495000
        <<SET CONDITON CODE>>                                           08500000
        TOS:=STATUSWORD LAND %176377;                                   08505000
        IF CC=2 THEN TOS:=TOS LOR %400                                  08510000
        ELSE IF CC=0 THEN TOS:=TOS LOR %1000;                           08515000
        STATUSWORD:=TOS;                                                08520000
        SOURCE := SAVESOURCE;  <<RESTORE NON-SIGNIFICANT DIGIT>>        08525000
  END                                                                   08530000
ELSE IF NOT(0<=SOURCEDIGS<=28) THEN DEC'SIM'TRAP(15);                   08535000
TOS:=%031400+SDEC;                                                      08540000
<<EXIT OVER USER'S STACK MARKER>>                                       08545000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            08550000
ASSEMBLE(XEQ 0);                                                        08555000
END <<CVDB>>;                                                           08560000
$PAGE                                                                   08565000
$CONTROL SEGMENT=FIRMWARESIM1                                  <<01820>>08570000
<<......................................................................08575000
.                                                                      .08580000
.                             CVAD                                     .08585000
.                                                                      .08590000
......................................................................>>08595000
PROCEDURE CVAD;                                                         08600000
OPTION PRIVILEGED,UNCALLABLE;                                           08605000
                                                                        08610000
COMMENT:  CONVERTS ASCII SOURCE TO DECIMAL DIGITS BY BRUTE FORCE;       08615000
                                                                        08620000
BEGIN                                                                   08625000
LOGICAL NONZERO,            <<TRUE IF NONZERO DIGIT FOUND>>             08630000
        STATUSWORD=Q-6,     <<WHERE CONDITION CODE IS>>                 08635000
        INSTR=Q-4,          <<MACHINE INSTRUCTION CODE>>                08640000
        BLANKMODE,          <<TRUE IF EXPECTING LEADING BLANK>>         08645000
        TARGETDIGS=Q-11,    <<USER'S DECIMAL DIGITS>>                   08650000
        SOURCEDIGS=Q-9,     <<USERS ASCII SOURCE DIGITS>>               08655000
        SDEC=Q-3,           <<HOW TO LEAVE STACK, IN INSTRUCTION>>      08660000
        PLUS,               <<TRUE IF SOURCE IS POSITIVE>>              08665000
        FIRSTDIGIT;         <<TRUE IF FIRST DIGIT OF A BYTE>>           08670000
INTEGER ASCOUNT,            <<ASCII DIGIT COUNTER>>                     08675000
        DCNT,               <<LOOP COUNTER>>                            08680000
        TARGETBYTE,         <<DECIMAL DIGIT COUNTER>>                   08685000
        XREG=X;                                                         08690000
BYTE POINTER TARGET=Q-12,   <<WHERE DEICMAL RESULT GOES>>               08695000
           SOURCE=Q-10;     <<WHERE DECIMAL SOURCE IS>>                 08700000
<<GET RID OF PRIVILEGED MODE AND GET SDEC>>                             08705000
IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIVILEGED MODE>>           08710000
  BEGIN                                                                 08715000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    08720000
  END;                                                                  08725000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                08730000
SDEC:=IF INSTR.(11:1) THEN 4 ELSE 2;                                    08735000
NONZERO:=BLANKMODE:=FALSE; PLUS:=FIRSTDIGIT:=TRUE;                      08740000
IF 1<=INTEGER(TARGETDIGS)<=28 AND                                       08745000
     1<=INTEGER(SOURCEDIGS)<=28 THEN                                    08750000
  BEGIN                                                                 08755000
    TARGETBYTE:=TARGETDIGS&LSR(1);  <<NUMBER OF TARGET BYTES -1 >>      08760000
    ASCOUNT:=SOURCEDIGS-1;   <<NUMBER OF SOURCE DIGITS (BYTES)>>        08765000
    TOS:=SOURCE(ASCOUNT)-%60; <<GET SIGN DIGIT>>                        08770000
    ASSEMBLE(DUP,STAX); <<PUT A COPY IN XREG AND ON TOS>>               08775000
    IF XREG>=0 THEN <<MIGHT BE A VALID ASCII DIGIT>>                    08780000
      IF XREG<10 THEN <<UNSIGNED>>                                      08785000
        BEGIN                                                           08790000
          TOS:=TOS&LSL(4) LOR %(2)1111; <<UNSIGNED DECIMAL>>            08795000
          IF XREG>0 THEN NONZERO:=TRUE;                                 08800000
        END                                                             08805000
      ELSE IF %21<=XREG<=%31 THEN <<POSITIVE 1-9>>                      08810000
        BEGIN                                                           08815000
          TOS:=(TOS-%20)&LSL(4) LOR %(2)1100; <<DIGIT AND PLUS>>        08820000
          NONZERO:=TRUE;                                                08825000
        END                                                             08830000
      ELSE IF XREG=%113 THEN <<PLUS ZERO>>                              08835000
        TOS:=TOS LAND 0 LOR %(2)1100                                    08840000
      ELSE IF %32<=XREG<=%42 THEN <<NEGATIVE>>                          08845000
        BEGIN                                                           08850000
          PLUS:=FALSE;                                                  08855000
          NONZERO:=TRUE;                                                08860000
          TOS:=(TOS-%31)&LSL(4) LOR %(2)1101; <<MINUS AND DIGIT>>       08865000
        END                                                             08870000
      ELSE IF XREG=%115 THEN <<ZERO AND MINUS>>                         08875000
        BEGIN                                                           08880000
          TOS:=TOS LAND 0 LOR %(2)1101;                                 08885000
          PLUS:=FALSE;                                                  08890000
        END                                                             08895000
      ELSE DEC'SIM'TRAP(12)                                             08900000
    ELSE IF XREG=%177760 <<BLANK>> THEN <<PLUS ZERO>>                   08905000
      BEGIN                                                             08910000
        BLANKMODE:=TRUE;                                                08915000
        TOS:=TOS LAND 0 LOR %(2)1100;                                   08920000
      END                                                               08925000
    ELSE DEC'SIM'TRAP(12);                                              08930000
    TARGET(TARGETBYTE):=BYTE(TOS);  <<STORE SIGN AND ONE DIGIT>>        08935000
    DCNT:=IF (TOS:=SOURCEDIGS)>TARGETDIGS THEN                          08940000
            TARGETDIGS-1 ELSE TOS-1;                                    08945000
    WHILE DCNT>0 DO                                                     08950000
      BEGIN                                                             08955000
        TOS:=SOURCE(ASCOUNT:=ASCOUNT-1)-%60; <<GET ASCII DIGIT>>        08960000
        ASSEMBLE(DUP,STAX);  <<LEAVE ON TOS AND PUT IN XREG>>           08965000
        IF 0<=XREG<=%11 AND NOT BLANKMODE THEN <<VALID DIGIT>>          08970000
          BEGIN                                                         08975000
            IF XREG>0 THEN NONZERO:=TRUE;                               08980000
            IF NOT FIRSTDIGIT THEN <<2 DIGITS, BOTH ON TOS>>            08985000
              TOS:=TOS&LSL(4) LOR TOS; <<COMBINE DIGITS ON TOS>>        08990000
          END                                                           08995000
        ELSE IF XREG=%177760<<BLANK>> AND BLANKMODE THEN                09000000
                  <<PUT IN LEADING ZERO>>                               09005000
          IF FIRSTDIGIT THEN TOS:=TOS LAND 0                            09010000
          ELSE                                                          09015000
            BEGIN                                                       09020000
              ASSEMBLE(DEL); <<GET RID OF SECOND DIGIT>>                09025000
              TOS:=TOS LAND %17;                                        09030000
            END                                                         09035000
        ELSE IF XREG=%177760 <<BLANK>> THEN <<FIRST BLANK>>             09040000
          BEGIN                                                         09045000
            IF FIRSTDIGIT THEN TOS:=TOS LAND 0 <<PUT IN 0>>             09050000
            ELSE                                                        09055000
              BEGIN                                                     09060000
                ASSEMBLE(DEL);  <<GET RID OF SECOND DIGIT>>             09065000
                TOS:=TOS LAND %17;                                      09070000
              END;                                                      09075000
            BLANKMODE:=TRUE;                                            09080000
          END                                                           09085000
        ELSE <<INVALID DIGIT>>                                          09090000
          DEC'SIM'TRAP(12);                                             09095000
        IF NOT FIRSTDIGIT THEN <<STORE TARGET BYTE>>                    09100000
          TARGET(TARGETBYTE:=TARGETBYTE-1):=BYTE(TOS);                  09105000
        FIRSTDIGIT:=IF FIRSTDIGIT THEN FALSE ELSE TRUE;                 09110000
        DCNT:=DCNT-1;                                                   09115000
      END<<WHILE>>;                                                     09120000
    IF NOT FIRSTDIGIT AND TARGETBYTE>0 THEN <<ONE DIGIT LEFT OVER>>     09125000
      BEGIN                                                             09130000
        TOS:=TOS LAND %17; <<PUT IN ZERO IN LEFT DIGIT>>                09135000
        TARGET(TARGETBYTE:=TARGETBYTE-1):=BYTE(TOS);                    09140000
      END;                                                              09145000
                                                                        09150000
<<IF TARGETBYTE AND ASCOUNT BOTH 0 => DONE; IF ASCOUNT>0                09155000
  THEN DONE; IF TARGETBYTE>0 AND ASCOUNT=0 => ZERO FILL>>               09160000
                                                                        09165000
    IF ASCOUNT=0 AND TARGETBYTE>0 THEN <<ZERO FILL>>                    09170000
      BEGIN                                                             09175000
        XREG:=TARGETBYTE;                                               09180000
        WHILE (XREG:=(XREG-1))>=0 DO <<HIGH ORDER ZERO FILL>>           09185000
            TARGET(XREG):=0;                                            09190000
      END;                                                              09195000
    <<SET CONDITION CODE>>                                              09200000
    TOS:=STATUSWORD; TOS:=TOS LAND %176377;                             09205000
    IF NOT NONZERO THEN <<OPERAND IS ZERO>>                             09210000
      TOS:=TOS LOR %1000                                                09215000
    ELSE IF NOT PLUS THEN TOS:=TOS LOR %400;                            09220000
    STATUSWORD:=TOS;                                                    09225000
  END                                                                   09230000
ELSE IF NOT(0<=INTEGER(SOURCEDIGS)<=28)                                 09235000
   OR NOT (0<=INTEGER(TARGETDIGS)<=28) THEN DEC'SIM'TRAP(15);           09240000
TOS:=%031400+SDEC;                                                      09245000
<<EXIT OVER USERS STACK MARKER>>                                        09250000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            09255000
ASSEMBLE(XEQ 0);                                                        09260000
END <<CVAD>>;                                                           09265000
$PAGE                                                                   09270000
<<......................................................................09275000
.                                                                      .09280000
.                             CVDA                                     .09285000
.                                                                      .09290000
......................................................................>>09295000
PROCEDURE CVDA;                                                         09300000
OPTION PRIVILEGED,UNCALLABLE;                                           09305000
                                                                        09310000
COMMENT: CONVERTS A DECIMAL STRING TO AN ASCII STRING BY THE            09315000
         GOOD OLE ADD %60 TECHNIQUE;                                    09320000
                                                                        09325000
BEGIN                                                                   09330000
INTEGER ACNT,            <<ASCII DIGIT COUNTER>>                        09335000
        DCNT,            <<DECIMAL DIGIT COUNTER>>                      09340000
        AREG = S-0,  <<TOP OF STACK>>                                   09345000
        TARGETDIGS=Q-10,     <<USER'S NUMBER OF ASCII DIGITS>>          09350000
        SDEC=Q-3,                 <<HOW TO LEAVE STACK UPON EXIT>>      09355000
        TARGETBYTES,     <<LENGTH OF TARGET STRING>>                    09360000
        XREG=X;                                                         09365000
LOGICAL INSTR=Q-4,         <<MACHINE INSTRUCTION CODE>>                 09370000
        STATUSWORD=Q-6;  <<WHERE PRIV MODE BIT IS>>                     09375000
BYTE POINTER TARGET=Q-11, <<WHERE ASCII RESULT GOES>>                   09380000
           SOURCE=Q-9;  <<WHERE DECIMAL SOURCE IS>>                     09385000
EQUATE  CCG = 0,   <<CONDITION CODES>>                                  09390000
        CCL = 1,                                                        09395000
        CCE = 2;                                                        09400000
<<GET RID OF PRIVILEGED MODE AND GET SDEC>>                             09405000
IF INTEGER(STATUSWORD)>=0 THEN                                          09410000
  BEGIN                                                                 09415000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    09420000
  END;                                                                  09425000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                09430000
SDEC:=IF INSTR.(11:1) THEN 3 ELSE 1;                                    09435000
ACNT:=DCNT:=-1;                                                         09440000
IF 1<=TARGETDIGS<=28 THEN                                               09445000
  BEGIN                                                                 09450000
    TARGETBYTES:=TARGETDIGS-1;                                          09455000
    IF NOT (LOGICAL(TARGETDIGS)) THEN <<LEADING ZERO>>                  09460000
      BEGIN                                                             09465000
        TOS:=LOGICAL(SOURCE) LAND %17 ;                                 09470000
        ASSEMBLE(DUP);                                                  09475000
        IF TOS>%(2)1001 THEN <<INVALID DIGIT>> DEC'SIM'TRAP(13);        09480000
        TARGET:=TOS+%60;    <<CONVERT TO ASCII>>                        09485000
        ACNT:=DCNT:=0;      <<INCREMENT COUNTS>>                        09490000
      END;                                                              09495000
LOOP:                                                                   09500000
    TOS:=0;  <<PUCSH 0>>                                                09505000
    TOS:=SOURCE(DCNT:=DCNT+1); <<GET TWO DIGITS>>                       09510000
    TOS:=TOS&DCSR(4);    <<ISOLATE LEFT DIGIT ON TOS>>                  09515000
    ASSEMBLE(DUP); IF TOS>%(2)1001 THEN DEC'SIM'TRAP(13);               09520000
    TARGET(ACNT:=ACNT+1):=TOS+%60;  <<CONVERT TO ASCII>>                09525000
    TOS:=TOS&CSL(4);    <<SHIFT BACK FOR RIGHT DIGIT>>                  09530000
    IF ACNT=TARGETBYTES THEN                                            09535000
        GO TO PROCESSIGN;                                               09540000
    ASSEMBLE(DUP); IF TOS>%(2)1001 THEN DEC'SIM'TRAP(13);               09545000
    TARGET(ACNT:=ACNT+1):=TOS+%60;  <<SECOND DIGIT TO ASCII>>           09550000
    GO TO LOOP;  <<MORE DIGITS>>                                        09555000
PROCESSIGN:                                                             09560000
    TOS := TARGET(TARGETDIGS);                                          09565000
    TARGET(TARGETDIGS) := 0;  <<PLACES TERMINATION MARKER>>             09570000
    SCAN TARGET WHILE %60 <<"0">> ,1;  <<SCAN WHILE ZERO>>              09575000
    IF (TOS=@TARGET(TARGETDIGS)) AND CARRY THEN                         09580000
      STATUSWORD.(6:2) := CCE                                           09585000
    ELSE                                                                09590000
      BEGIN  <<TARGET WAS NOT ALL ZEROS>>                               09595000
      ASSEMBLE(STBX,LDXA);  <<GET SIGN FROM S-1>>                       09600000
      IF TOS = %(2)1101 THEN  <<NEGATIVE SIGN>>                         09605000
        STATUSWORD.(6:2) := CCL                                         09610000
      ELSE                                                              09615000
        STATUSWORD.(6:2) := CCG                                         09620000
      END;                                                              09625000
    TARGET(TARGETDIGS) := TOS;                                          09630000
    ASSEMBLE(DUP);                                                      09635000
    IF (INSTR.(9:1)=1) OR (INSTR.(10:1)=1) AND (AREG<>%(2)1101) THEN    09640000
        BEGIN TOS:=TOS LOR %17;                                <<C0.12>>09645000
        IF STATUSWORD.(6:2)=CCL THEN STATUSWORD.(6:2):=CCG;END;<<C0.12>>09650000
    IF TOS<>%(2)1111 THEN <<NOT UNSIGNED>>                              09655000
      BEGIN                                                             09660000
        IF TOS<>%(2)1101 THEN <<NOT MINUS>>                             09665000
          TOS:=%20 ELSE TOS:=%31; <<PUSH SIGN FLAG>>                    09670000
        TOS:=TARGET(ACNT);                                              09675000
        ASSEMBLE(DUP);                                                  09680000
        IF TOS=%60 THEN                                                 09685000
          BEGIN                                                         09690000
            ASSEMBLE(XCH); <<GET SIGNFLAG ON TOS>>                      09695000
            IF TOS=%20 THEN TOS:=%173 ELSE TOS:=%175;                   09700000
          END                                                           09705000
        ELSE TOS:=TOS+TOS;                                              09710000
        TARGET(XREG):=TOS;  <<STORE SIGN DIGIT>>                        09715000
      END;                                                              09720000
  END                                                                   09725000
ELSE IF NOT(0<=TARGETDIGS<=28) THEN DEC'SIM'TRAP(15);                   09730000
TOS:=%031400+SDEC;                                                      09735000
PUSH(Q); TOS:=TOS-5; SET(Q); <<EXIT USES USERS STACK AMRKER>>           09740000
ASSEMBLE(XEQ 0);                                                        09745000
END <<CVDA>>;                                                           09750000
$PAGE                                                                   09755000
<<......................................................................09760000
.                                                                      .09765000
.                             CMPD                                     .09770000
.                             ADDD                                     .09775000
.                             SUBD                                     .09780000
.                                                                      .09785000
......................................................................>>09790000
                                                                        09795000
$CONTROL SEGMENT=FIRMWARESIM2                                  <<00652>>09800000
                                                                        09805000
PROCEDURE CMPD;                                                         09810000
OPTION PRIVILEGED,UNCALLABLE;                                           09815000
                                                                        09820000
COMMENT: COMPARES OP2 TO OP1, ADDS OP1 TO OP2 (RESULT IN                09825000
         OP2) AND SUBTRACTS OP1 FROM OP2( RESULT IN OP2).               09830000
         SETS CONDITION CODE A, OVERFLOW.  TRAPS ON ILLEGAL             09835000
         DIGITS, AND DECIMAL OVERFLOW;                                  09840000
                                                                        09845000
BEGIN                                                                   09850000
ENTRY ADDD,SUBD;                                                        09855000
INTEGER SUB:=0,         <<SUBTRACT FLAG, VALUE=1 IF SUBTRACT>>          09860000
        OP1SIGN:=0,     <<4 IF OP1 IS NEGATIVE>>                        09865000
        OP2SIGN:=0,     <<2 IF OP2 IS NEGATIVE>>                        09870000
        OP1DIGS=Q-9,     <<USERS # OF DIGITS IN OP1>>                   09875000
        OP2DIGS=Q-11,    <<USERS # OF DIGITS IN OP2>>                   09880000
        SDEC=Q-3,            <<HOW TO LEAVE STACK ON EXIT>>             09885000
        XREG=X,         <<YES FOLKS>>                                   09890000
        DCNT,           <<DECIMAL DIGIT COUNTER>>                       09895000
        DCNT1,          <<ANOTHER DGIT COUNTER>>                        09900000
        TOP2DIGS,       <<TEMP FOR OP2 DIGITS IF CMPD>>                 09905000
        OP2X,            <<INDEX FOR OP2 ARRAY>>                        09910000
        OP1X;           <<INDEX FOR OP1 ARRAY>>                         09915000
LOGICAL RESULTSIGN,     <<TRUE IF RESULT SIGN IS NEGATIVE>>             09920000
        CHECKOP1,       <<TRUE IF CHECKZERO IS TO CHECK OP1>>           09925000
        INSTR=Q-4,       <<MACHINE INSTRUCTION CODE W SDEC>>            09930000
        STATUSWORD=Q-6, <<WHERE CONDITION CODE IS KEPT>>                09935000
        NEXTCARRY,      <<TRUE IF CARRY OR BORROW>>                     09940000
        COMPLEMENT,     <<TRUE IF ACTUAL SUBTRACT>>                     09945000
        CMP:=FALSE,     <<TRUE IF COMPARE OPERATION>>                   09950000
        RESTORE1,    <<RESTORE NON-SIG DIGIT IN OP1>>                   09955000
        RESTORE2,    <<RESTORE NON-SIG DIGIT IN OP2>>                   09960000
        FIXSTACK,    <<RESTORE OP1 ADR ON STACK>>                       09965000
        SAVEOP1,    <<HOLDS SAVED OP2 NON-SIG DIGIT>>                   09970000
        SAVEOP2,     <<HOLDS SAVED OP2 NON-SIG DIGIT>>                  09975000
        EXTEND,       <<TRUE IF PROPAGATE IS CALLED TO EXTEND OP1>>     09980000
        OP1ZERO,        <<TRUE IN COMPARE IF OP1 IS ZERO>>              09985000
        OP2ADR,         <<TEMP USED TO HOLD REAL OP2 ADRESS FOR         09990000
                          COMPARE>>                                     09995000
        OP1ADR=OP2ADR,  <<TEMP USED TO HOLD REAL OP1 ADR>>              10000000
        ONE,             <<HIGH ORDER 1>>                               10005000
        SIX,            <<HIGH ORDER 6>>                                10010000
        NINE,           <<HIGH ORDER 9>>                                10015000
        NONZERO,        <<TRUE IF RESULT IS NOT = 0>>                   10020000
        DOVERFLOW,      <<TRUE IF DECIMAL OVERFLOW>>                    10025000
        ALLZEROS,       <<TRUE IF OPERAND IS ALL ZEROS>>                10030000
        ONEANDZEROS,    <<TRUE IF NEXT DIGIT IS ONE AND ALL             10035000
                          THE REST ARE ZEROS IN CHECKZERO>>             10040000
        FLIPSIGN,       <<TRUE IF OP2 SIGN IS TO BE NEGATED>>           10045000
        LEFT;           <<TRUE IF NEXT DIGIT IS TO GO INTO LEFT         10050000
                          HALF OF A BYTE>>                              10055000
ARRAY WLOP2(0:7);      <<LOCAL ARRAY FOR OP2>>                          10060000
BYTE ARRAY LOP2(*)=WLOP2;  <<ARRAY USED FOR OP2 IN COMPARE>>            10065000
BYTE ARRAY LOP1(*)=WLOP2;  <<BYTE ARRAY FOR TEMP OP1>>                  10070000
BYTE POINTER OP1=Q-10,     <<WHERE OPERAND 1 IS>>                       10075000
           OP2=Q-12;     <<WHERE OPERAND 2 IS>>                         10080000
DEFINE SDEC'AND'MODE=                                                   10085000
    IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV MODE>>             10090000
      BEGIN                                                             10095000
        PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                10100000
      END;                                                              10105000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                10110000
    SDEC:=INSTR.(10:2);                                                 10115000
    SDEC:=IF SDEC=0 THEN 0 ELSE IF SDEC=1 THEN 2 ELSE 4                 10120000
#;                                                                      10125000
                                                                        10130000
SUBROUTINE TRAP(CODE);                                                  10135000
VALUE CODE; INTEGER CODE; <<TRAP INDEX>>                                10140000
                                                                        10145000
                                                                        10150000
<<CALLS TRAP HANDLER AFTER RESTORING OP2 ADDRESS AND DIGIT              10155000
  COUNT FOR CMPD>>                                                      10160000
                                                                        10165000
BEGIN                                                                   10170000
IF CMP THEN <<CMPD, RESTORE OP2 ADDRESS AND OP2DIGS ON STACK>>          10175000
  BEGIN                                                                 10180000
    @OP2:=OP2ADR;                                                       10185000
    OP2DIGS:=TOP2DIGS;                                                  10190000
  END;                                                                  10195000
IF FIXSTACK THEN @OP1 := OP1ADR;                                        10200000
IF RESTORE1 THEN OP1 := BYTE(SAVEOP1);                                  10205000
IF RESTORE2 THEN OP2 := LOGICAL(OP2) LOR SAVEOP2;                       10210000
DEC'SIM'TRAP(CODE);  <<INVOKE TRAP HANDLER>>                            10215000
END <<TRAP>>;                                                           10220000
                                                                        10225000
                                                                        10230000
SUBROUTINE RECOMPLEMENT;                                                10235000
                                                                        10240000
COMMENT: TENS COMPLEMENTS THE NUMBER OF OP2 DIGITS COMPUTED SO FAR;     10245000
                                                                        10250000
BEGIN                                                                   10255000
NEXTCARRY:=FALSE; FLIPSIGN:=TRUE;                                       10260000
XREG:=OP2DIGS&LSR(1); <<INDEX>>                                         10265000
DCNT1:=0; <<LOOP COUNTER FOR RECOMPLEMENTATION>>                        10270000
TOS:=OP2(XREG); <<FIRST DIGIT AND SIGN DIGIT>>                          10275000
TOS:=TOS & LSR(4); <<S,D; SIGN AND DIGIT REVERSED, SIGN WILL BE SET     10280000
                          LATER>>                                       10285000
WHILE DCNT1<OP2DIGS DO <<COMPLEMENT ALL COMPUTED RESULT DIGITS>>        10290000
  BEGIN                                                                 10295000
    IF LOGICAL(DCNT1) THEN <<GET 2 MORE DIGITS>>                        10300000
      BEGIN                                                             10305000
        TOS:=OP2(XREG);                                                 10310000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    10315000
        TOS:=TOS&DCSR(4);  <<ISOLATE A DIGIT>>                          10320000
      END                                                               10325000
    ELSE <<ISOLATE SECOND DIGIT OF A BYTE>>                             10330000
      BEGIN                                                             10335000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    10340000
        TOS:=TOS&DCSR(4); <<ISOLATE DIGIT>>                             10345000
      END;                                                              10350000
    TOS:=NINE;                                                          10355000
    ASSEMBLE(XCH,LSUB); <<SUBTRACT NINE-DIGIT>>                         10360000
    IF NEXTCARRY OR DCNT1=0 THEN <<PROPAGATE CARRY>>                    10365000
      TOS:=LOGICAL(TOS)+ONE;                                            10370000
    ASSEMBLE(DUP);  <<COPY OF COMPLEMENTED DIGIT>>                      10375000
    TOS:=LOGICAL(TOS)+SIX; <<CHECK FOR CARRY>>                          10380000
    IF CARRY THEN <<COMPLEMENTING CAUSED CARRY>>                        10385000
      BEGIN                                                             10390000
        NEXTCARRY:=TRUE;                                                10395000
        ASSEMBLE(DELB);                                                 10400000
      END                                                               10405000
    ELSE                                                                10410000
      BEGIN                                                             10415000
       NEXTCARRY:=FALSE;                                                10420000
       ASSEMBLE(DEL);                                                   10425000
      END;                                                              10430000
    TOS:=TOS&LSR(8); TOS:=TOS LOR TOS;                                  10435000
    IF NOT (LOGICAL(DCNT1)) THEN                                        10440000
      BEGIN                                                             10445000
        OP2(XREG):=BYTE(TOS);                                           10450000
        XREG:=XREG-1;                                                   10455000
      END;                                                              10460000
    DCNT1:=DCNT1+1;                                                     10465000
  END <<WHILE>>;                                                        10470000
IF NOT (LOGICAL(DCNT1)) THEN <<ONE DIGIT LEFT OVER>>                    10475000
  BEGIN                                                                 10480000
     ASSEMBLE(DUP);                                                     10485000
     TOS:=TOS&LSR(4);                                                   10490000
     ASSEMBLE(XCH);                                                     10495000
     TOS:=TOS&LSL(4);                                                   10500000
     TOS:=TOS LOR TOS;                                                  10505000
     OP2(XREG):=BYTE(TOS);                                              10510000
   END;                                                                 10515000
END <<RECOMPLEMENT>>;                                                   10520000
                                                                        10525000
SUBROUTINE CHECKZERO;                                                   10530000
                                                                        10535000
COMMENT: CHECKS (IF CHECKOP1 THEN OP1 ELSE OP2) FOR ALL ZEROS           10540000
         OR ALL ZEROS WITH LEADING 1, AND VALIDITY;                     10545000
                                                                        10550000
BEGIN                                                                   10555000
SUB:=1; DCNT1:=DCNT; <<STARTS WITH FIRST NON-COMPUTED DIGIT>>           10560000
IF CHECKOP1 THEN <<OP1>>                                                10565000
  BEGIN                                                                 10570000
    TOS:=OP1DIGS-DCNT;                                                  10575000
     XREG:=IF LOGICAL(OP1DIGS) THEN (TOS-1)&LSR(1) ELSE TOS&LSR(1);     10580000
    IF LEFT THEN                                                        10585000
      BEGIN                                                             10590000
        TOS:=OP1(XREG);                                                 10595000
        XREG:=XREG-1;                                                   10600000
      END;                                                              10605000
  END                                                                   10610000
ELSE <<OP2>>                                                            10615000
  BEGIN                                                                 10620000
    TOS:=OP2DIGS-DCNT;                                                  10625000
    XREG:=IF LOGICAL(OP2DIGS) THEN (TOS-1)&LSR(1) ELSE TOS&LSR(1);      10630000
    IF LEFT THEN                                                        10635000
      BEGIN                                                             10640000
        TOS:=OP2(XREG);                                                 10645000
        XREG:=XREG-1;                                                   10650000
      END;                                                              10655000
  END;                                                                  10660000
ALLZEROS:=TRUE;                                                         10665000
IF LEFT THEN                                                            10670000
  BEGIN                                                                 10675000
    TOS:=TOS&LSR(4); <<EXAMINE LEFT DIGIT SEPARATELY>>                  10680000
    ASSEMBLE(XAX); <<INDEX IN TOS, DIGIT IN X>>                         10685000
    IF XREG>%(2)1001 THEN TRAP(13)                                      10690000
    ELSE IF XREG=1 THEN                                                 10695000
      ONEANDZEROS:=TRUE                                                 10700000
    ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                                10705000
    SUB:=0; XREG:=TOS;                                                  10710000
  END;                                                                  10715000
WHILE XREG>=0 DO <<CHECK REST OF DIGITS>>                               10720000
  BEGIN                                                                 10725000
    TOS:=IF CHECKOP1 THEN OP1(XREG) ELSE OP2(XREG);                     10730000
    XREG:=XREG-1;                                                       10735000
    <<CHECK RIGHT DIGIT>>                                               10740000
    ASSEMBLE(DUP);                                                      10745000
    TOS:=TOS LAND %17; <<ISOLATE RIGHT DIGIT>>                          10750000
    ASSEMBLE(XAX); <<INDEX TO TOS, DIGIT TO XREG>>                      10755000
    IF XREG>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>                    10760000
    ELSE IF LOGICAL(SUB) THEN <<CHECK FOR LEADING 1>>                   10765000
      BEGIN                                                             10770000
        IF XREG=1 THEN ONEANDZEROS:=TRUE                                10775000
        ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                            10780000
        SUB:=0;                                                         10785000
      END                                                               10790000
    ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                                10795000
    ASSEMBLE(XCH); <<DIGITS ON TOS, INDEX IN TOS-1>>                    10800000
    XREG:=TOS&LSR(4); <<ISOLATE LEFT DIGIT AND PUT IN X>>               10805000
    IF XREG>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>                    10810000
    ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                                10815000
    XREG:=TOS; <<GET INDEX BACK FROM TOS>>                              10820000
  END <<WHILE>>;                                                        10825000
IF ONEANDZEROS THEN <<A 1 WAS THE FIRST DIGIT FOUND>>                   10830000
  BEGIN                                                                 10835000
    IF NOT ALLZEROS THEN ONEANDZEROS:=FALSE;                            10840000
    ALLZEROS:=FALSE;                                                    10845000
  END                                                                   10850000
ELSE IF NOT ALLZEROS THEN NONZERO:=TRUE;                                10855000
END <<CHECKZERO>>;                                                      10860000
                                                                        10865000
SUBROUTINE PROPAGATE;                                                   10870000
                                                                        10875000
COMMENT: PROPAGATES A CARRY IN OP2 AND EXTENDS OP1 WITH 9'S             10880000
         WHEN RUN OUT OF OP1 DIGITS;                                    10885000
                                                                        10890000
BEGIN                                                                   10895000
DCNT1:=DCNT;                                                            10900000
TOS:=OP2DIGS-DCNT;                                                      10905000
XREG:=IF LOGICAL(OP2DIGS) THEN (TOS-1)&LSR(1) ELSE TOS&LSR(1);          10910000
IF LEFT THEN                                                            10915000
  BEGIN                                                                 10920000
    TOS:=OP2(XREG);                                                     10925000
    ASSEMBLE(DUP);                                                      10930000
    TOS:=TOS&LSR(4); <<PUT D2 IN RIGHT>>                                10935000
    ASSEMBLE(XCH);                                                      10940000
    TOS:=TOS&LSL(4) LAND %377; <<PUT D1 IN LEFT>>                       10945000
    TOS:=TOS LOR TOS; <<DIGITS ARE REVERSED>>                           10950000
  END;                                                                  10955000
OP1SIGN:=OP2DIGS;                                                       10960000
IF LEFT AND LOGICAL(DCNT) OR NOT LEFT AND NOT(LOGICAL(DCNT)) THEN       10965000
  BEGIN                                                                 10970000
    DCNT1:=DCNT1+1;                                                     10975000
    OP1SIGN:=OP1SIGN+1;                                                 10980000
  END;                                                                  10985000
WHILE DCNT1 <OP1SIGN DO <<PROPAGATE TO END IF NECESSARY>>               10990000
  BEGIN                                                                 10995000
    IF LOGICAL(DCNT1) THEN <<GET TWO MORE DIGITS>>                      11000000
      BEGIN                                                             11005000
        TOS:=OP2(XREG);                                                 11010000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    11015000
        TOS:=TOS&DCSR(4); <<ISOLATE FIRST DIGIT>>                       11020000
      END                                                               11025000
    ELSE <<ISOLATE SECOND DIGIT OF BYTE>>                               11030000
      BEGIN                                                             11035000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    11040000
        TOS:=TOS&DCSR(4); <<ISOLATE SECOND DIGIT>>                      11045000
      END;                                                              11050000
    ASSEMBLE(DUP); <<DOPY OF DIGIT FOR VALIDITY>>                       11055000
    IF LOGICAL(TOS)>%110000 THEN TRAP(13);                              11060000
    IF NEXTCARRY OR EXTEND THEN <<PROPAGATE IT>>                        11065000
      BEGIN                                                             11070000
        IF NEXTCARRY THEN                                               11075000
          BEGIN                                                         11080000
            NEXTCARRY:=FALSE;                                           11085000
            TOS:=ONE;                                                   11090000
            ASSEMBLE(LADD);                                             11095000
          END;                                                          11100000
        IF EXTEND THEN                                                  11105000
          BEGIN                                                         11110000
            TOS:=NINE;                                                  11115000
            ASSEMBLE(LADD);                                             11120000
          END;                                                          11125000
        IF CARRY THEN                                                   11130000
          BEGIN                                                         11135000
            NEXTCARRY:=TRUE;                                            11140000
            TOS:=LOGICAL(TOS)+SIX;                                      11145000
          END                                                           11150000
        ELSE                                                            11155000
          BEGIN                                                         11160000
            ASSEMBLE(DUP);                                              11165000
            TOS:=LOGICAL(TOS)+SIX; <<CHECKFOR CARRY>>                   11170000
            IF CARRY THEN                                               11175000
              BEGIN                                                     11180000
                NEXTCARRY:=TRUE;                                        11185000
                ASSEMBLE(DELB);                                         11190000
              END                                                       11195000
            ELSE ASSEMBLE(DEL);                                         11200000
          END;                                                          11205000
      END;                                                              11210000
    ASSEMBLE(TEST);IF <> THEN <<NONZERO DIGIT>> NONZERO:=TRUE;          11215000
    TOS:=TOS&LSR(8); TOS:=TOS LOR TOS;                                  11220000
    IF NOT (LOGICAL(DCNT1)) THEN                                        11225000
      BEGIN                                                             11230000
        OP2(XREG):=BYTE(TOS);                                           11235000
        XREG:=XREG-1;                                                   11240000
      END;                                                              11245000
    DCNT1:=DCNT1+1;                                                     11250000
  END <<WHILE>>;                                                        11255000
IF NOT (LOGICAL(DCNT1)) THEN <<STORE ONLY 1 DIGIT>>                     11260000
  BEGIN                                                                 11265000
    ASSEMBLE(DUP);                                                      11270000
    TOS:=TOS&LSR(4);                                                    11275000
    ASSEMBLE(XCH);                                                      11280000
    TOS:=TOS&LSL(4);                                                    11285000
    TOS:=TOS LOR TOS;                                                   11290000
    OP2(XREG):=BYTE(TOS);                                               11295000
  END;                                                                  11300000
END <<PROPAGATE>>;                                                      11305000
                                                                        11310000
                                                                        11315000
SDEC'AND'MODE;               <<COMPARE ENTRY POINT>>                    11320000
CMP:=TRUE; OP1SIGN:=OP2SIGN:=0;                                         11325000
IF 1<=OP1DIGS<=28 AND                                                   11330000
   1<=OP2DIGS<=28 THEN                                                  11335000
  BEGIN                                                                 11340000
    TOS:=LOGICAL(OP1(OP1DIGS&LSR(1))) LAND %17;                         11345000
    TOS:=LOGICAL(OP2(OP2DIGS&LSR(1))) LAND %17;                         11350000
    IF TOS=%(2)1101 THEN OP2SIGN:=1; IF TOS=%(2)1101 THEN OP1SIGN:=1;   11355000
    IF OP1SIGN<>OP2SIGN THEN <<SIGNS DIFFER, THE ONLY WAY THEY          11360000
                               COULD BE EQUAL IS IF THEY ARE +0,-0>>    11365000
      BEGIN                                                             11370000
        OP1ZERO:=FALSE;  DCNT:=0;                              <<C0.12>>11375000
        OP2ADR := @OP2;  <<IN CASE OF A TRAP, I DON'T WANT THE><<C0.12>>11380000
        TOP2DIGS := OP2DIGS; <<TRAP ROUTINE TO GIVE BAD FIXUPS><<C0.12>>11385000
        LEFT := TRUE;  <<START WITH LEFT PART OF SIGN BYTE>>   <<C0.12>>11390000
        RESTORE1 := RESTORE2 := FIXSTACK := FALSE;             <<C0.12>>11395000
        IF NOT(LOGICAL(OP1DIGS)) THEN  <<ZERO HIGH ORDER>>     <<C0.12>>11400000
           BEGIN       <<NON-SIGNIFICANT DIGIT TEMPORARILY>>   <<C0.12>>11405000
           TOS := OP1;                                         <<C0.12>>11410000
           ASSEMBLE(DUP);  <<MAKE ONE COPY FOR FIXUP, ONE TO SAVE>>     11415000
           SAVEOP1 := TOS;                                     <<C0.12>>11420000
           OP1 := TOS LAND %17;                                <<C0.12>>11425000
           RESTORE1 := TRUE;                                   <<C0.12>>11430000
           END;                                                <<C0.12>>11435000
        ONEANDZEROS:=NONZERO:=FALSE; CHECKOP1:=TRUE;                    11440000
        CHECKZERO; <<CHECK OP1>>                                        11445000
        IF ALLZEROS THEN OP1ZERO:=TRUE;                                 11450000
        DCNT:=0; CHECKOP1:=ONEANDZEROS:=NONZERO:=FALSE;                 11455000
        IF NOT(LOGICAL(OP2DIGS)) THEN  <<TEMP FIXUP OF OP2>>   <<C0.11>>11460000
           BEGIN                                               <<C0.11>>11465000
           TOS := OP2;                                         <<C0.11>>11470000
           ASSEMBLE(DUP);                                      <<C0.11>>11475000
           SAVEOP2 := TOS LAND %360;                           <<C0.11>>11480000
           OP2 := TOS LAND %17;                                <<C0.11>>11485000
           RESTORE2 := TRUE;                                   <<C0.11>>11490000
           END;                                                <<C0.11>>11495000
        CHECKZERO; <<CHECK OP2>>                                        11500000
        IF RESTORE1 THEN OP1 := BYTE(SAVEOP1);                 <<C0.11>>11505000
        IF RESTORE2 THEN OP2 := LOGICAL(OP2) LOR SAVEOP2;      <<C0.11>>11510000
        TOS:=STATUSWORD LAND %176377;                                   11515000
        IF OP1ZERO AND ALLZEROS THEN <<+0 AND -0>>                      11520000
          TOS:=TOS LOR %1000 <<CC =>>                                   11525000
        ELSE IF OP2SIGN>OP1SIGN THEN <<OP2 -, OP1 +, CC< >>             11530000
          TOS:=TOS LOR %400;                                            11535000
        STATUSWORD:=TOS;                                                11540000
        TOS:=%031400+SDEC;                                              11545000
        PUSH(Q); TOS:=TOS-5; SET(Q); <<EXIT TO USER>>                   11550000
        ASSEMBLE(XEQ 0); <<EXIT>>                                       11555000
      END                                                               11560000
    ELSE <<SIGNS ARE THE SAME, DO SUBTRACT>>                            11565000
      BEGIN                                                             11570000
        <<PREVENTS DECIMAL OVERFLOW FROM OCCURING AS A                  11575000
          RESULT OF A COMPARE BY MOVING OP2 TO A LOCAL IN               11580000
          THE CORRECT POSITION>>                                        11585000
        WLOP2:=0; MOVE WLOP2(1):=WLOP2,(7); <<ZERO IT>>                 11590000
        OP1ZERO:=(OP2DIGS+2)&LSR(1);<<TEMP FOR NUMBER OF BYTES IN OP2>> 11595000
        TOS := OP2;  <<GET HIGH ORDER BYTE OF OP2>>            <<C0.12>>11600000
        IF NOT LOGICAL(OP2DIGS) THEN  <<NECESSARY TO ZERO OUT NON->>    11605000
          OP2 := LOGICAL(OP2) LAND %17;    <<SIGNIFICANT DIGIT IN LOP2>>11610000
        MOVE LOP2(16-OP1ZERO):=OP2,(OP1ZERO);                           11615000
        OP2 := TOS;  <<RESTORE OP2 TO ORIGINAL STATE>>         <<C0.12>>11620000
        OP2ADR:=@OP2; <<SAVE OP2 ADDRESS FOR LATER RESTORATION>>        11625000
        TOP2DIGS:=OP2DIGS; <<SAVE OPERAND 2 DIGIT COUNT>>               11630000
        IF OP2DIGS>=OP1DIGS THEN <<NO PROBLEM WITH LENGHTS>>            11635000
          @OP2:=@LOP2(16-OP1ZERO)                                       11640000
        ELSE                                                            11645000
          BEGIN                                                         11650000
            OP2DIGS:=OP1DIGS;                                           11655000
            @OP2:=@LOP2(16-(OP1DIGS+2)&LSR(1));                         11660000
          END;                                                          11665000
        OP1SIGN:=OP2SIGN:=0;                                            11670000
      END;                                                              11675000
  END                                                                   11680000
ELSE CMP:=FALSE;                                                        11685000
                                                                        11690000
SUBD:              <<SUBTRACT ENTRY POINT>>                             11695000
SUB:=1;                                                                 11700000
                                                                        11705000
ADDD:                   <<ADD ENTRY POINT>>                             11710000
                                                                        11715000
IF NOT CMP THEN <<GET SDEC AND GET USER MODE>>                          11720000
  BEGIN                                                                 11725000
    SDEC'AND'MODE;                                                      11730000
  END;                                                                  11735000
LEFT:=RESULTSIGN:=DOVERFLOW:=ALLZEROS:=ONEANDZEROS:=COMPLEMENT:=        11740000
NONZERO:=FLIPSIGN:=NEXTCARRY:=EXTEND:=FALSE;                            11745000
NINE:=%110000; ONE:=%10000; SIX:=%60000;                                11750000
IF CMP OR 1<=OP1DIGS<=28 AND                                            11755000
  1<=OP2DIGS<=28 THEN                                                   11760000
  BEGIN                                                                 11765000
    <<ZERO HIGH ORDER NON-SIG DIGITS>>                                  11770000
    RESTORE1 := RESTORE2 := FIXSTACK := FALSE;                          11775000
    IF CMP THEN                                                         11780000
      BEGIN  <<FIX UP NON-SIGNIFICANT DIGITS>>                          11785000
      <<FIRST DIGIT OF OP2 WAS FIXED UP FOR COMPARE IN COMPARE><<C0.12>>11790000
      <<INITIALIZATION SECTION ABOVE>>                         <<C0.12>>11795000
      IF NOT(LOGICAL(OP1DIGS)) THEN                                     11800000
        BEGIN                                                           11805000
        TOS := OP1;                                                     11810000
        ASSEMBLE(DUP);                                                  11815000
        SAVEOP1 := TOS;                                                 11820000
        OP1 := TOS LAND %17;                                            11825000
        RESTORE1 := TRUE;                                               11830000
        END                                                             11835000
      END                                                               11840000
    ELSE                                                                11845000
      IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN <<NO OVERLAP>>    11850000
        BEGIN                                                           11855000
        IF NOT(LOGICAL(OP1DIGS)) THEN                                   11860000
          BEGIN                                                         11865000
          TOS := OP1;                                                   11870000
          ASSEMBLE(DUP);                                                11875000
          SAVEOP1 := TOS;                                               11880000
          OP1 := TOS LAND %17;                                          11885000
          RESTORE1 := TRUE;                                             11890000
          END;                                                          11895000
        IF NOT(LOGICAL(OP2DIGS)) THEN                                   11900000
          BEGIN                                                         11905000
          TOS := OP2;                                                   11910000
          ASSEMBLE(DUP);                                                11915000
          SAVEOP2 := TOS LAND %360;                                     11920000
          OP2 := TOS LAND %17;                                          11925000
          RESTORE2 := TRUE;                                             11930000
          END                                                           11935000
        END                                                             11940000
      ELSE   <<OVERLAPPING OPERANDS>>                                   11945000
        BEGIN                                                           11950000
        FIXSTACK := TRUE;                                               11955000
        MOVE LOP1 := OP1,((OP1DIGS+2)&LSR(1));  <<MOVE TO LOCAL>>       11960000
        OP1ADR := @OP1;                                                 11965000
        @OP1 := @LOP1;  <<NOW POINTS TO LOCAL>>                         11970000
        IF NOT(LOGICAL(OP1DIGS)) THEN                                   11975000
          OP1 := LOGICAL(OP1) LAND %17;                                 11980000
        IF NOT(LOGICAL(OP2DIGS)) THEN                                   11985000
          BEGIN                                                         11990000
          TOS := OP2;                                                   11995000
          ASSEMBLE(DUP);                                                12000000
          SAVEOP2 := TOS LAND %360;                                     12005000
          OP2 := TOS LAND %17;                                          12010000
          RESTORE2 := TRUE;                                             12015000
          END                                                           12020000
        END;                                                            12025000
    OP1X:=OP1DIGS&LSR(1); OP2X:=OP2DIGS&LSR(1); DCNT:=0;                12030000
    TOS:=OP1(OP1X); <<FIRST DIGIT AND SIGN>>                            12035000
    TOS:=0; TOS:=TOS & DCSR(4); <<ISOLATE OP1 SIGN>>                    12040000
    IF TOS=%150000 THEN <<OP1 IS NEGATIVE>>                             12045000
      OP1SIGN:=4;                                                       12050000
    TOS:=OP2(OP2X);   <<FIRST DIGIT AND SIGN OF OP1>>                   12055000
    TOS:=0; TOS:=TOS&DCSR(4); ASSEMBLE(DUP); <<ISOLATE OP2 SIGN DIGIT>> 12060000
    IF TOS=%150000 THEN <<OP2 IS NEGATIVE>>                             12065000
      OP2SIGN:=2;                                                       12070000
    TOS:=TOS &LSR(8); TOS:=TOS LOR TOS; <<PUT SIGN DIGIT IN OP2 WORD>>  12075000
    CASE * OP1SIGN+OP2SIGN+SUB OF <<SET FLAGS>>                         12080000
      BEGIN                                                             12085000
        <<ADD, OP1 +, OP2 +>> ;                                         12090000
        <<SUB, OP1 +, OP2 +>>                                           12095000
        COMPLEMENT:=TRUE;  <<ACTUAL SUBTRACT>>                          12100000
        <<ADD, OP1 +, OP2 ->>                                           12105000
        COMPLEMENT:=TRUE; <<ACTUAL SUBTRACT>>                           12110000
        <<SUB, OP1 +, OP2 ->>                                           12115000
         RESULTSIGN:=TRUE;    <<RESULT SIGN WILL BE ->>                 12120000
        <<ADD, OP1 -, OP2 +>>                                           12125000
        COMPLEMENT:=TRUE;    <<ACTUAL SUBTRACT>>                        12130000
        <<SUB, OP1 -, OP2 +>>;                                          12135000
        <<ADD, OP1 -, OP2 ->>                                           12140000
        RESULTSIGN:=TRUE;                                               12145000
        <<SUB, OP1 -, OP2 ->>                                           12150000
        COMPLEMENT:=TRUE;   <<ACTUAL SUBTRACT>>                         12155000
      END <<CASE>>;                                                     12160000
    WHILE DCNT<OP1DIGS AND DCNT<OP2DIGS DO <<DIGIT BY DIGIT ADD>>       12165000
      BEGIN                                                             12170000
        IF LOGICAL(DCNT) THEN <<TIME TO GET 2 MORE DIGITS>>             12175000
          BEGIN                                                         12180000
            ASSEMBLE(DEL); <<CLEAN OFF STACK>>                          12185000
            TOS:=OP1(OP1X:=OP1X-1); <<GET 2 DIGITS>>                    12190000
            TOS:=0; <<EXTEND TO DOUBLE>>                                12195000
            TOS:=TOS&DCSR(4); <<ISOLATE DIGIT IN TOP 4 BITS>>           12200000
            ASSEMBLE(DUP);                                              12205000
            IF LOGICAL(TOS)>%110000 THEN  TRAP(13);                     12210000
            TOS:=OP2(OP2X:=OP2X-1); <<2 MORE OP2 DIGITS>>               12215000
            TOS:=0; <<EXTEND TO DOUBLE>>                                12220000
            TOS:=TOS&DCSR(4); <<ISOLATE DIGIT ON TOS>>                  12225000
            ASSEMBLE(DUP);                                              12230000
            IF LOGICAL(TOS)>%110000 THEN TRAP(13);                      12235000
            ASSEMBLE(CAB); <<OP1,OP2,OP2,OP1 ON TOS>>                   12240000
          END                                                           12245000
        ELSE <<GET NEXT DIGIT FROM OLD BYTE>>                           12250000
          BEGIN                                                         12255000
            ASSEMBLE(XCH, <<OP2, OP1 ON TOS>>                           12260000
                     ZERO); <<EXTEND TO DOUBLE>>                        12265000
            TOS:=TOS&DCSR(4); <<ISOLATE OP1 DIGIT>>                     12270000
            ASSEMBLE(DUP); <<READY FOR INVALID DIGIT CHECK>>            12275000
            IF LOGICAL(TOS)>%110000 THEN TRAP(13);                      12280000
            ASSEMBLE(CAB,  <<READY FOR OP2 DIGIT>>                      12285000
                     ZERO); <<EXTEND TO DOUBLE>>                        12290000
            TOS:=TOS&DCSR(4); <<ISOLATE DIGIT>>                         12295000
            ASSEMBLE(DUP); <<COPY FOR VALIDTITY CHECK>>                 12300000
            IF LOGICAL(TOS)>%110000 THEN TRAP(13);                      12305000
            ASSEMBLE(CAB); <<OP1,OP2,OP2,OP1 ON TOS>>                   12310000
          END;                                                          12315000
        IF COMPLEMENT THEN <<SUBTRACT>>                                 12320000
          BEGIN                                                         12325000
            TOS:=NINE; ASSEMBLE(XCH,LSUB);                              12330000
            IF DCNT=0 THEN TOS:=LOGICAL(TOS)+ONE;                       12335000
          END;                                                          12340000
        IF NEXTCARRY THEN                                               12345000
          BEGIN                                                         12350000
            NEXTCARRY:=FALSE;                                           12355000
            TOS:=LOGICAL(TOS)+ONE; <<INCR OP1 DIGIT>>                   12360000
          END;                                                          12365000
        TOS:=LOGICAL(TOS)+LOGICAL(TOS); <<LOGICAL ADD>>                 12370000
        IF CARRY THEN                                                   12375000
          BEGIN                                                         12380000
            NEXTCARRY:=TRUE;                                            12385000
            TOS:=LOGICAL(TOS)+SIX;                                      12390000
          END                                                           12395000
        ELSE <<CHECK FOR A RESULT DIGIT>10>>                            12400000
          BEGIN                                                         12405000
            ASSEMBLE(DUP); <<COPY RESULT DIGIT>>                        12410000
            TOS:=LOGICAL(TOS)+SIX;                                      12415000
            IF CARRY THEN                                               12420000
              BEGIN                                                     12425000
                NEXTCARRY:=TRUE; ASSEMBLE(DELB);                        12430000
              END                                                       12435000
            ELSE ASSEMBLE(DEL);                                         12440000
          END;                                                          12445000
        ASSEMBLE(DUP); <<COPY RESULT DIGIT>>                            12450000
        IF TOS<>0 THEN NONZERO:=TRUE;                                   12455000
        TOS:=TOS&LSR(8);                                                12460000
        TOS:=TOS LOR TOS;                                               12465000
        IF NOT(LOGICAL(DCNT)) THEN <<STORE TWO DIGITS>>                 12470000
          OP2(OP2X):=BYTE(TOS);                                         12475000
        DCNT:=DCNT+1;                                                   12480000
      END <<WHILE>>;                                                    12485000
    IF NOT(LOGICAL(DCNT)) THEN <<STORE 1 DIGIT>>                        12490000
      BEGIN                                                             12495000
        ASSEMBLE(DUP); <<R1,D2>>                                        12500000
        TOS:=TOS&LSR(4); <<R1>>                                         12505000
        ASSEMBLE(XCH);  <<R1;R1,D2>>                                    12510000
        TOS:=TOS&LSL(4); <<R1;B,R1,D2,B>>                               12515000
        TOS:=TOS LOR TOS; <<D2,R1>>                                     12520000
        OP2(OP2X):=BYTE(TOS);                                           12525000
        LEFT:=TRUE;                                                     12530000
      END;                                                              12535000
    <<TERMINATION>>                                                     12540000
    IF DCNT=OP1DIGS AND DCNT=OP2DIGS THEN <<EQUAL LENGHT OPERANDS>>     12545000
      BEGIN                                                             12550000
        IF COMPLEMENT THEN <<SUBTRACTION>>                              12555000
          BEGIN                                                         12560000
            IF NOT NEXTCARRY THEN RECOMPLEMENT;                         12565000
          END                                                           12570000
        ELSE IF NEXTCARRY <<ADD OVERFLOW>> THEN DOVERFLOW:=TRUE;        12575000
      END                                                               12580000
    ELSE IF DCNT=OP1DIGS THEN <<RAN OUT OF OP1 DIGITS>>                 12585000
      IF COMPLEMENT THEN <<SUBTRACTION>>                                12590000
        BEGIN                                                           12595000
           EXTEND:=TRUE; PROPAGATE;                                     12600000
          IF NOT NEXTCARRY THEN RECOMPLEMENT;                           12605000
        END                                                             12610000
      ELSE <<ADD>>                                                      12615000
        BEGIN                                                           12620000
          IF NEXTCARRY THEN                                             12625000
            BEGIN                                                       12630000
              PROPAGATE;                                                12635000
              IF NEXTCARRY THEN DOVERFLOW:=TRUE; <<OVERFLOW>>           12640000
            END                                                         12645000
          ELSE                                                          12650000
            BEGIN                                                       12655000
              CHECKOP1:=FALSE;                                          12660000
              CHECKZERO;                                                12665000
              IF NOT ALLZEROS THEN NONZERO:=TRUE;                       12670000
            END;                                                        12675000
        END                                                             12680000
    ELSE <<RAN OUT OF OP2 DIGITS>>                                      12685000
      BEGIN                                                             12690000
        CHECKOP1:=TRUE;                                                 12695000
        CHECKZERO;  <<CHECK REST OF OP1 DIGITS FOR VALIDITY AND         12700000
                         FOR A SPECIAL CASE OPERATION>>                 12705000
        IF COMPLEMENT THEN <<SUBTRACT>>                                 12710000
          BEGIN                                                         12715000
            IF ONEANDZEROS THEN <<COULD BE ALL RIGHT>>                  12720000
              BEGIN                                                     12725000
                TOS:=NEXTCARRY; TOS:=NONZERO;                           12730000
                <<KEEP NONZERO ON TOS AS TEMP,                          12735000
                  RECOMPLEMENT MAY CHANGE IT>>                          12740000
                RECOMPLEMENT;                                           12745000
                IF TOS <<NONZERO>> XOR TOS <<NEXTCARRY>> THEN           12750000
                  DOVERFLOW:=TRUE; <<OVERFLOW>>                         12755000
              END                                                       12760000
            ELSE                                                        12765000
              IF NOT ALLZEROS THEN <<OVERFLOW>>                         12770000
                BEGIN                                                   12775000
                  RECOMPLEMENT;                                         12780000
                  DOVERFLOW:=TRUE;                                      12785000
                END                                                     12790000
              ELSE IF NOT NEXTCARRY THEN RECOMPLEMENT;                  12795000
          END                                                           12800000
        ELSE <<ADD CASE>>                                               12805000
          IF NEXTCARRY OR NOT ALLZEROS THEN DOVERFLOW:=TRUE;            12810000
        LEFT := TRUE;  <<NOW CHECK RESULT FOR ZERO>>                    12815000
        DCNT := 0;  <<START WITH 0'TH DIGIT OF RESULT>>                 12820000
        CHECKOP1 := FALSE;                                              12825000
        CHECKZERO;  <<CHECK SIGN OF RESULT OPERAND>>                    12830000
        IF ALLZEROS THEN NONZERO := FALSE;  <<RESULT IS 0>>             12835000
      END;                                                              12840000
    <<SET THE FINAL SIGN>>                                              12845000
    TOS:=%(2)1100; <<PLUS>>                                             12850000
    IF NONZERO THEN                                                     12855000
     IF FLIPSIGN AND OP2SIGN=0 OR                                       12860000
          NOT FLIPSIGN AND OP2SIGN=2 THEN <<NEGATIVE>>                  12865000
      BEGIN                                                             12870000
        RESULTSIGN:=TRUE;                                               12875000
        TOS:=TOS+1; <<MAKE SIGN NEGATIVE>>                              12880000
      END;                                                              12885000
    OP2(XREG):=LOGICAL(OP2(OP2DIGS&LSR(1))) LAND %360 LOR TOS;          12890000
    <<SET CONDITION CODE>>                                              12895000
    TOS:=STATUSWORD LAND %176377;                                       12900000
    IF NONZERO AND RESULTSIGN THEN <<->>                                12905000
       TOS:=TOS LOR %400                                                12910000
    ELSE IF NOT NONZERO THEN <<ZERO>>                                   12915000
       TOS:=TOS LOR %1000;                                              12920000
    STATUSWORD:=TOS;                                                    12925000
    IF DOVERFLOW THEN TRAP(11); <<DECIMAL OVERFLOW>>                    12930000
    IF CMP THEN <<RESTORE OP2 ADDRESS AND DIGIT COUNT>>                 12935000
      BEGIN @OP2:=OP2ADR; OP2DIGS:=TOP2DIGS; END;                       12940000
    IF FIXSTACK THEN @OP1 := OP1ADR;                                    12945000
    IF RESTORE1 THEN OP1 := SAVEOP1;                                    12950000
    IF RESTORE2 THEN OP2 := LOGICAL(OP2) LOR SAVEOP2;                   12955000
  END                                                                   12960000
ELSE IF NOT (0<=OP1DIGS<=28) OR NOT (0<=OP2DIGS<=28) THEN               12965000
   DEC'SIM'TRAP(15);                                                    12970000
TOS:=%031400+SDEC;                                                      12975000
<<EXIT OVER USER'S STACK MARKER>>                                       12980000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            12985000
ASSEMBLE(XEQ 0); <<DO SDEC>>                                            12990000
END <<CMPD>>;                                                           12995000
$PAGE                                                                   13000000
$CONTROL SEGMENT=FIRMWARESIM2                                           13005000
<<......................................................................13010000
.                                                                      .13015000
.                                 MPYD                                 .13020000
.                                                                      .13025000
.                  ADDED IN C0.11                                      .13030000
......................................................................>>13035000
PROCEDURE MPYDSIM;                                                      13040000
OPTION PRIVILEGED,UNCALLABLE;                                           13045000
                                                                        13050000
COMMENT:                                                                13055000
                                                                        13060000
THE OPERAND2 FIELD IS REPLACED BYU THE OPERAND2 FIELD TIMES THE         13065000
OPERAND1 FIELD.  THE RANGE OF DIGITS LEGAL (NOT TRAPPED) FOR            13070000
THE TWO OPERANDS IS 0<=DIGITS<=28, 0 DIGITS IS A NOP WITH SDEC.         13075000
IF THE RESULT IS TOO LARGE TO BE REPRESENTED IN THE RESULT              13080000
FIELD, THE LEFT TRUNCATED RESULT IS LEFT IN OP2 AND A TRAP              13085000
OCCURS.  CCA IS SET ON THE RESULT.                            ;         13090000
                                                                        13095000
                                                                        13100000
BEGIN                                                                   13105000
                                                                        13110000
BYTE POINTER OP1=Q-10,        <<OPERAND 1 PACKED DECIMAL FIELD>>        13115000
             OP2=Q-12;        <<OPERAND 2 PACKED DECIMAL FIELD>>        13120000
INTEGER OP1DIGS=Q-9,        <<NUMBER OF DECIMAL DIGITS IN OP1>>         13125000
        OP2DIGS=Q-11;       <<NUMBER OF DECIMAL DIGITS IN OP2>>         13130000
                                                                        13135000
INTEGER OP1X,          <<INDEX TO OP1 WHEN MULTIPLYING>>                13140000
        OP2X,          <<INDEX TO OP2 WHEN MULTIPLYING>>                13145000
        LOP1WORDS,     <<NUMBER OF WORDS IN BINARY EQUIVALENT OF OP1>>  13150000
        LOP2WORDS,     <<NUMBER OF WORDS IN BINARY EQUIVALENT OF OP2>>  13155000
        WORDS,         <<DUMMY PARAMETER FOR MULTIWORD NEGATE>>         13160000
        RESLEN:=0,        <<LENGTH OF RESULT IN BINARY WORDS>>          13165000
        XREG=X;                                                         13170000
LOGICAL DCARRY,        <<FLAG FOR PROPAGATION OF CARRY IN MULTIPLY>>    13175000
        DOVERFLOW:=FALSE,   <<TRUE IF PRODUCT OVERFLOWS>>               13180000
        INSTR=Q-4,     <<MACHINE OPCODE WITH SDEC>>                     13185000
        MINUS:=FALSE,  <<TRUE IF RESULT IS TO BE MINUS>>                13190000
        ZERO:=FALSE,    <<TRUE IF RESULT IS ZERO>>                      13195000
        STATUSWORD=Q-6; <<WHERE CC IS KEPT>>                            13200000
ARRAY LOP1(-1:5),       <<ARRRAY FOR BINARY EQUIVALENT OF OP1>>         13205000
      LOP2(-1:5),       <<ARRAY FOR BINARY EQUIVALENT OF OP2>>          13210000
      PRODUCT(-3:9);    <<ARRAY FOR BINARY PRODUCT>>                    13215000
DOUBLE POINTER DLOP1=LOP1, <<OP1 IS ACCESSED BY DOUBLEWORDS>>           13220000
               DLOP2=LOP2, <<OP2 IS ACCESSED BY DOUBLEWORDS>>           13225000
               DP=PRODUCT, <<RESULT ARRAY ALSO ACCESSED BY DOUBLEWORD>> 13230000
               DOP1,DOP2;   <<DUMMY PARAMETERS FOR MULTIPLY>>           13235000
DOUBLE PHIGH;          <<TEMP FOR HIGH ORDER PART OF A PRODUCT>>        13240000
POINTER P=OP1X;        <<DUMMY PARAMETER FOR MULTIWORD NEGATE>>         13245000
INTEGER TEMPSDEC=Q-3;  <<LOCAL STOREAGE FOR SDEC>>             <<03.00>>13250000
                                                                        13255000
SUBROUTINE ZERORESULT;                                                  13260000
                                                                        13265000
<<IF OP1 IS ZERO, ZEROS OUT OP2 GIVING ZERO RESULT>>                    13270000
                                                                        13275000
BEGIN                                                                   13280000
ZERO:=TRUE;                                                             13285000
XREG:=OP2DIGS&LSR(1);                                                   13290000
TOS:=%(2)1100; <<POSITIVE SIGN>>                                        13295000
OP2(XREG):=BYTE(TOS); XREG:=XREG-1;  <<PUT IN SIGHN BYTE>>              13300000
WHILE XREG>0 DO <<ZERO OUT REST OF OP2>>                       <<C0.12>>13305000
  BEGIN                                                                 13310000
    OP2(XREG):=0;                                                       13315000
    XREG:=XREG-1;                                                       13320000
  END;                                                                  13325000
IF (XREG = 0) THEN <<HANDLE LAST DIGIT?>>                      <<C0.12>>13330000
   IF NOT(LOGICAL(OP2DIGS)) THEN  <<PRESERVE LEFT DIGIT>>      <<C0.12>>13335000
      OP2:=LOGICAL(OP2) LAND %360 ELSE OP2:=0;                 <<C0.12>>13340000
END <<ZERORESULT>>;                                            <<C0.12>>13345000
                                                                        13350000
SUBROUTINE NEGATE;                                                      13355000
                                                                        13360000
<<DOES NEGATION OF THE ARRAY P, WHICH IS OF LENGTH WORDS>>              13365000
                                                                        13370000
BEGIN                                                                   13375000
XREG := WORDS; <<USED TO INDEX THROUGH RESULT ARRAY>>                   13380000
TOS := 1;  <<TWO'S COMPLEMENT IS COMPLEMENT, INCREMENT>>                13385000
WHILE (XREG := XREG-1) >= 0 DO  <<TAKE TWO'S COMPLEMENT>>               13390000
   BEGIN                                                                13395000
   P(XREG) := NOT(P(XREG)) + TOS;                                       13400000
   IF CARRY THEN TOS := 1 ELSE TOS := 0; <<PROPAGATE CARRY>>            13405000
   END;  <<NEGATION LOOP>>                                              13410000
DEL;                                                                    13415000
END <<NEGATE>>;                                                         13420000
                                                                        13425000
SUBROUTINE TWOBYFOUR;                                                   13430000
                                                                        13435000
<<MULTIPLIES A TWO WORD OPERAND BY A FOUR WORD OPERAND TO               13440000
  GET A SIX WORD RESULT>>                                               13445000
                                                                        13450000
BEGIN                                                                   13455000
ASSEMBLE(DZRO);                                                         13460000
TOS:=DOP2(1);                                                           13465000
TOS:=DOP1;                                                              13470000
ASSEMBLE(DMPY); <<DMPY: FOUR WORD PRODUCT>>                             13475000
DP(XREG):=TOS;   <<LEAVE HIGH ORDER PART ON TOS>>                       13480000
TOS:=DOP2;                                                              13485000
TOS:=DOP1;                                                              13490000
ASSEMBLE(DMPY; <<DMPY>>                                                 13495000
         DXCH        ); <<LEAVE HIGH ORDER PART ON TOS>>                13500000
PHIGH:=TOS; <<STORE IT TEMPORARILY>>                                    13505000
ASSEMBLE(DADD);    <<ADD LOW OF THIS ONE AND HIGH PART OF LAST TIME>>   13510000
DP:=TOS;           <<STORE NEW LOW ORDER PART>>                         13515000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE ANY CARRRY OUT OF LOW ORDER       13520000
                            PART TO HIGH ORDER PART>>                   13525000
TOS:=PHIGH;         <<GET HIGH ORDER PART>>                             13530000
ASSEMBLE(DADD);      <<PROPAGATE THE CARRY>>                            13535000
DP(-1):=TOS;                                                            13540000
END <<TWOBYFOUR>>;                                                      13545000
                                                                        13550000
SUBROUTINE TWOBYSIX;                                                    13555000
                                                                        13560000
<<MULTIPLIES A TWO WORD OPERAND BY A SIX WORD OPERAND,                  13565000
  PRODUCING A EIGHT WORD RESULT>>                                       13570000
                                                                        13575000
BEGIN                                                                   13580000
ASSEMBLE(DZRO,DZRO);  <<USED TO PROPAGATE CARRIES>>                     13585000
TOS:=DOP2(2);                                                           13590000
TOS:=DOP1;                                                              13595000
ASSEMBLE(DMPY); <<DMPY: FOUR WORD PRODUCT>>                             13600000
DP(XREG):=TOS;   <<LEAVE HIGH ORDER PART ON TOS>>                       13605000
TOS:=DOP2(1);                                                           13610000
TOS:=DOP1;                                                              13615000
ASSEMBLE(DMPY;    <<DMPY>>                                              13620000
         DXCH        );  <<LEAVE HIGH ORDER PART ON TOS>>               13625000
PHIGH:=TOS;     <<CURRENT HIGH ORDER PART>>                             13630000
ASSEMBLE(DADD);                                                         13635000
DP(XREG):=TOS;  <<STORE NEW LOW ORDER PART>>                            13640000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE CARRY TO HIGH ORDER PART>>        13645000
TOS:=PHIGH;                                                             13650000
ASSEMBLE(DADD); <<FORM NEW HIGH ORDER PART>>                            13655000
TOS:=DOP2;                                                              13660000
TOS:=DOP1;                                                              13665000
ASSEMBLE(DMPY;   <<DMPY>>                                               13670000
         DXCH        ); <<LEAVE HIGH ORDER PART ON TOS>>                13675000
PHIGH :=TOS;                                                            13680000
ASSEMBLE(DADD); <<FORM NEW LOW ORDER PART>>                             13685000
DP:=TOS;                                                                13690000
IF CARRY THEN TOS:=TOS+1;                                               13695000
TOS:=PHIGH;                                                             13700000
ASSEMBLE(DADD); <<FORM HIGHEST ORDER PART>>                             13705000
DP(-1):=TOS; <<STORE IT>>                                               13710000
END <<TWOBYSIX>>;                                                       13715000
                                                                        13720000
SUBROUTINE FOURBYFOUR;                                                  13725000
                                                                        13730000
<<MULTIPLIES A FOUR WORD OPERAND BY ANOTHER, PRODUCING AN               13735000
  EIGHT WORD RESULT>>                                                   13740000
                                                                        13745000
BEGIN                                                                   13750000
ASSEMBLE(DZRO,DZRO);                                                    13755000
TOS:=DLOP2(1); TOS:=DLOP1(1);                                           13760000
ASSEMBLE(DMPY); <<DMPY: FOUR WORD PRODUCT>>                             13765000
DP(2):=TOS;                                                             13770000
TOS:=DLOP2(1); TOS:=DLOP1;                                              13775000
ASSEMBLE(DMPY;   <<DMPY>>                                               13780000
         DXCH        ); <<LEAVE HIGH ORDER PART OF PRODUCT ON TOS>>     13785000
PHIGH:=TOS;                                                             13790000
ASSEMBLE(DADD); <<FORM NEW LOW ORDER PART>>                             13795000
DP(1):=TOS;                                                             13800000
IF CARRY THEN TOS:=TOS+1;                                               13805000
TOS:=PHIGH;                                                             13810000
ASSEMBLE(DADD); <<GET NEW HIGH ORDER PART>>                             13815000
DP:=TOS;                                                                13820000
<<**************NEXT RANK************>>                                 13825000
TOS:=DLOP2; TOS:=DLOP1(1);                                              13830000
ASSEMBLE(DMPY); <<DMPY>>                                                13835000
DP(XREG):=TOS+DP(1); <<ACCUMULATE MORE PARTIAL PRODUCT>>                13840000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE A CARRY TO HIGH PART ON TOS>>     13845000
TOS:=DLOP2; TOS:=DLOP1;                                                 13850000
ASSEMBLE(DMPY;    <<DMPY>>                                              13855000
           DXCH        );                                               13860000
PHIGH:=TOS;                                                             13865000
ASSEMBLE(DADD);                                                         13870000
DCARRY:=IF CARRY THEN TRUE ELSE FALSE;                                  13875000
DP:=TOS+DP;                                                             13880000
IF CARRY THEN TOS:=TOS+1;                                               13885000
IF DCARRY THEN TOS:=TOS+1;                                              13890000
TOS:=PHIGH;                                                             13895000
ASSEMBLE(DADD);                                                         13900000
DP(-1):=TOS;                                                            13905000
END <<FOURBYFOUR>>;                                                     13910000
                                                                        13915000
                                                                        13920000
SUBROUTINE MBYN;                                                        13925000
                                                                        13930000
<<A GENERAL ALGORITHM FOR MULTIPLYING AN OPERAND OF M WORDS             13935000
  BY AN OPERAND OF N WORDS TO PRODUCE AN M+N WORD RESULT>>              13940000
                                                                        13945000
                                                                        13950000
BEGIN                                                                   13955000
OP2X:=LOP2WORDS&LSR(1)-1; DCARRY:=FALSE;                                13960000
DO                                                                      13965000
  BEGIN                                                                 13970000
    OP1X:=LOP1WORDS&LSR(1)-1;                                           13975000
    TOS:=0D; IF DCARRY THEN TOS:=TOS+1;                                 13980000
    DO                                                                  13985000
      BEGIN                                                             13990000
        ASSEMBLE(DZRO,DXCH);                                            13995000
        TOS:=DLOP2(OP2X); TOS:=DLOP1(OP1X);                             14000000
        ASSEMBLE(DMPY;   <<DMPY FOUR WORD PRODUCT>>                     14005000
                 DXCH          ); <<LEAVE HIGH ORDER PART ON TOS>>      14010000
        PHIGH:=TOS; <<STORE HIGH ORDER PART OF PRODUCT>>                14015000
        ASSEMBLE(DADD); <<FORM NEW LOW ORDER PART>>                     14020000
        DCARRY:=IF CARRY THEN TRUE ELSE FALSE; <<LOOK FOR A CARRY TO BE 14025000
                                                 PROPAGATED>>           14030000
        DP(XREG):=TOS+DP(OP1X+OP2X); <<ACCUMULATE PARTIAL PRODUCTS>>    14035000
        IF CARRY THEN TOS:=TOS+1;                                       14040000
        IF DCARRY THEN TOS:=TOS+1;                                      14045000
        TOS:=PHIGH; <<GET BACK CURRENT HIGH ORDER PART>>                14050000
        ASSEMBLE(DADD); <<ADD IN CARRIES FROM LOW ORDER PART TO FORM    14055000
                          NEW HIGH ORDER PART>>                         14060000
      END                                                               14065000
    UNTIL (OP1X:=OP1X-1)<0;                                             14070000
    DP(XREG):=TOS+DP(OP1X+OP2X);                                        14075000
    DCARRY:=IF CARRY THEN TRUE ELSE FALSE;                              14080000
  END                                                                   14085000
UNTIL (OP2X:=OP2X-1)<0;                                                 14090000
END <<MBYN>>;                                                           14095000
                                                                        14100000
                                                                        14105000
TEMPSDEC := INSTR.(10:2);  <<EXTRACT SDEC PART FROM OPCODE>>            14110000
TEMPSDEC := IF TEMPSDEC=0 THEN 0 ELSE IF TEMPSDEC=1 THEN 2 ELSE 4;      14115000
PUSH(STATUS);                                                           14120000
TOS := TOS LAND %157777;  <<TURN OFF TRAPS>>                            14125000
TOS.(0:1) := STATUSWORD.(0:1);  <<SET MODE TO CALLER'S MODE>>           14130000
SET(STATUS);                                                            14135000
IF 1<=OP1DIGS<=28 AND 1<=OP2DIGS<=28 THEN                               14140000
  BEGIN                                                                 14145000
    <<TURN OFF TRAPS>> PUSH(STATUS); TOS:=TOS LAND %157777; SET(STATUS);14150000
<<CONVERT OPERAND 1 TO BINARY>>                                         14155000
    LOP1WORDS:=IF OP1DIGS<=4 THEN 1                                     14160000
               ELSE IF OP1DIGS<=9 THEN 2                                14165000
               ELSE IF OP1DIGS<=18 THEN 4                               14170000
               ELSE 6;                                                  14175000
    TOS:=@LOP1; TOS:=@OP1;TOS:=OP1DIGS;                                 14180000
    ASSEMBLE(CON %020625); <<CVDB>>                                     14185000
    IF OVERFLOW THEN <<INVALID DIGIT>> DEC'SIM'TRAP(13)                 14190000
    ELSE IF = THEN <<PRODUCT IS ZERO>>                                  14195000
      ZERORESULT                                                        14200000
    ELSE <<MAY DO MULTIPLY>>                                            14205000
      BEGIN                                                             14210000
        IF < THEN <<NEGATE OP1>>                                        14215000
          BEGIN                                                         14220000
            ASSEMBLE(INCM MINUS);                                       14225000
            @P:=@LOP1; WORDS:=LOP1WORDS; NEGATE;                        14230000
          END;                                                          14235000
        <<CONVERT OPERAND 2 TO BINARY>>                                 14240000
        LOP2WORDS:=IF OP2DIGS<=4 THEN 1                                 14245000
                   ELSE IF OP2DIGS<=9 THEN 2                            14250000
                   ELSE IF OP2DIGS<=18 THEN 4                           14255000
                   ELSE 6;                                              14260000
        TOS:=@LOP2; TOS:=@OP2; TOS:=OP2DIGS;                            14265000
        ASSEMBLE(CON %020625); <<CVDB>>                                 14270000
        IF OVERFLOW THEN DEC'SIM'TRAP(13) <<ILLEGAL DIGIT>>             14275000
        ELSE IF = THEN <<PRODUCT IS ZERO>> ZERO:=TRUE                   14280000
        ELSE <<DO THE MULTIPLY>>                                        14285000
          BEGIN                                                         14290000
            IF < THEN <<NEGATE OP2>>                                    14295000
              BEGIN                                                     14300000
                ASSEMBLE(INCM MINUS);                                   14305000
                @P:=@LOP2; WORDS:=LOP2WORDS; NEGATE;                    14310000
              END;                                                      14315000
            PRODUCT(-3):=0; MOVE PRODUCT(-2):=PRODUCT(-3),(12);         14320000
            IF LOP1WORDS=1 AND LOP2WORDS=1 THEN <<1X1-MACHINE MULTIPLY>>14325000
              BEGIN                                                     14330000
                RESLEN:=2; <<TWO WORD RESULT>>                          14335000
                TOS:=LOP1; TOS:=LOP2; ASSEMBLE(LMPY); DP(-1):=TOS;      14340000
              END                                                       14345000
            ELSE  <<MULTIWORD MULTIPLY>>                                14350000
            BEGIN                                                       14355000
             LOP1(XREG):=LOP2(-1):=0;                                   14360000
             XREG:=0;                                                   14365000
             WHILE LOP1(XREG)=0 DO XREG:=XREG+1;                        14370000
             @LOP1:=@LOP1+XREG; LOP1WORDS:=LOP1WORDS-XREG;              14375000
             <<ELIMINATES LEADING ZERO FROM OP1 AND OP2>>               14380000
             XREG:=0;                                                   14385000
             WHILE LOP2(XREG)=0 DO XREG:=XREG+1;                        14390000
             @LOP2:=@LOP2+XREG; LOP2WORDS:=LOP2WORDS-XREG;              14395000
             <<PAD OPERANDS TO EVEN LENGTHS>>                           14400000
             IF LOGICAL(LOP1WORDS) THEN                                 14405000
               BEGIN                                                    14410000
                 LOP1WORDS:=LOP1WORDS+1; @LOP1:=@LOP1-1;                14415000
               END;                                                     14420000
             IF LOGICAL(LOP2WORDS) THEN                                 14425000
               BEGIN                                                    14430000
                 LOP2WORDS:=LOP2WORDS+1; @LOP2:=@LOP2-1;                14435000
               END;                                                     14440000
            IF LOP1WORDS=2 AND LOP2WORDS=2 THEN <<DMPY>>                14445000
              BEGIN                                                     14450000
                TOS:=DLOP1; TOS:=DLOP2;                                 14455000
                ASSEMBLE(DMPY); <<DMPY>>                                14460000
                DP:=TOS; DP(-1):=TOS; RESLEN:=4;                        14465000
              END                                                       14470000
            ELSE <<2X4, 2X6, 4X4, 4X6, 6X6>>                            14475000
              BEGIN                                                     14480000
                CASE * LOP1WORDS&LSR(1)-1 OF                            14485000
                  BEGIN                                                 14490000
                    <<OP1 2 WORDS>>                                     14495000
                    CASE * LOP2WORDS&LSR(1)-2 OF                        14500000
                      BEGIN                                             14505000
                        <<OP2 4 WORDS>>                                 14510000
                        BEGIN                                           14515000
                          @DOP1:=@LOP1; @DOP2:=@LOP2; TWOBYFOUR;        14520000
                        END;                                            14525000
                        <<LOP2 6 WORDS>>                                14530000
                        BEGIN                                           14535000
                          @DOP1:=@LOP1; @DOP2:=@LOP2; TWOBYSIX;         14540000
                        END;                                            14545000
                      END <<CASE>>;                                     14550000
                    <<LOP1 4 WORDS>>                                    14555000
                    CASE * LOP2WORDS&LSR(1)-1 OF                        14560000
                      BEGIN                                             14565000
                        <<OP2 2 WORDS>>                                 14570000
                        BEGIN                                           14575000
                          @DOP1:=@LOP2; @DOP2:=@LOP1; TWOBYFOUR;        14580000
                        END;                                            14585000
                        <<OP2 4 WORDS>>                                 14590000
                        FOURBYFOUR;                                     14595000
                        <<OP2 6 WORDS>>                                 14600000
                        MBYN;                                           14605000
                      END <<CASE>>;                                     14610000
                    <<OP1 6 WORDS>>                                     14615000
                    CASE * LOP2WORDS&LSR(1)-1 OF                        14620000
                      BEGIN                                             14625000
                        <<OP2 2 WORDS>>                                 14630000
                        BEGIN                                           14635000
                          @DOP1:=@LOP2; @DOP2:=@LOP1; TWOBYSIX;         14640000
                        END;                                            14645000
                        <<OP2 4 WORDS>>                                 14650000
                        MBYN;                                           14655000
                        <<OP2 6 WORDS>>                                 14660000
                        MBYN;                                           14665000
                      END <<CASE>>;                                     14670000
                  END <<CASE>>;                                         14675000
              END;                                                      14680000
            END;                                                        14685000
            @PRODUCT:=@PRODUCT-2;                                       14690000
            <<GET RID OF ZERO WORDS IN PRODUCT>>                        14695000
            XREG:=0;                                                    14700000
            WHILE PRODUCT(XREG)=0 DO XREG:=XREG+1;                      14705000
            @PRODUCT:=@PRODUCT+XREG;                                    14710000
            RESLEN:=LOP1WORDS+LOP2WORDS-XREG;                           14715000
            IF INTEGER(PRODUCT)<0 THEN <<CVBD WILL SEE NEGATIVE>>       14720000
                  BEGIN                                                 14725000
                    @PRODUCT:=@PRODUCT-1; RESLEN:=RESLEN+1;             14730000
                    IF RESLEN>6 THEN DOVERFLOW:=TRUE;                   14735000
                  END;                                                  14740000
            IF MINUS THEN <<NEGATE RESULT>>                             14745000
              BEGIN                                                     14750000
                @P:=@PRODUCT; WORDS:=RESLEN; NEGATE;                    14755000
              END;                                                      14760000
            <<CONVERT PRODUCT BACK TO DECIMAL, ALL WORDS OF PRODUCT     14765000
              ARE KNOWN TO BE NONZERO>>                                 14770000
            TOS:=@OP2;TOS:=OP2DIGS; TOS:=@PRODUCT;                      14775000
            TOS:=IF RESLEN>=6 THEN 6 ELSE RESLEN;                       14780000
            ASSEMBLE(CON %020624); <<CVBD>>                             14785000
            IF = THEN ZERO:=TRUE;                                       14790000
            IF OVERFLOW OR RESLEN>6 THEN                                14795000
              DOVERFLOW:=TRUE;                                          14800000
          END <<MULTIPLY>>;                                             14805000
      END <<OP1 NOT ZERO>>;                                             14810000
    <<SET CCA ON RESULT>>                                               14815000
    TOS := STATUSWORD LAND %172377;                            <<03.00>>14820000
    IF ZERO THEN TOS:=TOS LOR %1000                                     14825000
    ELSE IF MINUS THEN TOS:=TOS LOR %400;                               14830000
    STATUSWORD:=TOS;                                                    14835000
    IF DOVERFLOW THEN <<DECIMAL OVERFLOW>> DEC'SIM'TRAP(11);            14840000
  END                                                                   14845000
ELSE IF NOT(0<=OP1DIGS<=28) OR NOT(0<=OP2DIGS<=28) THEN                 14850000
  DEC'SIM'TRAP(15) <<INVALID DIGIT COUNT>>;                             14855000
TOS := %031400+TEMPSDEC;  <<SET UP RETURN STATEMENT>>          <<03.00>>14860000
PUSH(Q); TOS := TOS-5; <<POP PROC TRAPS STUFF>> SET(Q);                 14865000
ASSEMBLE(XEQ 0);                                                        14870000
END <<MPYD>>;                                                           14875000
$PAGE                                                                   14880000
$CONTROL SEGMENT=FIRMWARESIM1                                  <<01820>>14885000
<<......................................................................14890000
.                                                                      .14895000
.                             SRD                                      .14900000
.                                                                      .14905000
......................................................................>>14910000
PROCEDURE SRD;                                                          14915000
OPTION PRIVILEGED,UNCALLABLE;                                           14920000
                                                                        14925000
COMMENT: SHIFTS AND MOVES OP1 TO OP2 BYTE SHIFT AMOUNT IN               14930000
         XREGISTER AND SETS CCA ON RESULT;                              14935000
                                                                        14940000
BEGIN                                                                   14945000
INTEGER SHIFT,         <<SHIFT AMOUNT>>                                 14950000
        OP1X,          <<OPERAND 1 INDEX>>                              14955000
        OP2X,          <<OPERAND 2 INDEX>>                              14960000
        XREG=X,                                                         14965000
        OLDX=Q-8,          <<USER'S XREG, HAS SHIFT AMOUNT>>            14970000
        OP2DIGS=Q-11,      <<USER'S OPERAND 2 # OF BDIGITS>>            14975000
        OP1DIGS=Q-9,       <<USER'S # OF OPERAND 1 DIGITS>>             14980000
        SDEC=Q-3,            <<IN INSTRUCTION CODE, HOW TO LEAVE STACK>>14985000
        OP1LIM;        <<SHIFT LIMIT>>                                  14990000
LOGICAL STATUSWORD=Q-6,<<WHERE STATUS WORD IS>>                         14995000
        INSTR=Q-4,       <<MACHINE INSTRUCTION CODE, HAS SDEC>>         15000000
        NONZERO,       <<TRUE IF RESULT IS NONZERO>>                    15005000
        ZEROOP2,       <<TRUE IF HIGH ORDER ZERO FILL>>                 15010000
        SAVEOP1,   <<FOR SAVING NON-SIGNIFICANT DIGITS>>                15015000
        RESTORE,    <<TRUE => RESTORE NON-SIGNIFICANT DIGIT>>           15020000
        SAVEOP2,       <<FOR SAVING OP2 NON-SIG DIGITS>>                15025000
        RIGHT,         <<TRUE IF NEXT DIGIT IS IN RIGHT                 15030000
                         HALF OF A BYTE>>                               15035000
        MINUS;         <<TRUE IF RESULT IS MINUS>>                      15040000
BYTE POINTER OP1=Q-10, <<WHERE OPERAND 1 IS>>                           15045000
           OP2=Q-12;   <<WHERE OPERAND 2 IS>>                           15050000
SUBROUTINE TRAP(CODE);                                                  15055000
VALUE CODE; INTEGER CODE;                                               15060000
BEGIN                                                                   15065000
IF RESTORE THEN OP1 := LOGICAL(OP1) LOR SAVEOP1;                        15070000
DEC'SIM'TRAP(CODE);                                                     15075000
END;                                                                    15080000
<<GET RID OF PRIVILEGED MODE AND GET SDEC>>                             15085000
IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV MODE>>                 15090000
  BEGIN                                                                 15095000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    15100000
  END;                                                                  15105000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                15110000
SDEC:=INSTR.(10:2);                                                     15115000
SDEC:=IF SDEC=0 THEN 0 ELSE IF SDEC=1 THEN 2 ELSE 4;                    15120000
OLDX := LOGICAL(OLDX) LAND %37;  <<TRUNCATE TO 5 BITS>>        <<C0.12>>15125000
RIGHT:=NONZERO:=ZEROOP2:=MINUS:=FALSE;                                  15130000
IF 1<=OP1DIGS<=28 AND                                                   15135000
   1<=OP2DIGS<=28 THEN                                                  15140000
  BEGIN                                                                 15145000
    RESTORE := FALSE;                                                   15150000
    IF NOT(LOGICAL(OP1DIGS)) THEN <<NON-SIGNIFICANT DIGIT>>             15155000
      BEGIN                                                             15160000
      TOS := OP1;                                                       15165000
      ASSEMBLE(DUP);                                                    15170000
      SAVEOP1 := TOS LAND %360;                                         15175000
      OP1 := TOS LAND %17;                                              15180000
      IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN                   15185000
        RESTORE := TRUE                                                 15190000
      ELSE    <<OVERLAPPING OPERANDS>>                                  15195000
        IF OP1DIGS >= OP2DIGS THEN                                      15200000
          RESTORE := TRUE                                               15205000
      END;                                                              15210000
     SAVEOP2 := IF LOGICAL(OP2DIGS) THEN 0 ELSE LOGICAL(OP2)LAND%360;   15215000
    SHIFT:=LOGICAL(OLDX) LAND %37;                                      15220000
    OP1X:=OP1DIGS&LSR(1); OP2X:=OP2DIGS&LSR(1);                         15225000
    IF SHIFT>=OP1DIGS THEN                                              15230000
                <<NO SHIFT NECESSARY, JUST ZEROS>>                      15235000
      BEGIN                                                             15240000
        XREG:=OP1DIGS&LSR(1);                                           15245000
        TOS:=LOGICAL(OP1(XREG)) LAND %360;                              15250000
        IF TOS>%(2)10010000 THEN TRAP(13);                              15255000
        WHILE (XREG:=XREG-1)>=0 DO                                      15260000
          BEGIN                                                         15265000
            TOS:=OP1(XREG);                                             15270000
            ASSEMBLE(DUP);                                              15275000
            TOS:=TOS LAND %17;                                          15280000
            ASSEMBLE(XCH);                                              15285000
            TOS:=TOS LAND %360;                                         15290000
            IF TOS>%(2)10010000 OR TOS>%(2)1001 THEN                    15295000
              TRAP(13); <<INVALID DIGIT>>                               15300000
          END;                                                          15305000
        OP2(OP2X):=%(2)1100; <<PLUS SINCE ZERO>>                        15310000
        OP2X:=OP2X-1; ZEROOP2:=TRUE;                                    15315000
      END                                                               15320000
    ELSE                                                                15325000
      BEGIN                                                             15330000
        TOS:=OP1(OP1X); <<GET SIGN DIGIT>>                              15335000
        TOS:=TOS LAND %17; <<ISOLATE SIGN DIGIT>>                       15340000
        ASSEMBLE(DUP); <<COPY SIGN DIGIT>>                              15345000
        IF TOS=%(2)1101 THEN MINUS:=TRUE <<NEGATIVE>>                   15350000
        ELSE TOS:=TOS LAND %0 LOR%(2)1100;                              15355000
        TOS:=(OP1LIM:=(OP1DIGS-SHIFT)); ASSEMBLE(DUP);                  15360000
        IF LOGICAL(OP1DIGS) THEN <<ODD # OF DIGITS>>                    15365000
          BEGIN                                                         15370000
            IF NOT(LOGICAL(TOS)) THEN RIGHT:=TRUE;                      15375000
            XREG:=(TOS-1)&LSR(1);                                       15380000
          END                                                           15385000
        ELSE <<EVEN # OF DIGITS>>                                       15390000
          BEGIN                                                         15395000
            IF LOGICAL(TOS) THEN RIGHT:=TRUE;                           15400000
            XREG:=TOS&LSR(1);                                           15405000
          END;                                                          15410000
        TOS:=OP1(XREG); <<GET FIRST SHIFTED BYTE>>                      15415000
        OP1X:=XREG-1;                                                   15420000
        IF RIGHT THEN <<REIGHT DIGIT IS NEXT REQUIRED>>                 15425000
          BEGIN                                                         15430000
            ASSEMBLE(DUP); <<COPY NEW DIGITS>>                          15435000
            TOS:=TOS LAND %17; <<ISOLATE RIGHT DIGIT>>                  15440000
            ASSEMBLE(DUP,DUP); <<MAKE TTWO COPIES>>                     15445000
            IF TOS>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>             15450000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           15455000
            TOS:=TOS&LSL(4); <<SHIFT DIGIT INTO POSITION>>              15460000
            ASSEMBLE(CAB,OR); <<COMBINE DIGIT AND SIGN>>                15465000
            OP2(OP2X):=BYTE(TOS); <<SOTORE SIGN AND DIGIT>>             15470000
            TOS:=TOS&LSR(4); <<LEAVE NEXT DIGIT IN RIGHT>>              15475000
          END                                                           15480000
        ELSE <<LEFT DIGIT OF BYTE IS NEXT REQUIRED>>                    15485000
          BEGIN                                                         15490000
            TOS:=TOS&LSR(4); <<GET DIGIT IN RIGHT PART                  15495000
                                   OF BYTE ON TOS>>                     15500000
            ASSEMBLE(DUP,DUP);                                          15505000
            IF TOS>%(2)1001 THEN <<INVALID DIGIT>> TRAP(13)             15510000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           15515000
            TOS:=TOS&LSL(4);                                            15520000
            TOS:=TOS LOR TOS; <<COMBINE DIGIT AND SIGN>>                15525000
            OP2(OP2X):=BYTE(TOS);                                       15530000
          END;                                                          15535000
        OP2X:=OP2X-1;                                                   15540000
       <<DO THE SHIFT>>                                                 15545000
        WHILE OP1X>=0 AND OP2X>=0 DO                                    15550000
          BEGIN                                                         15555000
            TOS:=OP1(OP1X); OP1X:=OP1X-1;                               15560000
            ASSEMBLE(DUP);                                              15565000
            IF RIGHT THEN <<CHECK BOTH DIGITS>>                         15570000
              BEGIN                                                     15575000
                TOS:=TOS LAND %17; <<ISOLATE D1>>                       15580000
                TOS:=TOS&LSL(4);  <<SHIFT IT TO LEFT>>                  15585000
                ASSEMBLE(DUP,DUP); <<2 COPIES OF D1>>                   15590000
                IF TOS>%(2)10010000 THEN TRAP(13);             <<C0.12>>15595000
           IF OP2X=0 AND NOT(LOGICAL(OP2DIGS)) THEN ASSEMBLE(DDEL;DZRO);15600000
                IF TOS>0 THEN NONZERO:=TRUE;                   <<C0.12>>15605000
                ASSEMBLE(CAB,DUP;DUP); <<GET READY TO CHECK D0>>        15610000
                IF TOS>%(2)1001 THEN TRAP(13)                           15615000
                ELSE IF TOS>%0 THEN NONZERO:=TRUE;                      15620000
                TOS:=TOS LOR TOS; <<PRODUCE NEW BYTE>>                  15625000
                OP2(OP2X):=BYTE(TOS);                                   15630000
                TOS:=TOS&LSR(4); <<PUT D2 IN RIGHT DIGIT>>              15635000
              END                                                       15640000
            ELSE <<D0;0;D2,D1>>                                         15645000
              BEGIN                                                     15650000
                ASSEMBLE(DUP); <<COPY BOTH DIGITS>>                     15655000
                TOS:=TOS LAND %17; ASSEMBLE(DUP);                       15660000
                IF TOS>%(2)1001 THEN TRAP(13)                           15665000
                ELSE IF TOS>0 THEN NONZERO:=TRUE;                       15670000
                TOS:=TOS LAND %360; ASSEMBLE(DUP);                      15675000
                IF TOS>%(2)10010000 THEN TRAP(13);             <<C0.12>>15680000
                IF OP2X=0 AND NOT(LOGICAL(OP2DIGS)) THEN       <<C0.12>>15685000
                   ASSEMBLE(DEL;ANDI %17;ZERO);                <<C0.12>>15690000
                IF TOS>0 THEN NONZERO:=TRUE;                   <<C0.12>>15695000
                OP2(OP2X):=BYTE(TOS);                                   15700000
               END;                                                     15705000
            OP2X:=OP2X-1;                                               15710000
          END <<WHILE>>;                                                15715000
        IF RIGHT AND OP2X>=0 THEN <<ONE DIGIT LEFT ON TOS>>             15720000
          BEGIN                                                         15725000
            ASSEMBLE(DUP,DUP); <<GET READY TO CHECK IT>>                15730000
            IF TOS>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>             15735000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           15740000
            OP2(OP2X):=BYTE(TOS);                                       15745000
            OP2X:=OP2X-1;                                               15750000
          END;                                                          15755000
        IF (XREG:=OP1X)>=0 THEN <<CHECK REMAINING DIGITS>>              15760000
          BEGIN                                                         15765000
            WHILE XREG>=0 DO                                            15770000
              BEGIN                                                     15775000
                TOS:=OP1(XREG);                                         15780000
                ASSEMBLE(DUP);                                          15785000
                TOS:=TOS LAND %17;                                      15790000
                ASSEMBLE(XCH);                                          15795000
                TOS:=TOS LAND %360;                                     15800000
                IF TOS>%(2)10010000 OR TOS>%(2)1001 THEN                15805000
                  TRAP(13);                                             15810000
                XREG:=XREG-1;                                           15815000
              END;                                                      15820000
          END;                                                          15825000
        IF NOT NONZERO AND MINUS THEN <<CHANGE TO PLUS>>                15830000
          BEGIN                                                         15835000
            TOS_OP2(OP2DIGS&LSR(1));                           <<C0.12>>15840000
            TOS:=TOS LAND %360 LOR %(2)1100;<<PLUS>>                    15845000
            OP2(XREG)_BYTE(TOS);                               <<C0.12>>15850000
          END;                                                          15855000
        IF (TOS:=(OP2DIGS-(OP1DIGS-SHIFT)))>0 THEN <<NEED ZERO FILL>>   15860000
          BEGIN                                                         15865000
            RIGHT:=FALSE; ZEROOP2:=TRUE;                                15870000
            IF LOGICAL(OP2DIGS) THEN                                    15875000
              BEGIN                                                     15880000
                IF NOT(LOGICAL(TOS)) THEN RIGHT:=TRUE;                  15885000
              END                                                       15890000
            ELSE                                                        15895000
              BEGIN                                                     15900000
                IF LOGICAL(TOS) THEN RIGHT:=TRUE;                       15905000
              END;                                                      15910000
            IF NOT RIGHT THEN <<ZERO OUT A DIGIT>>                      15915000
              BEGIN                                                     15920000
                XREG:=OP2X+1;                                           15925000
                OP2(XREG):=LOGICAL(OP2(XREG)) LAND %17;                 15930000
              END;                                                      15935000
          END;                                                          15940000
      END;                                                              15945000
<<ZERO FILL>>                                                           15950000
    IF ZEROOP2 THEN <<BYTE BY BYTE ZERO FILL>>                          15955000
      BEGIN                                                             15960000
        XREG:=OP2X;                                                     15965000
        WHILE XREG>=0 DO                                                15970000
          BEGIN                                                         15975000
            OP2(XREG):=0;                                               15980000
            XREG:=XREG-1;                                               15985000
          END;                                                          15990000
      END;                                                              15995000
    IF RESTORE THEN OP1 := LOGICAL(OP1) LOR SAVEOP1;                    16000000
    OP2 := LOGICAL(OP2) LOR SAVEOP2;                                    16005000
    TOS:=STATUSWORD LAND %176377;                                       16010000
    IF NOT NONZERO THEN <<ZERO>>                                        16015000
      TOS:=TOS LOR %1000                                                16020000
    ELSE IF MINUS THEN TOS:=TOS LOR %400;                               16025000
    STATUSWORD:=TOS;                                                    16030000
  END <<SHIFT>>                                                         16035000
ELSE IF NOT(0<=OP1DIGS<=28) OR NOT(0<=OP2DIGS<=28) THEN                 16040000
   DEC'SIM'TRAP(15);                                                    16045000
TOS:=%031400+SDEC;                                                      16050000
<<EXIT OVER USER'S STACK MARKER>>                                       16055000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            16060000
ASSEMBLE(XEQ 0);                                                        16065000
END <<SRD>>;                                                            16070000
$PAGE                                                                   16075000
$CONTROL SEGMENT=FIRMWARESIM2                                  <<01820>>16080000
<<......................................................................16085000
.                                                                      .16090000
.                             NSLD                                     .16095000
.                             SLD                                      .16100000
.                                                                      .16105000
......................................................................>>16110000
                                                                        16115000
PROCEDURE NSLD;                                                         16120000
OPTION PRIVILEGED,UNCALLABLE;                                           16125000
                                                                        16130000
COMMENT: MOVES AND SHIFTS OP1 INTO OP2 USING SHIFT AMOUNT               16135000
         IN X REGISTER, SETS CCA AND CARRY ON DIGITS LOST;              16140000
                                                                        16145000
BEGIN                                                                   16150000
ENTRY SLD;                                                              16155000
INTEGER SHIFT,        <<SHIFT AMOUNT, PASSED IN XREG>>                  16160000
        ZCNT,         <<COUNT OF LEADING ZEROS FOR NORMALIZING SHIFT>>  16165000
        OP1DIGS=Q-9,      <<USERS # OF DIGITS IN OPERAND1>>             16170000
        OP2DIGS=Q-11,     <<USER'S # OF DIGISTS IN OPERAND 2>>          16175000
        SDEC=Q-3,            <<IN INSTRUCTION CODE, HOW TO LEAVE STACK>>16180000
        SHIFTDIF,      <<DIFFERENCE IN GIVEN AND EFFECTIVE SHIFTS>>     16185000
        OP1X,         <<INDEX FOR OP1>>                                 16190000
        OP2X,         <<INDEX FOR OP2>>                                 16195000
        XREG=X,                                                         16200000
        S0=S-0,                                                         16205000
        LIMIT1,LIMIT2;   <<HOW MANY BYTES TO GO>>                       16210000
LOGICAL STATUSWORD=Q-6, <<WHERE CARRY AND CONDITION CODE ARE>>          16215000
        INSTR=Q-4,       <<MACHINE INSTRUCTION CODE>>                   16220000
        CARRYSET,      <<TRUE IF SIGNIFICANT DIGITS ARE SHIFTED OUT     16225000
                         AND CARRY IS SET AS INDICATOR>>                16230000
        NONZERO,       <<TRUE IF RESULT IS NONZERO>>                    16235000
        RIGHT1,RIGHT2,          <<TRUE IF NEXT DIGIT GOES INTO RIGHT    16240000
                          HALF OF BYTE>>                                16245000
        SAVEOP1,   <<SAVES NON-SIGNIFICANT DIGIT IN OP1>>               16250000
        RESTORE,    <<TRUE => RESTORE ABOVE NON-SIG DIGIT>>             16255000
        SAVEOP2,         <<SAVES OP2 NON-SIG DIGIT>>                    16260000
        MINUS,         <<TRUE IF RESULT IS MINUS>>                      16265000
        NORMSHIFT:=FALSE, <<NORMALIZING SHIFT FLAG>>                    16270000
        NOSHIFT:=FALSE, <<TRUE IF NO DATA MOVEMENT IN NSLD>>            16275000
        HIGHORDERZEROS, <<TRUE IF HIGH ORDER ZERO FILL>>                16280000
        ZERO,             <<WHILE LOOP FLAG>>                           16285000
        NEWX=Q-8,         <<USER'S X REGISTER>>                         16290000
        ZEROOP2;       <<TRUE IF HIGH ORDER ZERO FILL>>                 16295000
BYTE POINTER OP1=Q-10,    <<USERS OPERAND 1>>                           16300000
           OP2=Q-12;  <<USERS OPERAND 2>>                               16305000
DEFINE SDEC'AND'MODE=                                                   16310000
    IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV MODE>>             16315000
      BEGIN                                                             16320000
        PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                16325000
      END;                                                              16330000
STATUSWORD.(4:2):=0;  <<CLEAR OVERFLOW>>                                16335000
    NEWX := LOGICAL(NEWX) LAND %37;                                     16340000
    SDEC:=INSTR.(10:2);                                                 16345000
    SDEC:=IF SDEC=0 THEN 0 ELSE IF SDEC=1 THEN 2 ELSE 4                 16350000
#;                                                                      16355000
                                                                        16360000
SUBROUTINE TRAP(CODE);                                                  16365000
VALUE CODE; INTEGER CODE;                                               16370000
BEGIN                                                                   16375000
IF RESTORE THEN OP1 := LOGICAL(OP1) LOR SAVEOP1;                        16380000
IF CODE=11 THEN  <<DECIMAL OVERFLOW>>                                   16385000
  STATUSWORD.(5:1) := 1;  <<SET CARRY IN USER STATUS>>                  16390000
DEC'SIM'TRAP(CODE);                                                     16395000
END;                                                                    16400000
SDEC'AND'MODE;                                                          16405000
NORMSHIFT:=TRUE;                                                        16410000
SHIFTDIF:=-1;                                                           16415000
IF 1<=OP1DIGS<=28 AND                                                   16420000
   1<=OP2DIGS<=28 THEN                                                  16425000
  BEGIN                                                                 16430000
    SHIFT:=LOGICAL(NEWX) LAND %37;                                      16435000
    ZCNT:=0;                                                            16440000
    RESTORE := FALSE;                                                   16445000
    IF NOT(LOGICAL(OP1DIGS)) THEN <<NON-SIGNIFICANT DIG HERE>>          16450000
      BEGIN                                                             16455000
      ZCNT := -1;                                                       16460000
      TOS := OP1;                                                       16465000
      ASSEMBLE(DUP);                                                    16470000
      SAVEOP1 := TOS LAND %360;                                         16475000
      OP1 := TOS LAND %17;                                              16480000
      IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN                   16485000
        RESTORE := TRUE                                                 16490000
      ELSE    <<OVERLAPPING OPERANDS>>                                  16495000
        IF OP1DIGS >= OP2DIGS THEN                                      16500000
          RESTORE := TRUE                                               16505000
      END;                                                              16510000
    SAVEOP2 := IF LOGICAL(OP2DIGS) THEN 0 ELSE LOGICAL(OP2)LAND%360;    16515000
    ZERO:=TRUE;                                                         16520000
    OP1X:=OP1DIGS&LSR(1);                                               16525000
    XREG:=0;                                                            16530000
    WHILE XREG<OP1X AND ZERO DO <<COUNT LEADING ZEROS>>                 16535000
      BEGIN                                                             16540000
        TOS:=OP1(XREG);                                                 16545000
        ASSEMBLE(DUP); <<COPY>>                                         16550000
        IF TOS<>0 THEN <<LEADING ZEROS STOP HERE>>                      16555000
          BEGIN                                                         16560000
            ZERO:=FALSE;                                                16565000
            TOS:=TOS&LSR(4); <<GET RID OF RIGTH DIGIT>>                 16570000
            IF TOS=0 THEN ZCNT:=ZCNT+1;                                 16575000
          END                                                           16580000
        ELSE <<2 ZERO DIGITS>>                                          16585000
          BEGIN                                                         16590000
            ASSEMBLE(DEL);<<DELETE COPY>>                               16595000
            ZCNT:=ZCNT+2;                                               16600000
          END;                                                          16605000
        XREG:=XREG+1;                                                   16610000
      END;                                                              16615000
    IF XREG=OP1X AND ZERO THEN <<CHECK SIGN BYTE FOR ZERO>>             16620000
      BEGIN                                                             16625000
        TOS:=LOGICAL(OP1(XREG)) LAND %360;                              16630000
        IF TOS=0 THEN ZCNT:=ZCNT+1;                                     16635000
      END;                                                              16640000
    IF (TOS:=(OP2DIGS-OP1DIGS+ZCNT))<0 THEN                             16645000
            <<MAXIMUM ALLOWABLE SHIFT AMOUNT IS ON TOS>>                16650000
      NOSHIFT:=TRUE  <<NO DATA MOVEMENT>>                               16655000
    ELSE                                                                16660000
      BEGIN                                                             16665000
        ASSEMBLE(DUP); <<DUP MAX SHIFT>>                                16670000
        IF (TOS:=(TOS-SHIFT))<0 THEN <<MAX-REQUESTED SHIFT>>            16675000
          BEGIN                                                         16680000
            SHIFTDIF:=-TOS;                                             16685000
            IF ZCNT<>OP1DIGS THEN NEWX:=TOS ELSE ASSEMBLE(DEL);<<C0.12>>16690000
          END                                                           16695000
       ELSE ASSEMBLE(DDEL);                                             16700000
     END;                                                               16705000
  END                                                                   16710000
ELSE NORMSHIFT:=FALSE;                                                  16715000
                                                                        16720000
SLD:                                                                    16725000
IF NOT NORMSHIFT THEN                                                   16730000
  BEGIN                                                                 16735000
    SDEC'AND'MODE;                                                      16740000
  END;                                                                  16745000
ZEROOP2:=NONZERO:=CARRYSET:=RIGHT1:=RIGHT2:=MINUS                       16750000
    :=HIGHORDERZEROS:=FALSE;  OP1X:=OP2X:=0;                            16755000
IF NORMSHIFT OR 1<=OP1DIGS<=28 AND                                      16760000
   1<=OP2DIGS<=28 THEN                                                  16765000
  BEGIN                                                                 16770000
    IF NOT NORMSHIFT THEN  <<ZERO NON-SIGNIFICANT DIGITS>>              16775000
      BEGIN                                                             16780000
       SAVEOP2:=IF LOGICAL(OP2DIGS) THEN 0 ELSE LOGICAL(OP2)LAND%360;   16785000
      RESTORE := FALSE;                                                 16790000
      IF NOT(LOGICAL(OP1DIGS)) THEN <<NON-SIGNIFICANT DIG HERE>>        16795000
        BEGIN                                                           16800000
        TOS := OP1;                                                     16805000
        ASSEMBLE(DUP);                                                  16810000
        SAVEOP1 := TOS LAND %360;                                       16815000
        OP1 := TOS LAND %17;                                            16820000
        IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN                 16825000
          RESTORE := TRUE                                               16830000
        ELSE    <<OVERLAPPING OPERANDS>>                                16835000
          IF OP1DIGS >= OP2DIGS THEN                                    16840000
            RESTORE := TRUE                                             16845000
        END;                                                            16850000
      END;                                                              16855000
    IF (SHIFT:=(NEWX LAND %37))>=OP2DIGS OR NOSHIFT THEN <<NO SHIFT>>   16860000
      BEGIN                                                             16865000
        XREG:=OP1DIGS&LSR(1);                                           16870000
        TOS:=LOGICAL(OP1(XREG)) LAND %360; ASSEMBLE(DUP);               16875000
        IF TOS>%(2)10010000 THEN TRAP(13) <<ILLEGAL DIGIT>>             16880000
        ELSE IF TOS>0 THEN CARRYSET:=TRUE;                              16885000
        WHILE (XREG:=XREG-1)>=0 DO                                      16890000
          BEGIN                                                         16895000
            TOS:=OP1(XREG);                                             16900000
            ASSEMBLE(DUP);                                              16905000
            TOS:=TOS LAND %17;                                          16910000
            ASSEMBLE(XCH);                                              16915000
            TOS:=TOS LAND %360; ASSEMBLE(DDUP);                         16920000
            IF TOS>%(2)10010000 OR TOS>%(2)1001 THEN                    16925000
              TRAP(13) <<INVALID DIGIT>>                                16930000
            ELSE IF TOS>0 OR TOS>0 THEN CARRYSET:=TRUE;                 16935000
          END;                                                          16940000
        IF NOSHIFT THEN TRAP(11); <<DECIMAL OVERFLOW>>                  16945000
        ZEROOP2:=TRUE;                                                  16950000
      END                                                               16955000
    ELSE <<SHIFT>>                                                      16960000
      BEGIN                                                             16965000
        <<CHECK FOR HIGH ORDER ZERO FILL>>                              16970000
        IF (TOS:=(OP2DIGS-(OP1DIGS+SHIFT)))>0 THEN                      16975000
                  <<HIGH ORDER ZERO FILL NEEDED, NO                     16980000
                     DIGITS SHIFTED OUT>>                               16985000
          BEGIN                                                         16990000
            HIGHORDERZEROS:=TRUE;                                       16995000
            IF NOT (LOGICAL(OP1DIGS)) THEN RIGHT1:=TRUE;                17000000
                     <<FIRST DIGIT TO BE SHIFTED INTO OP2 IS IN         17005000
                       RIGHT HALF OF A BYTE>>                           17010000
            <<TOS CONTAINS NUMBER OF HIGH ORDER ZEROS>>                 17015000
            ASSEMBLE(DUP);                                              17020000
            IF LOGICAL(OP2DIGS) THEN                                    17025000
              BEGIN                                                     17030000
                LIMIT2:=(TOS-2)&ASR(1);                                 17035000
                IF LOGICAL(TOS) THEN RIGHT2:=TRUE; <<FIRST DIGIT        17040000
                       TO BE SHIFTED INTO OP2 GOES INTO RIGHT HALF      17045000
                       OF A BYTE>>                                      17050000
              END                                                       17055000
            ELSE                                                        17060000
              BEGIN                                                     17065000
                LIMIT2:=(TOS-1)&LSR(1);                                 17070000
                IF NOT(LOGICAL(TOS)) THEN RIGHT2:=TRUE;                 17075000
              END;                                                      17080000
            <<DO HIGH ORDER ZERO FILL>>                                 17085000
            IF OP2DIGS>1 THEN <<LOOP NOT GOING TO CLOBBER SIGN DIGIT>>  17090000
              BEGIN                                                     17095000
                IF LOGICAL(OP2DIGS) THEN                                17100000
                  TOS := 0                                              17105000
                ELSE                                                    17110000
                  TOS := LOGICAL(OP2) LAND %360;                        17115000
                XREG:=0;                                                17120000
                WHILE XREG<=LIMIT2 DO <<2 ZEROS AT ONCE>>               17125000
                  BEGIN                                                 17130000
                    OP2(XREG):=0;                                       17135000
                    XREG:=XREG+1;                                       17140000
                  END;                                                  17145000
                OP2 := LOGICAL(OP2) LOR TOS;                            17150000
                OP2X:=XREG;                                             17155000
              END;                                                      17160000
            <<IF RIGHT2 IS FALSE THEN ALL HIGH ORDER ZEROS HAVE         17165000
              BEEN PUT IN, LELSE ONE GOES IN THE LEFT OF THE            17170000
              FIRST OP2 BYTE TO BE STORE INTO IN SHIFT>>                17175000
          END                                                           17180000
        ELSE                                                            17185000
          BEGIN                                                         17190000
            <<DIGITS MAY HAVE BEEN SHIFTED OUT; EXIAMINE THEM FOR       17195000
              SIGNIFICANCE AND VALIDITY>>                               17200000
            ASSEMBLE(NEG,DUP;DUP); <<FIX UP TOS SO THAT IT IS THE       17205000
                                     NUMBER OF DIGITS SHIFTED OUT       17210000
                                     AND COPY IT FOR LATER USE>>        17215000
            IF LOGICAL(OP1DIGS) THEN                                    17220000
              BEGIN                                                     17225000
                LIMIT1:=(TOS-2)&ASR(1);                                 17230000
                IF LOGICAL(TOS) THEN RIGHT1:=TRUE; <<IF RIGHT1 THEN     17235000
                         THE FIRST DIGIT TO BE SHIFTED IS IN            17240000
                         RIGHT OF OP1 BYTE CONTAINING IT>>              17245000
              END                                                       17250000
            ELSE                                                        17255000
              BEGIN                                                     17260000
                LIMIT1:=(TOS-1)&LSR(1);                                 17265000
                IF NOT(LOGICAL(TOS)) THEN RIGHT1:=TRUE;                 17270000
              END;                                                      17275000
            IF NOT(LOGICAL(OP2DIGS)) THEN RIGHT2:=TRUE;                 17280000
                   <<FIRST DIGIT SHIFTED INTO OP2 TO GO INTO RIGHT      17285000
                     HALF OF A BYTE>>                                   17290000
            IF TOS>0 THEN <<EXAMINE DIGITS SHIFTED OUT FOR              17295000
                             SIGNIFICANCE AND VALIDITY>>                17300000
              BEGIN                                                     17305000
                XREG:=0;                                                17310000
                WHILE XREG<=LIMIT1 DO                                   17315000
                  BEGIN                                                 17320000
                    TOS:=OP1(XREG); XREG:=XREG+1;                       17325000
                    ASSEMBLE(DUP); TOS:=TOS LAND %17;                   17330000
                    ASSEMBLE(DUP);                                      17335000
                    IF TOS>%(2)1001 THEN TRAP(13)                       17340000
                    ELSE IF TOS>0 THEN CARRYSET:=TRUE;                  17345000
                      BEGIN                                             17350000
                      TOS:=TOS LAND %360;                               17355000
                      ASSEMBLE(DUP);                                    17360000
                      IF TOS>%(2)10010000 THEN TRAP(13)                 17365000
                      ELSE IF TOS>0 THEN CARRYSET:=TRUE;                17370000
                    END                                                 17375000
                  END;                                                  17380000
                OP1X:=XREG;                                             17385000
                IF RIGHT1 THEN <<EXAMINE LEFT DIGIT FOR SAME AS         17390000
                                   ABOVE>>                              17395000
                  BEGIN                                                 17400000
                    TOS:=OP1(XREG); TOS:=TOS LAND %360;                 17405000
                    ASSEMBLE(DUP);                                      17410000
                    IF TOS>%(2)10010000 THEN TRAP(13)                   17415000
                    ELSE IF TOS>0 THEN CARRYSET:=TRUE;                  17420000
                  END;                                                  17425000
              END;                                                      17430000
          END;                                                          17435000
        <<ALL READY TO DO SHIFT>>                                       17440000
        LIMIT1:=(OP1DIGS-2)&ASR(1);                                     17445000
        LIMIT2:=(OP2DIGS-2)&ASR(1);                                     17450000
        <<HAVE NOTHING ON STACK NOW>>                                   17455000
        IF RIGHT2 THEN <<FIRST OP1 DIGIT GOES INTO RIGHT OF             17460000
                         OP2 BYTE>>                                     17465000
          BEGIN                                                         17470000
             TOS := OP1(OP1X); OP1X := XREG+1;                          17475000
             IF NOT RIGHT1 THEN <<DIGIT ON STACK IN LEFT 4 BITS>>       17480000
               BEGIN                                                    17485000
               TOS := 0;                                                17490000
               TOS := TOS & DLSR(4);  <<SPLIT DIGITS>>                  17495000
               TOS := TOS & LSR(8);   <<ALIGN LOW ORDER DIGIT>>         17500000
               ASSEMBLE(XCH);                                           17505000
               END;                                                     17510000
             TOS := TOS LAND %17;                                       17515000
             ASSEMBLE(DUP,DUP);                                         17520000
             IF TOS > %(2)1001 THEN TRAP(13)                            17525000
             ELSE IF TOS > 0 THEN NONZERO := TRUE;                      17530000
             XREG := OP2X;                                              17535000
             OP2(XREG) := IF HIGHORDERZEROS THEN TOS                    17540000
                  ELSE (LOGICAL(OP2(XREG)) LAND %360) LOR TOS;          17545000
             OP2X := XREG + 1                                           17550000
          END                                                           17555000
        ELSE IF RIGHT1 THEN <<FIRST OP1 DIGIT COMES FROM RIGHT>>        17560000
          BEGIN                                                         17565000
            TOS:=LOGICAL(OP1(OP1X)&LSL(4)) LAND %360; XREG:=XREG+1;     17570000
            ASSEMBLE(DUP,DUP); <<GET READY TO CHECK IT>>                17575000
            IF TOS>%(2)10010000 THEN TRAP(13)                           17580000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           17585000
            TOS:=OP1(XREG); OP1X:=XREG+1; ASSEMBLE(DUP);                17590000
            TOS:=TOS&LSR(4); ASSEMBLE(DUP,DUP);                         17595000
            IF TOS>%(2)1001 THEN TRAP(13)                               17600000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           17605000
            ASSEMBLE(CAB,OR); <<GET OTHER DIGIT AND COMBINE>>           17610000
            OP2(OP2X):=BYTE(TOS); OP2X:=XREG+1;                         17615000
            TOS:=TOS&LSL(4) LAND %360; <<LEAVE DIGIT IN LEFT OF BYTE>>  17620000
          END;                                                          17625000
<<IF RIGHT2 THEN                                                        17630000
    IF RIGHT1 THEN 0 DIGITS ON STACK                                    17635000
    ELSE 1 DIGIT ON STACK IN LEFT POSITION                              17640000
  ELSE                                                                  17645000
    IF RIGHT1 THEN 1 DIGIT ON STACK>>                                   17650000
<<KNOW THAT NEXT DIGIT GOES INTO LEFT PART OF AN OP2 BYTE>>             17655000
        RIGHT2:=RIGHT1 XOR RIGHT2; <<ONE DIGIT ON STACK>>               17660000
        WHILE OP1X<=LIMIT1 AND OP2X<=LIMIT2 DO                          17665000
          BEGIN                                                         17670000
            TOS:=OP1(OP1X); OP1X:=XREG+1;                               17675000
            IF RIGHT2 THEN <<ONE DIGIT ON STACK ALREADY>>               17680000
              BEGIN                                                     17685000
                 ASSEMBLE(DUP); <<COPY DIGITS>>                         17690000
                 TOS:=TOS&LSR(4); <<ISOLATE LEFT DIGIT>>                17695000
                 ASSEMBLE(CAB,OR); <<PUT TOGETHER BYTE>>                17700000
              END;                                                      17705000
            ASSEMBLE(DUP,DUP); <<COPY DIGITS>>                          17710000
            TOS:=TOS LAND %17;                                          17715000
            ASSEMBLE(DUP);                                              17720000
            IF TOS>%(2)1001 THEN TRAP(13)                               17725000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           17730000
            TOS:=TOS LAND %360;                                         17735000
            ASSEMBLE(DUP);                                              17740000
            IF TOS>%(2)10010000 THEN TRAP(13)                           17745000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           17750000
            OP2(OP2X):=BYTE(TOS); OP2X:=XREG+1;                         17755000
            IF RIGHT2 THEN <<GET EXTRA DIGIT IN POSITION>>              17760000
              BEGIN                                                     17765000
                TOS:=TOS&LSL(4);                                        17770000
                TOS:=TOS LAND %360;                                     17775000
              END;                                                      17780000
          END;                                                          17785000
        IF OP1X<LIMIT1+2 THEN <<HAVEN'T GOT SIGN BYTE YET>>             17790000
          BEGIN                                                         17795000
            TOS:=OP1(OP1DIGS&LSR(1)); <<GET SIGN BYTE>>                 17800000
            ASSEMBLE(DUP); <<COPY SIGN BYTE>>                           17805000
            TOS:=TOS LAND %17;                                          17810000
            ASSEMBLE(XCH); <<GET READY TO CHECK LAST DIGIT>>            17815000
            TOS:=TOS LAND %360; <<ISOLATE IT>>                          17820000
            ASSEMBLE(DUP,DUP);                                          17825000
            IF TOS>%(2)10010000 THEN TRAP(13)                           17830000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           17835000
            ASSEMBLE(XCH); <<LAST DIGIT;SIGN>>                          17840000
          END                                                           17845000
        ELSE TOS:=TOS&LSR(4); <<PUT SIGN IN RIGHT PART OF BYTE ON TOS>> 17850000
        <<HAVE ON STACK: LAST DIGIT,0    OR    0,SIGN                   17855000
                0,SIGN                    >>                            17860000
        IF TOS=%(2)1101 THEN MINUS:=TRUE; <<TEST AND DELETE SIGN>>      17865000
        TOS:=%(2)1100;                                                  17870000
        IF NONZERO AND MINUS THEN TOS:=TOS+1;                           17875000
        <<CORRECT SIGN DIGIT NOW ON STACK>>                             17880000
        IF OP2X=LIMIT2+1 THEN <<STORE SIGN AND DIGIT>>                  17885000
          OP2(OP2X):=IF RIGHT2 THEN BYTE(TOS) ELSE BYTE(TOS LOR TOS)    17890000
        ELSE                                                            17895000
          BEGIN                                                         17900000
            IF RIGHT2 AND OP1X<LIMIT1+2  THEN <<A DIGIT ON STACK        17905000
                             IN ADDITION TO LAST DIGIT AND SIGN>>       17910000
              BEGIN                                                     17915000
                ASSEMBLE(XCH); <<0,S;D,0>>                              17920000
                TOS:=TOS&LSR(4); <<MOVE LAST DIGIT TO RIGHT OF BYTE>>   17925000
                ASSEMBLE(CAB); <<GET OLD DIGIT FOR CHECKING>>           17930000
                ASSEMBLE(DUP,DUP);                                      17935000
                IF TOS>%(2)10010000 THEN TRAP(13)                       17940000
                ELSE IF TOS>0 THEN NONZERO:=TRUE;                       17945000
                OP2(OP2X):=BYTE(TOS LOR TOS); OP2X:=XREG+1;             17950000
                IF (S0=%(2)1100) AND MINUS AND NONZERO THEN             17955000
                   TOS := TOS+1;  <<FIXUP SIGN TO %(2)1101>>            17960000
                IF OP2X<LIMIT2+1 THEN ZEROOP2:=3 <<SIGN ON STACK>>      17965000
                ELSE OP2(OP2X):=BYTE(TOS);                              17970000
              END                                                       17975000
            ELSE IF RIGHT2 THEN <<ONLY SIGN DIGIT ON STACK>>            17980000
              BEGIN                                                     17985000
                IF (XREG:=OP2X)=LIMIT2+1 THEN <<STORE SIGN AND          17990000
                                                ZERO DIGIT>>            17995000
                   OP2(XREG):=BYTE(TOS)                                 18000000
                ELSE ZEROOP2:=3; <<SIGN ON STACK>>                      18005000
              END                                                       18010000
            ELSE <<ONLY D,0;0,S ON STACK>>                              18015000
              IF OP2X=LIMIT2+1 THEN <<TIME TO STORE SIGN BYTE>>         18020000
                BEGIN                                                   18025000
                  ASSEMBLE(XCH); <<0,S;D,0>>                            18030000
                  TOS:=TOS LOR TOS; <<COMBINE LAST DIGIT AND SIGN>>     18035000
                  OP2(OP2X):=BYTE(TOS); <<STORE IT >>                   18040000
                END                                                     18045000
              ELSE  <<DIGIT AND SIGN ON STACK>>                         18050000
                BEGIN                                                   18055000
                  ZEROOP2:=1;                                           18060000
                  ASSEMBLE(XCH);                                        18065000
                END;                                                    18070000
          END;                                                          18075000
      END <<SHIFT>>;                                                    18080000
<<HIGH ORDER ZERO FILL>>                                                18085000
    IF ZEROOP2 THEN <<ZERO FILL>>                                       18090000
      BEGIN                                                             18095000
        XREG:=OP2X;                                                     18100000
        IF ZEROOP2=1 THEN <<DIGIT AND SIGN ON STACK>>                   18105000
          BEGIN                                                         18110000
            OP2(XREG):=BYTE(TOS);                                       18115000
            XREG:=XREG+1;                                               18120000
          END                                                           18125000
        ELSE IF ZEROOP2<>3 THEN TOS:=%(2)1100;                          18130000
        LIMIT2:=(OP2DIGS-2)&ASR(1);                                     18135000
        WHILE XREG<=LIMIT2 DO                                           18140000
          BEGIN                                                         18145000
            OP2(XREG):=0;                                               18150000
            XREG:=XREG+1;                                               18155000
          END;                                                          18160000
        OP2(XREG):=TOS; <<STORE SIGN>>                                  18165000
      END;                                                              18170000
    IF RESTORE THEN OP1 := LOGICAL(OP1)LOR SAVEOP1;                     18175000
    OP2 := LOGICAL(OP2) LOR SAVEOP2;                                    18180000
    <<SET CC AND CARRY IF NECESSARY>>                                   18185000
    TOS:=STATUSWORD LAND %174377;                                       18190000
    IF NOT NONZERO THEN <<RESULT IS ZERO>>                              18195000
      TOS:=TOS LOR %1000                                                18200000
    ELSE IF MINUS THEN                                                  18205000
      TOS:=TOS LOR %400;                                                18210000
    IF NORMSHIFT THEN <<NORMAL LEFT SHIFT>>                             18215000
      BEGIN                                                             18220000
        IF SHIFTDIF>0 AND NONZERO THEN <<SHIFT AMOUNT HAS BEEN REDUCED>>18225000
          BEGIN                                                         18230000
            NEWX:=SHIFTDIF; TOS := TOS LOR %2000;  <<SET CARRY>>        18235000
          END;                                                          18240000
      END                                                               18245000
    ELSE IF CARRYSET THEN TOS:=TOS LOR %2000;                           18250000
    STATUSWORD:=TOS;                                                    18255000
  END                                                                   18260000
ELSE IF NOT(0<=OP1DIGS<=28) OR NOT(0<=OP2DIGS<=28) THEN                 18265000
   DEC'SIM'TRAP(15);                                                    18270000
TOS:=%031400+SDEC;                                                      18275000
<<EXIT OVER USER'S STACK MARKER>>                                       18280000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            18285000
ASSEMBLE(XEQ 0);                                                        18290000
END <<NLS>>;                                                            18295000
$PAGE                                                                   18300000
<<......................................................................18305000
.                                                                      .18310000
.                             DMPY                                     .18315000
.                                                                      .18320000
......................................................................>>18325000
                                                                        18330000
$CONTROL SEGMENT=FIRMWARESIM2                                           18335000
                                                                        18340000
PROCEDURE DMUL;                                                         18345000
OPTION PRIVILEGED,UNCALLABLE;                                           18350000
                                                                        18355000
COMMENT: MULTIPLIES THE TWO DOUBLE WORDS ON TOS TOGETHER,               18360000
         USING EACH AS A LOGICAL DOUBLEWORD. THE                        18365000
         FOUR WORD LOGICAL PRODUCT IS LEFT ON TOS;                      18370000
                                                                        18375000
BEGIN                                                                   18380000
LOGICAL SIGNFLAG,           <<TRUE IF ANSWER NEGATIVE>>                 18385000
        TOPZERO,          <<TRUE IF TOP 2 WORDS OF RESULT ARE ZERO>>    18390000
        INSTR=Q-4,        <<MACHINE INSTRUCTION CODE, HAS SDEC>>        18395000
        NONZERO,          <<TRUE IF RESULTI IS NOT ZERO>>               18400000
        STATUSWORD=Q-6;    <<CONDITION CODE AND CARRY>>                 18405000
DOUBLE LOCOP1,        <<LOCAL OP1>>                                     18410000
       LOCOP2,            <<LOCAL OP2>>                                 18415000
       OP1=Q-10,      <<USERS OPERAND 1>>                               18420000
       OP2=Q-12;      <<USER'S OPERAND 2>>                              18425000
LOGICAL LOC1=LOCOP1, LOC2=LOCOP1+1,                                     18430000
        LOC3=LOCOP2, LOC4=LOCOP2+1;                                     18435000
ARRAY RESULT(0:3);          <<LOCAL RESULT>>                            18440000
DOUBLE POINTER DRES1:=@RESULT, DRES2:=@RESULT(2);                       18445000
<<GET RID OF PRIVILEGED MODE AND DISABLE TRAPS>>                        18450000
PUSH(STATUS);                                                           18455000
IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV>> TOS:=TOS LAND %77777;18460000
TOS:=TOS LAND %157777; <<TURN OFF TRAPS>>                               18465000
SET(STATUS);                                                            18470000
SIGNFLAG:=NONZERO:=FALSE;                                               18475000
TOPZERO := TRUE;                                                        18480000
TOS:=OP2;                                                               18485000
LOCOP2:=TOS; <<PUT IN LOCAL>>                                           18490000
TOS:=OP1;                                                               18495000
LOCOP1:=TOS;                                                            18500000
TOS:=LOC4; <<LOW ORDER PART OF OP2>>                                    18505000
ASSEMBLE(DUP);                                                          18510000
TOS:=TOS**LOC2; <<MULTIPLY LOW ORDER PARTS>>                            18515000
RESULT(3):=TOS; <<PARTIAL RESULT>>                                      18520000
ASSEMBLE(ZERO,XCH;CAB); <<SET UP NEXT PART>>                            18525000
TOS:=TOS**LOC1; <<LOW TIMES HIGH>>                                      18530000
ASSEMBLE(DADD); <<PARTIAL PRODUCT>>                                     18535000
TOS:=LOC2**LOC3; <<HIGH TIMES LOW>>                                     18540000
ASSEMBLE(DADD);  <<ANOTHER PARTIAL PRODUCT>>                            18545000
RESULT(2):=TOS;                                                         18550000
TOS:=0;                                                                 18555000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE CARRY>>                           18560000
ASSEMBLE(XCH); <<SET UP FOR NEXT PARTIAL>>                              18565000
TOS:=LOC1**LOC3; <<MULTIPLY HIGHS>>                                     18570000
ASSEMBLE(DADD);                                                         18575000
DRES1:=TOS; <<LAST PARTIAL PRODUCT>>                                    18580000
OP1 := DRES2;  <<LOW ORDER DWORD>>                                      18585000
IF <> THEN NONZERO := TRUE;                                             18590000
OP2 := DRES1;  <<HIGH ORDER DWORD>>                                     18595000
IF <> THEN   <<TOP DWORD IS NOT ALL ZEROS>>                             18600000
  BEGIN                                                                 18605000
  TOPZERO := FALSE;                                                     18610000
  NONZERO := TRUE;                                                      18615000
  END;                                                                  18620000
TOS:=RESULT; TOS:=TOS&CSL(1); IF TOS THEN SIGNFLAG:=TRUE;               18625000
TOS := STATUSWORD LAND %174377;  <<CLEAR CARRY & CC>>                   18630000
IF NOT TOPZERO THEN <<SET CARRY>>                                       18635000
  TOS := TOS LOR %2000;                                                 18640000
IF NOT NONZERO THEN <<CCE>> TOS := TOS LOR %1000                        18645000
  ELSE IF SIGNFLAG THEN <<CCL>> TOS := TOS LOR %400;                    18650000
STATUSWORD := TOS;                                                      18655000
<<EXIT OVER USERS STACK>>                                               18660000
PUSH(Q); TOS := TOS -5; SET(Q);                                         18665000
RETURN 0;                                                               18670000
END;   <<DMUL (DMPY) >>                                                 18675000
$CONTROL SEGMENT=FIRMWARESIM1                                  <<01820>>18680000
procedure STUNSIM;                                             <<01745>>18685000
option privileged,uncallable;                                  <<01745>>18690000
begin        <<STUNSIM>>                                       <<01745>>18695000
                                                               <<01745>>18700000
equate        XCH'SUB                  =  %3221,               <<01745>>18705000
                                                               <<01745>>18710000
              DDUP                     =  %46,                 <<01876>>18715000
                                                               <<01745>>18720000
              SETQ                     =  %27402,              <<01745>>18725000
                                                               <<01745>>18730000
              DUP                      =  %45,                 <<01876>>18735000
                                                               <<01876>>18740000
              DUP'NOP                  =  %4500,               <<01876>>18745000
                                                               <<01745>>18750000
              SETQS                    =  %27403;              <<01745>>18755000
                                                               <<01745>>18760000
                                                               <<01745>>18765000
integer       CURR'X                   =  Q-3,                 <<01745>>18770000
                                                               <<01745>>18775000
              TRAP'X                   =  Q-10,                <<01745>>18780000
                                                               <<01745>>18785000
              X                        =  X;                   <<01745>>18790000
                                                               <<01745>>18795000
                                                               <<01745>>18800000
logical       CURR'DELTAQ              =  Q+0,                 <<01745>>18805000
                                                               <<01745>>18810000
              CURR'STATUS              =  Q-1,                 <<01745>>18815000
                                                               <<01745>>18820000
              NEXT1                    =  Q-4,                 <<01745>>18825000
                                                               <<01745>>18830000
              NEXT                     =  Q-5,                 <<01745>>18835000
                                                               <<01745>>18840000
              USER'DELTAQ              =  Q-4,                 <<01745>>18845000
                                                               <<01745>>18850000
              USER'DELTAQ'             =  Q-11,                <<01876>>18855000
                                                               <<01876>>18860000
              INSTRUCTION              =  Q-6,                 <<01745>>18865000
                                                               <<01745>>18870000
              TRAP'DELTAQ              =  Q-7,                 <<01745>>18875000
                                                               <<01745>>18880000
              TRAP'STATUS              =  Q-8,                 <<01745>>18885000
                                                               <<01745>>18890000
              TRAP'DELTAP              =  Q-9;                 <<01745>>18895000
                                                               <<01745>>18900000
                                                               <<01745>>18905000
double        USER'DELTAQ'TOS          =  Q-12,                <<01745>>18910000
                                                               <<01745>>18915000
              TRAP'DELTAQ'TOS          =  Q-10,                <<01745>>18920000
                                                               <<01745>>18925000
              TRAP'DELTAP'STATUS       =  Q-9,                 <<01745>>18930000
              TRAP'X'DELTAP            =  Q-10,                <<01876>>18935000
                                                               <<01876>>18940000
              USER'STATUS'DELTAQ       =  Q-12,                <<01876>>18945000
                                                               <<01876>>18950000
                                                               <<01745>>18955000
              CURR'DELTAP'STATUS       =  Q-2;                 <<01745>>18960000
                                                               <<01745>>18965000
                                                               <<01745>>18970000
array         PCBX(*)                  =  Q+0;                 <<01745>>18975000
                                                               <<01745>>18980000
                                                               <<01745>>18985000
define        S'EQUALS'Q               =  TRAP'DELTAQ=4#,      <<01745>>18990000
                                                               <<01745>>18995000
              S'EQUALS'Q1              =  TRAP'DELTAQ=5#,      <<01745>>19000000
                                                               <<01745>>19005000
              SIMBIT                   =  (0:1)#,              <<06634>>19010000
                                                               <<01745>>19015000
              SET'CC                   =  push(STATUS);        <<01745>>19020000
                                          tos:=tos&lsr(8);     <<01745>>19025000
                                          TRAP'STATUS.CC:=tos#,<<01745>>19030000
                                                               <<01745>>19035000
              RESET'Q                  =  push(Q);             <<01745>>19040000
                                          tos:=tos-CURR'DELTAQ;<<01745>>19045000
                                          set(Q)#,             <<01745>>19050000
                                                               <<01745>>19055000
              LEFTSTACKOP              =  INSTRUCTION.(4:6)#,  <<01876>>19060000
                                                               <<01876>>19065000
              CC                       =  (6:2)#;              <<01745>>19070000
                                                               <<01745>>19075000
                                                               <<01745>>19080000
subroutine LOGSTUN;                                            <<01745>>19085000
 begin                                                         <<01745>>19090000
 push(Q,DL);                                                   <<01745>>19095000
 assemble(xch,sub);                                            <<01745>>19100000
 assemble(dup,stax);                                           <<01745>>19105000
 X:=X-1;                                                       <<01745>>19110000
 tos:=-PCBX(X);                                                <<01745>>19115000
 assemble(add);                                                <<01745>>19120000
 X:=tos+6;                                                     <<06634>>19125000
 tos:=PCBX(X);                                                 <<01745>>19130000
 tos.SIMBIT:=1;                                                <<01745>>19135000
 PCBX(X):=tos;                                                 <<01745>>19140000
 end;                                                          <<01745>>19145000
                                                               <<01745>>19150000
if S'EQUALS'Q                                                  <<01876>>19155000
 then                                                          <<01876>>19160000
  if INSTRUCTION=SETQ                                          <<01876>>19165000
   then                                                        <<01876>>19170000
    begin        <<SET Q>>                                     <<01876>>19175000
    LOGSTUN;                                                   <<01876>>19180000
    RESET'Q;                                                   <<01876>>19185000
    CURR'DELTAQ:=logical(@CURR'DELTAQ)-USER'DELTAQ;            <<01876>>19190000
    return 1;                                                  <<01876>>19195000
    end          <<SET Q>>                                     <<01876>>19200000
 else                                                          <<01876>>19205000
  if LEFTSTACKOP=DUP                                           <<01876>>19210000
   then                                                        <<01876>>19215000
    begin       <<DUP/NOP>>                                    <<01876>>19220000
    LOGSTUN;                                                   <<01876>>19225000
    CURR'DELTAQ:=CURR'DELTAQ+TRAP'DELTAQ;                      <<01876>>19230000
    CURR'DELTAP'STATUS:=TRAP'DELTAP'STATUS;                    <<01876>>19235000
    CURR'X:=TRAP'X;                                            <<01876>>19240000
    TRAP'X:=USER'DELTAQ';                                      <<01876>>19245000
    SET'CC;                                                    <<01876>>19250000
    return 6;                                                  <<01876>>19255000
    end         <<DUP/NOP>>                                    <<01876>>19260000
 else                                                          <<01876>>19265000
  if LEFTSTACKOP=DDUP                                          <<01876>>19270000
   then                                                        <<01876>>19275000
    begin        <<DDUP>>                                      <<01876>>19280000
    LOGSTUN;                                                   <<01876>>19285000
    CURR'DELTAQ:=CURR'DELTAQ+TRAP'DELTAQ;                      <<01876>>19290000
    CURR'DELTAP'STATUS:=TRAP'DELTAP'STATUS;                    <<01876>>19295000
    CURR'X:=TRAP'X;                                            <<01876>>19300000
    TRAP'X'DELTAP:=USER'STATUS'DELTAQ;                         <<01876>>19305000
    SET'CC;                                                    <<01876>>19310000
    return 5;                                                  <<01876>>19315000
    end;         <<DDUP>>                                      <<01876>>19320000
                                                               <<01745>>19325000
if S'EQUALS'Q1                                                 <<01745>>19330000
 then                                                          <<01745>>19335000
  if INSTRUCTION=XCH'SUB and NEXT=DUP'NOP and NEXT1=SETQS      <<01745>>19340000
   then                                                        <<01745>>19345000
    begin        <<XCH/SUB/DUP/NOP>>                           <<01745>>19350000
    LOGSTUN;                                                   <<01745>>19355000
    tos:=USER'DELTAQ'TOS;                                      <<01745>>19360000
    assemble(xch);                                             <<01745>>19365000
    USER'DELTAQ'TOS:=tos;                                      <<01745>>19370000
    SET'CC;                                                    <<01745>>19375000
    TRAP'DELTAQ:=TRAP'DELTAQ+1;                                <<01745>>19380000
    RESET'Q;                                                   <<01745>>19385000
    return;                                                    <<01745>>19390000
    end          <<XCH/SUB/DUP/NOP>>                           <<01745>>19395000
 else                                                          <<01745>>19400000
 if LEFTSTACKOP=DDUP                                           <<01876>>19405000
   then                                                        <<01745>>19410000
    begin        <<DDUP>>                                      <<01745>>19415000
    LOGSTUN;                                                   <<01745>>19420000
    CURR'DELTAQ:=CURR'DELTAQ+TRAP'DELTAQ;                      <<01745>>19425000
    CURR'DELTAP'STATUS:=TRAP'DELTAP'STATUS;                    <<01745>>19430000
    CURR'X:=TRAP'X;                                            <<01745>>19435000
    TRAP'DELTAQ'TOS:=USER'DELTAQ'TOS;                          <<01745>>19440000
    SET'CC;                                                    <<01745>>19445000
    return 5;                                                  <<01764>>19450000
    end;         <<DDUP>>                                      <<01745>>19455000
end;        <<STUNSIM>>                                        <<01745>>19460000
$CONTROL SEGMENT=MAIN                                          <<01745>>19465000
END.                                                           <<01745>>19470000
