$CONTROL MAP,CODE,USLINIT                                               00010000
<<FIRMWARESIM - MODULE 78>>                                             00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$THIRTY                                                                 00028000
$CONTROL SEGMENT=FIRMWARESIM1                                           00030000
BEGIN                                                                   00032000
            << >>                                                       00034000
            <<FIRMWARE SIMULATION ROUTINES ->>                          00036000
            <<  DOUBLE PRECISION: ADD       >>                          00038000
            <<                    SUBTRACT  >>                          00040000
            <<                    MULTIPLY  >>                          00042000
            <<                    DIVIDE    >>                          00044000
            <<                    COMPARE   >>                          00046000
            <<                    NEGATE    >>                          00048000
            <<  DECIMAL FIRMWARE: CVBD      >>                          00050000
            <<                    CVDB      >>                          00052000
            <<                    CVAD      >>                          00054000
            <<                    CVDA      >>                          00056000
            <<                    SRD       >>                          00058000
            <<                    NSLD      >>                          00060000
            <<                    SLD       >>                          00062000
            <<                    ADDD      >>                          00064000
            <<                    CMPD      >>                          00066000
            <<                    SUBD      >>                          00068000
            <<                    DMPY      >>                          00070000
            << >>                                                       00072000
                                                                        00074000
PROCEDURE GETPRIVMODE; OPTION PRIVILEGED,EXTERNAL;                      00076000
PROCEDURE ABORT(MODE,CODE,PARAM);                                       00078000
     VALUE MODE,CODE,PARAM;                                             00080000
     LOGICAL MODE,CODE,PARAM;                                           00082000
     OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                             00084000
PROCEDURE ININRETURN;                                                   00086000
OPTION EXTERNAL;                                                        00088000
                                                                        00090000
PROCEDURE DEC'SIM'TRAP(TRAPNUM);                                        00092000
VALUE TRAPNUM;INTEGER TRAPNUM;                                          00094000
OPTION PRIVILEGED,EXTERNAL;                                             00096000
                                                                        00098000
<<......................................................................00100000
.                                                                      .00102000
.                             EMATH                                    .00104000
.                                                                      .00106000
......................................................................>>00108000
PROCEDURE EMATH;                                                        00110000
OPTION PRIVILEGED,UNCALLABLE;                                           00112000
BEGIN                                                                   00114000
COMMENT PERFORMS DOUBLE PRECISION ARITHMETIC OPERATIONS:                00116000
          ADD,                                                          00118000
          SUBTRACT,                                                     00120000
          MULTIPLY,                                                     00122000
          DIVIDE;                                                       00124000
     DEFINE                                                             00126000
       LU=ASSEMBLE(LOAD Q+1;LDD Q+2)#,                                  00128000
       LV=ASSEMBLE(LOAD Q+4;LDD Q+5)#,                                  00130000
       SU=ASSEMBLE(STOR Q+3;STD Q+1)#,                                  00132000
       SV=ASSEMBLE(STOR Q+6;STD Q+4)#,                                  00134000
       LX=ASSEMBLE(LOAD Q-6,I;INCM Q-6;LDD Q-6,I;DECM Q-6)#,            00136000
       LY=ASSEMBLE(LOAD Q-5,I;INCM Q-5;LDD Q-5,I;DECM Q-5)#,            00138000
       LZ=ASSEMBLE(LOAD Q-4,I;INCM Q-4;LDD Q-4,I;DECM Q-4)#,            00140000
       SX=ASSEMBLE(INCM Q-6;STD Q-6,I;DECM Q-6;STOR Q-6,I)#,            00142000
       SY=ASSEMBLE(INCM Q-5;STD Q-5,I;DECM Q-5;STOR Q-5,I)#,            00144000
       SZ=ASSEMBLE(INCM Q-4;STD Q-4,I;DECM Q-4;STOR Q-4,I)#;            00146000
COMMENT DATA DECLARATIONS *********************************************;00148000
      INTEGER                                <<                       >>00150000
         U1         =Q+1,                    <<MSW(U)                 >>00152000
         U2         =Q+2,                    <<MIDDLE WORD OF U       >>00154000
         U3         =Q+3,                    <<LSW(U)                 >>00156000
         V1         =Q+4,                    <<MSW(V)                 >>00158000
         V2         =Q+5,                    <<MIDDLE WORD OF V       >>00160000
         V3         =Q+6,                    <<LSW(V)                 >>00162000
         SIGN       =Q+7,                    <<SIGN OF RESULT         >>00164000
         EXPU       =Q+8,                    <<EXPONENT(U)            >>00166000
         EXPV       =Q+9,                    <<EXPONENT(V)            >>00168000
          OPCODE     =Q+11,                                             00170000
         DELTAQ     =Q-0,                                               00172000
         MYSTAT     =Q-1,                                               00174000
         A          =S-0,                    <<                       >>00176000
         B          =S-1,                    <<GREAT                  >>00178000
         C          =S-2,                    <<   FOR                 >>00180000
         I          =U1,                     <<      PLAYING          >>00182000
         XREG       =X;                      <<         GAMES         >>00184000
      LOGICAL                                <<                       >>00186000
         LU1        =U1,                     <<                       >>00188000
         LU2        =U2,                     <<                       >>00190000
         LU3        =U3,                     <<                       >>00192000
         LV1        =V1,                     <<                       >>00194000
         LV2        =V2,                     <<                       >>00196000
         LV3        =V3,                     <<                       >>00198000
         OVFL       =Q+10;                   <<OVERFLOW INDICATOR>>     00200000
      DOUBLE                                 <<                       >>00202000
         BA         =S-1,                    <<                       >>00204000
         V1V2       =V1,                     <<IF YOU                 >>00206000
         V2V3       =V2,                     << CANT FIGURE           >>00208000
         U1U2       =U1,                     <<  THIS OUT, GO TO      >>00210000
         U2U3       =U2;                     <<   PROGRAMMERS SCHOOL  >>00212000
      DOUBLE POINTER                                                    00214000
         DZ         =Q-4;                                               00216000
      ENTRY                                                             00218000
         EADD,                               <<ADD ENTRY      Z _ X+Y >>00220000
         ESUB,                               <<SUBTRACT ENTRY Z _ X-Y >>00222000
         EMPY,                               <<MULTIPLY ENTRY Z _ X*Y >>00224000
         EDIV;                               <<DIVIDE ENTRY   Z _ X/Y >>00226000
      ARRAY                                  <<                       >>00228000
         STACK(*)   =Q-6;                    <<ERROR STACK MARKER LOC >>00230000
      SUBROUTINE ALLOCATE;                                              00232000
      COMMENT CLEANS UP STACK FROM INTERNAL INTERRUPT ROUTINE AND       00234000
              ALLOCATES LOCAL STORAGE                             ;     00236000
      BEGIN                                                             00238000
           XREG _ TOS;                       <<SAVE RETURN ADDRESS>>    00240000
           PUSH(S,Q);                                                   00242000
           TOS _ TOS - DELTAQ;                                          00244000
           ASSEMBLE(DUP);                                               00246000
           SET(Q);                           <<GO BACK 1 MARKER>>       00248000
           TOS _ TOS - TOS - 9;                                         00250000
           ASSEMBLE(SUBS 0);                                            00252000
          IF MYSTAT > 0 THEN                 <<USER MODE CALL>>         00254000
          BEGIN                                                         00256000
               PUSH(STATUS);                                            00258000
               ASSEMBLE(TRBC 0);             <<RESET PRIV.   >>         00260000
               SET(STATUS);                                             00262000
          END;                                                          00264000
           TOS_0D;                                                      00266000
           TOS _ XREG;                       <<RESET RETURN ADDRESS>>   00268000
      END;                                                              00270000
      SUBROUTINE UNPACK;                                                00272000
        BEGIN                           <<UNPACK U AND V. EXPONENTS     00274000
                                          ARE SHIFTED                   00276000
                                          RIGHT AND STORED IN EXPU,EXPV.00278000
                                          IMPLICIT BITS ARE SET         00280000
                                          AND FRACTIONS                 00282000
                                          ARE SHIFTED LEFT 2 BITS.      00284000
                                          SIGN _ U1 XOR U2>>            00286000
          TOS _ V1;                                                     00288000
          TOS _ U1;                                                     00290000
          ASSEMBLE(DDUP,XOR);                                           00292000
          SIGN _ TOS;                        <<BIT(0)=0 IF SAME SIGN>>  00294000
          EXPU _ A.(1:9);                    <<EXPON+256>>              00296000
          TOS _ TOS.(10:6);                  <<FRACTION>>               00298000
          ASSEMBLE(TSBC 9);                  <<SET IMPLICIT BIT>>       00300000
          U1 _ TOS;                                                     00302000
          EXPV _ A.(1:9);                    <<DITTO>>                  00304000
          TOS _ TOS.(10:6);                                             00306000
          ASSEMBLE(TSBC 9);                                             00308000
          V1 _ TOS;                                                     00310000
         LU; TOS_TOS&TASL(2); SU;                                       00312000
        END;   <<UNPACK>>                                               00314000
COMMENT ADD/SUBTRACT PART *********************************************;00316000
ESUB:                                        <<SUBTRACT ENTRY>>         00318000
      ALLOCATE;                                                         00320000
      OPCODE_%20401;                                                    00322000
      LZ;                                                               00324000
      ASSEMBLE(OR,FNEG;DEL);                 <<CHANG SIGN AND ADD>>     00326000
      @DZ _ @DZ + 1;                                                    00328000
      TOS _ DZ;                                                         00330000
      GO ADD;                                <<W _ U + (-V)>>           00332000
EADD:                                        <<ADD ENTRY>>              00334000
      ALLOCATE;                                                         00336000
      OPCODE_%20400;                                                    00338000
      LZ;                                                               00340000
ADD:    SV;                                                             00342000
      LY; SU;                                                           00344000
      TOS _ U1;                                                         00346000
      ASSEMBLE(TSBC 0);                      <<SIGN MSW(U)=SIGN MSW(V)>>00348000
      TOS _ V1;                              <<FOR COMPARISON>>         00350000
      ASSEMBLE(TSBC 0;                                                  00352000
               LCMP);                        <<COMPARE U1 WITH V1>>     00354000
      IF < THEN                                                         00356000
      BEGIN                                                             00358000
SWAP:          LU;                                                      00360000
               LV; SU;                                                  00362000
               SV;                                                      00364000
      END    <<SWAP>>                                                   00366000
      ELSE                                   <<U1 >= V1>>               00368000
      BEGIN                                                             00370000
           IF = THEN                                                    00372000
           BEGIN                                                        00374000
                TOS _ U2U3 - V2V3; DDEL;                                00376000
                IF NOCARRY THEN GO SWAP;                                00378000
           END;     <<U1 = V1>>                                         00380000
      END;   <<U1 >= V1>>                                               00382000
      TOS _ U1;                              <<SAVE SIGN OF RESULT>>    00384000
      LV; TOS_TOS&TASR(0);                                              00386000
      DDEL; DEL;                                                        00388000
      IF = THEN                                                         00390000
      BEGIN                                  <<V=0 SO ANSWER=U>>        00392000
           TOS _ U2U3;                                                  00394000
           XREG _ 0;                                                    00396000
           TOS _ TOS & TASR(0);                                         00398000
           GO TO CCA;                                                   00400000
      END;                                                              00402000
      UNPACK;                                <<UNPACK U AND V>>         00404000
      LV; TOS_TOS&TASL(2); SV;                                          00406000
      IF SIGN < 0 THEN                                                  00408000
      BEGIN                                  <<COMPLIMENT V>>           00410000
           TOS _ NOT LV1;                                               00412000
           V2V3 _ -V2V3;                                                00414000
           IF = THEN TOS _ TOS + 1;                                     00416000
           V1 _ TOS;                                                    00418000
      END;   <<SIGN < 0>>                                               00420000
      SIGN _ TOS;                            <<SIGN OF RESULT>>         00422000
      TOS _ EXPU;                            <<EXP+256>>                00424000
      EXPU _ EXPU + %400;                    <<EXP+512 FOR PACK>>       00426000
      TOS _ TOS - EXPV;                      <<SHIFT COUNT>>            00428000
      XREG _ A;                              <<FOR TASR>>               00430000
      IF TOS > 40 THEN                                                  00432000
      BEGIN                                  <<U MUCH GREATER>>         00434000
            TOS _ U1;                                                   00436000
            GO TO FINISHADD;                                            00438000
      END;                                                              00440000
      LV;                                                               00442000
      ASSEMBLE(TASR 0,X);                    <<LINE UP BINARY POINTS>>  00444000
      U2U3 _ TOS + U2U3;                     <<ADD U AND V>>            00446000
      IF CARRY THEN TOS _ TOS + 1;                                      00448000
      TOS _ TOS + U1;                                                   00450000
FINISHADD:                                                              00452000
      TOS _ U2U3;                            <<RESULT ON TOS>>          00454000
COMMENT PACKING PART **************************************************;00456000
PACK:                                                                   00458000
      XREG_0; XREG_XREG+1;   <<KLUDGE FOR TNSL ERROR IN MICROCODE>>     00460000
      TOS _ TOS & TNSL;                                                 00462000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             00464000
      TOS _ 0; TOS _ 4;                      <<DOUBLE 4>>               00466000
      ASSEMBLE(DADD);                        <<ROUND>>                  00468000
      IF CARRY THEN C _ C + 1;                                          00470000
      TOS _ TOS&TASR(3);                     <<SHIFT TO BIT 9>>         00472000
      ASSEMBLE(CAB);                         <<U1 ON TOS>>              00474000
      TOS _ EXPU;                            <<MOVE      >>             00476000
      TOS _ XREG;                            <<  EXPONENT>>             00478000
      TOS _ TOS + %400;                                                 00480000
      TOS _ TOS - TOS;                       <<    INTO  >>             00482000
      TOS _ TOS&LSL(6);                      <<      U1  >>             00484000
      TOS _ TOS + TOS;                                                  00486000
      ASSEMBLE(DUP,STAX);                    <<SAVE U1 FOR ERROR TEST>> 00488000
      IF SIGN < 0 THEN ASSEMBLE(TSBC 0)      <<SET SIGN BIT>>           00490000
                  ELSE ASSEMBLE(TRBC 0);                                00492000
      ASSEMBLE(CAB,CAB);                     <<ROTATE U1 BACK>>         00494000
      ASSEMBLE(DTST);                                                   00496000
      IF = THEN OVFL _ TRUE;                 << UNDERFLOW POSSIBLE >>   00498000
      TOS _ TOS & TASR(0);                                              00500000
CCA:  PUSH(STATUS);                                                     00502000
      TOS _ MYSTAT;                                                     00504000
      ASSEMBLE(XCH);                                                    00506000
      TOS . (6:2) _ TOS . (6:2);                                        00508000
      MYSTAT _ TOS;                                                     00510000
      SX;                                                               00512000
      TOS _ XREG;                                                       00514000
      IF < THEN                                                         00516000
      BEGIN                                                             00518000
           TOS _ TOS & LSL(1);                                          00520000
           IF < THEN                                                    00522000
UNDERF:    TOS _ 9 ELSE                                                 00524000
           TOS _ 8;                                                     00526000
ERROR:     IF MYSTAT.(2:1) = 1 THEN                                     00528000
           BEGIN                                                        00530000
                TOS_OPCODE;                                             00532000
                I _ 0;                                                  00534000
                <<MOVE CURRENT STACK MARKER ABOVE RESULT ADDR. (Q-6)>>  00536000
                WHILE (I _ I + 1) <= 3 DO STACK(I) _ STACK(I + 2);      00538000
                STACK(I) _ DELTAQ - 2;                         <<00.03>>00540000
            PUSH(Q);                                                    00542000
            TOS_TOS-2;                                                  00544000
            SET(Q);                                                     00546000
            GETPRIVMODE;                                                00548000
            XREG_TOS;                                                   00550000
            ABORT(%400,A,0);                                            00552000
           END ELSE MYSTAT . (4:1) _ 1;                                 00554000
           RETURN 3                                                     00556000
      END;                                                              00558000
      IF = AND OVFL THEN GO TO UNDERF;                                  00560000
      MYSTAT . (4:1) _0;                                                00562000
      RETURN 3;                                                         00564000
COMMENT MULTIPLY PART *************************************************;00566000
EMPY:                                        <<MULTIPLY ENTRY>>         00568000
      ALLOCATE;                                                         00570000
      OPCODE_%20402;                                                    00572000
      XREG _ 0;                                                         00574000
      LY; TOS_TOS&TASR(0);                                              00576000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             00578000
      SU;                                                               00580000
      LZ; TOS_TOS&TASR(0);                                              00582000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             00584000
      SV;                                                               00586000
      UNPACK;                                <<UNPACK U AND V>>         00588000
      EXPU _ EXPU + EXPV;                    <<RESULT EXPON + 512>>     00590000
      TOS _ U1; TOS _ V1;                                               00592000
      XREG _ A;                                                         00594000
      ASSEMBLE(LMPY,XCH);                    <<M,0_U1*V1>>              00596000
      TOS _ U2;                                                         00598000
      ASSEMBLE(LDXA,LMPY);                   <<L,J_U2*V1>>              00600000
      TOS _ U1; TOS _ V2;                                               00602000
      XREG _ A;                                                         00604000
      ASSEMBLE(LMPY,ZERO);                   <<K,I_U1*V2,PUSH 0>>       00606000
      TOS _ U2;                                                         00608000
      ASSEMBLE(LDXA,LMPY);                   <<H,E_U2*V2>>              00610000
      TOS _ U3; TOS _ V1;                                               00612000
      ASSEMBLE(LMPY);                        <<G,D_U3*V1>>              00614000
      TOS _ U1; TOS _ V3;                                               00616000
      XREG _ A;                                                         00618000
      ASSEMBLE(LMPY,ZERO);                   <<F,C_U1*V3,PUSH 0>>       00620000
      TOS _ U2;                                                         00622000
      ASSEMBLE(LDXA,LMPY;DEL,ZERO);          <<B_U2*V3,PUSH 0>>         00624000
      TOS _ U3; TOS _ V2;                                               00626000
      ASSEMBLE(LMPY,DEL);                    <<A_U3*V2>>                00628000
      ASSEMBLE(DADD,DADD;DADD,DADD);         <<CALCULATE LOW 2 WORDS>>  00630000
      XREG _ TOS;                            <<SAVE LSW>>               00632000
      IF CARRY THEN B _ B + 1;                                          00634000
      ASSEMBLE(DADD,DADD;DADD,LDXA);         <<CALC REST GET LSW>>      00636000
      TOS _ TOS & TASR(6);                   <<LOGICAL SHIFT>>          00638000
      ASSEMBLE(CAB,ZERO;                                                00640000
               DPF 0:6;                                                 00642000
               CAB,CAB);                     <<  SIX PLACES RIGHT>>     00644000
      GO PACK;                               <<PACK RESULT>>            00646000
COMMENT DIVIDE  PART **************************************************;00648000
EDIV:                                        <<DIVIDE ENTRY>>           00650000
      ALLOCATE;                                                         00652000
      OPCODE_%20403;                                                    00654000
      XREG _ 0;                                                         00656000
      LZ; TOS_TOS&TASR(0);                                              00658000
      IF = THEN                                                         00660000
      BEGIN                                  <<DIVIDE BY ZERO ERROR>>   00662000
         LY; SX;                                                        00664000
           MYSTAT . (6:2) _2;                                           00666000
           TOS _ 10;                                                    00668000
           GO TO ERROR;                                                 00670000
      END;                                                              00672000
      SV;                                                               00674000
      LY; TOS_TOS&TASR(0);                                              00676000
      IF = THEN GO TO CCA;                   <<ANSWER = 0>>             00678000
      SU;                                                               00680000
      UNPACK;                                <<UNPACK U AND V>>         00682000
      LV; TOS_TOS&TASL(9);                                              00684000
      V2V3 _ TOS;                                                       00686000
      ASSEMBLE(TSBC 0);                                                 00688000
      V1 _ TOS;                                                         00690000
      EXPU _ EXPU - EXPV + %777;             <<ADJUST EXPON FOR PACK>>  00692000
      TOS _ U1U2;                                                       00694000
      TOS _ V1;                                                         00696000
      TOS _ U3;                                                         00698000
      ASSEMBLE(STAX,LDIV;                    <<U1U2/V1>>                00700000
               XCH,XAX);                     <<R1,Q1;R1,U3>>            00702000
      TOS _ V2;                                                         00704000
      ASSEMBLE(LDXA,LMPY;DSUB);              <<R1,U3,Q1*V2 ; R1 PRIME>> 00706000
      IF NOCARRY THEN                                                   00708000
      BEGIN                                  <<NEGATIVE REMAINDER>>     00710000
           TOS _ TOS + V1V2;                                            00712000
           XREG _ XREG - 1;                    <<SO Q1 IS TOO BIG>>     00714000
      END;                                                              00716000
      TOS _ 0; TOS _ XREG;                                              00718000
      TOS _ V3;                                                         00720000
      ASSEMBLE(LMPY,DSUB;                    <<R12,0-Q1*V3>>            00722000
               CAB,LDXA);                    <<R11,Q1>>                 00724000
      U1 _ TOS;                              <<STORE Q1>>               00726000
      IF NOCARRY THEN                                                   00728000
      BEGIN                                                             00730000
           TOS _ TOS - 1;                                               00732000
           IF NOCARRY THEN                                              00734000
           BEGIN                             <<NEGATIVE REMAINDER>>     00736000
                XREG _ TOS;                                             00738000
                TOS _ TOS + V2V3;                                       00740000
                TOS _ XREG;                                             00742000
                IF CARRY THEN TOS _ TOS + 1;                            00744000
                TOS _ TOS + V1;                                         00746000
                U1 _ U1 - 1;                                            00748000
           END;                                                         00750000
      END;                                                              00752000
      ASSEMBLE(ZROX,XBX);                    <<U3,0,UL,SAVE U4 IN X>>   00754000
      TOS _ V1;                                                         00756000
      ASSEMBLE(LDIV,CAB);                    <<Q21,R2T,U3>>             00758000
      TOS _ V1;                                                         00760000
      ASSEMBLE(LDIV,LDXA;                    <<Q21,Q22,R2,U+>>          00762000
               DXCH,DDUP);                   <<R2,U4,Q21,Q22,Q21,Q22>>  00764000
      U2U3 _ TOS; TOS _ V2;                  <<SAVE Q2 IN U2,V3>>       00766000
      ASSEMBLE(LMPY,CAB);                    <<U,L,Q21>>                00768000
      TOS _ V2;                                                         00770000
      ASSEMBLE(LMPY,XCH;                     <<R2,U4,V,L,A,0>>          00772000
               DADD,DSUB);                   <<R21,R22>>                00774000
      IF NOCARRY THEN                                                   00776000
      BEGIN                                  <<NEGATIVE REMAINDER>>     00778000
Q2LOOP:    TOS _ U2U3;                                                  00780000
           ASSEMBLE(DZRO,INCA;DSUB);         <<DEC Q2>>                 00782000
           U2U3 _ TOS;                                                  00784000
           TOS _ TOS + V1V2;                 <<ADD BACK V1V2>>          00786000
           IF NOCARRY THEN GO Q2LOOP;                                   00788000
      END;                                                              00790000
      TOS _ V3;                                                         00792000
      ASSEMBLE(STAX,ZERO);                                              00794000
      TOS _ U2U3;                                                       00796000
      ASSEMBLE(LDXA,LMPY;                    <<Q22*V3>>                 00798000
               CAB,LDXA;                     <<Q21*V3>>                 00800000
               LMPY,XCH;                                                00802000
               DADD,DSUB);                   <<R22,0-Q2*V3>>            00804000
      ASSEMBLE(CAB,STAX);                                               00806000
      IF NOCARRY THEN                                                   00808000
      BEGIN                                                             00810000
           XREG _ XREG - 1;                                             00812000
           IF NOCARRY THEN                                              00814000
           BEGIN                             <<NEGATIVE REMAINDER>>     00816000
                TOS _ V2V3; TOS _ V1;                                   00818000
                ASSEMBLE(ADAX,DADD);                                    00820000
                IF CARRY THEN XREG _ XREG + 1;                          00822000
                U3 _ U3 - 1;                                            00824000
           END;                                                         00826000
      END;                                   <<NOW HAVE U4,U5,X=U3>>    00828000
      ASSEMBLE(LDXA,CAB;CAB);                                           00830000
      TOS _ TOS & TASR(1);                   <<DIVIDE U3,U+,U5 BY 2>>   00832000
      ASSEMBLE(STAX,XCH);                                               00834000
      ASSEMBLE(TRBC 0);                                                 00836000
      ASSEMBLE(XCH);                                                    00838000
      TOS _ V1;                                                         00840000
      ASSEMBLE(LDIV,LDXA;                    <<Q3,R3,U5>>               00842000
               CAB,STAX);                    <<R3,U5,X=Q3>>             00844000
      TOS _ V2;                                                         00846000
      ASSEMBLE(LDXA,LMPY;DSUB);              <<R3,U5-Q3*V2>>            00848000
      IF NOCARRY THEN XREG _ XREG - 1;       <<Q3 TOO BIG>>             00850000
      TOS _ U1; TOS _ U3;                    <<LOAD Q1 AND Q2>>         00852000
      TOS _ XREG & LSL(1);                   <<Q1,Q2,Q3>>               00854000
      GO PACK;                                                          00856000
END <<EMATH>>;                                                          00858000
$PAGE                                                                   00860000
<<......................................................................00862000
.                                                                      .00864000
.                             ECMP                                     .00866000
.                                                                      .00868000
......................................................................>>00870000
PROCEDURE ECMP;                                                         00872000
OPTION PRIVILEGED,UNCALLABLE;                                           00874000
BEGIN                                                                   00876000
COMMENT PERFORMS DOUBLE PRECISION COMPARE, SETS CC=CCA;                 00878000
      INTEGER STATUS=Q-1,A=S-0;                                         00880000
      INTEGER POINTER U=Q-5,V=Q-4;           <<COMPARE  U:V>>           00882000
      DOUBLE POINTER DU=Q-5,DV=Q-4;                                     00884000
      INTEGER DELTAQ = Q-0;                                             00886000
      PUSH(Q);                                                          00888000
      TOS _ TOS - DELTAQ;                                               00890000
      SET(Q);                                <<BACKUP ONE MARKER>>      00892000
     IF STATUS > 0 THEN                      <<USER MODE CALL>>         00894000
     BEGIN                                                              00896000
          PUSH(STATUS);                                                 00898000
          ASSEMBLE(TRBC 0);                  <<RESET PRIV.   >>         00900000
          SET(STATUS);                                                  00902000
     END;                                                               00904000
      TOS _ U;                               <<LOAD MOST SIG. WORDS>>   00906000
      ASSEMBLE(DUP,STAX);                    <<SAVE MSW IN X>>          00908000
      TOS _ V;                                                          00910000
      ASSEMBLE(DDUP,XOR;DEL);                                           00912000
      IF < THEN                                                         00914000
      BEGIN                                  <<DIFFERENT SIGNS>>        00916000
           ASSEMBLE(DEL,TEST);               <<CHECK MSW(U)>>           00918000
           IF = THEN TOS _ TOS + 1;          <<CCG IF MSW(U)=0>>        00920000
      END <<DIFF. SIGNS>>                                               00922000
      ELSE                                                              00924000
      BEGIN                                  <<SAME SIGN>>              00926000
           @U _ @U + 1; @V _ @V + 1;         <<POINT TO LEAST SIG PART>>00928000
           TOS _ DU; TOS _ DV;               <<LOAD LOW 2 WORDS>>       00930000
           ASSEMBLE(DSUB,DXCH);              <<MSW(U AND V) ON TOP>>    00932000
           IF NOCARRY THEN TOS _ TOS + 1;                               00934000
           TOS _ TOS - TOS;                  <<FINISH THE 3-WORD SUB>>  00936000
           IF = THEN                                                    00938000
           BEGIN                             <<MSW(U-V)=0. CHECK REST>> 00940000
                TOS _ TOS & TASR(0);         <<SET 3-WORD CCA>>         00942000
                IF <> THEN TOS_TOS+1;        <<ANSWER REALLY > 0>>      00944000
           END;                                                         00946000
           ASSEMBLE(LDXA,DEL);               <<CHECK SIGN OF ARGS>>     00948000
           IF < THEN                         <<REVERSE U AND V>>        00950000
           BEGIN                                                        00952000
                TOS _ NOT TOS;                                          00954000
                IF <= THEN TOS _ TOS + 1;    <<CCE NOT VALID HERE>>     00956000
           END;                                                         00958000
           ASSEMBLE(TEST);                                              00960000
      END; <<SAME SIGN>>                                                00962000
      PUSH(STATUS);                                                     00964000
      TOS _ STATUS; ASSEMBLE(XCH);                                      00966000
      TOS . (6:2) _ TOS . (6:2);                                        00968000
      STATUS _ TOS;                                                     00970000
      RETURN 2;                                                         00972000
END <<ECMP>>;                                                           00974000
$PAGE                                                                   00976000
<<......................................................................00978000
.                                                                      .00980000
.                             ENEG                                     .00982000
.                                                                      .00984000
......................................................................>>00986000
PROCEDURE ENEG;                                                         00988000
OPTION PRIVILEGED,UNCALLABLE;                                           00990000
BEGIN                                                                   00992000
COMMENT PERFORMS DOUBLE PRECISION NEGATE;                               00994000
      INTEGER POINTER I=Q-4;                 <<FIRST WORD OF ARG>>      00996000
      DOUBLE POINTER D=Q-4;                  <<2ND AND 3RD WORDS>>      00998000
      INTEGER STATUS=Q-1,A=S-0;                                         01000000
      INTEGER DELTAQ = Q-0;                                             01002000
      PUSH(Q);                                                          01004000
      TOS _ TOS - DELTAQ;                                               01006000
      SET(Q);                                <<BACKUP ONE MARKER>>      01008000
      TOS _ STATUS;                                                     01010000
     IF > THEN                               <<USER MODE CALL>>         01012000
     BEGIN                                                              01014000
          PUSH(STATUS);                                                 01016000
          ASSEMBLE(TRBC 0);                  <<RESET PRIV.   >>         01018000
          SET(STATUS);                                                  01020000
     END;                                                               01022000
      TOS _ I;                                                          01024000
      @D _ @D+1;                                                        01026000
      TOS _ D;                                                          01028000
      @D _ @D-1;                                                        01030000
      ASSEMBLE(OR,FNEG;DEL);                 <<FIX MSW,DELETE REST>>    01032000
      I _ TOS;                                                          01034000
      PUSH(STATUS);                                                     01036000
      TOS . (6:2) _ TOS . (6:2);                                        01038000
      STATUS _ TOS;                                                     01040000
      RETURN 1;                                                         01042000
END <<ENEG>>;                                                           01044000
PROCEDURE QASL; OPTION PRIVILEGED,UNCALLABLE;                           01046000
     BEGIN                                                              01048000
       INTEGER                                                          01050000
         XREG      = X,                                                 01052000
         D         = Q-7,                                               01054000
         C         = Q-6,                                               01056000
         B         = Q-5,                                               01058000
         A         = Q-4,                                               01060000
         PARAM     = Q-4,                                               01062000
         MYSTAT    = Q-1,                                               01064000
         DELTAQ    = Q-0;                                               01066000
       DOUBLE                                                           01068000
         DD        = D,                                                 01070000
         DB        = B;                                                 01072000
         XREG_PARAM.(10:6);                                             01074000
         PUSH(Q);                                                       01076000
         TOS_TOS-DELTAQ;                                                01078000
         SET(Q);                                                        01080000
         TOS_MYSTAT;                                                    01082000
         IF > THEN                                                      01084000
          BEGIN                                                         01086000
           PUSH(STATUS);                                                01088000
           TOS.(0:1)_0;                                                 01090000
           SET(STATUS);                                                 01092000
          END;                                                          01094000
         TOS_DD;                                                        01096000
         TOS_0;                                                         01098000
         IF XREG > 15 THEN                                              01100000
          BEGIN                                                         01102000
           TOS_TOS&TASL(16);                                            01104000
           DDEL;                                                        01106000
           TOS_DB;                                                      01108000
           XREG_XREG-16;                                                01110000
           ASSEMBLE(TASL 0,X);                                          01112000
           TOS_0;                                                       01114000
           DB_TOS;                                                      01116000
          END                                                           01118000
         ELSE                                                           01120000
          BEGIN                                                         01122000
           ASSEMBLE(TASL 0,X);                                          01124000
           TOS_DB;                                                      01126000
           ASSEMBLE(TASL 0,X);                                          01128000
           ASSEMBLE(DXCH,OR;CAB,CAB);                                   01130000
           ASSEMBLE(DDUP);                                              01132000
           DB_TOS;                                                      01134000
           ASSEMBLE(OR;TASL 0;DEL);                                     01136000
          END;                                                          01138000
         DD_TOS;                                                        01140000
         PUSH(STATUS);                                                  01142000
         TOS.(6:2)_TOS.(6:2);                                           01144000
         MYSTAT_TOS;                                                    01146000
     END << QASL >>;                                                    01148000
PROCEDURE QASR; OPTION PRIVILEGED,UNCALLABLE;                           01150000
     BEGIN                                                              01152000
       INTEGER                                                          01154000
         XREG      = X,                                                 01156000
         D         = Q-7,                                               01158000
         C         = Q-6,                                               01160000
         B         = Q-5,                                               01162000
         A         = Q-4,                                               01164000
         PARAM     = Q-4,                                               01166000
         MYSTAT    = Q-1,                                               01168000
         DELTAQ    = Q-0;                                               01170000
       DOUBLE                                                           01172000
         DD        = D,                                                 01174000
         DB        = B;                                                 01176000
         XREG_PARAM.(10:6);                                             01178000
         PUSH(Q);                                                       01180000
         TOS_TOS-DELTAQ;                                                01182000
         SET(Q);                                                        01184000
         TOS_MYSTAT;                                                    01186000
         IF > THEN                                                      01188000
          BEGIN                                                         01190000
           PUSH(STATUS);                                                01192000
           TOS.(0:1)_0;                                                 01194000
           SET(STATUS);                                                 01196000
          END;                                                          01198000
          TOS_DD;                                                       01200000
         TOS_0;                                                         01202000
         IF XREG > 15 THEN                                              01204000
          BEGIN                                                         01206000
           TOS_TOS&TASR(16);                                            01208000
           TOS_B;                                                       01210000
           XREG_XREG-16;                                                01212000
           ASSEMBLE(TASR 0,X);                                          01214000
           DB_TOS;                                                      01216000
          END                                                           01218000
         ELSE                                                           01220000
          BEGIN                                                         01222000
           ASSEMBLE(TASR 0,X);                                          01224000
           TOS_DB;                                                      01226000
           ASSEMBLE(DLSR 0,X);                                          01228000
           ASSEMBLE(CAB,CAB;OR,XCH);                                    01230000
           ASSEMBLE(DDUP);                                              01232000
           DB_TOS;                                                      01234000
           ASSEMBLE(OR;TASL 0;DEL);                                     01236000
          END;                                                          01238000
         DD_TOS;                                                        01240000
         PUSH(STATUS);                                                  01242000
         TOS.(6:2)_TOS.(6:2);                                           01244000
         MYSTAT_TOS;                                                    01246000
     END << QASR >>;                                                    01248000
PROCEDURE DIMPY; OPTION PRIVILEGED,UNCALLABLE;                          01250000
     BEGIN                                                              01252000
       INTEGER                                                          01254000
         X         = X,                                                 01256000
         U1        = Q-7,                                               01258000
         U2        = Q-6,                                               01260000
         V1        = Q-5,                                               01262000
         V2        = Q-4,                                               01264000
         MYSTAT    = Q-1,                                               01266000
         DELTAQ    = Q-0;                                               01268000
       DOUBLE                                                           01270000
         DRES      = U1,                                                01272000
         U         = U1,                                                01274000
         REM       = V1,                                                01276000
         V         = V1;                                                01278000
       LOGICAL                                                          01280000
         SIGN      = Q+1,                                               01282000
         DENSIGN   = Q+2,                                               01284000
         OVFLOW    = Q+3,                                               01286000
         UOVFL     = Q+4,                                               01288000
         VOVFL     = Q+5,                                               01290000
         DIV       = Q+6;                                               01292000
       INTEGER                                                          01294000
       A         = S-0,                                                 01296000
         I         = SIGN,                                              01298000
         J         = DENSIGN,                                           01300000
         IDIV      = DIV;                                               01302000
       ARRAY                                                            01304000
         STACK(*)  = Q-6;                                               01306000
       ENTRY                                                            01308000
         DIDIV;                                                         01310000
         TOS_0;                                                         01312000
         GO MUL;                                                        01314000
DIDIV  :                                                                01316000
         TOS_1;                                                         01318000
MUL    :                                                                01320000
         X_TOS;                                                         01322000
        ASSEMBLE(PSDB);                                        <<01.03>>01324000
         PUSH(Q);                                                       01326000
         TOS_TOS_TOS-DELTAQ;                                            01328000
         SET(Q,S);                                                      01330000
        ASSEMBLE(PSEB);                                        <<01.03>>01332000
         TOS_0D;                                                        01334000
         TOS_0D;                                                        01336000
         TOS_0;                                                         01338000
         TOS_X;                                                         01340000
         TOS_MYSTAT;                                                    01342000
         IF > THEN                                                      01344000
          BEGIN                                                         01346000
           PUSH(STATUS);                                                01348000
           TOS.(0:1)_0;                                                 01350000
           SET(STATUS);                                                 01352000
          END;                                                          01354000
         TOS_U;                                                         01356000
         IF < THEN                                                      01358000
          BEGIN                                                         01360000
           ASSEMBLE(DNEG,DDUP);                                         01362000
           IF OVERFLOW THEN UOVFL_UOVFL+1;                              01364000
           U_TOS;                                                       01366000
           I_I+1;                                                       01368000
           J_J+1;                                                       01370000
          END;                                                          01372000
         TOS_V;                                                         01374000
         IF < THEN                                                      01376000
          BEGIN                                                         01378000
           ASSEMBLE(DNEG);                                              01380000
           IF OVERFLOW THEN VOVFL_VOVFL+1;                              01382000
           I_I+1;                                                       01384000
           V_TOS;                                                       01386000
          END ELSE DDEL;                                                01388000
DIVIDE : IF DIV THEN BEGIN                                              01390000
           IF VOVFL THEN BEGIN DDEL;                                    01392000
            IF UOVFL THEN BEGIN TOS_0D; TOS_TOS+1; TOS_0D; END ELSE     01394000
             BEGIN TOS_0D; TOS_U; IF DENSIGN THEN ASSEMBLE(DNEG) END;   01396000
            REM_TOS; GO RSLT;                                           01398000
           END ELSE IF UOVFL AND V=1D THEN BEGIN IF NOT SIGN            01400000
           THEN OVFLOW_TRUE; REM_0D; GO RSLT END; TOS_V;                01402000
           IF = THEN BEGIN TOS_4; GO DIVZERO END;                       01404000
           ASSEMBLE(DCMP);                                              01406000
           IF <= AND NOT UOVFL THEN                                     01408000
            BEGIN                                                       01410000
             TOS_0D;                                                    01412000
             IF U=V THEN                                                01414000
              BEGIN TOS_TOS+1; TOS_0D END                               01416000
             ELSE                                                       01418000
              TOS_U;                                                    01420000
            END                                                         01422000
           ELSE                                                         01424000
            BEGIN                                                       01426000
             IF V1 = 0 THEN                                             01428000
              BEGIN                                                     01430000
               TOS_U;                                                   01432000
               ASSEMBLE(ZERO,CAB);                                      01434000
               TOS_V2;                                                  01436000
               ASSEMBLE(LDIV,CAB);                                      01438000
               TOS_V2;                                                  01440000
               ASSEMBLE(LDIV,ZERO;XCH);                                 01442000
              END                                                       01444000
             ELSE                                                       01446000
              BEGIN                                                     01448000
               TOS_0;                                                   01450000
               TOS_U1;                                                  01452000
               TOS_V1;                                                  01454000
               ASSEMBLE(LDIV,STBX);                                     01456000
               TOS_U2;                                                  01458000
               ASSEMBLE(CAB);                                           01460000
               TOS_V2;                                                  01462000
               ASSEMBLE(LMPY,DSUB);                                     01464000
               WHILE NOCARRY DO                                         01466000
                BEGIN                                                   01468000
                 X_X-1;                                                 01470000
                 TOS_TOS+V;                                             01472000
                END;                                                    01474000
               ASSEMBLE(ZERO,LDXA;DXCH);                                01476000
              END;                                                      01478000
           END;                                                         01480000
           IF DENSIGN THEN ASSEMBLE(DNEG);                              01482000
           REM_TOS;                                                     01484000
           GO STORE;                                                    01486000
          END;                                                          01488000
MULTIPLY:                                                               01490000
         IF UOVFL THEN BEGIN DDEL; IF V=0D THEN TOS_0D ELSE             01492000
          IF V=1D THEN TOS_U ELSE GO OVFL; GO RSLT END                  01494000
         ELSE IF VOVFL THEN BEGIN DDEL; IF U=0D THEN TOS_0D ELSE        01496000
          IF U=1D THEN TOS_V ELSE GO OVFL; GO RSLT END;                 01498000
         TOS_V2;                                                        01500000
         ASSEMBLE(DUP,CAB;LMPY,XCH;DXCH,LMPY);                          01502000
         TOS_V1; TOS_U2;                                                01504000
         ASSEMBLE(LMPY,DADD;CAB,ZERO;XCH,DADD;ZERO,CAB);                01506000
         TOS_U1;                                                        01508000
         TOS_V1;                                                        01510000
         ASSEMBLE(LMPY,DADD);                                           01512000
         IF TOS <> 0D THEN OVFLOW_TRUE;                                 01514000
         ASSEMBLE(XCH);                                                 01516000
STORE  :                                                                01518000
         ASSEMBLE(DTST);                                                01520000
         IF < THEN OVFLOW_TRUE;                                         01522000
         IF SIGN THEN ASSEMBLE(DNEG);                                   01524000
RSLT   :                                                                01526000
         ASSEMBLE(DTST);                                                01528000
         DRES_TOS;                                                      01530000
         PUSH(STATUS);                                                  01532000
         TOS.(6:2)_TOS.(6:2);                                           01534000
         TOS.(4:1)_0;                                                   01536000
         MYSTAT_TOS;                                                    01538000
         IF NOT OVFLOW THEN GO OUT;                                     01540000
OVFL   :                                                                01542000
         TOS_1;                                                         01544000
DIVZERO:                                                                01546000
         IF LOGICAL(MYSTAT.(2:1)) THEN                                  01548000
          BEGIN                                                         01550000
           IF DIV THEN TOS_%20571 ELSE                                  01552000
            BEGIN                                                       01554000
             TOS_%20570;                                                01556000
             I_0;                                                       01558000
             WHILE (I_I+1)<=3 DO STACK(I)_STACK(I+2);                   01560000
             STACK(I)_DELTAQ-2;                                         01562000
             PUSH(Q);                                                   01564000
             TOS_TOS-2;                                                 01566000
             SET(Q);                                                    01568000
            END;                                                        01570000
           GETPRIVMODE;                                                 01572000
           X_TOS;                                                       01574000
           ABORT(%400,A,0);                                             01576000
          END ELSE MYSTAT.(4:1)_1;                                      01578000
OUT    :                                                                01580000
         IF DIV THEN RETURN ELSE RETURN 2;                              01582000
     END;                                                               01584000
PROCEDURE QNEG; OPTION PRIVILEGED,UNCALLABLE;                           01586000
     BEGIN                                                              01588000
       INTEGER POINTER                                                  01590000
         U         = Q-4;                                               01592000
       DOUBLE POINTER                                                   01594000
         RU        = U;                                                 01596000
       INTEGER                                                          01598000
         MYSTAT    = Q-1,                                               01600000
         DELTAQ    = Q-0;                                               01602000
         PUSH(Q);                                                       01604000
         TOS_TOS-DELTAQ;                                                01606000
         SET(Q);                                                        01608000
         TOS_MYSTAT;                                                    01610000
         IF > THEN                                                      01612000
          BEGIN                                                         01614000
           PUSH(STATUS);                                                01616000
           TOS.(0:1)_0;                                                 01618000
           SET(STATUS);                                                 01620000
          END;                                                          01622000
         TOS_RU;                                                        01624000
         TOS_RU(1);                                                     01626000
         ASSEMBLE(OR,OR;FNEG,DEL);                                      01628000
         U_TOS;                                                         01630000
         PUSH(STATUS);                                                  01632000
         TOS.(6:2)_TOS.(6:2);                                           01634000
         MYSTAT_TOS;                                                    01636000
         RETURN 1;                                                      01638000
     END << QNEG >>;                                                    01640000
PROCEDURE QCMP; OPTION PRIVILEGED,UNCALLABLE;                           01642000
     BEGIN                                                              01644000
       INTEGER POINTER                                                  01646000
         U         = Q-5,                                               01648000
         V         = Q-4;                                               01650000
       DOUBLE POINTER                                                   01652000
         A         = S-0,                                               01654000
         B         = S-1;                                               01656000
       INTEGER                                                          01658000
         MYSTAT    = Q-1,                                               01660000
         DELTAQ    = Q-0;                                               01662000
       REAL POINTER                                                     01664000
         RU        = U,                                                 01666000
         RV        = V;                                                 01668000
         PUSH(Q);                                                       01670000
         TOS_TOS-DELTAQ;                                                01672000
         SET(Q);                                                        01674000
         TOS_MYSTAT;                                                    01676000
         IF > THEN                                                      01678000
          BEGIN                                                         01680000
           PUSH(STATUS);                                                01682000
           TOS.(0:1)_0;                                                 01684000
           SET(STATUS);                                                 01686000
          END;                                                          01688000
         IF RU = RV THEN                                                01690000
          BEGIN                                                         01692000
           ASSEMBLE(LDD U);                                             01694000
           IF U < 0 THEN ASSEMBLE(XCH);                                 01696000
           TOS_B(1)-A(1);                                               01698000
           IF <> THEN                                                   01700000
            BEGIN                                                       01702000
             IF NOCARRY THEN TOS_-1 ELSE TOS_1;                         01704000
             DEL                                                        01706000
            END;                                                        01708000
           DDEL; DDEL;                                                  01710000
          END;                                                          01712000
         PUSH(STATUS);                                                  01714000
         TOS.(6:2)_TOS.(6:2);                                           01716000
         MYSTAT_TOS;                                                    01718000
         RETURN 2;                                                      01720000
     END << QCMP >>;                                                    01722000
PROCEDURE QMATH; OPTION PRIVILEGED,UNCALLABLE;                          01724000
     BEGIN                                                              01726000
       INTEGER                                                          01728000
         U1        = Q+1,                                               01730000
         U2        = Q+2,                                               01732000
         U3        = Q+3,                                               01734000
         U4        = Q+4,                                               01736000
         V1        = Q+5,                                               01738000
         V2        = Q+6,                                               01740000
         V3        = Q+7,                                               01742000
         V4        = Q+8,                                               01744000
         TOSA      = Q+9,                                               01746000
         EXPU      = Q+10,                                              01748000
         EXPV      = Q+11,                                              01750000
         ESAVE     = Q+12,                                              01752000
         XSAVE     = Q+18,                                              01754000
         OPCODE    = Q+19,                                              01756000
         XREG      = X,                                                 01758000
         DELTAQ    = Q-0,                                               01760000
         MYSTAT    = Q-1,                                               01762000
         A         = S-0,                                               01764000
         B         = S-1,                                               01766000
         C         = S-2,                                               01768000
         S4        = S-4,                                               01770000
         S5        = S-5,                                               01772000
         S9        = S-9,                                               01774000
         S10       = S-10;                                              01776000
       DOUBLE                                                           01778000
         V1V2      = V1,                                                01780000
         V2V3      = V2,                                                01782000
         V3V4      = V3,                                                01784000
         U1U2      = U1,                                                01786000
         U2U3      = U2,                                                01788000
         U3U4      = U3,                                                01790000
         DSAVE     = Q+13;                                              01792000
       ARRAY                                                            01794000
         STACK(*)  = Q-6;                                               01796000
       EQUATE                                                           01798000
         PARAMETERS= 19;                                                01800000
       LOGICAL                                                          01802000
         SIGN      = Q+15,                                              01804000
         DIFSIGN   = Q+16,                                              01806000
         OVFL      = Q+17;                                              01808000
       DOUBLE POINTER                                                   01810000
         X         = Q-6,                                               01812000
         Y         = Q-5,                                               01814000
         Z         = Q-4;                                               01816000
       REAL POINTER                                                     01818000
         RX        = Q-6,                                               01820000
         RY        = Q-5,                                               01822000
         RZ        = Q-4;                                               01824000
       DEFINE                                                           01826000
         QTST      = ASSEMBLE(LDD S-3;LDD S-3); QTSTDEL#,               01828000
         QTSTEQUAL = ASSEMBLE(LDD S-3;OR;TASL 0;DEL)#,                  01830000
         QTSTDEL   = ASSEMBLE(OR;TASL 0;DEL,DDEL)#;                     01832000
       ENTRY                                                            01834000
         QADD,                                                          01836000
         QSUB,                                                          01838000
         QMPY,                                                          01840000
         QDIV;                                                          01842000
SUBROUTINE QASL;                                                        01844000
     BEGIN                                                              01846000
         ESAVE_TOS;                                                     01848000
         TOSA_TOS;                                                      01850000
         ASSEMBLE(TASL 0,X);                                            01852000
         TOS_0;                                                         01854000
         TOS_TOSA;                                                      01856000
         ASSEMBLE(DLSL 0,X);                                            01858000
         ASSEMBLE(CAB,CAB;OR,XCH);                                      01860000
         TOS_ESAVE;                                                     01862000
     END << QASL >>;                                                    01864000
SUBROUTINE QASR;                                                        01866000
     BEGIN                                                              01868000
         ESAVE_TOS;                                                     01870000
         ASSEMBLE(DLSR 0,X);                                            01872000
         DSAVE_TOS;                                                     01874000
         TOS_0;                                                         01876000
         ASSEMBLE(TASR 0,X);                                            01878000
         TOS_DSAVE;                                                     01880000
         ASSEMBLE(CAB,CAB;OR,XCH);                                      01882000
         TOS_ESAVE;                                                     01884000
     END << QASR >>;                                                    01886000
SUBROUTINE ALLOCATE;                                                    01888000
     BEGIN                                                              01890000
         XREG_TOS;                                                      01892000
         PUSH(Q);                                                       01894000
         TOS_TOS_TOS-DELTAQ;                                            01896000
         SET(Q);                                                        01898000
         TOS_TOS+PARAMETERS;                                            01900000
         SET(S);                                                        01902000
         OVFL_0; XSAVE_0;                                               01904000
         IF MYSTAT > 0 THEN                                             01906000
          BEGIN                                                         01908000
           PUSH(STATUS);                                                01910000
           TOS.(0:1)_0;                                                 01912000
           SET(STATUS);                                                 01914000
          END;                                                          01916000
         TOS_XREG;                                                      01918000
     END << ALLOCATE >>;                                                01920000
SUBROUTINE UNPACK;                                                      01922000
     BEGIN                                                              01924000
         TOS_S4;                                                        01926000
         TOS_S9;                                                        01928000
         ASSEMBLE(DDUP,DDUP;XOR);                                       01930000
         TOS_TOS.(0:1);                                                 01932000
         DIFSIGN_TOS;                                                   01934000
         EXPU_TOS.(1:9);                                                01936000
         EXPV_TOS.(1:9);                                                01938000
         TOS.(9:1)_1;                                                   01940000
         S10_TOS.(9:7);                                                 01942000
         TOS.(9:1)_1;                                                   01944000
         S5_TOS.(9:7);                                                  01946000
     END << UNPACK >>;                                                  01948000
QMPY   :                                                                01950000
         ALLOCATE;                                                      01952000
         OPCODE_%20413;                                                 01954000
         TOS_Y;                                                         01956000
         TOS_Y(1);                                                      01958000
         QTST;                                                          01960000
         IF = THEN GO CCA;                                              01962000
         TOS_Z;                                                         01964000
         TOS_Z(1);                                                      01966000
         QTST;                                                          01968000
         IF = THEN GO CCA;                                              01970000
         UNPACK;                                                        01972000
         V3V4_TOS;                                                      01974000
         V1V2_TOS;                                                      01976000
         U3U4_TOS;                                                      01978000
         U1U2_TOS;                                                      01980000
         EXPU_EXPU+EXPV;                                                01982000
         TOS_U1;                                                        01984000
         XREG_TOS_V1;                                                   01986000
         ASSEMBLE(LMPY,ZERO);                                           01988000
         TOS_U2;                                                        01990000
         ASSEMBLE(LDXA,LMPY);                                           01992000
         TOS_U1;                                                        01994000
         XREG_TOS_V2;                                                   01996000
         ASSEMBLE(LMPY,ZERO);                                           01998000
         TOS_U2;                                                        02000000
         ASSEMBLE(LDXA,LMPY);                                           02002000
         TOS_U3;                                                        02004000
         TOS_V1;                                                        02006000
         ASSEMBLE(LMPY);                                                02008000
         TOS_U1;                                                        02010000
         XREG_TOS_V3;                                                   02012000
         ASSEMBLE(LMPY,ZERO);                                           02014000
         TOS_U2;                                                        02016000
         ASSEMBLE(LDXA,LMPY);                                           02018000
         TOS_U3;                                                        02020000
         TOS_V2;                                                        02022000
         ASSEMBLE(LMPY);                                                02024000
         TOS_U4;                                                        02026000
         TOS_V1;                                                        02028000
         ASSEMBLE(LMPY);                                                02030000
         TOS_U1;                                                        02032000
         XREG_TOS_V4;                                                   02034000
         ASSEMBLE(LMPY,ZERO);                                           02036000
         TOS_U2;                                                        02038000
         ASSEMBLE(LDXA,LMPY);                                           02040000
         TOS_U3;                                                        02042000
         TOS_V3;                                                        02044000
         ASSEMBLE(LMPY);                                                02046000
         TOS_U4;                                                        02048000
         TOS_V2;                                                        02050000
         ASSEMBLE(LMPY,DADD);                                           02052000
         IF CARRY THEN S4_S4+1;                                         02054000
         ASSEMBLE(DADD);                                                02056000
         IF CARRY THEN C_C+1;                                           02058000
         ASSEMBLE(DEL,DADD;DADD,DADD);                                  02060000
         IF CARRY THEN S4_S4+1;                                         02062000
         ASSEMBLE(DADD);                                                02064000
         IF CARRY THEN C_C+1;                                           02066000
         U4_TOS;                                                        02068000
         ASSEMBLE(DADD,DADD;DADD);                                      02070000
         IF CARRY THEN C_C+1;                                           02072000
         U3_TOS;                                                        02074000
         ASSEMBLE(DADD,DADD;DADD);                                      02076000
         TOS_U3U4;                                                      02078000
         XREG_4;                                                        02080000
         QASR;                                                          02082000
         GO PACK;                                                       02084000
QDIV   :                                                                02086000
         ALLOCATE;                                                      02088000
         OPCODE_%20412;                                                 02090000
         TOS_Y;                                                         02092000
         TOS_Y(1);                                                      02094000
         QTSTEQUAL;                                                     02096000
         IF = THEN GO CCA;                                              02098000
         TOS_Z;                                                         02100000
         TOS_Z(XREG);                                                   02102000
         QTSTEQUAL;                                                     02104000
         IF = THEN                                                      02106000
          BEGIN                                                         02108000
           ASSEMBLE(DDEL,DDEL);                                         02110000
           QTST;                                                        02112000
           PUSH(STATUS);                                                02114000
           TOS_TOS.(6:2);                                               02116000
           TOS_MYSTAT;                                                  02118000
           ASSEMBLE(XCH);                                               02120000
           TOS.(6:2)_TOS;                                               02122000
           MYSTAT_TOS;                                                  02124000
           X(XREG)_TOS; X_TOS;                                          02126000
           TOS_10;                                                      02128000
           GO ERROR;                                                    02130000
          END;                                                          02132000
         UNPACK;                                                        02134000
         XREG_9;                                                        02136000
         QASL;                                                          02138000
         V3V4_TOS;                                                      02140000
         V2_TOS;                                                        02142000
         TOS.(0:1)_1;                                                   02144000
         V1_TOS;                                                        02146000
         EXPU_EXPU-EXPV+%777;                                           02148000
         XREG_8;                                                        02150000
         QASL;                                                          02152000
         U3U4_TOS;                                                      02154000
         U1U2_TOS;                                                      02156000
         TOS_U1U2;                                                      02158000
         TOS_V1;                                                        02160000
         ASSEMBLE(LDIV,XCH);                                            02162000
         XREG_U3;                                                       02164000
         ASSEMBLE(XAX,LDXA);                                            02166000
         TOS_V2;                                                        02168000
         ASSEMBLE(LMPY,DSUB);                                           02170000
         WHILE NOCARRY DO                                               02172000
          BEGIN                                                         02174000
           XREG_XREG-1;                                                 02176000
           TOS_TOS+V1V2;                                                02178000
          END;                                                          02180000
         TOS_U4;                                                        02182000
         TOS_V3;                                                        02184000
         ASSEMBLE(LDXA,LMPY;DSUB);                                      02186000
         IF NOCARRY THEN                                                02188000
          BEGIN                                                         02190000
           C_C-1;                                                       02192000
           IF NOCARRY THEN                                              02194000
            BEGIN                                                       02196000
             TOS_TOS+V2V3;                                              02198000
             ASSEMBLE(CAB);                                             02200000
             IF CARRY THEN TOS_TOS+1;                                   02202000
             TOS_TOS+V1;                                                02204000
             XREG_XREG-1;                                               02206000
             ASSEMBLE(CAB,CAB);                                         02208000
            END;                                                        02210000
          END;                                                          02212000
         TOS_0;                                                         02214000
         TOS_V4;                                                        02216000
         ASSEMBLE(LDXA,LMPY;DSUB);                                      02218000
         IF NOCARRY THEN                                                02220000
          BEGIN                                                         02222000
           ASSEMBLE(DXCH);                                              02224000
           TOS_TOS-1D;                                                  02226000
           IF NOCARRY THEN                                              02228000
            BEGIN                                                       02230000
             ASSEMBLE(DXCH);                                            02232000
             TOS_TOS+V3V4;                                              02234000
             ASSEMBLE(DXCH);                                            02236000
             IF CARRY THEN TOS_TOS+1D;                                  02238000
             TOS_TOS+V1V2;                                              02240000
             XREG_XREG-1;                                               02242000
            END;                                                        02244000
           ASSEMBLE(DXCH);                                              02246000
          END;                                                          02248000
         ASSEMBLE(LDXA);                                                02250000
         U1_TOS;                                                        02252000
         ASSEMBLE(DXCH);                                                02254000
         TOS_V1;                                                        02256000
         OVFL_0;                                                        02258000
         ASSEMBLE(LDIV,XCH;STAX,CAB);                                   02260000
         IF OVERFLOW THEN OVFL_1;                                       02262000
         TOS_V2;                                                        02264000
         IF OVFL THEN ASSEMBLE(DUP,LDXA;LMPY,DELB) ELSE                 02266000
         ASSEMBLE(LDXA,LMPY);                                           02268000
         ASSEMBLE(DSUB);                                                02270000
         WHILE NOCARRY DO                                               02272000
          BEGIN                                                         02274000
           XREG_XREG-1;                                                 02276000
           IF NOCARRY THEN OVFL_0;                                      02278000
           TOS_TOS+V1V2;                                                02280000
          END;                                                          02282000
         ASSEMBLE(CAB);                                                 02284000
         TOS_V3;                                                        02286000
         IF OVFL THEN ASSEMBLE(DUP,LDXA;LMPY,DELB) ELSE                 02288000
         ASSEMBLE(LDXA,LMPY);                                           02290000
         ASSEMBLE(DSUB);                                                02292000
         IF NOCARRY THEN                                                02294000
          BEGIN                                                         02296000
           C_C-1;                                                       02298000
           IF NOCARRY THEN                                              02300000
            BEGIN                                                       02302000
             TOS_TOS+V2V3;                                              02304000
             ASSEMBLE(CAB);                                             02306000
             IF CARRY THEN TOS_TOS+1;                                   02308000
             TOS_TOS+V1;                                                02310000
             XREG_XREG-1;                                               02312000
             ASSEMBLE(CAB,CAB);                                         02314000
             IF NOCARRY THEN OVFL_0;                                    02316000
            END;                                                        02318000
          END;                                                          02320000
         IF OVFL THEN BEGIN OVFL_0; U1_U1+1 END;                        02322000
         ASSEMBLE(LDXA);                                                02324000
         U2_TOS;                                                        02326000
         XREG_V1;                                                       02328000
         ASSEMBLE(XAX,LDIV;XCH,XAX);                                    02330000
         IF OVERFLOW THEN OVFL_1;                                       02332000
         TOS_V2;                                                        02334000
         IF OVFL THEN ASSEMBLE(DUP,LDXA;LMPY,DELB) ELSE                 02336000
         ASSEMBLE(LDXA,LMPY);                                           02338000
         ASSEMBLE(DSUB);                                                02340000
         WHILE NOCARRY DO                                               02342000
          BEGIN                                                         02344000
           XREG_XREG-1;                                                 02346000
           IF NOCARRY THEN OVFL_0;                                      02348000
           TOS_TOS+V1V2;                                                02350000
          END;                                                          02352000
         IF OVFL THEN BEGIN OVFL_0; U1U2_U1U2+1D END;                   02354000
         ASSEMBLE(LDXA);                                                02356000
         U3_TOS;                                                        02358000
         TOS_V1;                                                        02360000
         ASSEMBLE(LDIV,DEL);                                            02362000
         IF OVERFLOW THEN U3_U3+1;                                      02364000
         U4_TOS;                                                        02366000
         TOS_U1U2;                                                      02368000
         IF OVERFLOW THEN TOS_TOS+1D;                                   02370000
         TOS_U3U4;                                                      02372000
         XREG_6;                                                        02374000
         QASR;                                                          02376000
         GO PACK;                                                       02378000
QSUB   :                                                                02380000
         ALLOCATE; OPCODE_%20411;                                       02382000
         TOS_RZ;                                                        02384000
         TOS_RZ(1);                                                     02386000
         ASSEMBLE(OR,OR;FNEG,DEL);                                      02388000
         TOS_RZ;                                                        02390000
         DELB;                                                          02392000
         V1V2_TOS;                                                      02394000
         GO ADD;                                                        02396000
QADD   :                                                                02398000
         ALLOCATE;                                                      02400000
         OPCODE_%20410;                                                 02402000
         V1V2_RZ;                                                       02404000
ADD    :                                                                02406000
         TOS_Y&DLSL(1)&DLSR(1);                                         02408000
         TOS_V1V2&DLSL(1)&DLSR(1);                                      02410000
         ASSEMBLE(DCMP);                                                02412000
         IF > THEN                                                      02414000
          BEGIN                                                         02416000
NOSWAP :                                                                02418000
           TOS_RY;                                                      02420000
           TOS_RY(1);                                                   02422000
           TOS_V1V2;                                                    02424000
           TOS_RZ(1);                                                   02426000
          END ELSE                                                      02428000
         IF < THEN                                                      02430000
          BEGIN                                                         02432000
SWAP   :                                                                02434000
           TOS_V1V2;                                                    02436000
           TOS_RZ(1);                                                   02438000
           TOS_RY;                                                      02440000
           TOS_RY(1);                                                   02442000
          END                                                           02444000
         ELSE                                                           02446000
          BEGIN                                                         02448000
           TOS_Y(1)-Z(1);                                               02450000
           DDEL;                                                        02452000
           IF NOCARRY THEN GO SWAP ELSE GO NOSWAP;                      02454000
          END;                                                          02456000
         QTSTEQUAL;                                                     02458000
         IF = THEN                                                      02460000
          BEGIN                                                         02462000
           DDEL;                                                        02464000
           DDEL;                                                        02466000
           QTST;                                                        02468000
           GO CCA;                                                      02470000
          END;                                                          02472000
         ASSEMBLE(LOAD S-7);                                            02474000
         SIGN_TOS.(0:1);                                                02476000
         UNPACK;                                                        02478000
         XREG_2;                                                        02480000
         QASL;                                                          02482000
         V3V4_TOS;                                                      02484000
         V1V2_TOS;                                                      02486000
         QASL;                                                          02488000
         U3U4_TOS;                                                      02490000
         U1U2_TOS;                                                      02492000
         IF DIFSIGN THEN                                                02494000
          BEGIN                                                         02496000
           TOS_-V1V2;                                                   02498000
           V3V4_-V3V4;                                                  02500000
           IF <> THEN TOS_TOS-1D;                                       02502000
           V1V2_TOS;                                                    02504000
          END;                                                          02506000
         DIFSIGN_SIGN;                                                  02508000
         TOS_EXPU;                                                      02510000
         EXPU_EXPU+%400;                                                02512000
         XREG_TOS_TOS-EXPV;                                             02514000
         IF TOS > 56 THEN                                               02516000
          BEGIN                                                         02518000
           TOS_U1U2;                                                    02520000
           GO FINISHADD;                                                02522000
          END;                                                          02524000
         TOS_V1V2;                                                      02526000
         TOS_V3V4;                                                      02528000
         IF XREG < 16 THEN QASR ELSE                                    02530000
          BEGIN                                                         02532000
           ASSEMBLE(XCH);                                               02534000
           TOSA_TOS;                                                    02536000
           TOS_TOS&TASR(16);                                            02538000
           TOS_TOSA;                                                    02540000
           XREG_XREG-16;                                                02542000
           ASSEMBLE(TASR 0,X);                                          02544000
          END;                                                          02546000
         U3U4_TOS+U3U4;                                                 02548000
         IF CARRY THEN TOS_TOS+1D;                                      02550000
         TOS_TOS+U1U2;                                                  02552000
FINISHADD:                                                              02554000
         TOS_U3U4;                                                      02556000
PACK   :                                                                02558000
         ASSEMBLE(LDD S-3;XCH,ZROX);                                    02560000
         IF = THEN                                                      02562000
          BEGIN                                                         02564000
           DEL;                                                         02566000
           IF TOS.(0:6) = 0 THEN                                        02568000
            BEGIN                                                       02570000
             TOS_TOS&TNSL;                                              02572000
             XREG_XREG+16;                                              02574000
             ASSEMBLE(DXCH,XCH;DEL,CAB;CAB,ZERO);                       02576000
             IF XREG = 58 THEN GO CCA ELSE GO SAVEX;                    02578000
            END;                                                        02580000
          END ELSE DDEL;                                                02582000
         TOSA_TOS;                                                      02584000
         TOS_TOS&TNSL;                                                  02586000
         TOS_0;                                                         02588000
         TOS_TOSA;                                                      02590000
         ASSEMBLE(DLSL 0,X);                                            02592000
         ASSEMBLE(CAB,CAB;OR,XCH);                                      02594000
SAVEX  :                                                                02596000
         XSAVE_XREG;                                                    02598000
         TOS_TOS+4D;                                                    02600000
         IF CARRY THEN                                                  02602000
          ASSEMBLE(DXCH,DZRO;INCA,DADD;DXCH);                           02604000
         XREG_3;                                                        02606000
         QASR;                                                          02608000
         TOS_(EXPU-XSAVE-%400)&LSL(6);                                  02610000
         ASSEMBLE(LOAD S-4;ADD,DUP);                                    02612000
         XSAVE_TOS;                                                     02614000
         IF DIFSIGN THEN TOS.(0:1)_1 ELSE TOS.(0:1)_0;                  02616000
         ASSEMBLE(STOR S-4);                                            02618000
         TOS_TOS&TASL(0);                                               02620000
         IF = THEN OVFL_TRUE;                                           02622000
         QTST;                                                          02624000
CCA    :                                                                02626000
         PUSH(STATUS);                                                  02628000
         TOS_MYSTAT;                                                    02630000
         ASSEMBLE(XCH);                                                 02632000
         TOS.(6:2)_TOS.(6:2);                                           02634000
         MYSTAT_TOS;                                                    02636000
         X(1)_TOS;                                                      02638000
         X_TOS;                                                         02640000
         TOS_XSAVE;                                                     02642000
         IF < THEN                                                      02644000
          BEGIN                                                         02646000
           TOS_TOS&LSL(1);                                              02648000
           IF < THEN                                                    02650000
UNDERF :   TOS_9 ELSE TOS_8;                                            02652000
           TOS_MYSTAT; TOS_0;                                           02654000
           IF DIFSIGN THEN TOS_TOS+1;                                   02656000
           TOS.(6:2)_TOS;                                               02658000
           MYSTAT_TOS;                                                  02660000
ERROR  :   IF LOGICAL(MYSTAT.(2:1)) THEN                                02662000
            BEGIN                                                       02664000
             TOS_OPCODE;                                                02666000
             U1_0;                                                      02668000
             WHILE(U1_U1+1)<=3 DO STACK(U1)_STACK(U1+2);                02670000
             STACK(U1)_DELTAQ-2;                                        02672000
             PUSH(Q);                                                   02674000
             TOS_TOS-2;                                                 02676000
             SET(Q);                                                    02678000
             GETPRIVMODE; XREG_TOS;                                     02680000
             ABORT(%400,A,0);                                           02682000
            END ELSE MYSTAT.(4:1)_1;                                    02684000
           RETURN 3;                                                    02686000
          END;                                                          02688000
         IF = AND OVFL THEN GO UNDERF;                                  02690000
         MYSTAT.(4:1)_0;                                                02692000
         RETURN 3;                                                      02694000
     END << QMATH >>;                                                   02696000
$PAGE                                                                   02698000
<<......................................................................02700000
.                                                                      .02702000
.                             CVBD                                     .02704000
.                                                                      .02706000
......................................................................>>02708000
                                                                        02710000
                                                                        02712000
$CONTROL SEGMENT=FIRMWARESIM2                                  <<01820>>02714000
PROCEDURE CVBD;                                                         02716000
OPTION PRIVILEGED,UNCALLABLE;                                           02718000
                                                                        02720000
COMMENT: CONVERTS BINARY SOURCE TO DECIMAL DIGITS;                      02722000
                                                                        02724000
BEGIN                                                                   02726000
INTEGER CC,         <<TEMPORARY STORAGE FOR CONDITION CODE>>            02728000
        TARGETDIGS=Q-11,     <<USERS OP2 DIGITS>>                       02730000
        SOURCEWORDS=Q-9,     <<USERS OP1 WORDS>>                        02732000
        SDEC=Q-3,            <<EXTRACTED FROM INSTRUCTION>>             02734000
        XREG=X;                                                         02736000
LOGICAL DCNT,                <<COUNTER FOR DECIMAL DIGITS>>             02738000
        SAVETOP,             <<FOR SAVING TARGET NSD>>                  02740000
        DECOVERFLOW:=FALSE,  <<TRUE IF DECIMAL OVERFLOW HAS OCURRED>>   02742000
        INSTR=Q-4,           <<THE INSTRUCTION CODE>>                   02744000
        SIGN,                <<TRUE IF NEGATIVE>>                       02746000
        STATUSWORD=Q-6;      <<WHERE CONDITION CODE IS>>                02748000
BYTE ARRAY DOP(0:15);        <<LOCAL DECIMAL RESULT>>                   02750000
ARRAY BINOP(0:5);            <<LOCAL STORAGE FOR SOURCE>>               02752000
POINTER SOURCE=Q-10;         <<WHERE BINARY RESULT GOES>>               02754000
DOUBLE POINTER DSOURCE=SOURCE, DOSOURCE,                                02756000
               DBINOP=BINOP,  DOBINOP;                                  02758000
BYTE POINTER TARGET=Q-12;    <<WHERE DECIMAL SOURCE IS>>                02760000
                                                                        02762000
                                                                        02764000
SUBROUTINE DOVERFLOW;                                                   02766000
                                                                        02768000
<<IF RESULT OVERFLOWS, THE RESULT OPERAND IS EXIAMINED FOR              02770000
  ALL ZEROS.  IF THIS IS FOUND TO BE THE CASE, THE CONDITION            02772000
  CODE IS CHANGED TO CCE, AND THE SIGN IS CHANGED TO +>>                02774000
                                                                        02776000
BEGIN                                                                   02778000
TOS:=TARGET(TARGETDIGS&LSR(1)); <<GET SIGN BYTE>>                       02780000
TOS:=TOS LAND %360; <<ISOLATE FIRST DIGIT>>                             02782000
CC:=0;                                                                  02784000
IF TOS<>0 THEN CC:=1; <<NONZERO DIGIT FOUND>>                           02786000
WHILE (XREG:=XREG-1)>=0 DO <<EXAMINE THE REST OF RESULT>>               02788000
  IF INTEGER(TARGET(XREG))<>0 THEN CC:=1;                               02790000
IF CC=0 THEN <<NO NONZERO DIGITS>>                                      02792000
  BEGIN                                                                 02794000
    TARGET(TARGETDIGS&LSR(1)):=%(2)1100; <<PLUS SIGN>>                  02796000
    TOS:=STATUSWORD LAND %176377; <<SET CCE>>                           02798000
    TOS:=TOS LOR %1000;                                                 02800000
    STATUSWORD:=TOS;                                                    02802000
  END;                                                                  02804000
IF NOT(LOGICAL(TARGETDIGS)) THEN                                        02806000
  TARGET := (LOGICAL(TARGET) LAND %17) LOR (SAVETOP LAND %360);         02808000
DEC'SIM'TRAP(11); <<OVERFLOW>>                                          02810000
END <<DOVERFLOW>>;                                                      02812000
                                                                        02814000
                                                                        02816000
IF INTEGER(STATUSWORD)>=0 THEN <<TURN OFF PRIVILEGED MODE>>             02818000
  BEGIN                                                                 02820000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    02822000
  END;                                                                  02824000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                02826000
SDEC:=IF INSTR.(11:1) THEN 4 ELSE 2;                                    02828000
SIGN:=FALSE;                                                            02830000
IF 1<=SOURCEWORDS<=6 THEN                                               02832000
  BEGIN                                                                 02834000
    BINOP:=0; MOVE BINOP(1):=BINOP,(5); <<ZERO BINOP>>                  02836000
    IF 1<=TARGETDIGS<=28 THEN                                           02838000
      BEGIN                                                             02840000
        @DOSOURCE:=@SOURCE(-1); @DOBINOP:=@BINOP(-1);                   02842000
        IF INTEGER(SOURCE)>=0 THEN                                      02844000
          MOVE BINOP:=SOURCE,(SOURCEWORDS)                              02846000
        ELSE <<DO NEGATE WHILE MOVING>>                                 02848000
          BEGIN                                                         02850000
            CASE * SOURCEWORDS-1 OF                                     02852000
              BEGIN                                                     02854000
                <<1 WORD NEGATE>>                                       02856000
                BINOP:=-SOURCE;                                         02858000
                <<2 WORD NEGATE>>                                       02860000
                DBINOP:=-DSOURCE;                                       02862000
                <<3 WORD NEGATE>>                                       02864000
                BEGIN                                                   02866000
                  TOS:=0;                                               02868000
                  DOBINOP(XREG):=-DOSOURCE(1);                          02870000
                  IF <> THEN ASSEMBLE(DECA);                            02872000
                  BINOP:=-SOURCE+TOS;                                   02874000
                END;                                                    02876000
                <<4 WORD NEGATE>>                                       02878000
                BEGIN                                                   02880000
                  TOS:=0D;                                              02882000
                  DBINOP(XREG):=-DSOURCE(1);                            02884000
                  IF <> THEN ASSEMBLE(DECA,DECB);                       02886000
                  DBINOP:=-DSOURCE+TOS;                                 02888000
                END;                                                    02890000
                <<5 WORD NEGATE>>                                       02892000
                BEGIN                                                   02894000
                  ASSEMBLE(DZRO,ZERO);                                  02896000
                  DOBINOP(XREG):=-DOSOURCE(2);                          02898000
                  IF <> THEN ASSEMBLE(DECA,DECB;DDUP);                  02900000
                  DOBINOP(XREG):=-DOSOURCE(1)+TOS;                      02902000
                  ASSEMBLE(DTST);                                       02904000
                  IF = THEN IF DOBINOP(XREG)<>0D THEN ASSEMBLE(DECA);   02906000
                  BINOP:=-SOURCE+TOS;                                   02908000
                END;                                                    02910000
                <<SIX WORD NEGATE>>                                     02912000
                BEGIN                                                   02914000
                  ASSEMBLE(DZRO,DZRO);                                  02916000
                  DBINOP(XREG):=-DSOURCE(2);                            02918000
                  IF <> THEN ASSEMBLE(DECA,DECB;DDUP);                  02920000
                  DBINOP(XREG):=-DSOURCE(1)+TOS;                        02922000
                  ASSEMBLE(DTST);                                       02924000
                  IF = THEN IF DBINOP(XREG)<>0D THEN                    02926000
                    ASSEMBLE(DECA,DECB);                                02928000
                  DBINOP:=-DSOURCE+TOS;                                 02930000
                END;                                                    02932000
              END <<CASE>>;                                             02934000
            SIGN:=TRUE;                                                 02936000
          END;                                                          02938000
        CC:=IF INTEGER(SOURCE)<0 THEN 2                                 02940000
        ELSE IF DBINOP<>0D OR DBINOP(1)<>0D OR DBINOP(2)<>0D THEN       02942000
             1 ELSE 0;                                                  02944000
        TOS:=%(2)1100;  <<GET PLUS SIGN>>                               02946000
        IF SIGN THEN TOS:=TOS+1;  <<IF NEGATIVE, THEN MINUS>>           02948000
        DCNT:=IF LOGICAL(TOS:=TARGETDIGS) THEN TOS ELSE TOS+1;          02950000
LOOP:                                                                   02952000
        TOS:=0;                                                         02954000
        XREG:=0;                                                        02956000
        WHILE XREG<SOURCEWORDS DO <<DIVIDE EACH SORD BY 10>>            02958000
          BEGIN                                                         02960000
            TOS:=BINOP(XREG);                                           02962000
            TOS:=10;                                                    02964000
            ASSEMBLE(LDIV,XCH);                                         02966000
            BINOP(XREG):=TOS;                                           02968000
            XREG:=XREG+1;                                               02970000
          END;                                                          02972000
        IF DCNT THEN <<PACK TWO DIGITS/BYTE & STORE>>                   02974000
          BEGIN                                                         02976000
            XREG:=DCNT&LSR(1);                                          02978000
            DOP(XREG):=TOS&LSL(4) LOR TOS;                              02980000
          END;                                                          02982000
        DCNT:=DCNT-1;                                                   02984000
        IF (DCNT=1) AND NOT(LOGICAL(TARGETDIGS)) OR                     02986000
           (DCNT=0) AND     LOGICAL(TARGETDIGS)  THEN                   02988000
               <<ALL VALID DIGITS ALREADY GENERATED>>                   02990000
          BEGIN                                                         02992000
            XREG:=-1;                                                   02994000
            WHILE XREG<SOURCEWORDS-1 DO                                 02996000
              IF BINOP(XREG:=XREG+1)<>0 THEN DECOVERFLOW:=TRUE;         02998000
          END;                                                          03000000
        IF INTEGER(DCNT)>0 THEN GO TO LOOP;                             03002000
        IF NOT(LOGICAL(TARGETDIGS)) THEN DOP:=LOGICAL(DOP) LAND %17;    03004000
        SAVETOP := TARGET;                                              03006000
        MOVE TARGET:=DOP,(LOGICAL(TARGETDIGS+2)&LSR(1));                03008000
        TOS:=STATUSWORD LAND %176377; <<ZERO CC>>                       03010000
        IF CC=2 <<MINUS>> THEN TOS:=TOS LOR %400                        03012000
        ELSE IF CC=0 THEN TOS:=TOS LOR %1000;                           03014000
        STATUSWORD:=TOS;                                                03016000
        IF DECOVERFLOW THEN DOVERFLOW; <<DECIMAL OVERFLOW>>             03018000
        IF NOT(LOGICAL(TARGETDIGS)) THEN                                03020000
          TARGET:=(LOGICAL(TARGET) LAND %17)LOR(SAVETOP LAND %360);     03022000
      END                                                               03024000
    ELSE IF NOT (0<=TARGETDIGS<=28) THEN DEC'SIM'TRAP(15);              03026000
  END                                                                   03028000
ELSE IF NOT (0<=SOURCEWORDS<=6) THEN DEC'SIM'TRAP(14);                  03030000
TOS:=%031400+SDEC;                                                      03032000
<<EXIT OVER USERS STACK MARKER>>                                        03034000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            03036000
ASSEMBLE(XEQ 0);                                                        03038000
END <<CVBD>>;                                                           03040000
$PAGE                                                                   03042000
<<......................................................................03044000
.                                                                      .03046000
.                             CVDB                                     .03048000
.                                                                      .03050000
......................................................................>>03052000
PROCEDURE CVDB;                                                         03054000
OPTION PRIVILEGED,UNCALLABLE;                                           03056000
                                                                        03058000
COMMENT: CONVERTS DECIMAL DIGITS TO BINARY WORDS;                       03060000
                                                                        03062000
BEGIN                                                                   03064000
INTEGER LOCLEN,         <<LOCAL SOURCE LENGTH>>                         03066000
        SOURCEDIGS=Q-9, <<USER'S SOURCE LENTGTH>>                       03068000
        SDEC=Q-3,                                                       03070000
         CC,          <<TEMP STORAGE FOR CONDITION CODE>>               03072000
         XREG=X;                                                        03074000
LOGICAL STATUSWORD=Q-6,  <<WHERE CC IS KEPT>>                           03076000
        AREG = S-0,                                                     03078000
        SAVESOURCE,    <<FOR SAVING SOURCE NON-SIG DIGIT>>              03080000
        INSTR=Q-4;       <<MACHINE INSTRUCTION CODE>>                   03082000
DOUBLE DBIN1=Q+4, DBIN2=Q+6, DBIN3=Q+8;                                 03084000
INTEGER BIN1=DBIN1, BIN2=DBIN1+1, BIN3=DBIN2,                           03086000
        BIN4=DBIN2+1, BIN5=DBIN3, BIN6=DBIN3+1;                         03088000
BYTE ARRAY DIGITS(*)=S-2;                                               03090000
POINTER TARGET=Q-11;     <<WHERE BINARY RESULT GOES>>                   03092000
BYTE POINTER SOURCE=Q-10; <<WHERE DECIMAL SOURCE IS>>                   03094000
DOUBLE POINTER DRESULT=TARGET;                                          03096000
<<TURN OFF TRAPS, AND GET USER MODE>>                                   03098000
PUSH(STATUS);                                                           03100000
IF INTEGER(STATUSWORD)>=0 THEN TOS:=TOS LAND %77777; <<OFF PRIV MODE>>  03102000
TOS:=TOS LAND %157777; <<TURN OFF TRAPS>>                               03104000
SET(STATUS);                                                            03106000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                03108000
SDEC:=IF INSTR.(11:1) THEN 3 ELSE 2;                                    03110000
IF 1<=SOURCEDIGS<=28 THEN                                               03112000
  BEGIN                                                                 03114000
        TOS := SOURCE;                                                  03116000
        IF NOT(LOGICAL(SOURCEDIGS)) THEN SOURCE := AREG LAND %17;       03118000
        SAVESOURCE := TOS;                                              03120000
        ASSEMBLE(DZRO,DZRO;DZRO); <<ZERO LOCAL STORAGE>>                03122000
        LOCLEN:=IF LOGICAL((TOS:=SOURCEDIGS)) THEN TOS ELSE TOS+1;      03124000
        TOS:=SOURCE&LSL(8) ;  <<GET FIRST 2 DECIMAL DIGITS>>            03126000
        TOS:=LOGICAL(SOURCE(1)) LOR TOS; <<FIRST 4 DIGTS>>              03128000
        DO                                                              03130000
          BEGIN                                                         03132000
            TOS:=0;                                                     03134000
            TOS:=TOS&DCSL(4);                                           03136000
            ASSEMBLE(DUP);                                              03138000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    03140000
              BEGIN                                                     03142000
              SOURCE := SAVESOURCE;                                     03144000
              DEC'SIM'TRAP(13);  <<TRAP>>                               03146000
              END;                                                      03148000
            BIN6:=BIN6*10+TOS;                                          03150000
            IF XREG=LOCLEN THEN GO TO PROCESSIGN;                       03152000
          END                                                           03154000
        UNTIL (XREG:=XREG+1)>4;                                         03156000
        TOS:=SOURCE(2)&LSL(8);                                          03158000
        TOS:=LOGICAL(SOURCE(XREG+1)) LOR TOS; <<NEXT 4 DIGITS>>         03160000
        XREG:=5; <<FIFTH DIGIT>>                                        03162000
        DO <<CONVERT TWO WORDS>>                                        03164000
          BEGIN                                                         03166000
            TOS:=0;                                                     03168000
            TOS:=TOS&DCSL(4);                                           03170000
            ASSEMBLE(DUP);                                              03172000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    03174000
              BEGIN                                                     03176000
              SOURCE := SAVESOURCE;                                     03178000
              DEC'SIM'TRAP(13);  <<TRAP>>                               03180000
              END;                                                      03182000
            ASSEMBLE(ZERO,XCH);                                         03184000
            TOS:=DBIN3;                                                 03186000
            ASSEMBLE(DLSL 1;DDUP; DLSL 2; DADD,DADD);                   03188000
                   <<MULTIPLIES BY 10>>                                 03190000
            DBIN3:=TOS;                                                 03192000
            IF XREG=LOCLEN THEN GO TO PROCESSIGN;                       03194000
          END                                                           03196000
        UNTIL (XREG:=XREG+1)>8;                                         03198000
        ASSEMBLE(DZRO,ZERO); <<ZERO LOCAL STORAGE>>                     03200000
        MOVE DIGITS:=SOURCE(4),(6);<<MOVE NEXT 12 DIGITS ONTO STACK>>   03202000
        ASSEMBLE(XCH,CAB);                                              03204000
        XREG:=9;                                                        03206000
        DO   <<CONVERT 4 WORD RESULT>>                                  03208000
          BEGIN                                                         03210000
            TOS:=0;                                                     03212000
            TOS:=TOS&DCSL(4);                                           03214000
            ASSEMBLE(DUP);                                              03216000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    03218000
              BEGIN                                                     03220000
              SOURCE := SAVESOURCE;                                     03222000
              DEC'SIM'TRAP(13);  <<TRAP>>                               03224000
              END;                                                      03226000
            ASSEMBLE(ZERO,XCH);                                         03228000
            TOS:=BIN6;                                                  03230000
            TOS:=10;                                                    03232000
            ASSEMBLE(LMPY,DADD);                                        03234000
            BIN6:=TOS;                                                  03236000
            ASSEMBLE(DZRO,CAB);                                         03238000
            TOS:=BIN5;                                                  03240000
            TOS:=10;                                                    03242000
            ASSEMBLE(LMPY,DADD);                                        03244000
            BIN5:=TOS;                                                  03246000
            TOS:=DBIN2;                                                 03248000
            ASSEMBLE(DLSL 1; DDUP; DLSL 2; DADD,DADD);                  03250000
            DBIN2:=TOS;                                                 03252000
            IF XREG=12 OR XREG=16 THEN DEL;                             03254000
             IF XREG=LOCLEN THEN GO TO PROCESSIGN;                      03256000
          END                                                           03258000
        UNTIL (XREG:=XREG+1)>18;                                        03260000
        ASSEMBLE(DZRO,ZERO);<<TEN MORE DIGITS>>                         03262000
        MOVE DIGITS:=SOURCE(9),(6);                                     03264000
        ASSEMBLE(XCH,CAB);                                              03266000
        XREG:=18;                                                       03268000
        WHILE XREG<LOCLEN DO <<6 WORD RESULT>>                          03270000
          BEGIN                                                         03272000
            TOS:=0;                                                     03274000
            TOS:=TOS&DCSL(4);                                           03276000
            ASSEMBLE(DUP);                                              03278000
            IF TOS > %(2)1001 THEN <<ILLEGAL DIGIT>>                    03280000
              BEGIN                                                     03282000
              SOURCE := SAVESOURCE;                                     03284000
              DEC'SIM'TRAP(13);  <<TRAP>>                               03286000
              END;                                                      03288000
            ASSEMBLE(ZERO,XCH);                                         03290000
            TOS:=BIN6;                                                  03292000
            TOS:=10;                                                    03294000
            ASSEMBLE(LMPY,DADD);                                        03296000
            BIN6:=TOS;                                                  03298000
            ASSEMBLE(ZERO,XCH);                                         03300000
            TOS:=BIN5;                                                  03302000
            TOS:=10;                                                    03304000
            ASSEMBLE(LMPY,DADD);                                        03306000
            BIN5:=TOS;                                                  03308000
            ASSEMBLE(ZERO,XCH);                                         03310000
            TOS:=BIN4;                                                  03312000
            TOS:=10;                                                    03314000
            ASSEMBLE(LMPY,DADD);                                        03316000
            BIN4:=TOS;                                                  03318000
            ASSEMBLE(DZRO,CAB);                                         03320000
            TOS:=BIN3;                                                  03322000
            TOS:=10;                                                    03324000
            ASSEMBLE(LMPY,DADD);                                        03326000
            BIN3:=TOS;                                                  03328000
            TOS:=DBIN1;                                                 03330000
            ASSEMBLE(DLSL 1; DDUP; DLSL 2; DADD,DADD);                  03332000
            DBIN1:=TOS;                                                 03334000
            IF (XREG=21) OR (XREG=25) THEN DEL;                         03336000
            XREG:=XREG+1;                                               03338000
          END;                                                          03340000
PROCESSIGN:                                                             03342000
        XREG:=LOGICAL(XREG)&LSR(1);                                     03344000
        TOS:=LOGICAL(SOURCE(XREG)) LAND %17; <<SIGN DIGIT>>             03346000
        IF TOS=%(2)1101 THEN <<NEGATIVE>>                               03348000
          BEGIN                                                         03350000
            ASSEMBLE(DZRO,DZRO);                                        03352000
            DBIN3:=-DBIN3;                                              03354000
            IF <> THEN ASSEMBLE(DECA,DECB;DDUP);                        03356000
            DBIN2:=-DBIN2+TOS;                                          03358000
            ASSEMBLE(DTST);                                             03360000
            IF = THEN IF DBIN2<>0D THEN ASSEMBLE(DECA,DECB);            03362000
            DBIN1:=-DBIN1+TOS;                                          03364000
          END;                                                          03366000
        CC:=IF BIN1<0 THEN 2 ELSE IF DBIN3<>0D OR                       03368000
            DBIN2<>0D OR DBIN1<>0D THEN 1 ELSE 0;                       03370000
        IF SOURCEDIGS<=4 THEN <<ONE WORD>>                              03372000
          TARGET:=BIN6                                                  03374000
        ELSE IF SOURCEDIGS<=9 THEN <<TWO WORDS>>                        03376000
          DRESULT:=DBIN3                                                03378000
        ELSE <<4 OR 6 WORD RESULT>>                                     03380000
          BEGIN                                                         03382000
            TOS:=@TARGET;                                               03384000
            IF SOURCEDIGS<=18 THEN <<4 WORDS>>                          03386000
              BEGIN                                                     03388000
                TOS:=@DBIN2; TOS:=4;                                    03390000
              END                                                       03392000
            ELSE <<6 WORD RESULT>>                                      03394000
              BEGIN                                                     03396000
                TOS:=@DBIN1; TOS:=6;                                    03398000
              END;                                                      03400000
            ASSEMBLE(MOVE);                                             03402000
          END;                                                          03404000
        <<SET CONDITON CODE>>                                           03406000
        TOS:=STATUSWORD LAND %176377;                                   03408000
        IF CC=2 THEN TOS:=TOS LOR %400                                  03410000
        ELSE IF CC=0 THEN TOS:=TOS LOR %1000;                           03412000
        STATUSWORD:=TOS;                                                03414000
        SOURCE := SAVESOURCE;  <<RESTORE NON-SIGNIFICANT DIGIT>>        03416000
  END                                                                   03418000
ELSE IF NOT(0<=SOURCEDIGS<=28) THEN DEC'SIM'TRAP(15);                   03420000
TOS:=%031400+SDEC;                                                      03422000
<<EXIT OVER USER'S STACK MARKER>>                                       03424000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            03426000
ASSEMBLE(XEQ 0);                                                        03428000
END <<CVDB>>;                                                           03430000
$PAGE                                                                   03432000
$CONTROL SEGMENT=FIRMWARESIM1                                  <<01820>>03434000
<<......................................................................03436000
.                                                                      .03438000
.                             CVAD                                     .03440000
.                                                                      .03442000
......................................................................>>03444000
PROCEDURE CVAD;                                                         03446000
OPTION PRIVILEGED,UNCALLABLE;                                           03448000
                                                                        03450000
COMMENT:  CONVERTS ASCII SOURCE TO DECIMAL DIGITS BY BRUTE FORCE;       03452000
                                                                        03454000
BEGIN                                                                   03456000
LOGICAL NONZERO,            <<TRUE IF NONZERO DIGIT FOUND>>             03458000
        STATUSWORD=Q-6,     <<WHERE CONDITION CODE IS>>                 03460000
        INSTR=Q-4,          <<MACHINE INSTRUCTION CODE>>                03462000
        BLANKMODE,          <<TRUE IF EXPECTING LEADING BLANK>>         03464000
        TARGETDIGS=Q-11,    <<USER'S DECIMAL DIGITS>>                   03466000
        SOURCEDIGS=Q-9,     <<USERS ASCII SOURCE DIGITS>>               03468000
        SDEC=Q-3,           <<HOW TO LEAVE STACK, IN INSTRUCTION>>      03470000
        PLUS,               <<TRUE IF SOURCE IS POSITIVE>>              03472000
        FIRSTDIGIT;         <<TRUE IF FIRST DIGIT OF A BYTE>>           03474000
INTEGER ASCOUNT,            <<ASCII DIGIT COUNTER>>                     03476000
        DCNT,               <<LOOP COUNTER>>                            03478000
        TARGETBYTE,         <<DECIMAL DIGIT COUNTER>>                   03480000
        XREG=X;                                                         03482000
BYTE POINTER TARGET=Q-12,   <<WHERE DEICMAL RESULT GOES>>               03484000
           SOURCE=Q-10;     <<WHERE DECIMAL SOURCE IS>>                 03486000
<<GET RID OF PRIVILEGED MODE AND GET SDEC>>                             03488000
IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIVILEGED MODE>>           03490000
  BEGIN                                                                 03492000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    03494000
  END;                                                                  03496000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                03498000
SDEC:=IF INSTR.(11:1) THEN 4 ELSE 2;                                    03500000
NONZERO:=BLANKMODE:=FALSE; PLUS:=FIRSTDIGIT:=TRUE;                      03502000
IF 1<=INTEGER(TARGETDIGS)<=28 AND                                       03504000
     1<=INTEGER(SOURCEDIGS)<=28 THEN                                    03506000
  BEGIN                                                                 03508000
    TARGETBYTE:=TARGETDIGS&LSR(1);  <<NUMBER OF TARGET BYTES -1 >>      03510000
    ASCOUNT:=SOURCEDIGS-1;   <<NUMBER OF SOURCE DIGITS (BYTES)>>        03512000
    TOS:=SOURCE(ASCOUNT)-%60; <<GET SIGN DIGIT>>                        03514000
    ASSEMBLE(DUP,STAX); <<PUT A COPY IN XREG AND ON TOS>>               03516000
    IF XREG>=0 THEN <<MIGHT BE A VALID ASCII DIGIT>>                    03518000
      IF XREG<10 THEN <<UNSIGNED>>                                      03520000
        BEGIN                                                           03522000
          TOS:=TOS&LSL(4) LOR %(2)1111; <<UNSIGNED DECIMAL>>            03524000
          IF XREG>0 THEN NONZERO:=TRUE;                                 03526000
        END                                                             03528000
      ELSE IF %21<=XREG<=%31 THEN <<POSITIVE 1-9>>                      03530000
        BEGIN                                                           03532000
          TOS:=(TOS-%20)&LSL(4) LOR %(2)1100; <<DIGIT AND PLUS>>        03534000
          NONZERO:=TRUE;                                                03536000
        END                                                             03538000
      ELSE IF XREG=%113 THEN <<PLUS ZERO>>                              03540000
        TOS:=TOS LAND 0 LOR %(2)1100                                    03542000
      ELSE IF %32<=XREG<=%42 THEN <<NEGATIVE>>                          03544000
        BEGIN                                                           03546000
          PLUS:=FALSE;                                                  03548000
          NONZERO:=TRUE;                                                03550000
          TOS:=(TOS-%31)&LSL(4) LOR %(2)1101; <<MINUS AND DIGIT>>       03552000
        END                                                             03554000
      ELSE IF XREG=%115 THEN <<ZERO AND MINUS>>                         03556000
        BEGIN                                                           03558000
          TOS:=TOS LAND 0 LOR %(2)1101;                                 03560000
          PLUS:=FALSE;                                                  03562000
        END                                                             03564000
      ELSE DEC'SIM'TRAP(12)                                             03566000
    ELSE IF XREG=%177760 <<BLANK>> THEN <<PLUS ZERO>>                   03568000
      BEGIN                                                             03570000
        BLANKMODE:=TRUE;                                                03572000
        TOS:=TOS LAND 0 LOR %(2)1100;                                   03574000
      END                                                               03576000
    ELSE DEC'SIM'TRAP(12);                                              03578000
    TARGET(TARGETBYTE):=BYTE(TOS);  <<STORE SIGN AND ONE DIGIT>>        03580000
    DCNT:=IF (TOS:=SOURCEDIGS)>TARGETDIGS THEN                          03582000
            TARGETDIGS-1 ELSE TOS-1;                                    03584000
    WHILE DCNT>0 DO                                                     03586000
      BEGIN                                                             03588000
        TOS:=SOURCE(ASCOUNT:=ASCOUNT-1)-%60; <<GET ASCII DIGIT>>        03590000
        ASSEMBLE(DUP,STAX);  <<LEAVE ON TOS AND PUT IN XREG>>           03592000
        IF 0<=XREG<=%11 AND NOT BLANKMODE THEN <<VALID DIGIT>>          03594000
          BEGIN                                                         03596000
            IF XREG>0 THEN NONZERO:=TRUE;                               03598000
            IF NOT FIRSTDIGIT THEN <<2 DIGITS, BOTH ON TOS>>            03600000
              TOS:=TOS&LSL(4) LOR TOS; <<COMBINE DIGITS ON TOS>>        03602000
          END                                                           03604000
        ELSE IF XREG=%177760<<BLANK>> AND BLANKMODE THEN                03606000
                  <<PUT IN LEADING ZERO>>                               03608000
          IF FIRSTDIGIT THEN TOS:=TOS LAND 0                            03610000
          ELSE                                                          03612000
            BEGIN                                                       03614000
              ASSEMBLE(DEL); <<GET RID OF SECOND DIGIT>>                03616000
              TOS:=TOS LAND %17;                                        03618000
            END                                                         03620000
        ELSE IF XREG=%177760 <<BLANK>> THEN <<FIRST BLANK>>             03622000
          BEGIN                                                         03624000
            IF FIRSTDIGIT THEN TOS:=TOS LAND 0 <<PUT IN 0>>             03626000
            ELSE                                                        03628000
              BEGIN                                                     03630000
                ASSEMBLE(DEL);  <<GET RID OF SECOND DIGIT>>             03632000
                TOS:=TOS LAND %17;                                      03634000
              END;                                                      03636000
            BLANKMODE:=TRUE;                                            03638000
          END                                                           03640000
        ELSE <<INVALID DIGIT>>                                          03642000
          DEC'SIM'TRAP(12);                                             03644000
        IF NOT FIRSTDIGIT THEN <<STORE TARGET BYTE>>                    03646000
          TARGET(TARGETBYTE:=TARGETBYTE-1):=BYTE(TOS);                  03648000
        FIRSTDIGIT:=IF FIRSTDIGIT THEN FALSE ELSE TRUE;                 03650000
        DCNT:=DCNT-1;                                                   03652000
      END<<WHILE>>;                                                     03654000
    IF NOT FIRSTDIGIT AND TARGETBYTE>0 THEN <<ONE DIGIT LEFT OVER>>     03656000
      BEGIN                                                             03658000
        TOS:=TOS LAND %17; <<PUT IN ZERO IN LEFT DIGIT>>                03660000
        TARGET(TARGETBYTE:=TARGETBYTE-1):=BYTE(TOS);                    03662000
      END;                                                              03664000
                                                                        03666000
<<IF TARGETBYTE AND ASCOUNT BOTH 0 => DONE; IF ASCOUNT>0                03668000
  THEN DONE; IF TARGETBYTE>0 AND ASCOUNT=0 => ZERO FILL>>               03670000
                                                                        03672000
    IF ASCOUNT=0 AND TARGETBYTE>0 THEN <<ZERO FILL>>                    03674000
      BEGIN                                                             03676000
        XREG:=TARGETBYTE;                                               03678000
        WHILE (XREG:=(XREG-1))>=0 DO <<HIGH ORDER ZERO FILL>>           03680000
            TARGET(XREG):=0;                                            03682000
      END;                                                              03684000
    <<SET CONDITION CODE>>                                              03686000
    TOS:=STATUSWORD; TOS:=TOS LAND %176377;                             03688000
    IF NOT NONZERO THEN <<OPERAND IS ZERO>>                             03690000
      TOS:=TOS LOR %1000                                                03692000
    ELSE IF NOT PLUS THEN TOS:=TOS LOR %400;                            03694000
    STATUSWORD:=TOS;                                                    03696000
  END                                                                   03698000
ELSE IF NOT(0<=INTEGER(SOURCEDIGS)<=28)                                 03700000
   OR NOT (0<=INTEGER(TARGETDIGS)<=28) THEN DEC'SIM'TRAP(15);           03702000
TOS:=%031400+SDEC;                                                      03704000
<<EXIT OVER USERS STACK MARKER>>                                        03706000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            03708000
ASSEMBLE(XEQ 0);                                                        03710000
END <<CVAD>>;                                                           03712000
$PAGE                                                                   03714000
<<......................................................................03716000
.                                                                      .03718000
.                             CVDA                                     .03720000
.                                                                      .03722000
......................................................................>>03724000
PROCEDURE CVDA;                                                         03726000
OPTION PRIVILEGED,UNCALLABLE;                                           03728000
                                                                        03730000
COMMENT: CONVERTS A DECIMAL STRING TO AN ASCII STRING BY THE            03732000
         GOOD OLE ADD %60 TECHNIQUE;                                    03734000
                                                                        03736000
BEGIN                                                                   03738000
INTEGER ACNT,            <<ASCII DIGIT COUNTER>>                        03740000
        DCNT,            <<DECIMAL DIGIT COUNTER>>                      03742000
        AREG = S-0,  <<TOP OF STACK>>                                   03744000
        TARGETDIGS=Q-10,     <<USER'S NUMBER OF ASCII DIGITS>>          03746000
        SDEC=Q-3,                 <<HOW TO LEAVE STACK UPON EXIT>>      03748000
        TARGETBYTES,     <<LENGTH OF TARGET STRING>>                    03750000
        XREG=X;                                                         03752000
LOGICAL INSTR=Q-4,         <<MACHINE INSTRUCTION CODE>>                 03754000
        STATUSWORD=Q-6;  <<WHERE PRIV MODE BIT IS>>                     03756000
BYTE POINTER TARGET=Q-11, <<WHERE ASCII RESULT GOES>>                   03758000
           SOURCE=Q-9;  <<WHERE DECIMAL SOURCE IS>>                     03760000
EQUATE  CCG = 0,   <<CONDITION CODES>>                                  03762000
        CCL = 1,                                                        03764000
        CCE = 2;                                                        03766000
<<GET RID OF PRIVILEGED MODE AND GET SDEC>>                             03768000
IF INTEGER(STATUSWORD)>=0 THEN                                          03770000
  BEGIN                                                                 03772000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    03774000
  END;                                                                  03776000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                03778000
SDEC:=IF INSTR.(11:1) THEN 3 ELSE 1;                                    03780000
ACNT:=DCNT:=-1;                                                         03782000
IF 1<=TARGETDIGS<=28 THEN                                               03784000
  BEGIN                                                                 03786000
    TARGETBYTES:=TARGETDIGS-1;                                          03788000
    IF NOT (LOGICAL(TARGETDIGS)) THEN <<LEADING ZERO>>                  03790000
      BEGIN                                                             03792000
        TOS:=LOGICAL(SOURCE) LAND %17 ;                                 03794000
        ASSEMBLE(DUP);                                                  03796000
        IF TOS>%(2)1001 THEN <<INVALID DIGIT>> DEC'SIM'TRAP(13);        03798000
        TARGET:=TOS+%60;    <<CONVERT TO ASCII>>                        03800000
        ACNT:=DCNT:=0;      <<INCREMENT COUNTS>>                        03802000
      END;                                                              03804000
LOOP:                                                                   03806000
    TOS:=0;  <<PUCSH 0>>                                                03808000
    TOS:=SOURCE(DCNT:=DCNT+1); <<GET TWO DIGITS>>                       03810000
    TOS:=TOS&DCSR(4);    <<ISOLATE LEFT DIGIT ON TOS>>                  03812000
    ASSEMBLE(DUP); IF TOS>%(2)1001 THEN DEC'SIM'TRAP(13);               03814000
    TARGET(ACNT:=ACNT+1):=TOS+%60;  <<CONVERT TO ASCII>>                03816000
    TOS:=TOS&CSL(4);    <<SHIFT BACK FOR RIGHT DIGIT>>                  03818000
    IF ACNT=TARGETBYTES THEN                                            03820000
        GO TO PROCESSIGN;                                               03822000
    ASSEMBLE(DUP); IF TOS>%(2)1001 THEN DEC'SIM'TRAP(13);               03824000
    TARGET(ACNT:=ACNT+1):=TOS+%60;  <<SECOND DIGIT TO ASCII>>           03826000
    GO TO LOOP;  <<MORE DIGITS>>                                        03828000
PROCESSIGN:                                                             03830000
    TOS := TARGET(TARGETDIGS);                                          03832000
    TARGET(TARGETDIGS) := 0;  <<PLACES TERMINATION MARKER>>             03834000
    SCAN TARGET WHILE %60 <<"0">> ,1;  <<SCAN WHILE ZERO>>              03836000
    IF (TOS=@TARGET(TARGETDIGS)) AND CARRY THEN                         03838000
      STATUSWORD.(6:2) := CCE                                           03840000
    ELSE                                                                03842000
      BEGIN  <<TARGET WAS NOT ALL ZEROS>>                               03844000
      ASSEMBLE(STBX,LDXA);  <<GET SIGN FROM S-1>>                       03846000
      IF TOS = %(2)1101 THEN  <<NEGATIVE SIGN>>                         03848000
        STATUSWORD.(6:2) := CCL                                         03850000
      ELSE                                                              03852000
        STATUSWORD.(6:2) := CCG                                         03854000
      END;                                                              03856000
    TARGET(TARGETDIGS) := TOS;                                          03858000
    ASSEMBLE(DUP);                                                      03860000
    IF (INSTR.(9:1)=1) OR (INSTR.(10:1)=1) AND (AREG<>%(2)1101) THEN    03862000
        BEGIN TOS:=TOS LOR %17;                                <<C0.12>>03864000
        IF STATUSWORD.(6:2)=CCL THEN STATUSWORD.(6:2):=CCG;END;<<C0.12>>03866000
    IF TOS<>%(2)1111 THEN <<NOT UNSIGNED>>                              03868000
      BEGIN                                                             03870000
        IF TOS<>%(2)1101 THEN <<NOT MINUS>>                             03872000
          TOS:=%20 ELSE TOS:=%31; <<PUSH SIGN FLAG>>                    03874000
        TOS:=TARGET(ACNT);                                              03876000
        ASSEMBLE(DUP);                                                  03878000
        IF TOS=%60 THEN                                                 03880000
          BEGIN                                                         03882000
            ASSEMBLE(XCH); <<GET SIGNFLAG ON TOS>>                      03884000
            IF TOS=%20 THEN TOS:=%173 ELSE TOS:=%175;                   03886000
          END                                                           03888000
        ELSE TOS:=TOS+TOS;                                              03890000
        TARGET(XREG):=TOS;  <<STORE SIGN DIGIT>>                        03892000
      END;                                                              03894000
  END                                                                   03896000
ELSE IF NOT(0<=TARGETDIGS<=28) THEN DEC'SIM'TRAP(15);                   03898000
TOS:=%031400+SDEC;                                                      03900000
PUSH(Q); TOS:=TOS-5; SET(Q); <<EXIT USES USERS STACK AMRKER>>           03902000
ASSEMBLE(XEQ 0);                                                        03904000
END <<CVDA>>;                                                           03906000
$PAGE                                                                   03908000
<<......................................................................03910000
.                                                                      .03912000
.                             CMPD                                     .03914000
.                             ADDD                                     .03916000
.                             SUBD                                     .03918000
.                                                                      .03920000
......................................................................>>03922000
                                                                        03924000
$CONTROL SEGMENT=FIRMWARESIM2                                  <<00652>>03926000
                                                                        03928000
PROCEDURE CMPD;                                                         03930000
OPTION PRIVILEGED,UNCALLABLE;                                           03932000
                                                                        03934000
COMMENT: COMPARES OP2 TO OP1, ADDS OP1 TO OP2 (RESULT IN                03936000
         OP2) AND SUBTRACTS OP1 FROM OP2( RESULT IN OP2).               03938000
         SETS CONDITION CODE A, OVERFLOW.  TRAPS ON ILLEGAL             03940000
         DIGITS, AND DECIMAL OVERFLOW;                                  03942000
                                                                        03944000
BEGIN                                                                   03946000
ENTRY ADDD,SUBD;                                                        03948000
INTEGER SUB:=0,         <<SUBTRACT FLAG, VALUE=1 IF SUBTRACT>>          03950000
        OP1SIGN:=0,     <<4 IF OP1 IS NEGATIVE>>                        03952000
        OP2SIGN:=0,     <<2 IF OP2 IS NEGATIVE>>                        03954000
        OP1DIGS=Q-9,     <<USERS # OF DIGITS IN OP1>>                   03956000
        OP2DIGS=Q-11,    <<USERS # OF DIGITS IN OP2>>                   03958000
        SDEC=Q-3,            <<HOW TO LEAVE STACK ON EXIT>>             03960000
        XREG=X,         <<YES FOLKS>>                                   03962000
        DCNT,           <<DECIMAL DIGIT COUNTER>>                       03964000
        DCNT1,          <<ANOTHER DGIT COUNTER>>                        03966000
        TOP2DIGS,       <<TEMP FOR OP2 DIGITS IF CMPD>>                 03968000
        OP2X,            <<INDEX FOR OP2 ARRAY>>                        03970000
        OP1X;           <<INDEX FOR OP1 ARRAY>>                         03972000
LOGICAL RESULTSIGN,     <<TRUE IF RESULT SIGN IS NEGATIVE>>             03974000
        CHECKOP1,       <<TRUE IF CHECKZERO IS TO CHECK OP1>>           03976000
        INSTR=Q-4,       <<MACHINE INSTRUCTION CODE W SDEC>>            03978000
        STATUSWORD=Q-6, <<WHERE CONDITION CODE IS KEPT>>                03980000
        NEXTCARRY,      <<TRUE IF CARRY OR BORROW>>                     03982000
        COMPLEMENT,     <<TRUE IF ACTUAL SUBTRACT>>                     03984000
        CMP:=FALSE,     <<TRUE IF COMPARE OPERATION>>                   03986000
        RESTORE1,    <<RESTORE NON-SIG DIGIT IN OP1>>                   03988000
        RESTORE2,    <<RESTORE NON-SIG DIGIT IN OP2>>                   03990000
        FIXSTACK,    <<RESTORE OP1 ADR ON STACK>>                       03992000
        SAVEOP1,    <<HOLDS SAVED OP2 NON-SIG DIGIT>>                   03994000
        SAVEOP2,     <<HOLDS SAVED OP2 NON-SIG DIGIT>>                  03996000
        EXTEND,       <<TRUE IF PROPAGATE IS CALLED TO EXTEND OP1>>     03998000
        OP1ZERO,        <<TRUE IN COMPARE IF OP1 IS ZERO>>              04000000
        OP2ADR,         <<TEMP USED TO HOLD REAL OP2 ADRESS FOR         04002000
                          COMPARE>>                                     04004000
        OP1ADR=OP2ADR,  <<TEMP USED TO HOLD REAL OP1 ADR>>              04006000
        ONE,             <<HIGH ORDER 1>>                               04008000
        SIX,            <<HIGH ORDER 6>>                                04010000
        NINE,           <<HIGH ORDER 9>>                                04012000
        NONZERO,        <<TRUE IF RESULT IS NOT = 0>>                   04014000
        DOVERFLOW,      <<TRUE IF DECIMAL OVERFLOW>>                    04016000
        ALLZEROS,       <<TRUE IF OPERAND IS ALL ZEROS>>                04018000
        ONEANDZEROS,    <<TRUE IF NEXT DIGIT IS ONE AND ALL             04020000
                          THE REST ARE ZEROS IN CHECKZERO>>             04022000
        FLIPSIGN,       <<TRUE IF OP2 SIGN IS TO BE NEGATED>>           04024000
        LEFT;           <<TRUE IF NEXT DIGIT IS TO GO INTO LEFT         04026000
                          HALF OF A BYTE>>                              04028000
ARRAY WLOP2(0:7);      <<LOCAL ARRAY FOR OP2>>                          04030000
BYTE ARRAY LOP2(*)=WLOP2;  <<ARRAY USED FOR OP2 IN COMPARE>>            04032000
BYTE ARRAY LOP1(*)=WLOP2;  <<BYTE ARRAY FOR TEMP OP1>>                  04034000
BYTE POINTER OP1=Q-10,     <<WHERE OPERAND 1 IS>>                       04036000
           OP2=Q-12;     <<WHERE OPERAND 2 IS>>                         04038000
DEFINE SDEC'AND'MODE=                                                   04040000
    IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV MODE>>             04042000
      BEGIN                                                             04044000
        PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                04046000
      END;                                                              04048000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                04050000
    SDEC:=INSTR.(10:2);                                                 04052000
    SDEC:=IF SDEC=0 THEN 0 ELSE IF SDEC=1 THEN 2 ELSE 4                 04054000
#;                                                                      04056000
                                                                        04058000
SUBROUTINE TRAP(CODE);                                                  04060000
VALUE CODE; INTEGER CODE; <<TRAP INDEX>>                                04062000
                                                                        04064000
                                                                        04066000
<<CALLS TRAP HANDLER AFTER RESTORING OP2 ADDRESS AND DIGIT              04068000
  COUNT FOR CMPD>>                                                      04070000
                                                                        04072000
BEGIN                                                                   04074000
IF CMP THEN <<CMPD, RESTORE OP2 ADDRESS AND OP2DIGS ON STACK>>          04076000
  BEGIN                                                                 04078000
    @OP2:=OP2ADR;                                                       04080000
    OP2DIGS:=TOP2DIGS;                                                  04082000
  END;                                                                  04084000
IF FIXSTACK THEN @OP1 := OP1ADR;                                        04086000
IF RESTORE1 THEN OP1 := BYTE(SAVEOP1);                                  04088000
IF RESTORE2 THEN OP2 := LOGICAL(OP2) LOR SAVEOP2;                       04090000
DEC'SIM'TRAP(CODE);  <<INVOKE TRAP HANDLER>>                            04092000
END <<TRAP>>;                                                           04094000
                                                                        04096000
                                                                        04098000
SUBROUTINE RECOMPLEMENT;                                                04100000
                                                                        04102000
COMMENT: TENS COMPLEMENTS THE NUMBER OF OP2 DIGITS COMPUTED SO FAR;     04104000
                                                                        04106000
BEGIN                                                                   04108000
NEXTCARRY:=FALSE; FLIPSIGN:=TRUE;                                       04110000
XREG:=OP2DIGS&LSR(1); <<INDEX>>                                         04112000
DCNT1:=0; <<LOOP COUNTER FOR RECOMPLEMENTATION>>                        04114000
TOS:=OP2(XREG); <<FIRST DIGIT AND SIGN DIGIT>>                          04116000
TOS:=TOS & LSR(4); <<S,D; SIGN AND DIGIT REVERSED, SIGN WILL BE SET     04118000
                          LATER>>                                       04120000
WHILE DCNT1<OP2DIGS DO <<COMPLEMENT ALL COMPUTED RESULT DIGITS>>        04122000
  BEGIN                                                                 04124000
    IF LOGICAL(DCNT1) THEN <<GET 2 MORE DIGITS>>                        04126000
      BEGIN                                                             04128000
        TOS:=OP2(XREG);                                                 04130000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    04132000
        TOS:=TOS&DCSR(4);  <<ISOLATE A DIGIT>>                          04134000
      END                                                               04136000
    ELSE <<ISOLATE SECOND DIGIT OF A BYTE>>                             04138000
      BEGIN                                                             04140000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    04142000
        TOS:=TOS&DCSR(4); <<ISOLATE DIGIT>>                             04144000
      END;                                                              04146000
    TOS:=NINE;                                                          04148000
    ASSEMBLE(XCH,LSUB); <<SUBTRACT NINE-DIGIT>>                         04150000
    IF NEXTCARRY OR DCNT1=0 THEN <<PROPAGATE CARRY>>                    04152000
      TOS:=LOGICAL(TOS)+ONE;                                            04154000
    ASSEMBLE(DUP);  <<COPY OF COMPLEMENTED DIGIT>>                      04156000
    TOS:=LOGICAL(TOS)+SIX; <<CHECK FOR CARRY>>                          04158000
    IF CARRY THEN <<COMPLEMENTING CAUSED CARRY>>                        04160000
      BEGIN                                                             04162000
        NEXTCARRY:=TRUE;                                                04164000
        ASSEMBLE(DELB);                                                 04166000
      END                                                               04168000
    ELSE                                                                04170000
      BEGIN                                                             04172000
       NEXTCARRY:=FALSE;                                                04174000
       ASSEMBLE(DEL);                                                   04176000
      END;                                                              04178000
    TOS:=TOS&LSR(8); TOS:=TOS LOR TOS;                                  04180000
    IF NOT (LOGICAL(DCNT1)) THEN                                        04182000
      BEGIN                                                             04184000
        OP2(XREG):=BYTE(TOS);                                           04186000
        XREG:=XREG-1;                                                   04188000
      END;                                                              04190000
    DCNT1:=DCNT1+1;                                                     04192000
  END <<WHILE>>;                                                        04194000
IF NOT (LOGICAL(DCNT1)) THEN <<ONE DIGIT LEFT OVER>>                    04196000
  BEGIN                                                                 04198000
     ASSEMBLE(DUP);                                                     04200000
     TOS:=TOS&LSR(4);                                                   04202000
     ASSEMBLE(XCH);                                                     04204000
     TOS:=TOS&LSL(4);                                                   04206000
     TOS:=TOS LOR TOS;                                                  04208000
     OP2(XREG):=BYTE(TOS);                                              04210000
   END;                                                                 04212000
END <<RECOMPLEMENT>>;                                                   04214000
                                                                        04216000
SUBROUTINE CHECKZERO;                                                   04218000
                                                                        04220000
COMMENT: CHECKS (IF CHECKOP1 THEN OP1 ELSE OP2) FOR ALL ZEROS           04222000
         OR ALL ZEROS WITH LEADING 1, AND VALIDITY;                     04224000
                                                                        04226000
BEGIN                                                                   04228000
SUB:=1; DCNT1:=DCNT; <<STARTS WITH FIRST NON-COMPUTED DIGIT>>           04230000
IF CHECKOP1 THEN <<OP1>>                                                04232000
  BEGIN                                                                 04234000
    TOS:=OP1DIGS-DCNT;                                                  04236000
     XREG:=IF LOGICAL(OP1DIGS) THEN (TOS-1)&LSR(1) ELSE TOS&LSR(1);     04238000
    IF LEFT THEN                                                        04240000
      BEGIN                                                             04242000
        TOS:=OP1(XREG);                                                 04244000
        XREG:=XREG-1;                                                   04246000
      END;                                                              04248000
  END                                                                   04250000
ELSE <<OP2>>                                                            04252000
  BEGIN                                                                 04254000
    TOS:=OP2DIGS-DCNT;                                                  04256000
    XREG:=IF LOGICAL(OP2DIGS) THEN (TOS-1)&LSR(1) ELSE TOS&LSR(1);      04258000
    IF LEFT THEN                                                        04260000
      BEGIN                                                             04262000
        TOS:=OP2(XREG);                                                 04264000
        XREG:=XREG-1;                                                   04266000
      END;                                                              04268000
  END;                                                                  04270000
ALLZEROS:=TRUE;                                                         04272000
IF LEFT THEN                                                            04274000
  BEGIN                                                                 04276000
    TOS:=TOS&LSR(4); <<EXAMINE LEFT DIGIT SEPARATELY>>                  04278000
    ASSEMBLE(XAX); <<INDEX IN TOS, DIGIT IN X>>                         04280000
    IF XREG>%(2)1001 THEN TRAP(13)                                      04282000
    ELSE IF XREG=1 THEN                                                 04284000
      ONEANDZEROS:=TRUE                                                 04286000
    ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                                04288000
    SUB:=0; XREG:=TOS;                                                  04290000
  END;                                                                  04292000
WHILE XREG>=0 DO <<CHECK REST OF DIGITS>>                               04294000
  BEGIN                                                                 04296000
    TOS:=IF CHECKOP1 THEN OP1(XREG) ELSE OP2(XREG);                     04298000
    XREG:=XREG-1;                                                       04300000
    <<CHECK RIGHT DIGIT>>                                               04302000
    ASSEMBLE(DUP);                                                      04304000
    TOS:=TOS LAND %17; <<ISOLATE RIGHT DIGIT>>                          04306000
    ASSEMBLE(XAX); <<INDEX TO TOS, DIGIT TO XREG>>                      04308000
    IF XREG>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>                    04310000
    ELSE IF LOGICAL(SUB) THEN <<CHECK FOR LEADING 1>>                   04312000
      BEGIN                                                             04314000
        IF XREG=1 THEN ONEANDZEROS:=TRUE                                04316000
        ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                            04318000
        SUB:=0;                                                         04320000
      END                                                               04322000
    ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                                04324000
    ASSEMBLE(XCH); <<DIGITS ON TOS, INDEX IN TOS-1>>                    04326000
    XREG:=TOS&LSR(4); <<ISOLATE LEFT DIGIT AND PUT IN X>>               04328000
    IF XREG>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>                    04330000
    ELSE IF XREG>0 THEN ALLZEROS:=FALSE;                                04332000
    XREG:=TOS; <<GET INDEX BACK FROM TOS>>                              04334000
  END <<WHILE>>;                                                        04336000
IF ONEANDZEROS THEN <<A 1 WAS THE FIRST DIGIT FOUND>>                   04338000
  BEGIN                                                                 04340000
    IF NOT ALLZEROS THEN ONEANDZEROS:=FALSE;                            04342000
    ALLZEROS:=FALSE;                                                    04344000
  END                                                                   04346000
ELSE IF NOT ALLZEROS THEN NONZERO:=TRUE;                                04348000
END <<CHECKZERO>>;                                                      04350000
                                                                        04352000
SUBROUTINE PROPAGATE;                                                   04354000
                                                                        04356000
COMMENT: PROPAGATES A CARRY IN OP2 AND EXTENDS OP1 WITH 9'S             04358000
         WHEN RUN OUT OF OP1 DIGITS;                                    04360000
                                                                        04362000
BEGIN                                                                   04364000
DCNT1:=DCNT;                                                            04366000
TOS:=OP2DIGS-DCNT;                                                      04368000
XREG:=IF LOGICAL(OP2DIGS) THEN (TOS-1)&LSR(1) ELSE TOS&LSR(1);          04370000
IF LEFT THEN                                                            04372000
  BEGIN                                                                 04374000
    TOS:=OP2(XREG);                                                     04376000
    ASSEMBLE(DUP);                                                      04378000
    TOS:=TOS&LSR(4); <<PUT D2 IN RIGHT>>                                04380000
    ASSEMBLE(XCH);                                                      04382000
    TOS:=TOS&LSL(4) LAND %377; <<PUT D1 IN LEFT>>                       04384000
    TOS:=TOS LOR TOS; <<DIGITS ARE REVERSED>>                           04386000
  END;                                                                  04388000
OP1SIGN:=OP2DIGS;                                                       04390000
IF LEFT AND LOGICAL(DCNT) OR NOT LEFT AND NOT(LOGICAL(DCNT)) THEN       04392000
  BEGIN                                                                 04394000
    DCNT1:=DCNT1+1;                                                     04396000
    OP1SIGN:=OP1SIGN+1;                                                 04398000
  END;                                                                  04400000
WHILE DCNT1 <OP1SIGN DO <<PROPAGATE TO END IF NECESSARY>>               04402000
  BEGIN                                                                 04404000
    IF LOGICAL(DCNT1) THEN <<GET TWO MORE DIGITS>>                      04406000
      BEGIN                                                             04408000
        TOS:=OP2(XREG);                                                 04410000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    04412000
        TOS:=TOS&DCSR(4); <<ISOLATE FIRST DIGIT>>                       04414000
      END                                                               04416000
    ELSE <<ISOLATE SECOND DIGIT OF BYTE>>                               04418000
      BEGIN                                                             04420000
        TOS:=0; <<EXTEND TO DOUBLE>>                                    04422000
        TOS:=TOS&DCSR(4); <<ISOLATE SECOND DIGIT>>                      04424000
      END;                                                              04426000
    ASSEMBLE(DUP); <<DOPY OF DIGIT FOR VALIDITY>>                       04428000
    IF LOGICAL(TOS)>%110000 THEN TRAP(13);                              04430000
    IF NEXTCARRY OR EXTEND THEN <<PROPAGATE IT>>                        04432000
      BEGIN                                                             04434000
        IF NEXTCARRY THEN                                               04436000
          BEGIN                                                         04438000
            NEXTCARRY:=FALSE;                                           04440000
            TOS:=ONE;                                                   04442000
            ASSEMBLE(LADD);                                             04444000
          END;                                                          04446000
        IF EXTEND THEN                                                  04448000
          BEGIN                                                         04450000
            TOS:=NINE;                                                  04452000
            ASSEMBLE(LADD);                                             04454000
          END;                                                          04456000
        IF CARRY THEN                                                   04458000
          BEGIN                                                         04460000
            NEXTCARRY:=TRUE;                                            04462000
            TOS:=LOGICAL(TOS)+SIX;                                      04464000
          END                                                           04466000
        ELSE                                                            04468000
          BEGIN                                                         04470000
            ASSEMBLE(DUP);                                              04472000
            TOS:=LOGICAL(TOS)+SIX; <<CHECKFOR CARRY>>                   04474000
            IF CARRY THEN                                               04476000
              BEGIN                                                     04478000
                NEXTCARRY:=TRUE;                                        04480000
                ASSEMBLE(DELB);                                         04482000
              END                                                       04484000
            ELSE ASSEMBLE(DEL);                                         04486000
          END;                                                          04488000
      END;                                                              04490000
    ASSEMBLE(TEST);IF <> THEN <<NONZERO DIGIT>> NONZERO:=TRUE;          04492000
    TOS:=TOS&LSR(8); TOS:=TOS LOR TOS;                                  04494000
    IF NOT (LOGICAL(DCNT1)) THEN                                        04496000
      BEGIN                                                             04498000
        OP2(XREG):=BYTE(TOS);                                           04500000
        XREG:=XREG-1;                                                   04502000
      END;                                                              04504000
    DCNT1:=DCNT1+1;                                                     04506000
  END <<WHILE>>;                                                        04508000
IF NOT (LOGICAL(DCNT1)) THEN <<STORE ONLY 1 DIGIT>>                     04510000
  BEGIN                                                                 04512000
    ASSEMBLE(DUP);                                                      04514000
    TOS:=TOS&LSR(4);                                                    04516000
    ASSEMBLE(XCH);                                                      04518000
    TOS:=TOS&LSL(4);                                                    04520000
    TOS:=TOS LOR TOS;                                                   04522000
    OP2(XREG):=BYTE(TOS);                                               04524000
  END;                                                                  04526000
END <<PROPAGATE>>;                                                      04528000
                                                                        04530000
                                                                        04532000
SDEC'AND'MODE;               <<COMPARE ENTRY POINT>>                    04534000
CMP:=TRUE; OP1SIGN:=OP2SIGN:=0;                                         04536000
IF 1<=OP1DIGS<=28 AND                                                   04538000
   1<=OP2DIGS<=28 THEN                                                  04540000
  BEGIN                                                                 04542000
    TOS:=LOGICAL(OP1(OP1DIGS&LSR(1))) LAND %17;                         04544000
    TOS:=LOGICAL(OP2(OP2DIGS&LSR(1))) LAND %17;                         04546000
    IF TOS=%(2)1101 THEN OP2SIGN:=1; IF TOS=%(2)1101 THEN OP1SIGN:=1;   04548000
    IF OP1SIGN<>OP2SIGN THEN <<SIGNS DIFFER, THE ONLY WAY THEY          04550000
                               COULD BE EQUAL IS IF THEY ARE +0,-0>>    04552000
      BEGIN                                                             04554000
        OP1ZERO:=FALSE;  DCNT:=0;                              <<C0.12>>04556000
        OP2ADR := @OP2;  <<IN CASE OF A TRAP, I DON'T WANT THE><<C0.12>>04558000
        TOP2DIGS := OP2DIGS; <<TRAP ROUTINE TO GIVE BAD FIXUPS><<C0.12>>04560000
        LEFT := TRUE;  <<START WITH LEFT PART OF SIGN BYTE>>   <<C0.12>>04562000
        RESTORE1 := RESTORE2 := FIXSTACK := FALSE;             <<C0.12>>04564000
        IF NOT(LOGICAL(OP1DIGS)) THEN  <<ZERO HIGH ORDER>>     <<C0.12>>04566000
           BEGIN       <<NON-SIGNIFICANT DIGIT TEMPORARILY>>   <<C0.12>>04568000
           TOS := OP1;                                         <<C0.12>>04570000
           ASSEMBLE(DUP);  <<MAKE ONE COPY FOR FIXUP, ONE TO SAVE>>     04572000
           SAVEOP1 := TOS;                                     <<C0.12>>04574000
           OP1 := TOS LAND %17;                                <<C0.12>>04576000
           RESTORE1 := TRUE;                                   <<C0.12>>04578000
           END;                                                <<C0.12>>04580000
        ONEANDZEROS:=NONZERO:=FALSE; CHECKOP1:=TRUE;                    04582000
        CHECKZERO; <<CHECK OP1>>                                        04584000
        IF ALLZEROS THEN OP1ZERO:=TRUE;                                 04586000
        DCNT:=0; CHECKOP1:=ONEANDZEROS:=NONZERO:=FALSE;                 04588000
        IF NOT(LOGICAL(OP2DIGS)) THEN  <<TEMP FIXUP OF OP2>>   <<C0.11>>04590000
           BEGIN                                               <<C0.11>>04592000
           TOS := OP2;                                         <<C0.11>>04594000
           ASSEMBLE(DUP);                                      <<C0.11>>04596000
           SAVEOP2 := TOS LAND %360;                           <<C0.11>>04598000
           OP2 := TOS LAND %17;                                <<C0.11>>04600000
           RESTORE2 := TRUE;                                   <<C0.11>>04602000
           END;                                                <<C0.11>>04604000
        CHECKZERO; <<CHECK OP2>>                                        04606000
        IF RESTORE1 THEN OP1 := BYTE(SAVEOP1);                 <<C0.11>>04608000
        IF RESTORE2 THEN OP2 := LOGICAL(OP2) LOR SAVEOP2;      <<C0.11>>04610000
        TOS:=STATUSWORD LAND %176377;                                   04612000
        IF OP1ZERO AND ALLZEROS THEN <<+0 AND -0>>                      04614000
          TOS:=TOS LOR %1000 <<CC =>>                                   04616000
        ELSE IF OP2SIGN>OP1SIGN THEN <<OP2 -, OP1 +, CC< >>             04618000
          TOS:=TOS LOR %400;                                            04620000
        STATUSWORD:=TOS;                                                04622000
        TOS:=%031400+SDEC;                                              04624000
        PUSH(Q); TOS:=TOS-5; SET(Q); <<EXIT TO USER>>                   04626000
        ASSEMBLE(XEQ 0); <<EXIT>>                                       04628000
      END                                                               04630000
    ELSE <<SIGNS ARE THE SAME, DO SUBTRACT>>                            04632000
      BEGIN                                                             04634000
        <<PREVENTS DECIMAL OVERFLOW FROM OCCURING AS A                  04636000
          RESULT OF A COMPARE BY MOVING OP2 TO A LOCAL IN               04638000
          THE CORRECT POSITION>>                                        04640000
        WLOP2:=0; MOVE WLOP2(1):=WLOP2,(7); <<ZERO IT>>                 04642000
        OP1ZERO:=(OP2DIGS+2)&LSR(1);<<TEMP FOR NUMBER OF BYTES IN OP2>> 04644000
        TOS := OP2;  <<GET HIGH ORDER BYTE OF OP2>>            <<C0.12>>04646000
        IF NOT LOGICAL(OP2DIGS) THEN  <<NECESSARY TO ZERO OUT NON->>    04648000
          OP2 := LOGICAL(OP2) LAND %17;    <<SIGNIFICANT DIGIT IN LOP2>>04650000
        MOVE LOP2(16-OP1ZERO):=OP2,(OP1ZERO);                           04652000
        OP2 := TOS;  <<RESTORE OP2 TO ORIGINAL STATE>>         <<C0.12>>04654000
        OP2ADR:=@OP2; <<SAVE OP2 ADDRESS FOR LATER RESTORATION>>        04656000
        TOP2DIGS:=OP2DIGS; <<SAVE OPERAND 2 DIGIT COUNT>>               04658000
        IF OP2DIGS>=OP1DIGS THEN <<NO PROBLEM WITH LENGHTS>>            04660000
          @OP2:=@LOP2(16-OP1ZERO)                                       04662000
        ELSE                                                            04664000
          BEGIN                                                         04666000
            OP2DIGS:=OP1DIGS;                                           04668000
            @OP2:=@LOP2(16-(OP1DIGS+2)&LSR(1));                         04670000
          END;                                                          04672000
        OP1SIGN:=OP2SIGN:=0;                                            04674000
      END;                                                              04676000
  END                                                                   04678000
ELSE CMP:=FALSE;                                                        04680000
                                                                        04682000
SUBD:              <<SUBTRACT ENTRY POINT>>                             04684000
SUB:=1;                                                                 04686000
                                                                        04688000
ADDD:                   <<ADD ENTRY POINT>>                             04690000
                                                                        04692000
IF NOT CMP THEN <<GET SDEC AND GET USER MODE>>                          04694000
  BEGIN                                                                 04696000
    SDEC'AND'MODE;                                                      04698000
  END;                                                                  04700000
LEFT:=RESULTSIGN:=DOVERFLOW:=ALLZEROS:=ONEANDZEROS:=COMPLEMENT:=        04702000
NONZERO:=FLIPSIGN:=NEXTCARRY:=EXTEND:=FALSE;                            04704000
NINE:=%110000; ONE:=%10000; SIX:=%60000;                                04706000
IF CMP OR 1<=OP1DIGS<=28 AND                                            04708000
  1<=OP2DIGS<=28 THEN                                                   04710000
  BEGIN                                                                 04712000
    <<ZERO HIGH ORDER NON-SIG DIGITS>>                                  04714000
    RESTORE1 := RESTORE2 := FIXSTACK := FALSE;                          04716000
    IF CMP THEN                                                         04718000
      BEGIN  <<FIX UP NON-SIGNIFICANT DIGITS>>                          04720000
      <<FIRST DIGIT OF OP2 WAS FIXED UP FOR COMPARE IN COMPARE><<C0.12>>04722000
      <<INITIALIZATION SECTION ABOVE>>                         <<C0.12>>04724000
      IF NOT(LOGICAL(OP1DIGS)) THEN                                     04726000
        BEGIN                                                           04728000
        TOS := OP1;                                                     04730000
        ASSEMBLE(DUP);                                                  04732000
        SAVEOP1 := TOS;                                                 04734000
        OP1 := TOS LAND %17;                                            04736000
        RESTORE1 := TRUE;                                               04738000
        END                                                             04740000
      END                                                               04742000
    ELSE                                                                04744000
      IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN <<NO OVERLAP>>    04746000
        BEGIN                                                           04748000
        IF NOT(LOGICAL(OP1DIGS)) THEN                                   04750000
          BEGIN                                                         04752000
          TOS := OP1;                                                   04754000
          ASSEMBLE(DUP);                                                04756000
          SAVEOP1 := TOS;                                               04758000
          OP1 := TOS LAND %17;                                          04760000
          RESTORE1 := TRUE;                                             04762000
          END;                                                          04764000
        IF NOT(LOGICAL(OP2DIGS)) THEN                                   04766000
          BEGIN                                                         04768000
          TOS := OP2;                                                   04770000
          ASSEMBLE(DUP);                                                04772000
          SAVEOP2 := TOS LAND %360;                                     04774000
          OP2 := TOS LAND %17;                                          04776000
          RESTORE2 := TRUE;                                             04778000
          END                                                           04780000
        END                                                             04782000
      ELSE   <<OVERLAPPING OPERANDS>>                                   04784000
        BEGIN                                                           04786000
        FIXSTACK := TRUE;                                               04788000
        MOVE LOP1 := OP1,((OP1DIGS+2)&LSR(1));  <<MOVE TO LOCAL>>       04790000
        OP1ADR := @OP1;                                                 04792000
        @OP1 := @LOP1;  <<NOW POINTS TO LOCAL>>                         04794000
        IF NOT(LOGICAL(OP1DIGS)) THEN                                   04796000
          OP1 := LOGICAL(OP1) LAND %17;                                 04798000
        IF NOT(LOGICAL(OP2DIGS)) THEN                                   04800000
          BEGIN                                                         04802000
          TOS := OP2;                                                   04804000
          ASSEMBLE(DUP);                                                04806000
          SAVEOP2 := TOS LAND %360;                                     04808000
          OP2 := TOS LAND %17;                                          04810000
          RESTORE2 := TRUE;                                             04812000
          END                                                           04814000
        END;                                                            04816000
    OP1X:=OP1DIGS&LSR(1); OP2X:=OP2DIGS&LSR(1); DCNT:=0;                04818000
    TOS:=OP1(OP1X); <<FIRST DIGIT AND SIGN>>                            04820000
    TOS:=0; TOS:=TOS & DCSR(4); <<ISOLATE OP1 SIGN>>                    04822000
    IF TOS=%150000 THEN <<OP1 IS NEGATIVE>>                             04824000
      OP1SIGN:=4;                                                       04826000
    TOS:=OP2(OP2X);   <<FIRST DIGIT AND SIGN OF OP1>>                   04828000
    TOS:=0; TOS:=TOS&DCSR(4); ASSEMBLE(DUP); <<ISOLATE OP2 SIGN DIGIT>> 04830000
    IF TOS=%150000 THEN <<OP2 IS NEGATIVE>>                             04832000
      OP2SIGN:=2;                                                       04834000
    TOS:=TOS &LSR(8); TOS:=TOS LOR TOS; <<PUT SIGN DIGIT IN OP2 WORD>>  04836000
    CASE * OP1SIGN+OP2SIGN+SUB OF <<SET FLAGS>>                         04838000
      BEGIN                                                             04840000
        <<ADD, OP1 +, OP2 +>> ;                                         04842000
        <<SUB, OP1 +, OP2 +>>                                           04844000
        COMPLEMENT:=TRUE;  <<ACTUAL SUBTRACT>>                          04846000
        <<ADD, OP1 +, OP2 ->>                                           04848000
        COMPLEMENT:=TRUE; <<ACTUAL SUBTRACT>>                           04850000
        <<SUB, OP1 +, OP2 ->>                                           04852000
         RESULTSIGN:=TRUE;    <<RESULT SIGN WILL BE ->>                 04854000
        <<ADD, OP1 -, OP2 +>>                                           04856000
        COMPLEMENT:=TRUE;    <<ACTUAL SUBTRACT>>                        04858000
        <<SUB, OP1 -, OP2 +>>;                                          04860000
        <<ADD, OP1 -, OP2 ->>                                           04862000
        RESULTSIGN:=TRUE;                                               04864000
        <<SUB, OP1 -, OP2 ->>                                           04866000
        COMPLEMENT:=TRUE;   <<ACTUAL SUBTRACT>>                         04868000
      END <<CASE>>;                                                     04870000
    WHILE DCNT<OP1DIGS AND DCNT<OP2DIGS DO <<DIGIT BY DIGIT ADD>>       04872000
      BEGIN                                                             04874000
        IF LOGICAL(DCNT) THEN <<TIME TO GET 2 MORE DIGITS>>             04876000
          BEGIN                                                         04878000
            ASSEMBLE(DEL); <<CLEAN OFF STACK>>                          04880000
            TOS:=OP1(OP1X:=OP1X-1); <<GET 2 DIGITS>>                    04882000
            TOS:=0; <<EXTEND TO DOUBLE>>                                04884000
            TOS:=TOS&DCSR(4); <<ISOLATE DIGIT IN TOP 4 BITS>>           04886000
            ASSEMBLE(DUP);                                              04888000
            IF LOGICAL(TOS)>%110000 THEN  TRAP(13);                     04890000
            TOS:=OP2(OP2X:=OP2X-1); <<2 MORE OP2 DIGITS>>               04892000
            TOS:=0; <<EXTEND TO DOUBLE>>                                04894000
            TOS:=TOS&DCSR(4); <<ISOLATE DIGIT ON TOS>>                  04896000
            ASSEMBLE(DUP);                                              04898000
            IF LOGICAL(TOS)>%110000 THEN TRAP(13);                      04900000
            ASSEMBLE(CAB); <<OP1,OP2,OP2,OP1 ON TOS>>                   04902000
          END                                                           04904000
        ELSE <<GET NEXT DIGIT FROM OLD BYTE>>                           04906000
          BEGIN                                                         04908000
            ASSEMBLE(XCH, <<OP2, OP1 ON TOS>>                           04910000
                     ZERO); <<EXTEND TO DOUBLE>>                        04912000
            TOS:=TOS&DCSR(4); <<ISOLATE OP1 DIGIT>>                     04914000
            ASSEMBLE(DUP); <<READY FOR INVALID DIGIT CHECK>>            04916000
            IF LOGICAL(TOS)>%110000 THEN TRAP(13);                      04918000
            ASSEMBLE(CAB,  <<READY FOR OP2 DIGIT>>                      04920000
                     ZERO); <<EXTEND TO DOUBLE>>                        04922000
            TOS:=TOS&DCSR(4); <<ISOLATE DIGIT>>                         04924000
            ASSEMBLE(DUP); <<COPY FOR VALIDTITY CHECK>>                 04926000
            IF LOGICAL(TOS)>%110000 THEN TRAP(13);                      04928000
            ASSEMBLE(CAB); <<OP1,OP2,OP2,OP1 ON TOS>>                   04930000
          END;                                                          04932000
        IF COMPLEMENT THEN <<SUBTRACT>>                                 04934000
          BEGIN                                                         04936000
            TOS:=NINE; ASSEMBLE(XCH,LSUB);                              04938000
            IF DCNT=0 THEN TOS:=LOGICAL(TOS)+ONE;                       04940000
          END;                                                          04942000
        IF NEXTCARRY THEN                                               04944000
          BEGIN                                                         04946000
            NEXTCARRY:=FALSE;                                           04948000
            TOS:=LOGICAL(TOS)+ONE; <<INCR OP1 DIGIT>>                   04950000
          END;                                                          04952000
        TOS:=LOGICAL(TOS)+LOGICAL(TOS); <<LOGICAL ADD>>                 04954000
        IF CARRY THEN                                                   04956000
          BEGIN                                                         04958000
            NEXTCARRY:=TRUE;                                            04960000
            TOS:=LOGICAL(TOS)+SIX;                                      04962000
          END                                                           04964000
        ELSE <<CHECK FOR A RESULT DIGIT>10>>                            04966000
          BEGIN                                                         04968000
            ASSEMBLE(DUP); <<COPY RESULT DIGIT>>                        04970000
            TOS:=LOGICAL(TOS)+SIX;                                      04972000
            IF CARRY THEN                                               04974000
              BEGIN                                                     04976000
                NEXTCARRY:=TRUE; ASSEMBLE(DELB);                        04978000
              END                                                       04980000
            ELSE ASSEMBLE(DEL);                                         04982000
          END;                                                          04984000
        ASSEMBLE(DUP); <<COPY RESULT DIGIT>>                            04986000
        IF TOS<>0 THEN NONZERO:=TRUE;                                   04988000
        TOS:=TOS&LSR(8);                                                04990000
        TOS:=TOS LOR TOS;                                               04992000
        IF NOT(LOGICAL(DCNT)) THEN <<STORE TWO DIGITS>>                 04994000
          OP2(OP2X):=BYTE(TOS);                                         04996000
        DCNT:=DCNT+1;                                                   04998000
      END <<WHILE>>;                                                    05000000
    IF NOT(LOGICAL(DCNT)) THEN <<STORE 1 DIGIT>>                        05002000
      BEGIN                                                             05004000
        ASSEMBLE(DUP); <<R1,D2>>                                        05006000
        TOS:=TOS&LSR(4); <<R1>>                                         05008000
        ASSEMBLE(XCH);  <<R1;R1,D2>>                                    05010000
        TOS:=TOS&LSL(4); <<R1;B,R1,D2,B>>                               05012000
        TOS:=TOS LOR TOS; <<D2,R1>>                                     05014000
        OP2(OP2X):=BYTE(TOS);                                           05016000
        LEFT:=TRUE;                                                     05018000
      END;                                                              05020000
    <<TERMINATION>>                                                     05022000
    IF DCNT=OP1DIGS AND DCNT=OP2DIGS THEN <<EQUAL LENGHT OPERANDS>>     05024000
      BEGIN                                                             05026000
        IF COMPLEMENT THEN <<SUBTRACTION>>                              05028000
          BEGIN                                                         05030000
            IF NOT NEXTCARRY THEN RECOMPLEMENT;                         05032000
          END                                                           05034000
        ELSE IF NEXTCARRY <<ADD OVERFLOW>> THEN DOVERFLOW:=TRUE;        05036000
      END                                                               05038000
    ELSE IF DCNT=OP1DIGS THEN <<RAN OUT OF OP1 DIGITS>>                 05040000
      IF COMPLEMENT THEN <<SUBTRACTION>>                                05042000
        BEGIN                                                           05044000
           EXTEND:=TRUE; PROPAGATE;                                     05046000
          IF NOT NEXTCARRY THEN RECOMPLEMENT;                           05048000
        END                                                             05050000
      ELSE <<ADD>>                                                      05052000
        BEGIN                                                           05054000
          IF NEXTCARRY THEN                                             05056000
            BEGIN                                                       05058000
              PROPAGATE;                                                05060000
              IF NEXTCARRY THEN DOVERFLOW:=TRUE; <<OVERFLOW>>           05062000
            END                                                         05064000
          ELSE                                                          05066000
            BEGIN                                                       05068000
              CHECKOP1:=FALSE;                                          05070000
              CHECKZERO;                                                05072000
              IF NOT ALLZEROS THEN NONZERO:=TRUE;                       05074000
            END;                                                        05076000
        END                                                             05078000
    ELSE <<RAN OUT OF OP2 DIGITS>>                                      05080000
      BEGIN                                                             05082000
        CHECKOP1:=TRUE;                                                 05084000
        CHECKZERO;  <<CHECK REST OF OP1 DIGITS FOR VALIDITY AND         05086000
                         FOR A SPECIAL CASE OPERATION>>                 05088000
        IF COMPLEMENT THEN <<SUBTRACT>>                                 05090000
          BEGIN                                                         05092000
            IF ONEANDZEROS THEN <<COULD BE ALL RIGHT>>                  05094000
              BEGIN                                                     05096000
                TOS:=NEXTCARRY; TOS:=NONZERO;                           05098000
                <<KEEP NONZERO ON TOS AS TEMP,                          05100000
                  RECOMPLEMENT MAY CHANGE IT>>                          05102000
                RECOMPLEMENT;                                           05104000
                IF TOS <<NONZERO>> XOR TOS <<NEXTCARRY>> THEN           05106000
                  DOVERFLOW:=TRUE; <<OVERFLOW>>                         05108000
              END                                                       05110000
            ELSE                                                        05112000
              IF NOT ALLZEROS THEN <<OVERFLOW>>                         05114000
                BEGIN                                                   05116000
                  RECOMPLEMENT;                                         05118000
                  DOVERFLOW:=TRUE;                                      05120000
                END                                                     05122000
              ELSE IF NOT NEXTCARRY THEN RECOMPLEMENT;                  05124000
          END                                                           05126000
        ELSE <<ADD CASE>>                                               05128000
          IF NEXTCARRY OR NOT ALLZEROS THEN DOVERFLOW:=TRUE;            05130000
        LEFT := TRUE;  <<NOW CHECK RESULT FOR ZERO>>                    05132000
        DCNT := 0;  <<START WITH 0'TH DIGIT OF RESULT>>                 05134000
        CHECKOP1 := FALSE;                                              05136000
        CHECKZERO;  <<CHECK SIGN OF RESULT OPERAND>>                    05138000
        IF ALLZEROS THEN NONZERO := FALSE;  <<RESULT IS 0>>             05140000
      END;                                                              05142000
    <<SET THE FINAL SIGN>>                                              05144000
    TOS:=%(2)1100; <<PLUS>>                                             05146000
    IF NONZERO THEN                                                     05148000
     IF FLIPSIGN AND OP2SIGN=0 OR                                       05150000
          NOT FLIPSIGN AND OP2SIGN=2 THEN <<NEGATIVE>>                  05152000
      BEGIN                                                             05154000
        RESULTSIGN:=TRUE;                                               05156000
        TOS:=TOS+1; <<MAKE SIGN NEGATIVE>>                              05158000
      END;                                                              05160000
    OP2(XREG):=LOGICAL(OP2(OP2DIGS&LSR(1))) LAND %360 LOR TOS;          05162000
    <<SET CONDITION CODE>>                                              05164000
    TOS:=STATUSWORD LAND %176377;                                       05166000
    IF NONZERO AND RESULTSIGN THEN <<->>                                05168000
       TOS:=TOS LOR %400                                                05170000
    ELSE IF NOT NONZERO THEN <<ZERO>>                                   05172000
       TOS:=TOS LOR %1000;                                              05174000
    STATUSWORD:=TOS;                                                    05176000
    IF DOVERFLOW THEN TRAP(11); <<DECIMAL OVERFLOW>>                    05178000
    IF CMP THEN <<RESTORE OP2 ADDRESS AND DIGIT COUNT>>                 05180000
      BEGIN @OP2:=OP2ADR; OP2DIGS:=TOP2DIGS; END;                       05182000
    IF FIXSTACK THEN @OP1 := OP1ADR;                                    05184000
    IF RESTORE1 THEN OP1 := SAVEOP1;                                    05186000
    IF RESTORE2 THEN OP2 := LOGICAL(OP2) LOR SAVEOP2;                   05188000
  END                                                                   05190000
ELSE IF NOT (0<=OP1DIGS<=28) OR NOT (0<=OP2DIGS<=28) THEN               05192000
   DEC'SIM'TRAP(15);                                                    05194000
TOS:=%031400+SDEC;                                                      05196000
<<EXIT OVER USER'S STACK MARKER>>                                       05198000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            05200000
ASSEMBLE(XEQ 0); <<DO SDEC>>                                            05202000
END <<CMPD>>;                                                           05204000
$PAGE                                                                   05206000
$CONTROL SEGMENT=FIRMWARESIM2                                           05208000
<<......................................................................05210000
.                                                                      .05212000
.                                 MPYD                                 .05214000
.                                                                      .05216000
.                  ADDED IN C0.11                                      .05218000
......................................................................>>05220000
PROCEDURE MPYDSIM;                                                      05222000
OPTION PRIVILEGED,UNCALLABLE;                                           05224000
                                                                        05226000
COMMENT:                                                                05228000
                                                                        05230000
THE OPERAND2 FIELD IS REPLACED BYU THE OPERAND2 FIELD TIMES THE         05232000
OPERAND1 FIELD.  THE RANGE OF DIGITS LEGAL (NOT TRAPPED) FOR            05234000
THE TWO OPERANDS IS 0<=DIGITS<=28, 0 DIGITS IS A NOP WITH SDEC.         05236000
IF THE RESULT IS TOO LARGE TO BE REPRESENTED IN THE RESULT              05238000
FIELD, THE LEFT TRUNCATED RESULT IS LEFT IN OP2 AND A TRAP              05240000
OCCURS.  CCA IS SET ON THE RESULT.                            ;         05242000
                                                                        05244000
                                                                        05246000
BEGIN                                                                   05248000
                                                                        05250000
BYTE POINTER OP1=Q-10,        <<OPERAND 1 PACKED DECIMAL FIELD>>        05252000
             OP2=Q-12;        <<OPERAND 2 PACKED DECIMAL FIELD>>        05254000
INTEGER OP1DIGS=Q-9,        <<NUMBER OF DECIMAL DIGITS IN OP1>>         05256000
        OP2DIGS=Q-11;       <<NUMBER OF DECIMAL DIGITS IN OP2>>         05258000
                                                                        05260000
INTEGER OP1X,          <<INDEX TO OP1 WHEN MULTIPLYING>>                05262000
        OP2X,          <<INDEX TO OP2 WHEN MULTIPLYING>>                05264000
        LOP1WORDS,     <<NUMBER OF WORDS IN BINARY EQUIVALENT OF OP1>>  05266000
        LOP2WORDS,     <<NUMBER OF WORDS IN BINARY EQUIVALENT OF OP2>>  05268000
        WORDS,         <<DUMMY PARAMETER FOR MULTIWORD NEGATE>>         05270000
        RESLEN:=0,        <<LENGTH OF RESULT IN BINARY WORDS>>          05272000
        XREG=X;                                                         05274000
LOGICAL DCARRY,        <<FLAG FOR PROPAGATION OF CARRY IN MULTIPLY>>    05276000
        DOVERFLOW:=FALSE,   <<TRUE IF PRODUCT OVERFLOWS>>               05278000
        INSTR=Q-4,     <<MACHINE OPCODE WITH SDEC>>                     05280000
        MINUS:=FALSE,  <<TRUE IF RESULT IS TO BE MINUS>>                05282000
        ZERO:=FALSE,    <<TRUE IF RESULT IS ZERO>>                      05284000
        STATUSWORD=Q-6; <<WHERE CC IS KEPT>>                            05286000
ARRAY LOP1(-1:5),       <<ARRRAY FOR BINARY EQUIVALENT OF OP1>>         05288000
      LOP2(-1:5),       <<ARRAY FOR BINARY EQUIVALENT OF OP2>>          05290000
      PRODUCT(-3:9);    <<ARRAY FOR BINARY PRODUCT>>                    05292000
DOUBLE POINTER DLOP1=LOP1, <<OP1 IS ACCESSED BY DOUBLEWORDS>>           05294000
               DLOP2=LOP2, <<OP2 IS ACCESSED BY DOUBLEWORDS>>           05296000
               DP=PRODUCT, <<RESULT ARRAY ALSO ACCESSED BY DOUBLEWORD>> 05298000
               DOP1,DOP2;   <<DUMMY PARAMETERS FOR MULTIPLY>>           05300000
DOUBLE PHIGH;          <<TEMP FOR HIGH ORDER PART OF A PRODUCT>>        05302000
POINTER P=OP1X;        <<DUMMY PARAMETER FOR MULTIWORD NEGATE>>         05304000
INTEGER TEMPSDEC=Q-3;  <<LOCAL STOREAGE FOR SDEC>>             <<03.00>>05306000
                                                                        05308000
SUBROUTINE ZERORESULT;                                                  05310000
                                                                        05312000
<<IF OP1 IS ZERO, ZEROS OUT OP2 GIVING ZERO RESULT>>                    05314000
                                                                        05316000
BEGIN                                                                   05318000
ZERO:=TRUE;                                                             05320000
XREG:=OP2DIGS&LSR(1);                                                   05322000
TOS:=%(2)1100; <<POSITIVE SIGN>>                                        05324000
OP2(XREG):=BYTE(TOS); XREG:=XREG-1;  <<PUT IN SIGHN BYTE>>              05326000
WHILE XREG>0 DO <<ZERO OUT REST OF OP2>>                       <<C0.12>>05328000
  BEGIN                                                                 05330000
    OP2(XREG):=0;                                                       05332000
    XREG:=XREG-1;                                                       05334000
  END;                                                                  05336000
IF (XREG = 0) THEN <<HANDLE LAST DIGIT?>>                      <<C0.12>>05338000
   IF NOT(LOGICAL(OP2DIGS)) THEN  <<PRESERVE LEFT DIGIT>>      <<C0.12>>05340000
      OP2:=LOGICAL(OP2) LAND %360 ELSE OP2:=0;                 <<C0.12>>05342000
END <<ZERORESULT>>;                                            <<C0.12>>05344000
                                                                        05346000
SUBROUTINE NEGATE;                                                      05348000
                                                                        05350000
<<DOES NEGATION OF THE ARRAY P, WHICH IS OF LENGTH WORDS>>              05352000
                                                                        05354000
BEGIN                                                                   05356000
XREG := WORDS; <<USED TO INDEX THROUGH RESULT ARRAY>>                   05358000
TOS := 1;  <<TWO'S COMPLEMENT IS COMPLEMENT, INCREMENT>>                05360000
WHILE (XREG := XREG-1) >= 0 DO  <<TAKE TWO'S COMPLEMENT>>               05362000
   BEGIN                                                                05364000
   P(XREG) := NOT(P(XREG)) + TOS;                                       05366000
   IF CARRY THEN TOS := 1 ELSE TOS := 0; <<PROPAGATE CARRY>>            05368000
   END;  <<NEGATION LOOP>>                                              05370000
DEL;                                                                    05372000
END <<NEGATE>>;                                                         05374000
                                                                        05376000
SUBROUTINE TWOBYFOUR;                                                   05378000
                                                                        05380000
<<MULTIPLIES A TWO WORD OPERAND BY A FOUR WORD OPERAND TO               05382000
  GET A SIX WORD RESULT>>                                               05384000
                                                                        05386000
BEGIN                                                                   05388000
ASSEMBLE(DZRO);                                                         05390000
TOS:=DOP2(1);                                                           05392000
TOS:=DOP1;                                                              05394000
ASSEMBLE(DMPY); <<DMPY: FOUR WORD PRODUCT>>                             05396000
DP(XREG):=TOS;   <<LEAVE HIGH ORDER PART ON TOS>>                       05398000
TOS:=DOP2;                                                              05400000
TOS:=DOP1;                                                              05402000
ASSEMBLE(DMPY; <<DMPY>>                                                 05404000
         DXCH        ); <<LEAVE HIGH ORDER PART ON TOS>>                05406000
PHIGH:=TOS; <<STORE IT TEMPORARILY>>                                    05408000
ASSEMBLE(DADD);    <<ADD LOW OF THIS ONE AND HIGH PART OF LAST TIME>>   05410000
DP:=TOS;           <<STORE NEW LOW ORDER PART>>                         05412000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE ANY CARRRY OUT OF LOW ORDER       05414000
                            PART TO HIGH ORDER PART>>                   05416000
TOS:=PHIGH;         <<GET HIGH ORDER PART>>                             05418000
ASSEMBLE(DADD);      <<PROPAGATE THE CARRY>>                            05420000
DP(-1):=TOS;                                                            05422000
END <<TWOBYFOUR>>;                                                      05424000
                                                                        05426000
SUBROUTINE TWOBYSIX;                                                    05428000
                                                                        05430000
<<MULTIPLIES A TWO WORD OPERAND BY A SIX WORD OPERAND,                  05432000
  PRODUCING A EIGHT WORD RESULT>>                                       05434000
                                                                        05436000
BEGIN                                                                   05438000
ASSEMBLE(DZRO,DZRO);  <<USED TO PROPAGATE CARRIES>>                     05440000
TOS:=DOP2(2);                                                           05442000
TOS:=DOP1;                                                              05444000
ASSEMBLE(DMPY); <<DMPY: FOUR WORD PRODUCT>>                             05446000
DP(XREG):=TOS;   <<LEAVE HIGH ORDER PART ON TOS>>                       05448000
TOS:=DOP2(1);                                                           05450000
TOS:=DOP1;                                                              05452000
ASSEMBLE(DMPY;    <<DMPY>>                                              05454000
         DXCH        );  <<LEAVE HIGH ORDER PART ON TOS>>               05456000
PHIGH:=TOS;     <<CURRENT HIGH ORDER PART>>                             05458000
ASSEMBLE(DADD);                                                         05460000
DP(XREG):=TOS;  <<STORE NEW LOW ORDER PART>>                            05462000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE CARRY TO HIGH ORDER PART>>        05464000
TOS:=PHIGH;                                                             05466000
ASSEMBLE(DADD); <<FORM NEW HIGH ORDER PART>>                            05468000
TOS:=DOP2;                                                              05470000
TOS:=DOP1;                                                              05472000
ASSEMBLE(DMPY;   <<DMPY>>                                               05474000
         DXCH        ); <<LEAVE HIGH ORDER PART ON TOS>>                05476000
PHIGH :=TOS;                                                            05478000
ASSEMBLE(DADD); <<FORM NEW LOW ORDER PART>>                             05480000
DP:=TOS;                                                                05482000
IF CARRY THEN TOS:=TOS+1;                                               05484000
TOS:=PHIGH;                                                             05486000
ASSEMBLE(DADD); <<FORM HIGHEST ORDER PART>>                             05488000
DP(-1):=TOS; <<STORE IT>>                                               05490000
END <<TWOBYSIX>>;                                                       05492000
                                                                        05494000
SUBROUTINE FOURBYFOUR;                                                  05496000
                                                                        05498000
<<MULTIPLIES A FOUR WORD OPERAND BY ANOTHER, PRODUCING AN               05500000
  EIGHT WORD RESULT>>                                                   05502000
                                                                        05504000
BEGIN                                                                   05506000
ASSEMBLE(DZRO,DZRO);                                                    05508000
TOS:=DLOP2(1); TOS:=DLOP1(1);                                           05510000
ASSEMBLE(DMPY); <<DMPY: FOUR WORD PRODUCT>>                             05512000
DP(2):=TOS;                                                             05514000
TOS:=DLOP2(1); TOS:=DLOP1;                                              05516000
ASSEMBLE(DMPY;   <<DMPY>>                                               05518000
         DXCH        ); <<LEAVE HIGH ORDER PART OF PRODUCT ON TOS>>     05520000
PHIGH:=TOS;                                                             05522000
ASSEMBLE(DADD); <<FORM NEW LOW ORDER PART>>                             05524000
DP(1):=TOS;                                                             05526000
IF CARRY THEN TOS:=TOS+1;                                               05528000
TOS:=PHIGH;                                                             05530000
ASSEMBLE(DADD); <<GET NEW HIGH ORDER PART>>                             05532000
DP:=TOS;                                                                05534000
<<**************NEXT RANK************>>                                 05536000
TOS:=DLOP2; TOS:=DLOP1(1);                                              05538000
ASSEMBLE(DMPY); <<DMPY>>                                                05540000
DP(XREG):=TOS+DP(1); <<ACCUMULATE MORE PARTIAL PRODUCT>>                05542000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE A CARRY TO HIGH PART ON TOS>>     05544000
TOS:=DLOP2; TOS:=DLOP1;                                                 05546000
ASSEMBLE(DMPY;    <<DMPY>>                                              05548000
           DXCH        );                                               05550000
PHIGH:=TOS;                                                             05552000
ASSEMBLE(DADD);                                                         05554000
DCARRY:=IF CARRY THEN TRUE ELSE FALSE;                                  05556000
DP:=TOS+DP;                                                             05558000
IF CARRY THEN TOS:=TOS+1;                                               05560000
IF DCARRY THEN TOS:=TOS+1;                                              05562000
TOS:=PHIGH;                                                             05564000
ASSEMBLE(DADD);                                                         05566000
DP(-1):=TOS;                                                            05568000
END <<FOURBYFOUR>>;                                                     05570000
                                                                        05572000
                                                                        05574000
SUBROUTINE MBYN;                                                        05576000
                                                                        05578000
<<A GENERAL ALGORITHM FOR MULTIPLYING AN OPERAND OF M WORDS             05580000
  BY AN OPERAND OF N WORDS TO PRODUCE AN M+N WORD RESULT>>              05582000
                                                                        05584000
                                                                        05586000
BEGIN                                                                   05588000
OP2X:=LOP2WORDS&LSR(1)-1; DCARRY:=FALSE;                                05590000
DO                                                                      05592000
  BEGIN                                                                 05594000
    OP1X:=LOP1WORDS&LSR(1)-1;                                           05596000
    TOS:=0D; IF DCARRY THEN TOS:=TOS+1;                                 05598000
    DO                                                                  05600000
      BEGIN                                                             05602000
        ASSEMBLE(DZRO,DXCH);                                            05604000
        TOS:=DLOP2(OP2X); TOS:=DLOP1(OP1X);                             05606000
        ASSEMBLE(DMPY;   <<DMPY FOUR WORD PRODUCT>>                     05608000
                 DXCH          ); <<LEAVE HIGH ORDER PART ON TOS>>      05610000
        PHIGH:=TOS; <<STORE HIGH ORDER PART OF PRODUCT>>                05612000
        ASSEMBLE(DADD); <<FORM NEW LOW ORDER PART>>                     05614000
        DCARRY:=IF CARRY THEN TRUE ELSE FALSE; <<LOOK FOR A CARRY TO BE 05616000
                                                 PROPAGATED>>           05618000
        DP(XREG):=TOS+DP(OP1X+OP2X); <<ACCUMULATE PARTIAL PRODUCTS>>    05620000
        IF CARRY THEN TOS:=TOS+1;                                       05622000
        IF DCARRY THEN TOS:=TOS+1;                                      05624000
        TOS:=PHIGH; <<GET BACK CURRENT HIGH ORDER PART>>                05626000
        ASSEMBLE(DADD); <<ADD IN CARRIES FROM LOW ORDER PART TO FORM    05628000
                          NEW HIGH ORDER PART>>                         05630000
      END                                                               05632000
    UNTIL (OP1X:=OP1X-1)<0;                                             05634000
    DP(XREG):=TOS+DP(OP1X+OP2X);                                        05636000
    DCARRY:=IF CARRY THEN TRUE ELSE FALSE;                              05638000
  END                                                                   05640000
UNTIL (OP2X:=OP2X-1)<0;                                                 05642000
END <<MBYN>>;                                                           05644000
                                                                        05646000
                                                                        05648000
TEMPSDEC := INSTR.(10:2);  <<EXTRACT SDEC PART FROM OPCODE>>            05650000
TEMPSDEC := IF TEMPSDEC=0 THEN 0 ELSE IF TEMPSDEC=1 THEN 2 ELSE 4;      05652000
PUSH(STATUS);                                                           05654000
TOS := TOS LAND %157777;  <<TURN OFF TRAPS>>                            05656000
TOS.(0:1) := STATUSWORD.(0:1);  <<SET MODE TO CALLER'S MODE>>           05658000
SET(STATUS);                                                            05660000
IF 1<=OP1DIGS<=28 AND 1<=OP2DIGS<=28 THEN                               05662000
  BEGIN                                                                 05664000
    <<TURN OFF TRAPS>> PUSH(STATUS); TOS:=TOS LAND %157777; SET(STATUS);05666000
<<CONVERT OPERAND 1 TO BINARY>>                                         05668000
    LOP1WORDS:=IF OP1DIGS<=4 THEN 1                                     05670000
               ELSE IF OP1DIGS<=9 THEN 2                                05672000
               ELSE IF OP1DIGS<=18 THEN 4                               05674000
               ELSE 6;                                                  05676000
    TOS:=@LOP1; TOS:=@OP1;TOS:=OP1DIGS;                                 05678000
    ASSEMBLE(CON %020625); <<CVDB>>                                     05680000
    IF OVERFLOW THEN <<INVALID DIGIT>> DEC'SIM'TRAP(13)                 05682000
    ELSE IF = THEN <<PRODUCT IS ZERO>>                                  05684000
      ZERORESULT                                                        05686000
    ELSE <<MAY DO MULTIPLY>>                                            05688000
      BEGIN                                                             05690000
        IF < THEN <<NEGATE OP1>>                                        05692000
          BEGIN                                                         05694000
            ASSEMBLE(INCM MINUS);                                       05696000
            @P:=@LOP1; WORDS:=LOP1WORDS; NEGATE;                        05698000
          END;                                                          05700000
        <<CONVERT OPERAND 2 TO BINARY>>                                 05702000
        LOP2WORDS:=IF OP2DIGS<=4 THEN 1                                 05704000
                   ELSE IF OP2DIGS<=9 THEN 2                            05706000
                   ELSE IF OP2DIGS<=18 THEN 4                           05708000
                   ELSE 6;                                              05710000
        TOS:=@LOP2; TOS:=@OP2; TOS:=OP2DIGS;                            05712000
        ASSEMBLE(CON %020625); <<CVDB>>                                 05714000
        IF OVERFLOW THEN DEC'SIM'TRAP(13) <<ILLEGAL DIGIT>>             05716000
        ELSE IF = THEN <<PRODUCT IS ZERO>> ZERO:=TRUE                   05718000
        ELSE <<DO THE MULTIPLY>>                                        05720000
          BEGIN                                                         05722000
            IF < THEN <<NEGATE OP2>>                                    05724000
              BEGIN                                                     05726000
                ASSEMBLE(INCM MINUS);                                   05728000
                @P:=@LOP2; WORDS:=LOP2WORDS; NEGATE;                    05730000
              END;                                                      05732000
            PRODUCT(-3):=0; MOVE PRODUCT(-2):=PRODUCT(-3),(12);         05734000
            IF LOP1WORDS=1 AND LOP2WORDS=1 THEN <<1X1-MACHINE MULTIPLY>>05736000
              BEGIN                                                     05738000
                RESLEN:=2; <<TWO WORD RESULT>>                          05740000
                TOS:=LOP1; TOS:=LOP2; ASSEMBLE(LMPY); DP(-1):=TOS;      05742000
              END                                                       05744000
            ELSE  <<MULTIWORD MULTIPLY>>                                05746000
            BEGIN                                                       05748000
             LOP1(XREG):=LOP2(-1):=0;                                   05750000
             XREG:=0;                                                   05752000
             WHILE LOP1(XREG)=0 DO XREG:=XREG+1;                        05754000
             @LOP1:=@LOP1+XREG; LOP1WORDS:=LOP1WORDS-XREG;              05756000
             <<ELIMINATES LEADING ZERO FROM OP1 AND OP2>>               05758000
             XREG:=0;                                                   05760000
             WHILE LOP2(XREG)=0 DO XREG:=XREG+1;                        05762000
             @LOP2:=@LOP2+XREG; LOP2WORDS:=LOP2WORDS-XREG;              05764000
             <<PAD OPERANDS TO EVEN LENGTHS>>                           05766000
             IF LOGICAL(LOP1WORDS) THEN                                 05768000
               BEGIN                                                    05770000
                 LOP1WORDS:=LOP1WORDS+1; @LOP1:=@LOP1-1;                05772000
               END;                                                     05774000
             IF LOGICAL(LOP2WORDS) THEN                                 05776000
               BEGIN                                                    05778000
                 LOP2WORDS:=LOP2WORDS+1; @LOP2:=@LOP2-1;                05780000
               END;                                                     05782000
            IF LOP1WORDS=2 AND LOP2WORDS=2 THEN <<DMPY>>                05784000
              BEGIN                                                     05786000
                TOS:=DLOP1; TOS:=DLOP2;                                 05788000
                ASSEMBLE(DMPY); <<DMPY>>                                05790000
                DP:=TOS; DP(-1):=TOS; RESLEN:=4;                        05792000
              END                                                       05794000
            ELSE <<2X4, 2X6, 4X4, 4X6, 6X6>>                            05796000
              BEGIN                                                     05798000
                CASE * LOP1WORDS&LSR(1)-1 OF                            05800000
                  BEGIN                                                 05802000
                    <<OP1 2 WORDS>>                                     05804000
                    CASE * LOP2WORDS&LSR(1)-2 OF                        05806000
                      BEGIN                                             05808000
                        <<OP2 4 WORDS>>                                 05810000
                        BEGIN                                           05812000
                          @DOP1:=@LOP1; @DOP2:=@LOP2; TWOBYFOUR;        05814000
                        END;                                            05816000
                        <<LOP2 6 WORDS>>                                05818000
                        BEGIN                                           05820000
                          @DOP1:=@LOP1; @DOP2:=@LOP2; TWOBYSIX;         05822000
                        END;                                            05824000
                      END <<CASE>>;                                     05826000
                    <<LOP1 4 WORDS>>                                    05828000
                    CASE * LOP2WORDS&LSR(1)-1 OF                        05830000
                      BEGIN                                             05832000
                        <<OP2 2 WORDS>>                                 05834000
                        BEGIN                                           05836000
                          @DOP1:=@LOP2; @DOP2:=@LOP1; TWOBYFOUR;        05838000
                        END;                                            05840000
                        <<OP2 4 WORDS>>                                 05842000
                        FOURBYFOUR;                                     05844000
                        <<OP2 6 WORDS>>                                 05846000
                        MBYN;                                           05848000
                      END <<CASE>>;                                     05850000
                    <<OP1 6 WORDS>>                                     05852000
                    CASE * LOP2WORDS&LSR(1)-1 OF                        05854000
                      BEGIN                                             05856000
                        <<OP2 2 WORDS>>                                 05858000
                        BEGIN                                           05860000
                          @DOP1:=@LOP2; @DOP2:=@LOP1; TWOBYSIX;         05862000
                        END;                                            05864000
                        <<OP2 4 WORDS>>                                 05866000
                        MBYN;                                           05868000
                        <<OP2 6 WORDS>>                                 05870000
                        MBYN;                                           05872000
                      END <<CASE>>;                                     05874000
                  END <<CASE>>;                                         05876000
              END;                                                      05878000
            END;                                                        05880000
            @PRODUCT:=@PRODUCT-2;                                       05882000
            <<GET RID OF ZERO WORDS IN PRODUCT>>                        05884000
            XREG:=0;                                                    05886000
            WHILE PRODUCT(XREG)=0 DO XREG:=XREG+1;                      05888000
            @PRODUCT:=@PRODUCT+XREG;                                    05890000
            RESLEN:=LOP1WORDS+LOP2WORDS-XREG;                           05892000
            IF INTEGER(PRODUCT)<0 THEN <<CVBD WILL SEE NEGATIVE>>       05894000
                  BEGIN                                                 05896000
                    @PRODUCT:=@PRODUCT-1; RESLEN:=RESLEN+1;             05898000
                    IF RESLEN>6 THEN DOVERFLOW:=TRUE;                   05900000
                  END;                                                  05902000
            IF MINUS THEN <<NEGATE RESULT>>                             05904000
              BEGIN                                                     05906000
                @P:=@PRODUCT; WORDS:=RESLEN; NEGATE;                    05908000
              END;                                                      05910000
            <<CONVERT PRODUCT BACK TO DECIMAL, ALL WORDS OF PRODUCT     05912000
              ARE KNOWN TO BE NONZERO>>                                 05914000
            TOS:=@OP2;TOS:=OP2DIGS; TOS:=@PRODUCT;                      05916000
            TOS:=IF RESLEN>=6 THEN 6 ELSE RESLEN;                       05918000
            ASSEMBLE(CON %020624); <<CVBD>>                             05920000
            IF = THEN ZERO:=TRUE;                                       05922000
            IF OVERFLOW OR RESLEN>6 THEN                                05924000
              DOVERFLOW:=TRUE;                                          05926000
          END <<MULTIPLY>>;                                             05928000
      END <<OP1 NOT ZERO>>;                                             05930000
    <<SET CCA ON RESULT>>                                               05932000
    TOS := STATUSWORD LAND %172377;                            <<03.00>>05934000
    IF ZERO THEN TOS:=TOS LOR %1000                                     05936000
    ELSE IF MINUS THEN TOS:=TOS LOR %400;                               05938000
    STATUSWORD:=TOS;                                                    05940000
    IF DOVERFLOW THEN <<DECIMAL OVERFLOW>> DEC'SIM'TRAP(11);            05942000
  END                                                                   05944000
ELSE IF NOT(0<=OP1DIGS<=28) OR NOT(0<=OP2DIGS<=28) THEN                 05946000
  DEC'SIM'TRAP(15) <<INVALID DIGIT COUNT>>;                             05948000
TOS := %031400+TEMPSDEC;  <<SET UP RETURN STATEMENT>>          <<03.00>>05950000
PUSH(Q); TOS := TOS-5; <<POP PROC TRAPS STUFF>> SET(Q);                 05952000
ASSEMBLE(XEQ 0);                                                        05954000
END <<MPYD>>;                                                           05956000
$PAGE                                                                   05958000
$CONTROL SEGMENT=FIRMWARESIM1                                  <<01820>>05960000
<<......................................................................05962000
.                                                                      .05964000
.                             SRD                                      .05966000
.                                                                      .05968000
......................................................................>>05970000
PROCEDURE SRD;                                                          05972000
OPTION PRIVILEGED,UNCALLABLE;                                           05974000
                                                                        05976000
COMMENT: SHIFTS AND MOVES OP1 TO OP2 BYTE SHIFT AMOUNT IN               05978000
         XREGISTER AND SETS CCA ON RESULT;                              05980000
                                                                        05982000
BEGIN                                                                   05984000
INTEGER SHIFT,         <<SHIFT AMOUNT>>                                 05986000
        OP1X,          <<OPERAND 1 INDEX>>                              05988000
        OP2X,          <<OPERAND 2 INDEX>>                              05990000
        XREG=X,                                                         05992000
        OLDX=Q-8,          <<USER'S XREG, HAS SHIFT AMOUNT>>            05994000
        OP2DIGS=Q-11,      <<USER'S OPERAND 2 # OF BDIGITS>>            05996000
        OP1DIGS=Q-9,       <<USER'S # OF OPERAND 1 DIGITS>>             05998000
        SDEC=Q-3,            <<IN INSTRUCTION CODE, HOW TO LEAVE STACK>>06000000
        OP1LIM;        <<SHIFT LIMIT>>                                  06002000
LOGICAL STATUSWORD=Q-6,<<WHERE STATUS WORD IS>>                         06004000
        INSTR=Q-4,       <<MACHINE INSTRUCTION CODE, HAS SDEC>>         06006000
        NONZERO,       <<TRUE IF RESULT IS NONZERO>>                    06008000
        ZEROOP2,       <<TRUE IF HIGH ORDER ZERO FILL>>                 06010000
        SAVEOP1,   <<FOR SAVING NON-SIGNIFICANT DIGITS>>                06012000
        RESTORE,    <<TRUE => RESTORE NON-SIGNIFICANT DIGIT>>           06014000
        SAVEOP2,       <<FOR SAVING OP2 NON-SIG DIGITS>>                06016000
        RIGHT,         <<TRUE IF NEXT DIGIT IS IN RIGHT                 06018000
                         HALF OF A BYTE>>                               06020000
        MINUS;         <<TRUE IF RESULT IS MINUS>>                      06022000
BYTE POINTER OP1=Q-10, <<WHERE OPERAND 1 IS>>                           06024000
           OP2=Q-12;   <<WHERE OPERAND 2 IS>>                           06026000
SUBROUTINE TRAP(CODE);                                                  06028000
VALUE CODE; INTEGER CODE;                                               06030000
BEGIN                                                                   06032000
IF RESTORE THEN OP1 := LOGICAL(OP1) LOR SAVEOP1;                        06034000
DEC'SIM'TRAP(CODE);                                                     06036000
END;                                                                    06038000
<<GET RID OF PRIVILEGED MODE AND GET SDEC>>                             06040000
IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV MODE>>                 06042000
  BEGIN                                                                 06044000
    PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                    06046000
  END;                                                                  06048000
STATUSWORD.(4:1):=0;  <<CLEAR OVERFLOW>>                                06050000
SDEC:=INSTR.(10:2);                                                     06052000
SDEC:=IF SDEC=0 THEN 0 ELSE IF SDEC=1 THEN 2 ELSE 4;                    06054000
OLDX := LOGICAL(OLDX) LAND %37;  <<TRUNCATE TO 5 BITS>>        <<C0.12>>06056000
RIGHT:=NONZERO:=ZEROOP2:=MINUS:=FALSE;                                  06058000
IF 1<=OP1DIGS<=28 AND                                                   06060000
   1<=OP2DIGS<=28 THEN                                                  06062000
  BEGIN                                                                 06064000
    RESTORE := FALSE;                                                   06066000
    IF NOT(LOGICAL(OP1DIGS)) THEN <<NON-SIGNIFICANT DIGIT>>             06068000
      BEGIN                                                             06070000
      TOS := OP1;                                                       06072000
      ASSEMBLE(DUP);                                                    06074000
      SAVEOP1 := TOS LAND %360;                                         06076000
      OP1 := TOS LAND %17;                                              06078000
      IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN                   06080000
        RESTORE := TRUE                                                 06082000
      ELSE    <<OVERLAPPING OPERANDS>>                                  06084000
        IF OP1DIGS >= OP2DIGS THEN                                      06086000
          RESTORE := TRUE                                               06088000
      END;                                                              06090000
     SAVEOP2 := IF LOGICAL(OP2DIGS) THEN 0 ELSE LOGICAL(OP2)LAND%360;   06092000
    SHIFT:=LOGICAL(OLDX) LAND %37;                                      06094000
    OP1X:=OP1DIGS&LSR(1); OP2X:=OP2DIGS&LSR(1);                         06096000
    IF SHIFT>=OP1DIGS THEN                                              06098000
                <<NO SHIFT NECESSARY, JUST ZEROS>>                      06100000
      BEGIN                                                             06102000
        XREG:=OP1DIGS&LSR(1);                                           06104000
        TOS:=LOGICAL(OP1(XREG)) LAND %360;                              06106000
        IF TOS>%(2)10010000 THEN TRAP(13);                              06108000
        WHILE (XREG:=XREG-1)>=0 DO                                      06110000
          BEGIN                                                         06112000
            TOS:=OP1(XREG);                                             06114000
            ASSEMBLE(DUP);                                              06116000
            TOS:=TOS LAND %17;                                          06118000
            ASSEMBLE(XCH);                                              06120000
            TOS:=TOS LAND %360;                                         06122000
            IF TOS>%(2)10010000 OR TOS>%(2)1001 THEN                    06124000
              TRAP(13); <<INVALID DIGIT>>                               06126000
          END;                                                          06128000
        OP2(OP2X):=%(2)1100; <<PLUS SINCE ZERO>>                        06130000
        OP2X:=OP2X-1; ZEROOP2:=TRUE;                                    06132000
      END                                                               06134000
    ELSE                                                                06136000
      BEGIN                                                             06138000
        TOS:=OP1(OP1X); <<GET SIGN DIGIT>>                              06140000
        TOS:=TOS LAND %17; <<ISOLATE SIGN DIGIT>>                       06142000
        ASSEMBLE(DUP); <<COPY SIGN DIGIT>>                              06144000
        IF TOS=%(2)1101 THEN MINUS:=TRUE <<NEGATIVE>>                   06146000
        ELSE TOS:=TOS LAND %0 LOR%(2)1100;                              06148000
        TOS:=(OP1LIM:=(OP1DIGS-SHIFT)); ASSEMBLE(DUP);                  06150000
        IF LOGICAL(OP1DIGS) THEN <<ODD # OF DIGITS>>                    06152000
          BEGIN                                                         06154000
            IF NOT(LOGICAL(TOS)) THEN RIGHT:=TRUE;                      06156000
            XREG:=(TOS-1)&LSR(1);                                       06158000
          END                                                           06160000
        ELSE <<EVEN # OF DIGITS>>                                       06162000
          BEGIN                                                         06164000
            IF LOGICAL(TOS) THEN RIGHT:=TRUE;                           06166000
            XREG:=TOS&LSR(1);                                           06168000
          END;                                                          06170000
        TOS:=OP1(XREG); <<GET FIRST SHIFTED BYTE>>                      06172000
        OP1X:=XREG-1;                                                   06174000
        IF RIGHT THEN <<REIGHT DIGIT IS NEXT REQUIRED>>                 06176000
          BEGIN                                                         06178000
            ASSEMBLE(DUP); <<COPY NEW DIGITS>>                          06180000
            TOS:=TOS LAND %17; <<ISOLATE RIGHT DIGIT>>                  06182000
            ASSEMBLE(DUP,DUP); <<MAKE TTWO COPIES>>                     06184000
            IF TOS>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>             06186000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           06188000
            TOS:=TOS&LSL(4); <<SHIFT DIGIT INTO POSITION>>              06190000
            ASSEMBLE(CAB,OR); <<COMBINE DIGIT AND SIGN>>                06192000
            OP2(OP2X):=BYTE(TOS); <<SOTORE SIGN AND DIGIT>>             06194000
            TOS:=TOS&LSR(4); <<LEAVE NEXT DIGIT IN RIGHT>>              06196000
          END                                                           06198000
        ELSE <<LEFT DIGIT OF BYTE IS NEXT REQUIRED>>                    06200000
          BEGIN                                                         06202000
            TOS:=TOS&LSR(4); <<GET DIGIT IN RIGHT PART                  06204000
                                   OF BYTE ON TOS>>                     06206000
            ASSEMBLE(DUP,DUP);                                          06208000
            IF TOS>%(2)1001 THEN <<INVALID DIGIT>> TRAP(13)             06210000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           06212000
            TOS:=TOS&LSL(4);                                            06214000
            TOS:=TOS LOR TOS; <<COMBINE DIGIT AND SIGN>>                06216000
            OP2(OP2X):=BYTE(TOS);                                       06218000
          END;                                                          06220000
        OP2X:=OP2X-1;                                                   06222000
       <<DO THE SHIFT>>                                                 06224000
        WHILE OP1X>=0 AND OP2X>=0 DO                                    06226000
          BEGIN                                                         06228000
            TOS:=OP1(OP1X); OP1X:=OP1X-1;                               06230000
            ASSEMBLE(DUP);                                              06232000
            IF RIGHT THEN <<CHECK BOTH DIGITS>>                         06234000
              BEGIN                                                     06236000
                TOS:=TOS LAND %17; <<ISOLATE D1>>                       06238000
                TOS:=TOS&LSL(4);  <<SHIFT IT TO LEFT>>                  06240000
                ASSEMBLE(DUP,DUP); <<2 COPIES OF D1>>                   06242000
                IF TOS>%(2)10010000 THEN TRAP(13);             <<C0.12>>06244000
           IF OP2X=0 AND NOT(LOGICAL(OP2DIGS)) THEN ASSEMBLE(DDEL;DZRO);06246000
                IF TOS>0 THEN NONZERO:=TRUE;                   <<C0.12>>06248000
                ASSEMBLE(CAB,DUP;DUP); <<GET READY TO CHECK D0>>        06250000
                IF TOS>%(2)1001 THEN TRAP(13)                           06252000
                ELSE IF TOS>%0 THEN NONZERO:=TRUE;                      06254000
                TOS:=TOS LOR TOS; <<PRODUCE NEW BYTE>>                  06256000
                OP2(OP2X):=BYTE(TOS);                                   06258000
                TOS:=TOS&LSR(4); <<PUT D2 IN RIGHT DIGIT>>              06260000
              END                                                       06262000
            ELSE <<D0;0;D2,D1>>                                         06264000
              BEGIN                                                     06266000
                ASSEMBLE(DUP); <<COPY BOTH DIGITS>>                     06268000
                TOS:=TOS LAND %17; ASSEMBLE(DUP);                       06270000
                IF TOS>%(2)1001 THEN TRAP(13)                           06272000
                ELSE IF TOS>0 THEN NONZERO:=TRUE;                       06274000
                TOS:=TOS LAND %360; ASSEMBLE(DUP);                      06276000
                IF TOS>%(2)10010000 THEN TRAP(13);             <<C0.12>>06278000
                IF OP2X=0 AND NOT(LOGICAL(OP2DIGS)) THEN       <<C0.12>>06280000
                   ASSEMBLE(DEL;ANDI %17;ZERO);                <<C0.12>>06282000
                IF TOS>0 THEN NONZERO:=TRUE;                   <<C0.12>>06284000
                OP2(OP2X):=BYTE(TOS);                                   06286000
               END;                                                     06288000
            OP2X:=OP2X-1;                                               06290000
          END <<WHILE>>;                                                06292000
        IF RIGHT AND OP2X>=0 THEN <<ONE DIGIT LEFT ON TOS>>             06294000
          BEGIN                                                         06296000
            ASSEMBLE(DUP,DUP); <<GET READY TO CHECK IT>>                06298000
            IF TOS>%(2)1001 THEN TRAP(13) <<INVALID DIGIT>>             06300000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           06302000
            OP2(OP2X):=BYTE(TOS);                                       06304000
            OP2X:=OP2X-1;                                               06306000
          END;                                                          06308000
        IF (XREG:=OP1X)>=0 THEN <<CHECK REMAINING DIGITS>>              06310000
          BEGIN                                                         06312000
            WHILE XREG>=0 DO                                            06314000
              BEGIN                                                     06316000
                TOS:=OP1(XREG);                                         06318000
                ASSEMBLE(DUP);                                          06320000
                TOS:=TOS LAND %17;                                      06322000
                ASSEMBLE(XCH);                                          06324000
                TOS:=TOS LAND %360;                                     06326000
                IF TOS>%(2)10010000 OR TOS>%(2)1001 THEN                06328000
                  TRAP(13);                                             06330000
                XREG:=XREG-1;                                           06332000
              END;                                                      06334000
          END;                                                          06336000
        IF NOT NONZERO AND MINUS THEN <<CHANGE TO PLUS>>                06338000
          BEGIN                                                         06340000
            TOS_OP2(OP2DIGS&LSR(1));                           <<C0.12>>06342000
            TOS:=TOS LAND %360 LOR %(2)1100;<<PLUS>>                    06344000
            OP2(XREG)_BYTE(TOS);                               <<C0.12>>06346000
          END;                                                          06348000
        IF (TOS:=(OP2DIGS-(OP1DIGS-SHIFT)))>0 THEN <<NEED ZERO FILL>>   06350000
          BEGIN                                                         06352000
            RIGHT:=FALSE; ZEROOP2:=TRUE;                                06354000
            IF LOGICAL(OP2DIGS) THEN                                    06356000
              BEGIN                                                     06358000
                IF NOT(LOGICAL(TOS)) THEN RIGHT:=TRUE;                  06360000
              END                                                       06362000
            ELSE                                                        06364000
              BEGIN                                                     06366000
                IF LOGICAL(TOS) THEN RIGHT:=TRUE;                       06368000
              END;                                                      06370000
            IF NOT RIGHT THEN <<ZERO OUT A DIGIT>>                      06372000
              BEGIN                                                     06374000
                XREG:=OP2X+1;                                           06376000
                OP2(XREG):=LOGICAL(OP2(XREG)) LAND %17;                 06378000
              END;                                                      06380000
          END;                                                          06382000
      END;                                                              06384000
<<ZERO FILL>>                                                           06386000
    IF ZEROOP2 THEN <<BYTE BY BYTE ZERO FILL>>                          06388000
      BEGIN                                                             06390000
        XREG:=OP2X;                                                     06392000
        WHILE XREG>=0 DO                                                06394000
          BEGIN                                                         06396000
            OP2(XREG):=0;                                               06398000
            XREG:=XREG-1;                                               06400000
          END;                                                          06402000
      END;                                                              06404000
    IF RESTORE THEN OP1 := LOGICAL(OP1) LOR SAVEOP1;                    06406000
    OP2 := LOGICAL(OP2) LOR SAVEOP2;                                    06408000
    TOS:=STATUSWORD LAND %176377;                                       06410000
    IF NOT NONZERO THEN <<ZERO>>                                        06412000
      TOS:=TOS LOR %1000                                                06414000
    ELSE IF MINUS THEN TOS:=TOS LOR %400;                               06416000
    STATUSWORD:=TOS;                                                    06418000
  END <<SHIFT>>                                                         06420000
ELSE IF NOT(0<=OP1DIGS<=28) OR NOT(0<=OP2DIGS<=28) THEN                 06422000
   DEC'SIM'TRAP(15);                                                    06424000
TOS:=%031400+SDEC;                                                      06426000
<<EXIT OVER USER'S STACK MARKER>>                                       06428000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            06430000
ASSEMBLE(XEQ 0);                                                        06432000
END <<SRD>>;                                                            06434000
$PAGE                                                                   06436000
$CONTROL SEGMENT=FIRMWARESIM2                                  <<01820>>06438000
<<......................................................................06440000
.                                                                      .06442000
.                             NSLD                                     .06444000
.                             SLD                                      .06446000
.                                                                      .06448000
......................................................................>>06450000
                                                                        06452000
PROCEDURE NSLD;                                                         06454000
OPTION PRIVILEGED,UNCALLABLE;                                           06456000
                                                                        06458000
COMMENT: MOVES AND SHIFTS OP1 INTO OP2 USING SHIFT AMOUNT               06460000
         IN X REGISTER, SETS CCA AND CARRY ON DIGITS LOST;              06462000
                                                                        06464000
BEGIN                                                                   06466000
ENTRY SLD;                                                              06468000
INTEGER SHIFT,        <<SHIFT AMOUNT, PASSED IN XREG>>                  06470000
        ZCNT,         <<COUNT OF LEADING ZEROS FOR NORMALIZING SHIFT>>  06472000
        OP1DIGS=Q-9,      <<USERS # OF DIGITS IN OPERAND1>>             06474000
        OP2DIGS=Q-11,     <<USER'S # OF DIGISTS IN OPERAND 2>>          06476000
        SDEC=Q-3,            <<IN INSTRUCTION CODE, HOW TO LEAVE STACK>>06478000
        SHIFTDIF,      <<DIFFERENCE IN GIVEN AND EFFECTIVE SHIFTS>>     06480000
        OP1X,         <<INDEX FOR OP1>>                                 06482000
        OP2X,         <<INDEX FOR OP2>>                                 06484000
        XREG=X,                                                         06486000
        S0=S-0,                                                         06488000
        LIMIT1,LIMIT2;   <<HOW MANY BYTES TO GO>>                       06490000
LOGICAL STATUSWORD=Q-6, <<WHERE CARRY AND CONDITION CODE ARE>>          06492000
        INSTR=Q-4,       <<MACHINE INSTRUCTION CODE>>                   06494000
        CARRYSET,      <<TRUE IF SIGNIFICANT DIGITS ARE SHIFTED OUT     06496000
                         AND CARRY IS SET AS INDICATOR>>                06498000
        NONZERO,       <<TRUE IF RESULT IS NONZERO>>                    06500000
        RIGHT1,RIGHT2,          <<TRUE IF NEXT DIGIT GOES INTO RIGHT    06502000
                          HALF OF BYTE>>                                06504000
        SAVEOP1,   <<SAVES NON-SIGNIFICANT DIGIT IN OP1>>               06506000
        RESTORE,    <<TRUE => RESTORE ABOVE NON-SIG DIGIT>>             06508000
        SAVEOP2,         <<SAVES OP2 NON-SIG DIGIT>>                    06510000
        MINUS,         <<TRUE IF RESULT IS MINUS>>                      06512000
        NORMSHIFT:=FALSE, <<NORMALIZING SHIFT FLAG>>                    06514000
        NOSHIFT:=FALSE, <<TRUE IF NO DATA MOVEMENT IN NSLD>>            06516000
        HIGHORDERZEROS, <<TRUE IF HIGH ORDER ZERO FILL>>                06518000
        ZERO,             <<WHILE LOOP FLAG>>                           06520000
        NEWX=Q-8,         <<USER'S X REGISTER>>                         06522000
        ZEROOP2;       <<TRUE IF HIGH ORDER ZERO FILL>>                 06524000
BYTE POINTER OP1=Q-10,    <<USERS OPERAND 1>>                           06526000
           OP2=Q-12;  <<USERS OPERAND 2>>                               06528000
DEFINE SDEC'AND'MODE=                                                   06530000
    IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV MODE>>             06532000
      BEGIN                                                             06534000
        PUSH(STATUS); TOS:=TOS LAND %77777; SET(STATUS);                06536000
      END;                                                              06538000
STATUSWORD.(4:2):=0;  <<CLEAR OVERFLOW>>                                06540000
    NEWX := LOGICAL(NEWX) LAND %37;                                     06542000
    SDEC:=INSTR.(10:2);                                                 06544000
    SDEC:=IF SDEC=0 THEN 0 ELSE IF SDEC=1 THEN 2 ELSE 4                 06546000
#;                                                                      06548000
                                                                        06550000
SUBROUTINE TRAP(CODE);                                                  06552000
VALUE CODE; INTEGER CODE;                                               06554000
BEGIN                                                                   06556000
IF RESTORE THEN OP1 := LOGICAL(OP1) LOR SAVEOP1;                        06558000
IF CODE=11 THEN  <<DECIMAL OVERFLOW>>                                   06560000
  STATUSWORD.(5:1) := 1;  <<SET CARRY IN USER STATUS>>                  06562000
DEC'SIM'TRAP(CODE);                                                     06564000
END;                                                                    06566000
SDEC'AND'MODE;                                                          06568000
NORMSHIFT:=TRUE;                                                        06570000
SHIFTDIF:=-1;                                                           06572000
IF 1<=OP1DIGS<=28 AND                                                   06574000
   1<=OP2DIGS<=28 THEN                                                  06576000
  BEGIN                                                                 06578000
    SHIFT:=LOGICAL(NEWX) LAND %37;                                      06580000
    ZCNT:=0;                                                            06582000
    RESTORE := FALSE;                                                   06584000
    IF NOT(LOGICAL(OP1DIGS)) THEN <<NON-SIGNIFICANT DIG HERE>>          06586000
      BEGIN                                                             06588000
      ZCNT := -1;                                                       06590000
      TOS := OP1;                                                       06592000
      ASSEMBLE(DUP);                                                    06594000
      SAVEOP1 := TOS LAND %360;                                         06596000
      OP1 := TOS LAND %17;                                              06598000
      IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN                   06600000
        RESTORE := TRUE                                                 06602000
      ELSE    <<OVERLAPPING OPERANDS>>                                  06604000
        IF OP1DIGS >= OP2DIGS THEN                                      06606000
          RESTORE := TRUE                                               06608000
      END;                                                              06610000
    SAVEOP2 := IF LOGICAL(OP2DIGS) THEN 0 ELSE LOGICAL(OP2)LAND%360;    06612000
    ZERO:=TRUE;                                                         06614000
    OP1X:=OP1DIGS&LSR(1);                                               06616000
    XREG:=0;                                                            06618000
    WHILE XREG<OP1X AND ZERO DO <<COUNT LEADING ZEROS>>                 06620000
      BEGIN                                                             06622000
        TOS:=OP1(XREG);                                                 06624000
        ASSEMBLE(DUP); <<COPY>>                                         06626000
        IF TOS<>0 THEN <<LEADING ZEROS STOP HERE>>                      06628000
          BEGIN                                                         06630000
            ZERO:=FALSE;                                                06632000
            TOS:=TOS&LSR(4); <<GET RID OF RIGTH DIGIT>>                 06634000
            IF TOS=0 THEN ZCNT:=ZCNT+1;                                 06636000
          END                                                           06638000
        ELSE <<2 ZERO DIGITS>>                                          06640000
          BEGIN                                                         06642000
            ASSEMBLE(DEL);<<DELETE COPY>>                               06644000
            ZCNT:=ZCNT+2;                                               06646000
          END;                                                          06648000
        XREG:=XREG+1;                                                   06650000
      END;                                                              06652000
    IF XREG=OP1X AND ZERO THEN <<CHECK SIGN BYTE FOR ZERO>>             06654000
      BEGIN                                                             06656000
        TOS:=LOGICAL(OP1(XREG)) LAND %360;                              06658000
        IF TOS=0 THEN ZCNT:=ZCNT+1;                                     06660000
      END;                                                              06662000
    IF (TOS:=(OP2DIGS-OP1DIGS+ZCNT))<0 THEN                             06664000
            <<MAXIMUM ALLOWABLE SHIFT AMOUNT IS ON TOS>>                06666000
      NOSHIFT:=TRUE  <<NO DATA MOVEMENT>>                               06668000
    ELSE                                                                06670000
      BEGIN                                                             06672000
        ASSEMBLE(DUP); <<DUP MAX SHIFT>>                                06674000
        IF (TOS:=(TOS-SHIFT))<0 THEN <<MAX-REQUESTED SHIFT>>            06676000
          BEGIN                                                         06678000
            SHIFTDIF:=-TOS;                                             06680000
            IF ZCNT<>OP1DIGS THEN NEWX:=TOS ELSE ASSEMBLE(DEL);<<C0.12>>06682000
          END                                                           06684000
       ELSE ASSEMBLE(DDEL);                                             06686000
     END;                                                               06688000
  END                                                                   06690000
ELSE NORMSHIFT:=FALSE;                                                  06692000
                                                                        06694000
SLD:                                                                    06696000
IF NOT NORMSHIFT THEN                                                   06698000
  BEGIN                                                                 06700000
    SDEC'AND'MODE;                                                      06702000
  END;                                                                  06704000
ZEROOP2:=NONZERO:=CARRYSET:=RIGHT1:=RIGHT2:=MINUS                       06706000
    :=HIGHORDERZEROS:=FALSE;  OP1X:=OP2X:=0;                            06708000
IF NORMSHIFT OR 1<=OP1DIGS<=28 AND                                      06710000
   1<=OP2DIGS<=28 THEN                                                  06712000
  BEGIN                                                                 06714000
    IF NOT NORMSHIFT THEN  <<ZERO NON-SIGNIFICANT DIGITS>>              06716000
      BEGIN                                                             06718000
       SAVEOP2:=IF LOGICAL(OP2DIGS) THEN 0 ELSE LOGICAL(OP2)LAND%360;   06720000
      RESTORE := FALSE;                                                 06722000
      IF NOT(LOGICAL(OP1DIGS)) THEN <<NON-SIGNIFICANT DIG HERE>>        06724000
        BEGIN                                                           06726000
        TOS := OP1;                                                     06728000
        ASSEMBLE(DUP);                                                  06730000
        SAVEOP1 := TOS LAND %360;                                       06732000
        OP1 := TOS LAND %17;                                            06734000
        IF @OP1 <> @OP2-(OP1DIGS-OP2DIGS+1)&ASR(1) THEN                 06736000
          RESTORE := TRUE                                               06738000
        ELSE    <<OVERLAPPING OPERANDS>>                                06740000
          IF OP1DIGS >= OP2DIGS THEN                                    06742000
            RESTORE := TRUE                                             06744000
        END;                                                            06746000
      END;                                                              06748000
    IF (SHIFT:=(NEWX LAND %37))>=OP2DIGS OR NOSHIFT THEN <<NO SHIFT>>   06750000
      BEGIN                                                             06752000
        XREG:=OP1DIGS&LSR(1);                                           06754000
        TOS:=LOGICAL(OP1(XREG)) LAND %360; ASSEMBLE(DUP);               06756000
        IF TOS>%(2)10010000 THEN TRAP(13) <<ILLEGAL DIGIT>>             06758000
        ELSE IF TOS>0 THEN CARRYSET:=TRUE;                              06760000
        WHILE (XREG:=XREG-1)>=0 DO                                      06762000
          BEGIN                                                         06764000
            TOS:=OP1(XREG);                                             06766000
            ASSEMBLE(DUP);                                              06768000
            TOS:=TOS LAND %17;                                          06770000
            ASSEMBLE(XCH);                                              06772000
            TOS:=TOS LAND %360; ASSEMBLE(DDUP);                         06774000
            IF TOS>%(2)10010000 OR TOS>%(2)1001 THEN                    06776000
              TRAP(13) <<INVALID DIGIT>>                                06778000
            ELSE IF TOS>0 OR TOS>0 THEN CARRYSET:=TRUE;                 06780000
          END;                                                          06782000
        IF NOSHIFT THEN TRAP(11); <<DECIMAL OVERFLOW>>                  06784000
        ZEROOP2:=TRUE;                                                  06786000
      END                                                               06788000
    ELSE <<SHIFT>>                                                      06790000
      BEGIN                                                             06792000
        <<CHECK FOR HIGH ORDER ZERO FILL>>                              06794000
        IF (TOS:=(OP2DIGS-(OP1DIGS+SHIFT)))>0 THEN                      06796000
                  <<HIGH ORDER ZERO FILL NEEDED, NO                     06798000
                     DIGITS SHIFTED OUT>>                               06800000
          BEGIN                                                         06802000
            HIGHORDERZEROS:=TRUE;                                       06804000
            IF NOT (LOGICAL(OP1DIGS)) THEN RIGHT1:=TRUE;                06806000
                     <<FIRST DIGIT TO BE SHIFTED INTO OP2 IS IN         06808000
                       RIGHT HALF OF A BYTE>>                           06810000
            <<TOS CONTAINS NUMBER OF HIGH ORDER ZEROS>>                 06812000
            ASSEMBLE(DUP);                                              06814000
            IF LOGICAL(OP2DIGS) THEN                                    06816000
              BEGIN                                                     06818000
                LIMIT2:=(TOS-2)&ASR(1);                                 06820000
                IF LOGICAL(TOS) THEN RIGHT2:=TRUE; <<FIRST DIGIT        06822000
                       TO BE SHIFTED INTO OP2 GOES INTO RIGHT HALF      06824000
                       OF A BYTE>>                                      06826000
              END                                                       06828000
            ELSE                                                        06830000
              BEGIN                                                     06832000
                LIMIT2:=(TOS-1)&LSR(1);                                 06834000
                IF NOT(LOGICAL(TOS)) THEN RIGHT2:=TRUE;                 06836000
              END;                                                      06838000
            <<DO HIGH ORDER ZERO FILL>>                                 06840000
            IF OP2DIGS>1 THEN <<LOOP NOT GOING TO CLOBBER SIGN DIGIT>>  06842000
              BEGIN                                                     06844000
                IF LOGICAL(OP2DIGS) THEN                                06846000
                  TOS := 0                                              06848000
                ELSE                                                    06850000
                  TOS := LOGICAL(OP2) LAND %360;                        06852000
                XREG:=0;                                                06854000
                WHILE XREG<=LIMIT2 DO <<2 ZEROS AT ONCE>>               06856000
                  BEGIN                                                 06858000
                    OP2(XREG):=0;                                       06860000
                    XREG:=XREG+1;                                       06862000
                  END;                                                  06864000
                OP2 := LOGICAL(OP2) LOR TOS;                            06866000
                OP2X:=XREG;                                             06868000
              END;                                                      06870000
            <<IF RIGHT2 IS FALSE THEN ALL HIGH ORDER ZEROS HAVE         06872000
              BEEN PUT IN, LELSE ONE GOES IN THE LEFT OF THE            06874000
              FIRST OP2 BYTE TO BE STORE INTO IN SHIFT>>                06876000
          END                                                           06878000
        ELSE                                                            06880000
          BEGIN                                                         06882000
            <<DIGITS MAY HAVE BEEN SHIFTED OUT; EXIAMINE THEM FOR       06884000
              SIGNIFICANCE AND VALIDITY>>                               06886000
            ASSEMBLE(NEG,DUP;DUP); <<FIX UP TOS SO THAT IT IS THE       06888000
                                     NUMBER OF DIGITS SHIFTED OUT       06890000
                                     AND COPY IT FOR LATER USE>>        06892000
            IF LOGICAL(OP1DIGS) THEN                                    06894000
              BEGIN                                                     06896000
                LIMIT1:=(TOS-2)&ASR(1);                                 06898000
                IF LOGICAL(TOS) THEN RIGHT1:=TRUE; <<IF RIGHT1 THEN     06900000
                         THE FIRST DIGIT TO BE SHIFTED IS IN            06902000
                         RIGHT OF OP1 BYTE CONTAINING IT>>              06904000
              END                                                       06906000
            ELSE                                                        06908000
              BEGIN                                                     06910000
                LIMIT1:=(TOS-1)&LSR(1);                                 06912000
                IF NOT(LOGICAL(TOS)) THEN RIGHT1:=TRUE;                 06914000
              END;                                                      06916000
            IF NOT(LOGICAL(OP2DIGS)) THEN RIGHT2:=TRUE;                 06918000
                   <<FIRST DIGIT SHIFTED INTO OP2 TO GO INTO RIGHT      06920000
                     HALF OF A BYTE>>                                   06922000
            IF TOS>0 THEN <<EXAMINE DIGITS SHIFTED OUT FOR              06924000
                             SIGNIFICANCE AND VALIDITY>>                06926000
              BEGIN                                                     06928000
                XREG:=0;                                                06930000
                WHILE XREG<=LIMIT1 DO                                   06932000
                  BEGIN                                                 06934000
                    TOS:=OP1(XREG); XREG:=XREG+1;                       06936000
                    ASSEMBLE(DUP); TOS:=TOS LAND %17;                   06938000
                    ASSEMBLE(DUP);                                      06940000
                    IF TOS>%(2)1001 THEN TRAP(13)                       06942000
                    ELSE IF TOS>0 THEN CARRYSET:=TRUE;                  06944000
                      BEGIN                                             06946000
                      TOS:=TOS LAND %360;                               06948000
                      ASSEMBLE(DUP);                                    06950000
                      IF TOS>%(2)10010000 THEN TRAP(13)                 06952000
                      ELSE IF TOS>0 THEN CARRYSET:=TRUE;                06954000
                    END                                                 06956000
                  END;                                                  06958000
                OP1X:=XREG;                                             06960000
                IF RIGHT1 THEN <<EXAMINE LEFT DIGIT FOR SAME AS         06962000
                                   ABOVE>>                              06964000
                  BEGIN                                                 06966000
                    TOS:=OP1(XREG); TOS:=TOS LAND %360;                 06968000
                    ASSEMBLE(DUP);                                      06970000
                    IF TOS>%(2)10010000 THEN TRAP(13)                   06972000
                    ELSE IF TOS>0 THEN CARRYSET:=TRUE;                  06974000
                  END;                                                  06976000
              END;                                                      06978000
          END;                                                          06980000
        <<ALL READY TO DO SHIFT>>                                       06982000
        LIMIT1:=(OP1DIGS-2)&ASR(1);                                     06984000
        LIMIT2:=(OP2DIGS-2)&ASR(1);                                     06986000
        <<HAVE NOTHING ON STACK NOW>>                                   06988000
        IF RIGHT2 THEN <<FIRST OP1 DIGIT GOES INTO RIGHT OF             06990000
                         OP2 BYTE>>                                     06992000
          BEGIN                                                         06994000
             TOS := OP1(OP1X); OP1X := XREG+1;                          06996000
             IF NOT RIGHT1 THEN <<DIGIT ON STACK IN LEFT 4 BITS>>       06998000
               BEGIN                                                    07000000
               TOS := 0;                                                07002000
               TOS := TOS & DLSR(4);  <<SPLIT DIGITS>>                  07004000
               TOS := TOS & LSR(8);   <<ALIGN LOW ORDER DIGIT>>         07006000
               ASSEMBLE(XCH);                                           07008000
               END;                                                     07010000
             TOS := TOS LAND %17;                                       07012000
             ASSEMBLE(DUP,DUP);                                         07014000
             IF TOS > %(2)1001 THEN TRAP(13)                            07016000
             ELSE IF TOS > 0 THEN NONZERO := TRUE;                      07018000
             XREG := OP2X;                                              07020000
             OP2(XREG) := IF HIGHORDERZEROS THEN TOS                    07022000
                  ELSE (LOGICAL(OP2(XREG)) LAND %360) LOR TOS;          07024000
             OP2X := XREG + 1                                           07026000
          END                                                           07028000
        ELSE IF RIGHT1 THEN <<FIRST OP1 DIGIT COMES FROM RIGHT>>        07030000
          BEGIN                                                         07032000
            TOS:=LOGICAL(OP1(OP1X)&LSL(4)) LAND %360; XREG:=XREG+1;     07034000
            ASSEMBLE(DUP,DUP); <<GET READY TO CHECK IT>>                07036000
            IF TOS>%(2)10010000 THEN TRAP(13)                           07038000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           07040000
            TOS:=OP1(XREG); OP1X:=XREG+1; ASSEMBLE(DUP);                07042000
            TOS:=TOS&LSR(4); ASSEMBLE(DUP,DUP);                         07044000
            IF TOS>%(2)1001 THEN TRAP(13)                               07046000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           07048000
            ASSEMBLE(CAB,OR); <<GET OTHER DIGIT AND COMBINE>>           07050000
            OP2(OP2X):=BYTE(TOS); OP2X:=XREG+1;                         07052000
            TOS:=TOS&LSL(4) LAND %360; <<LEAVE DIGIT IN LEFT OF BYTE>>  07054000
          END;                                                          07056000
<<IF RIGHT2 THEN                                                        07058000
    IF RIGHT1 THEN 0 DIGITS ON STACK                                    07060000
    ELSE 1 DIGIT ON STACK IN LEFT POSITION                              07062000
  ELSE                                                                  07064000
    IF RIGHT1 THEN 1 DIGIT ON STACK>>                                   07066000
<<KNOW THAT NEXT DIGIT GOES INTO LEFT PART OF AN OP2 BYTE>>             07068000
        RIGHT2:=RIGHT1 XOR RIGHT2; <<ONE DIGIT ON STACK>>               07070000
        WHILE OP1X<=LIMIT1 AND OP2X<=LIMIT2 DO                          07072000
          BEGIN                                                         07074000
            TOS:=OP1(OP1X); OP1X:=XREG+1;                               07076000
            IF RIGHT2 THEN <<ONE DIGIT ON STACK ALREADY>>               07078000
              BEGIN                                                     07080000
                 ASSEMBLE(DUP); <<COPY DIGITS>>                         07082000
                 TOS:=TOS&LSR(4); <<ISOLATE LEFT DIGIT>>                07084000
                 ASSEMBLE(CAB,OR); <<PUT TOGETHER BYTE>>                07086000
              END;                                                      07088000
            ASSEMBLE(DUP,DUP); <<COPY DIGITS>>                          07090000
            TOS:=TOS LAND %17;                                          07092000
            ASSEMBLE(DUP);                                              07094000
            IF TOS>%(2)1001 THEN TRAP(13)                               07096000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           07098000
            TOS:=TOS LAND %360;                                         07100000
            ASSEMBLE(DUP);                                              07102000
            IF TOS>%(2)10010000 THEN TRAP(13)                           07104000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           07106000
            OP2(OP2X):=BYTE(TOS); OP2X:=XREG+1;                         07108000
            IF RIGHT2 THEN <<GET EXTRA DIGIT IN POSITION>>              07110000
              BEGIN                                                     07112000
                TOS:=TOS&LSL(4);                                        07114000
                TOS:=TOS LAND %360;                                     07116000
              END;                                                      07118000
          END;                                                          07120000
        IF OP1X<LIMIT1+2 THEN <<HAVEN'T GOT SIGN BYTE YET>>             07122000
          BEGIN                                                         07124000
            TOS:=OP1(OP1DIGS&LSR(1)); <<GET SIGN BYTE>>                 07126000
            ASSEMBLE(DUP); <<COPY SIGN BYTE>>                           07128000
            TOS:=TOS LAND %17;                                          07130000
            ASSEMBLE(XCH); <<GET READY TO CHECK LAST DIGIT>>            07132000
            TOS:=TOS LAND %360; <<ISOLATE IT>>                          07134000
            ASSEMBLE(DUP,DUP);                                          07136000
            IF TOS>%(2)10010000 THEN TRAP(13)                           07138000
            ELSE IF TOS>0 THEN NONZERO:=TRUE;                           07140000
            ASSEMBLE(XCH); <<LAST DIGIT;SIGN>>                          07142000
          END                                                           07144000
        ELSE TOS:=TOS&LSR(4); <<PUT SIGN IN RIGHT PART OF BYTE ON TOS>> 07146000
        <<HAVE ON STACK: LAST DIGIT,0    OR    0,SIGN                   07148000
                0,SIGN                    >>                            07150000
        IF TOS=%(2)1101 THEN MINUS:=TRUE; <<TEST AND DELETE SIGN>>      07152000
        TOS:=%(2)1100;                                                  07154000
        IF NONZERO AND MINUS THEN TOS:=TOS+1;                           07156000
        <<CORRECT SIGN DIGIT NOW ON STACK>>                             07158000
        IF OP2X=LIMIT2+1 THEN <<STORE SIGN AND DIGIT>>                  07160000
          OP2(OP2X):=IF RIGHT2 THEN BYTE(TOS) ELSE BYTE(TOS LOR TOS)    07162000
        ELSE                                                            07164000
          BEGIN                                                         07166000
            IF RIGHT2 AND OP1X<LIMIT1+2  THEN <<A DIGIT ON STACK        07168000
                             IN ADDITION TO LAST DIGIT AND SIGN>>       07170000
              BEGIN                                                     07172000
                ASSEMBLE(XCH); <<0,S;D,0>>                              07174000
                TOS:=TOS&LSR(4); <<MOVE LAST DIGIT TO RIGHT OF BYTE>>   07176000
                ASSEMBLE(CAB); <<GET OLD DIGIT FOR CHECKING>>           07178000
                ASSEMBLE(DUP,DUP);                                      07180000
                IF TOS>%(2)10010000 THEN TRAP(13)                       07182000
                ELSE IF TOS>0 THEN NONZERO:=TRUE;                       07184000
                OP2(OP2X):=BYTE(TOS LOR TOS); OP2X:=XREG+1;             07186000
                IF (S0=%(2)1100) AND MINUS AND NONZERO THEN             07188000
                   TOS := TOS+1;  <<FIXUP SIGN TO %(2)1101>>            07190000
                IF OP2X<LIMIT2+1 THEN ZEROOP2:=3 <<SIGN ON STACK>>      07192000
                ELSE OP2(OP2X):=BYTE(TOS);                              07194000
              END                                                       07196000
            ELSE IF RIGHT2 THEN <<ONLY SIGN DIGIT ON STACK>>            07198000
              BEGIN                                                     07200000
                IF (XREG:=OP2X)=LIMIT2+1 THEN <<STORE SIGN AND          07202000
                                                ZERO DIGIT>>            07204000
                   OP2(XREG):=BYTE(TOS)                                 07206000
                ELSE ZEROOP2:=3; <<SIGN ON STACK>>                      07208000
              END                                                       07210000
            ELSE <<ONLY D,0;0,S ON STACK>>                              07212000
              IF OP2X=LIMIT2+1 THEN <<TIME TO STORE SIGN BYTE>>         07214000
                BEGIN                                                   07216000
                  ASSEMBLE(XCH); <<0,S;D,0>>                            07218000
                  TOS:=TOS LOR TOS; <<COMBINE LAST DIGIT AND SIGN>>     07220000
                  OP2(OP2X):=BYTE(TOS); <<STORE IT >>                   07222000
                END                                                     07224000
              ELSE  <<DIGIT AND SIGN ON STACK>>                         07226000
                BEGIN                                                   07228000
                  ZEROOP2:=1;                                           07230000
                  ASSEMBLE(XCH);                                        07232000
                END;                                                    07234000
          END;                                                          07236000
      END <<SHIFT>>;                                                    07238000
<<HIGH ORDER ZERO FILL>>                                                07240000
    IF ZEROOP2 THEN <<ZERO FILL>>                                       07242000
      BEGIN                                                             07244000
        XREG:=OP2X;                                                     07246000
        IF ZEROOP2=1 THEN <<DIGIT AND SIGN ON STACK>>                   07248000
          BEGIN                                                         07250000
            OP2(XREG):=BYTE(TOS);                                       07252000
            XREG:=XREG+1;                                               07254000
          END                                                           07256000
        ELSE IF ZEROOP2<>3 THEN TOS:=%(2)1100;                          07258000
        LIMIT2:=(OP2DIGS-2)&ASR(1);                                     07260000
        WHILE XREG<=LIMIT2 DO                                           07262000
          BEGIN                                                         07264000
            OP2(XREG):=0;                                               07266000
            XREG:=XREG+1;                                               07268000
          END;                                                          07270000
        OP2(XREG):=TOS; <<STORE SIGN>>                                  07272000
      END;                                                              07274000
    IF RESTORE THEN OP1 := LOGICAL(OP1)LOR SAVEOP1;                     07276000
    OP2 := LOGICAL(OP2) LOR SAVEOP2;                                    07278000
    <<SET CC AND CARRY IF NECESSARY>>                                   07280000
    TOS:=STATUSWORD LAND %174377;                                       07282000
    IF NOT NONZERO THEN <<RESULT IS ZERO>>                              07284000
      TOS:=TOS LOR %1000                                                07286000
    ELSE IF MINUS THEN                                                  07288000
      TOS:=TOS LOR %400;                                                07290000
    IF NORMSHIFT THEN <<NORMAL LEFT SHIFT>>                             07292000
      BEGIN                                                             07294000
        IF SHIFTDIF>0 AND NONZERO THEN <<SHIFT AMOUNT HAS BEEN REDUCED>>07296000
          BEGIN                                                         07298000
            NEWX:=SHIFTDIF; TOS := TOS LOR %2000;  <<SET CARRY>>        07300000
          END;                                                          07302000
      END                                                               07304000
    ELSE IF CARRYSET THEN TOS:=TOS LOR %2000;                           07306000
    STATUSWORD:=TOS;                                                    07308000
  END                                                                   07310000
ELSE IF NOT(0<=OP1DIGS<=28) OR NOT(0<=OP2DIGS<=28) THEN                 07312000
   DEC'SIM'TRAP(15);                                                    07314000
TOS:=%031400+SDEC;                                                      07316000
<<EXIT OVER USER'S STACK MARKER>>                                       07318000
PUSH(Q); TOS:=TOS-5; SET(Q);                                            07320000
ASSEMBLE(XEQ 0);                                                        07322000
END <<NLS>>;                                                            07324000
$PAGE                                                                   07326000
<<......................................................................07328000
.                                                                      .07330000
.                             DMPY                                     .07332000
.                                                                      .07334000
......................................................................>>07336000
                                                                        07338000
$CONTROL SEGMENT=FIRMWARESIM2                                           07340000
                                                                        07342000
PROCEDURE DMUL;                                                         07344000
OPTION PRIVILEGED,UNCALLABLE;                                           07346000
                                                                        07348000
COMMENT: MULTIPLIES THE TWO DOUBLE WORDS ON TOS TOGETHER,               07350000
         USING EACH AS A LOGICAL DOUBLEWORD. THE                        07352000
         FOUR WORD LOGICAL PRODUCT IS LEFT ON TOS;                      07354000
                                                                        07356000
BEGIN                                                                   07358000
LOGICAL SIGNFLAG,           <<TRUE IF ANSWER NEGATIVE>>                 07360000
        TOPZERO,          <<TRUE IF TOP 2 WORDS OF RESULT ARE ZERO>>    07362000
        INSTR=Q-4,        <<MACHINE INSTRUCTION CODE, HAS SDEC>>        07364000
        NONZERO,          <<TRUE IF RESULTI IS NOT ZERO>>               07366000
        STATUSWORD=Q-6;    <<CONDITION CODE AND CARRY>>                 07368000
DOUBLE LOCOP1,        <<LOCAL OP1>>                                     07370000
       LOCOP2,            <<LOCAL OP2>>                                 07372000
       OP1=Q-10,      <<USERS OPERAND 1>>                               07374000
       OP2=Q-12;      <<USER'S OPERAND 2>>                              07376000
LOGICAL LOC1=LOCOP1, LOC2=LOCOP1+1,                                     07378000
        LOC3=LOCOP2, LOC4=LOCOP2+1;                                     07380000
ARRAY RESULT(0:3);          <<LOCAL RESULT>>                            07382000
DOUBLE POINTER DRES1:=@RESULT, DRES2:=@RESULT(2);                       07384000
<<GET RID OF PRIVILEGED MODE AND DISABLE TRAPS>>                        07386000
PUSH(STATUS);                                                           07388000
IF INTEGER(STATUSWORD)>=0 THEN <<GET RID OF PRIV>> TOS:=TOS LAND %77777;07390000
TOS:=TOS LAND %157777; <<TURN OFF TRAPS>>                               07392000
SET(STATUS);                                                            07394000
SIGNFLAG:=NONZERO:=FALSE;                                               07396000
TOPZERO := TRUE;                                                        07398000
TOS:=OP2;                                                               07400000
LOCOP2:=TOS; <<PUT IN LOCAL>>                                           07402000
TOS:=OP1;                                                               07404000
LOCOP1:=TOS;                                                            07406000
TOS:=LOC4; <<LOW ORDER PART OF OP2>>                                    07408000
ASSEMBLE(DUP);                                                          07410000
TOS:=TOS**LOC2; <<MULTIPLY LOW ORDER PARTS>>                            07412000
RESULT(3):=TOS; <<PARTIAL RESULT>>                                      07414000
ASSEMBLE(ZERO,XCH;CAB); <<SET UP NEXT PART>>                            07416000
TOS:=TOS**LOC1; <<LOW TIMES HIGH>>                                      07418000
ASSEMBLE(DADD); <<PARTIAL PRODUCT>>                                     07420000
TOS:=LOC2**LOC3; <<HIGH TIMES LOW>>                                     07422000
ASSEMBLE(DADD);  <<ANOTHER PARTIAL PRODUCT>>                            07424000
RESULT(2):=TOS;                                                         07426000
TOS:=0;                                                                 07428000
IF CARRY THEN TOS:=TOS+1; <<PROPAGATE CARRY>>                           07430000
ASSEMBLE(XCH); <<SET UP FOR NEXT PARTIAL>>                              07432000
TOS:=LOC1**LOC3; <<MULTIPLY HIGHS>>                                     07434000
ASSEMBLE(DADD);                                                         07436000
DRES1:=TOS; <<LAST PARTIAL PRODUCT>>                                    07438000
OP1 := DRES2;  <<LOW ORDER DWORD>>                                      07440000
IF <> THEN NONZERO := TRUE;                                             07442000
OP2 := DRES1;  <<HIGH ORDER DWORD>>                                     07444000
IF <> THEN   <<TOP DWORD IS NOT ALL ZEROS>>                             07446000
  BEGIN                                                                 07448000
  TOPZERO := FALSE;                                                     07450000
  NONZERO := TRUE;                                                      07452000
  END;                                                                  07454000
TOS:=RESULT; TOS:=TOS&CSL(1); IF TOS THEN SIGNFLAG:=TRUE;               07456000
TOS := STATUSWORD LAND %174377;  <<CLEAR CARRY & CC>>                   07458000
IF NOT TOPZERO THEN <<SET CARRY>>                                       07460000
  TOS := TOS LOR %2000;                                                 07462000
IF NOT NONZERO THEN <<CCE>> TOS := TOS LOR %1000                        07464000
  ELSE IF SIGNFLAG THEN <<CCL>> TOS := TOS LOR %400;                    07466000
STATUSWORD := TOS;                                                      07468000
<<EXIT OVER USERS STACK>>                                               07470000
PUSH(Q); TOS := TOS -5; SET(Q);                                         07472000
RETURN 0;                                                               07474000
END;   <<DMUL (DMPY) >>                                                 07476000
$CONTROL SEGMENT=FIRMWARESIM1                                  <<01820>>07478000
procedure STUNSIM;                                             <<01745>>07480000
option privileged,uncallable;                                  <<01745>>07482000
begin        <<STUNSIM>>                                       <<01745>>07484000
                                                               <<01745>>07486000
equate        XCH'SUB                  =  %3221,               <<01745>>07488000
                                                               <<01745>>07490000
              DDUP                     =  %46,                 <<01876>>07492000
                                                               <<01745>>07494000
              SETQ                     =  %27402,              <<01745>>07496000
                                                               <<01745>>07498000
              DUP                      =  %45,                 <<01876>>07500000
                                                               <<01876>>07502000
              DUP'NOP                  =  %4500,               <<01876>>07504000
                                                               <<01745>>07506000
              SETQS                    =  %27403;              <<01745>>07508000
                                                               <<01745>>07510000
                                                               <<01745>>07512000
integer       CURR'X                   =  Q-3,                 <<01745>>07514000
                                                               <<01745>>07516000
              TRAP'X                   =  Q-10,                <<01745>>07518000
                                                               <<01745>>07520000
              X                        =  X;                   <<01745>>07522000
                                                               <<01745>>07524000
                                                               <<01745>>07526000
logical       CURR'DELTAQ              =  Q+0,                 <<01745>>07528000
                                                               <<01745>>07530000
              CURR'STATUS              =  Q-1,                 <<01745>>07532000
                                                               <<01745>>07534000
              NEXT1                    =  Q-4,                 <<01745>>07536000
                                                               <<01745>>07538000
              NEXT                     =  Q-5,                 <<01745>>07540000
                                                               <<01745>>07542000
              USER'DELTAQ              =  Q-4,                 <<01745>>07544000
                                                               <<01745>>07546000
              USER'DELTAQ'             =  Q-11,                <<01876>>07548000
                                                               <<01876>>07550000
              INSTRUCTION              =  Q-6,                 <<01745>>07552000
                                                               <<01745>>07554000
              TRAP'DELTAQ              =  Q-7,                 <<01745>>07556000
                                                               <<01745>>07558000
              TRAP'STATUS              =  Q-8,                 <<01745>>07560000
                                                               <<01745>>07562000
              TRAP'DELTAP              =  Q-9;                 <<01745>>07564000
                                                               <<01745>>07566000
                                                               <<01745>>07568000
double        USER'DELTAQ'TOS          =  Q-12,                <<01745>>07570000
                                                               <<01745>>07572000
              TRAP'DELTAQ'TOS          =  Q-10,                <<01745>>07574000
                                                               <<01745>>07576000
              TRAP'DELTAP'STATUS       =  Q-9,                 <<01745>>07578000
              TRAP'X'DELTAP            =  Q-10,                <<01876>>07580000
                                                               <<01876>>07582000
              USER'STATUS'DELTAQ       =  Q-12,                <<01876>>07584000
                                                               <<01876>>07586000
                                                               <<01745>>07588000
              CURR'DELTAP'STATUS       =  Q-2;                 <<01745>>07590000
                                                               <<01745>>07592000
                                                               <<01745>>07594000
array         PCBX(*)                  =  Q+0;                 <<01745>>07596000
                                                               <<01745>>07598000
                                                               <<01745>>07600000
define        S'EQUALS'Q               =  TRAP'DELTAQ=4#,      <<01745>>07602000
                                                               <<01745>>07604000
              S'EQUALS'Q1              =  TRAP'DELTAQ=5#,      <<01745>>07606000
                                                               <<01745>>07608000
              SIMBIT                   =  (8:1)#,              <<01745>>07610000
                                                               <<01745>>07612000
              SET'CC                   =  push(STATUS);        <<01745>>07614000
                                          tos:=tos&lsr(8);     <<01745>>07616000
                                          TRAP'STATUS.CC:=tos#,<<01745>>07618000
                                                               <<01745>>07620000
              RESET'Q                  =  push(Q);             <<01745>>07622000
                                          tos:=tos-CURR'DELTAQ;<<01745>>07624000
                                          set(Q)#,             <<01745>>07626000
                                                               <<01745>>07628000
              LEFTSTACKOP              =  INSTRUCTION.(4:6)#,  <<01876>>07630000
                                                               <<01876>>07632000
              CC                       =  (6:2)#;              <<01745>>07634000
                                                               <<01745>>07636000
                                                               <<01745>>07638000
subroutine LOGSTUN;                                            <<01745>>07640000
 begin                                                         <<01745>>07642000
 push(Q,DL);                                                   <<01745>>07644000
 assemble(xch,sub);                                            <<01745>>07646000
 assemble(dup,stax);                                           <<01745>>07648000
 X:=X-1;                                                       <<01745>>07650000
 tos:=-PCBX(X);                                                <<01745>>07652000
 assemble(add);                                                <<01745>>07654000
 X:=tos+7;                                                     <<01745>>07656000
 tos:=PCBX(X);                                                 <<01745>>07658000
 tos.SIMBIT:=1;                                                <<01745>>07660000
 PCBX(X):=tos;                                                 <<01745>>07662000
 end;                                                          <<01745>>07664000
                                                               <<01745>>07666000
if S'EQUALS'Q                                                  <<01876>>07668000
 then                                                          <<01876>>07670000
  if INSTRUCTION=SETQ                                          <<01876>>07672000
   then                                                        <<01876>>07674000
    begin        <<SET Q>>                                     <<01876>>07676000
    LOGSTUN;                                                   <<01876>>07678000
    RESET'Q;                                                   <<01876>>07680000
    CURR'DELTAQ:=logical(@CURR'DELTAQ)-USER'DELTAQ;            <<01876>>07682000
    return 1;                                                  <<01876>>07684000
    end          <<SET Q>>                                     <<01876>>07686000
 else                                                          <<01876>>07688000
  if LEFTSTACKOP=DUP                                           <<01876>>07690000
   then                                                        <<01876>>07692000
    begin       <<DUP/NOP>>                                    <<01876>>07694000
    LOGSTUN;                                                   <<01876>>07696000
    CURR'DELTAQ:=CURR'DELTAQ+TRAP'DELTAQ;                      <<01876>>07698000
    CURR'DELTAP'STATUS:=TRAP'DELTAP'STATUS;                    <<01876>>07700000
    CURR'X:=TRAP'X;                                            <<01876>>07702000
    TRAP'X:=USER'DELTAQ';                                      <<01876>>07704000
    SET'CC;                                                    <<01876>>07706000
    return 6;                                                  <<01876>>07708000
    end         <<DUP/NOP>>                                    <<01876>>07710000
 else                                                          <<01876>>07712000
  if LEFTSTACKOP=DDUP                                          <<01876>>07714000
   then                                                        <<01876>>07716000
    begin        <<DDUP>>                                      <<01876>>07718000
    LOGSTUN;                                                   <<01876>>07720000
    CURR'DELTAQ:=CURR'DELTAQ+TRAP'DELTAQ;                      <<01876>>07722000
    CURR'DELTAP'STATUS:=TRAP'DELTAP'STATUS;                    <<01876>>07724000
    CURR'X:=TRAP'X;                                            <<01876>>07726000
    TRAP'X'DELTAP:=USER'STATUS'DELTAQ;                         <<01876>>07728000
    SET'CC;                                                    <<01876>>07730000
    return 5;                                                  <<01876>>07732000
    end;         <<DDUP>>                                      <<01876>>07734000
                                                               <<01745>>07736000
if S'EQUALS'Q1                                                 <<01745>>07738000
 then                                                          <<01745>>07740000
  if INSTRUCTION=XCH'SUB and NEXT=DUP'NOP and NEXT1=SETQS      <<01745>>07742000
   then                                                        <<01745>>07744000
    begin        <<XCH/SUB/DUP/NOP>>                           <<01745>>07746000
    LOGSTUN;                                                   <<01745>>07748000
    tos:=USER'DELTAQ'TOS;                                      <<01745>>07750000
    assemble(xch);                                             <<01745>>07752000
    USER'DELTAQ'TOS:=tos;                                      <<01745>>07754000
    SET'CC;                                                    <<01745>>07756000
    TRAP'DELTAQ:=TRAP'DELTAQ+1;                                <<01745>>07758000
    RESET'Q;                                                   <<01745>>07760000
    return;                                                    <<01745>>07762000
    end          <<XCH/SUB/DUP/NOP>>                           <<01745>>07764000
 else                                                          <<01745>>07766000
 if LEFTSTACKOP=DDUP                                           <<01876>>07768000
   then                                                        <<01745>>07770000
    begin        <<DDUP>>                                      <<01745>>07772000
    LOGSTUN;                                                   <<01745>>07774000
    CURR'DELTAQ:=CURR'DELTAQ+TRAP'DELTAQ;                      <<01745>>07776000
    CURR'DELTAP'STATUS:=TRAP'DELTAP'STATUS;                    <<01745>>07778000
    CURR'X:=TRAP'X;                                            <<01745>>07780000
    TRAP'DELTAQ'TOS:=USER'DELTAQ'TOS;                          <<01745>>07782000
    SET'CC;                                                    <<01745>>07784000
    return 5;                                                  <<01764>>07786000
    end;         <<DDUP>>                                      <<01745>>07788000
end;        <<STUNSIM>>                                        <<01745>>07790000
$CONTROL SEGMENT=MAIN                                          <<01745>>07792000
END.                                                           <<01745>>07794000
