$CONTROL USLINIT,MAP,CODE,SOURCE                                        00010000
<< DEBUGUTL --- MODULE   >>                                             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
$CONTROL SEGMENT = DEBUGUTL                                             00028000
$CONTROL PRIVILEGED                                                     00030000
BEGIN                                                                   00032000
EQUATE                                                                  00034000
   << COLUMNS IN DEASSEMBLED INSTR. >>                                  00036000
   COL2      = 5,          << OPERAND COLUMN        >>                  00038000
   COL'REG   = COL2,       << P, DB, Q & S COLUMN   >>                  00040000
   COL'DISP  = COL'REG+3,  << DISPLACEMENT COLUMN   >>                  00042000
   INSTR'LEN = 4,          << LEN OF INSTR IN ARRAY >>                  00044000
                                                                        00046000
   << EQUATES FOR REGISTER >>                                           00048000
   PDQS      = 0,                                                       00050000
   P'32      = 1,                                                       00052000
   S'REG     = 2,                                                       00054000
   STT       = 3,                                                       00056000
   SYS'REL   = 4,                                                       00058000
                                                                        00060000
   << RESULTS OF DEASSEMBLE >>                                          00062000
   OK             = 0,                                                  00064000
   INVALID'OPCODE = 1,                                                  00066000
   MISSING'2NDOP  = 2,                                                  00068000
   INVALID'2NDOP  = 3,                                                  00070000
   IGNORED'2NDOP  =-1,                                                  00072000
                                                                        00074000
   SERIES'33      = 2;                                                  00076000
                                                                        00078000
INTEGER                                                                 00080000
   X        = X,                                                        00082000
   S0       = S-0,                                                      00084000
   S1       = S-1,                                                      00086000
   S2       = S-2,                                                      00088000
   S3       = S-3,                                                      00090000
   S4       = S-4;                                                      00092000
LOGICAL                                                                 00094000
   PARMMASK = Q-4;                                                      00096000
                                                                        00098000
DEFINE                                                                  00100000
   DEF'COBOL'PB'DB =                                                    00102000
                                                                        00104000
   COBOL'PB'DB (INSTR,STRING);                                          00106000
      VALUE INSTR;                                                      00108000
      INTEGER INSTR;                                                    00110000
      BYTE ARRAY STRING;                                                00112000
   BEGIN                                                                00114000
      COMMENT:                                                          00116000
         THIS SUBROUTINE DECODES THE PB-DB FIELD OF                     00118000
         THE COBOL INSTRUCTIONS (BOTH 1&2 WORD).  IT RETURNS            00120000
         THE LENGTH OF THE FIELD.;                                      00122000
      IF INSTR.(15:1) = 1 THEN                                          00124000
         MOVE STRING := "DB"                                            00126000
      ELSE MOVE STRING := "PB";                                         00128000
      COBOL'PB'DB := 2;                                                 00130000
   END  << SUBROUTINE PB'DB >> #;                                       00132000
                                                                        00134000
<< DECLARATIONS FOR TESTING >>                                          00136000
INTEGER                                                                 00138000
   FNUM,                                                                00140000
   LEN,                                                                 00142000
   ERROR,                                                               00144000
   OFFSET,                                                              00146000
   I;                                                                   00148000
BYTE ARRAY                                                              00150000
   RESULT(0:71),                                                        00152000
   NAME(0:10) := "CODE ";                                               00154000
INTEGER ARRAY                                                           00156000
   CODE(0:200);                                                         00158000
                                                                        00160000
 DEFINE                                                                 00162000
    DEBUG   = PARMMASK.(15:1) #,                                        00164000
    TWOWORD = PARMMASK.(14:1) #;                                        00166000
                                                                        00168000
<< END DECLARATIONS FOR TESTING >>                                      00170000
INTRINSIC                                                               00172000
   ASCII,                                                               00174000
   PRINT,  << FOR TESTING ONLY >>                                       00176000
   FOPEN,                                                               00178000
   FREAD,                                                               00180000
   BINARY;                                                              00182000
                                                                        00184000
INTEGER PROCEDURE THISCPU;                                              00186000
   OPTION EXTERNAL;                                                     00188000
                                                                        00190000
$PAGE              "               ***** OCTAL *****"                   00192000
<<********************************************************************>>00194000
<<  P R O C E D U R E   O C T A L  >>                                   00196000
                                                                        00198000
LOGICAL PROCEDURE OCTAL (NUMBER,STRING);                                00200000
   VALUE NUMBER;                                                        00202000
   INTEGER NUMBER;                                                      00204000
   BYTE ARRAY STRING;                                                   00206000
   OPTION UNCALLABLE;                                                   00208000
BEGIN                                                                   00210000
   COMMENT:                                                             00212000
      THIS PROCEDURE CONVERTS NUMBER TO ASCII BASE 8.                   00214000
      IT REMOVES LEADING ZEROES AND RETURNS THE LENGTH                  00216000
      OF THE STRING.;                                                   00218000
   BYTE ARRAY                                                           00220000
     SCRATCH(0:5);                                                      00222000
   LOGICAL                                                              00224000
      LEN;                                                              00226000
   LEN := ASCII (NUMBER,8,SCRATCH);                                     00228000
   MOVE STRING := SCRATCH(6-LEN),(LEN);                                 00230000
   OCTAL := LEN;                                                        00232000
                                                                        00234000
END; << PROCEDURE OCTAL >>                                              00236000
$PAGE              "               ***** OPCODE'LEN *****"              00238000
<<********************************************************************>>00240000
<<  P R O C E D U R E   O P C O D E'L E N  >>                           00242000
                                                                        00244000
LOGICAL PROCEDURE OPCODE'LEN (STRING);                                  00246000
   BYTE ARRAY STRING;                                                   00248000
   OPTION UNCALLABLE;                                                   00250000
BEGIN                                                                   00252000
   COMMENT:                                                             00254000
      THIS PROCEDURE DETERMINES THE LENGTH OF                           00256000
      OPCODES WHICH DO NOT HAVE OPERANDS                                00258000
      ;                                                                 00260000
   EQUATE                                                               00262000
      MAX'LEN = 4;                                                      00264000
      LOGICAL                                                           00266000
         LEN = OPCODE'LEN;                                              00268000
                                                                        00270000
      LEN := 0;                                                         00272000
      WHILE STRING(LEN) <> " " AND LEN < MAX'LEN DO                     00274000
         LEN := LEN + 1;                                                00276000
                                                                        00278000
END; << PROCEDURE OPCODE'LEN >>                                         00280000
                                                                        00282000
                                                                        00284000
$PAGE              "               ***** REGISTER *****"                00286000
<<********************************************************************>>00288000
<<  P R O C E D U R E   R E G I S T E R  >>                             00290000
                                                                        00292000
LOGICAL PROCEDURE REGISTER (REG'TYPE,INSTR,STRING);                     00294000
   VALUE REG'TYPE, INSTR;                                               00296000
   INTEGER REG'TYPE, INSTR;                                             00298000
   BYTE ARRAY STRING;                                                   00300000
   OPTION UNCALLABLE;                                                   00302000
BEGIN                                                                   00304000
   COMMENT:                                                             00306000
      THIS PROCEDURE DECODES THE REGISTER AND DISPLACE-                 00308000
      MENT FIELD OF 'INSTR'. REG'TYPE IS THE TYPE OF                    00310000
      REGISTER:                                                         00312000
         REG'TYPE:  0) P-D-Q-S, DISPLACEMENT RANGE --  0:377/0:77       00314000
                       ADDRESS MODE DETERMINED BY (6:4)                 00316000
                    1) P REG, DISPLACEMENT RANGE --  0:37               00318000
                    2) S REG, DISPLACEMENT RANGE --  0:17               00320000
                    3) PL REG, DISPLACEMENT RANGE -- 0:377              00322000
                    4) SYS GLOBAL, DISPLACEMENT RANGE -- 0:17.          00324000
      THE RESULT HAS THE FORM RR+DDD.  THE LENGTH OF THE                00326000
      STRING IS RETURNED.;                                              00328000
   INTEGER                                                              00330000
      ADDR'MODE;                                                        00332000
   LOGICAL                                                              00334000
      LEN = REGISTER,                                                   00336000
      MASK;  << NUMBER OF BITS IN DISPLACEMENT >>                       00338000
                                                                        00340000
   CASE REG'TYPE OF                                                     00342000
      BEGIN                                                             00344000
      <<0>> << P/DQS -- 0:377 >>                                        00346000
         BEGIN                                                          00348000
         ADDR'MODE := INSTR.(6:4);                                      00350000
         IF ADDR'MODE < 8 THEN                                          00352000
            BEGIN << P >>                                               00354000
            MASK := %377;                                               00356000
            IF ADDR'MODE > 3 THEN MOVE STRING := "P-",2                 00358000
            ELSE MOVE STRING := "P+",2;                                 00360000
            END                                                         00362000
         ELSE IF ADDR'MODE<12 THEN                                      00364000
            BEGIN << DB >>                                              00366000
            MASK := %377;                                               00368000
            MOVE STRING := "DB+",2;                                     00370000
            END                                                         00372000
         ELSE IF ADDR'MODE < 14 THEN                                    00374000
            BEGIN << Q+ >>                                              00376000
            MASK := %177;                                               00378000
            MOVE STRING := "Q+",2                                       00380000
            END                                                         00382000
         ELSE IF ADDR'MODE = 14 THEN                                    00384000
            BEGIN                                                       00386000
            MASK := %77;                                                00388000
            MOVE STRING := "Q-",2;                                      00390000
            END                                                         00392000
         ELSE                                                           00394000
            BEGIN << S- >>                                              00396000
            MASK := %77;                                                00398000
            MOVE STRING := "S-",2;                                      00400000
            END;                                                        00402000
         END;                                                           00404000
      <<1>> << P -- 0:37 >>                                             00406000
         BEGIN                                                          00408000
         MASK := %37;                                                   00410000
         IF INSTR.(10:1) = 0 THEN MOVE STRING := "P+",2                 00412000
         ELSE MOVE STRING := "P-",2;                                    00414000
         END;                                                           00416000
      <<2>> << S -- 0:17 >>                                             00418000
         BEGIN                                                          00420000
         MASK := %17;                                                   00422000
         MOVE STRING := "S-",2;                                         00424000
         END;                                                           00426000
      <<3>> << STT -- 0:377 >>                                          00428000
         BEGIN                                                          00430000
         MASK := %377;                                                  00432000
         IF INSTR.(8:8) <> 0 THEN MOVE STRING := "STT ",2               00434000
         ELSE TOS := @STRING;                                           00436000
         END;                                                           00438000
      <<4>> << SYS -- 0:17 >>                                           00440000
         BEGIN                                                          00442000
         MASK := %17;                                                   00444000
         MOVE STRING := "SYS ",2;                                       00446000
         END;                                                           00448000
      END; <<CASE>>                                                     00450000
                                                                        00452000
   LEN := TOS - LOGICAL(@STRING);                                       00454000
   REGISTER:=LEN+OCTAL((MASK LAND LOGICAL(INSTR)),STRING(LEN));         00456000
                                                                        00458000
END; << PROCEDURE REGISTER >>                                           00460000
                                                                        00462000
$PAGE              "               ***** COBOL'2WORD *****"             00464000
<<********************************************************************>>00466000
<<  P R O C E D U R E   C O B O L'2 W O R D  >>                         00468000
                                                                        00470000
LOGICAL PROCEDURE COBOL'2WORD (RESULT,STRING,OPERAND);                  00472000
   VALUE OPERAND;                                                       00474000
   INTEGER RESULT,OPERAND;                                              00476000
   BYTE ARRAY STRING;                                                   00478000
   OPTION UNCALLABLE;                                                   00480000
BEGIN                                                                   00482000
   COMMENT:                                                             00484000
      THIS ROUTINE DECODES COBOL 2-WORD INSTRUCTIONS                    00486000
      (%20477).                                                         00488000
                                                                        00490000
      PARAMETERS:                                                       00492000
         RESULT:        OK                                              00494000
                        INVALID'2NDOP                                   00496000
         STRING:        DESTINATION ARRAY                               00498000
         OPERAND:       WORD 2 OF 2 WORD %20477 INSTR.                  00500000
                                                                        00502000
      RETURNS:          LENGTH OF STRING                                00504000
      ;                                                                 00506000
                                                                        00508000
   EQUATE                                                               00510000
      NUM'OPS = 5,                                                      00512000
      TR      = 2;                                                      00514000
                                                                        00516000
   BYTE ARRAY COBOL'OPS(0:NUM'OPS*INSTR'LEN-1) = PB :=                  00518000
      "LDW LDDWTR  ABSDNEGD";                                           00520000
   INTEGER                                                              00522000
      TYPE;                                                             00524000
   LOGICAL                                                              00526000
      LEN = COBOL'2WORD;                                                00528000
                                                                        00530000
   LOGICAL SUBROUTINE DEF'COBOL'PB'DB;                                  00532000
                                                                        00534000
                                                                        00536000
                                                                        00538000
                                                                        00540000
   LEN := 0;                                                            00542000
   RESULT := OK;                                                        00544000
                                                                        00546000
   IF 6 <= OPERAND <= 7 THEN                                            00548000
      BEGIN                                                             00550000
      MOVE STRING := "CMPT";                                            00552000
      << SDEC FIELD >>                                                  00554000
      LEN := COL2 + COBOL'PB'DB (OPERAND,STRING(COL2));                 00556000
      END                                                               00558000
   ELSE IF %10 <= OPERAND <= %17 THEN                                   00560000
      BEGIN                                                             00562000
      MOVE STRING := "TCCS";                                            00564000
      << SDEC FIELD >>                                                  00566000
      LEN := COL2 + OCTAL (OPERAND.(13:3),STRING(COL2));                00568000
      END                                                               00570000
   ELSE IF %20 <= OPERAND <= %37 THEN                                   00572000
      BEGIN                                                             00574000
      MOVE STRING := "CVND";                                            00576000
      << PUT SIGN CONTROL >>                                            00578000
      LEN := COL2 + OCTAL (OPERAND.(12:3),STRING(COL2));                00580000
      STRING(LEN) := ",";                                               00582000
      << PUT SDEC >>                                                    00584000
      LEN := LEN + 1 +                                                  00586000
             OCTAL (OPERAND.(15:1),STRING(LEN+1));                      00588000
      END                                                               00590000
   ELSE IF %40 <= OPERAND <= %51 THEN                                   00592000
      BEGIN                                                             00594000
      TYPE := OPERAND.(12:3);                                           00596000
      MOVE STRING := COBOL'OPS(TYPE&LSL(2)),(4);                        00598000
      IF TYPE = TR THEN                                                 00600000
         LEN := COL2 + COBOL'PB'DB (OPERAND,STRING(COL2))               00602000
      ELSE << SDEC >>                                                   00604000
         LEN := COL2 + OCTAL (OPERAND.(15:1),STRING(COL2));             00606000
      END                                                               00608000
   ELSE RESULT := INVALID'2NDOP;                                        00610000
                                                                        00612000
END; << PROCEDURE COBOL'2WORD >>                                        00614000
                                                                        00616000
                                                                        00618000
$PAGE              "               ***** COBOL'1WORD *****"             00620000
<<********************************************************************>>00622000
<<  P R O C E D U R E   C O B O L'1 W O R D  >>                         00624000
                                                                        00626000
LOGICAL PROCEDURE COBOL'1WORD (RESULT,STRING,INSTR);                    00628000
   VALUE INSTR;                                                         00630000
   INTEGER RESULT,INSTR;                                                00632000
   BYTE ARRAY STRING;                                                   00634000
   OPTION UNCALLABLE;                                                   00636000
BEGIN                                                                   00638000
   COMMENT:                                                             00640000
      THIS PROCEDURE DECODES 1-WORD COBOL INSTRUCTIONS.                 00642000
                                                                        00644000
      PARAMETERS:                                                       00646000
         RESULT:     OK                                                 00648000
                     INVALID'OPCODE                                     00650000
         STRING:     DESTINATION STRING                                 00652000
         INSTR:      THE INSTRUCTION                                    00654000
                                                                        00656000
      RESULT:        LENGTH OF INSTRUCTION                              00658000
                                                                        00660000
      ASSUMES:       INSTRUCTION IS IN RANGE OF                         00662000
                     COBOL INSTR. (%20460/%20476)                       00664000
      ;                                                                 00666000
   EQUATE                                                               00668000
      NUM'OPS = %17,                                                    00670000
      ALGN0   =   0,  << ALGN WITH SDEC 0 >>                            00672000
      ABSN1   =   3,  << ABSN WITH SDEC 1 >>                            00674000
      EDIT'PB = %10,  << EDIT PB          >>                            00676000
      CMPS'DB = %13;  << CMPS DB          >>                            00678000
                                                                        00680000
   BYTE ARRAY COBOL'OPS (0:NUM'OPS*INSTR'LEN-1) = PB :=                 00682000
      "ALGNALGNABSNABSN                ",                               00684000
      "EDITEDITCMPSCMPSXBR PARCENDP";                                   00686000
                                                                        00688000
   INTEGER                                                              00690000
      TYPE;                                                             00692000
   LOGICAL                                                              00694000
      LEN = COBOL'1WORD;                                                00696000
                                                                        00698000
   LOGICAL SUBROUTINE DEF'COBOL'PB'DB;                                  00700000
                                                                        00702000
   TYPE := INSTR.(12:4);                                                00704000
   MOVE STRING := COBOL'OPS(TYPE&LSL(2)),(4);                           00706000
                                                                        00708000
   << CHECK FOR SDEC AND PB-DB >>                                       00710000
                                                                        00712000
   IF ALGN0 <= TYPE <= ABSN1 THEN                                       00714000
      LEN := COL2 + OCTAL (INSTR.(15:1),STRING(COL2))                   00716000
   ELSE IF EDIT'PB <= TYPE <= CMPS'DB THEN                              00718000
      LEN := COL2 + COBOL'PB'DB (INSTR,STRING(COL2))                    00720000
   ELSE                                                                 00722000
      LEN := OPCODE'LEN (STRING);                                       00724000
                                                                        00726000
   << CHECK FOR 'UNUSED' INSTRUCTION >>                                 00728000
   IF LEN = 0 THEN RESULT := INVALID'OPCODE                             00730000
   ELSE RESULT := OK;                                                   00732000
                                                                        00734000
END;  << PROCEDURE COBOL'1WORD >>                                       00736000
                                                                        00738000
$PAGE              "               ***** OPCODE'2WD' *****"             00740000
                                                                        00742000
$PAGE              "               ***** OPCODE'2WD *****"              00744000
<<********************************************************************>>00746000
<<  P R O C E D U R E   O P C O D E'2 W D  >>                           00748000
LOGICAL PROCEDURE OPCODE'2WD (RESULT,STRING,INSTR,INSTR'WD2);           00750000
   VALUE INSTR,INSTR'WD2;                                               00752000
   INTEGER RESULT,INSTR,INSTR'WD2;                                      00754000
   BYTE ARRAY STRING;                                                   00756000
   OPTION UNCALLABLE;                                                   00758000
BEGIN                                                                   00760000
   COMMENT:                                                             00762000
      THIS PROCEDURE HANDLES TWO WORD INSTRUCTIONS.                     00764000
                                                                        00766000
      PARAMETERS:                                                       00768000
         RESULT:       OK                                               00770000
                       INVALID'2NDOP                                    00772000
         STRING:       DESTINATION STRING                               00774000
         INSTR:        1ST WORD OF INSTR                                00776000
         INSTR'WD2:    2ND WORD OF INSTR                                00778000
                                                                        00780000
      RESULTS:         LENGTH OF THE STRING                             00782000
                                                                        00784000
      ASSUMES:         INSTR IS A VALID 1ST WORD OF                     00786000
                       A 2 WORD INSTRUCTION.                            00788000
      ;                                                                 00790000
   EQUATE                                                               00792000
      NUM'IOOPS = 11,                                                   00794000
      NUM'S33   =  9,                                                   00796000
      DUMP      =%12,                                                   00798000
      SINC      =%10;                                                   00800000
                                                                        00802000
   BYTE ARRAY S33'HARDWARE(0:NUM'S33*INSTR'LEN-1) = PB :=               00804000
      "RCCRSCLRTOFFTON                 SINC";                           00806000
   BYTE ARRAY IO'OPS(0:NUM'IOOPS*INSTR'LEN-1)  = PB :=                  00808000
      "SIOPHIOPRIOCWIOC        INITMCS SEMLSTRTDUMP";                   00810000
                                                                        00812000
   LOGICAL                                                              00814000
      LEN = OPCODE'2WD;                                                 00816000
                                                                        00818000
   IF INSTR = %20477 THEN                                               00820000
      LEN := COBOL'2WORD (RESULT,STRING,INSTR'WD2)                      00822000
   ELSE                                                                 00824000
      BEGIN                                                             00826000
      IF INSTR = %20104 AND INSTR'WD2 <= SINC THEN                      00828000
         MOVE STRING := S33'HARDWARE (INSTR'WD2&LSL(2)),(4)             00830000
      ELSE IF INSTR = %20302 AND INSTR'WD2 <= DUMP THEN                 00832000
         MOVE STRING := IO'OPS (INSTR'WD2&LSL(2)),(4)                   00834000
      ELSE STRING := " "; << MARK INVALID >>                            00836000
                                                                        00838000
      LEN := OPCODE'LEN (STRING);                                       00840000
      IF LEN = 0 THEN RESULT := INVALID'2NDOP                           00842000
      ELSE RESULT := OK;                                                00844000
      END;                                                              00846000
                                                                        00848000
END;  << PROCEDURE OPCODE'2WD >>                                        00850000
                                                                        00852000
$PAGE              "               ***** OPCODE0 *****"                 00854000
<<********************************************************************>>00856000
<<  P R O C E D U R E   O P C O D E 0  >>                               00858000
                                                                        00860000
LOGICAL PROCEDURE OPCODE0(RESULT,STRING,INSTR);                         00862000
   VALUE INSTR;                                                         00864000
   INTEGER RESULT,INSTR;                                                00866000
   BYTE ARRAY STRING;                                                   00868000
   OPTION UNCALLABLE;                                                   00870000
BEGIN                                                                   00872000
   COMMENT:                                                             00874000
      THIS PROCEDURE DECODES STACKOPS (OPCODE = 0).                     00876000
                                                                        00878000
      PARAMETERS:                                                       00880000
         INSTR:   INSTRUCTION TO BE DECODED                             00882000
         STRING:  DESTINATION STRING                                    00884000
         RESULT:  OK                                                    00886000
                  INVALID'OPCODE                                        00888000
                                                                        00890000
      RETURNS:    LENGTH OF STRING                                      00892000
      ;                                                                 00894000
   EQUATE                                                               00896000
      NUM'STACKOPS = 64;                                                00898000
   BYTE ARRAY STACKOPS(0:NUM'STACKOPS*INSTR'LEN-1) = PB :=              00900000
      "NOP DELBDDELZROXINCXDECXZERODZRODCMPDADD",                       00902000
      "DSUBMPYLDIVLDNEGDXCHCMP ADD SUB MPY DIV ",                       00904000
      "NEG TESTSTBXDTSTDFLTBTSTXCH INCADECAXAX ",                       00906000
      "ADAXADXADEL ZROBLDXBSTAXLDXADUP DDUPFLT ",                       00908000
      "FCMPFADDFSUBFMPYFDIVFNEGCAB LCMPLADDLSUB",                       00910000
      "LMPYLDIVNOT OR  XOR AND FIXRFIXT....INCB",                       00912000
      "DECBXBX ADBXADXB";                                               00914000
                                                                        00916000
   RESULT := OK;                                                        00918000
   MOVE STRING := STACKOPS(INSTR.(4:6) & LSL(2)),(4);                   00920000
   IF STRING(3) = " " THEN STRING(3) := ","                             00922000
   ELSE STRING(4) := ",";                                               00924000
   MOVE STRING(COL2) := STACKOPS(INSTR.(10:6) & LSL(2)),(4);            00926000
   OPCODE0 := COL2 + OPCODE'LEN (STRING(COL2));                         00928000
                                                                        00930000
END; << PROCEDURE OPCODE0 >>                                            00932000
                                                                        00934000
                                                                        00936000
$PAGE              "               ***** OPCODE1 *****"                 00938000
<<********************************************************************>>00940000
<<  P R O C E D U R E   O P C O D E 1  >>                               00942000
                                                                        00944000
LOGICAL PROCEDURE OPCODE1(RESULT,STRING,INSTR);                         00946000
   VALUE INSTR;                                                         00948000
   INTEGER RESULT,INSTR;                                                00950000
   BYTE ARRAY STRING;                                                   00952000
   OPTION UNCALLABLE;                                                   00954000
BEGIN                                                                   00956000
   COMMENT:                                                             00958000
      THIS PROCEDURE DISASSEMBLES SHIFT AND BRANCH                      00960000
      INSTRUCTIONS (OPCODE = 1).                                        00962000
                                                                        00964000
      PARAMETERS:                                                       00966000
         INSTR:   INSTRUCTION TO BE DECODED                             00968000
         STRING:  DESTINATION STRING                                    00970000
         RESULT:  OK                                                    00972000
                  INVALID'OPCODE                                        00974000
                                                                        00976000
      RETURNS:    LENGTH OF STRING                                      00978000
      ;                                                                 00980000
   EQUATE                                                               00982000
      NUM'OPCODE1 = 32,                                                 00984000
      QASR        = %57, << INSTR.(4:6) >>                              00986000
      IABZ'       = %7,  << TYPES:  INSTR.(4:4) >>                      00988000
      IXBZ'       = %12,                                                00990000
      BNCY        = %15,                                                00992000
      CPRB        = %26,                                                00994000
      BNOV        = %31,                                                00996000
      BRO         = %36,                                                00998000
      SCAN'       = %6,                                                 01000000
      TNSL        = %16,                                                01002000
      QASL'QASR   = %17;                                                01004000
   BYTE ARRAY NEUMONICS(0:NUM'OPCODE1*INSTR'LEN-1) = PB :=              01006000
      "ASL ASR LSL LSR CSL CSR SCANIABZTASLTASRIXBZDXBZBCY ",           01008000
      "BNCYTNSLQASLDASLDASRDLSLDLSRDCSLDCSRCPRBDABZBOV BNOV",           01010000
      "TBC TRBCTSBCTCBCBRO BRE ";                                       01012000
   INTEGER                                                              01014000
      TYPE;                                                             01016000
   LOGICAL                                                              01018000
      LEN = OPCODE1;                                                    01020000
                                                                        01022000
   RESULT := OK;                                                        01024000
   TYPE := INSTR.(5:5);                                                 01026000
                                                                        01028000
   << SELECT APPROPRIATE OPCODE >>                                      01030000
   IF INSTR.(4:6) = QASR THEN                                           01032000
      MOVE STRING := "QASR"                                             01034000
   ELSE MOVE STRING := NEUMONICS(TYPE & LSL (2)),(4);                   01036000
                                                                        01038000
   IF TYPE = IABZ' OR                                                   01040000
      IXBZ' <= TYPE <= BNCY OR                                          01042000
      CPRB  <= TYPE <= BNOV OR                                          01044000
      TYPE  >= BRO THEN                                                 01046000
      BEGIN                                                             01048000
         << P-RELATIVE BRANCH >>                                        01050000
         LEN := COL'REG + REGISTER (P'32,INSTR,STRING(COL'REG));        01052000
         IF INSTR.(4:1) = 1 THEN << INDIRECT ADDRESS >>                 01054000
            BEGIN                                                       01056000
            MOVE STRING(LEN) := ",I";                                   01058000
            LEN := LEN+2;                                               01060000
            END;                                                        01062000
      END                                                               01064000
   ELSE IF TYPE = SCAN' OR TYPE = TNSL THEN                             01066000
      BEGIN                                                             01068000
      IF INSTR.(4:1) = 0 THEN LEN := 4                                  01070000
      ELSE                                                              01072000
         BEGIN                                                          01074000
         STRING(COL2) := "X";                                           01076000
         LEN := COL2+1;                                                 01078000
         END;                                                           01080000
      END                                                               01082000
   ELSE                                                                 01084000
      BEGIN                                                             01086000
      << TEST BIT OR SHIFT INSTRUCTION, BITS >>                         01088000
      << 10/15 CONTAIN A BIT POSITION OR SHIFT COUNT >>                 01090000
      LEN := COL2 + OCTAL (INSTR.(10:6),STRING(COL2));                  01092000
      IF INSTR.(4:1) = 1 AND TYPE <> QASL'QASR THEN                     01094000
         BEGIN                                                          01096000
         MOVE STRING(LEN) := ",X";                                      01098000
         LEN := LEN+2;                                                  01100000
         END;                                                           01102000
      END;                                                              01104000
                                                                        01106000
END; << PROCEDURE OPCODE1 >>                                            01108000
                                                                        01110000
                                                                        01112000
$PAGE              "               ***** OPCODE2 *****"                 01114000
<<********************************************************************>>01116000
<<  P R O C E D U R E   O P C O D E 2  >>                               01118000
                                                                        01120000
LOGICAL PROCEDURE OPCODE2(RESULT,STRING,INSTR);                         01122000
   VALUE INSTR;                                                         01124000
   INTEGER RESULT,INSTR;                                                01126000
   BYTE ARRAY STRING;                                                   01128000
   OPTION UNCALLABLE;                                                   01130000
BEGIN                                                                   01132000
   COMMENT:                                                             01134000
      THIS PROCEDURE DISASSEMBLES MOVES, IMMEDIATES AND                 01136000
      ARITHMETIC INSTRUCTIONS (OPCODE = 2).                             01138000
                                                                        01140000
      PARAMETERS:                                                       01142000
         INSTR:   INSTRUCTION TO BE DECODED                             01144000
         STRING:  DESTINATION STRING                                    01146000
         RESULT:  OK                                                    01148000
                  INVALID'OPCODE                                        01150000
                                                                        01152000
      RETURNS:    LENGTH OF STRING                                      01154000
      ;                                                                 01156000
   EQUATE                                                               01158000
      NUM'OPERANDOPS = 14,                                              01160000
      NUM'SDECOPS    = 24,                                              01162000
      NUM'SPECIALOPS = 36,                                              01164000
      NUM'DECIMALOPS = 11,                                              01166000
      PSHR           = 9,   << INSTR.(4:4)  >>                          01168000
      SETR           = 15,  << INSTR.(4:4)  >>                          01170000
      EXF            = 13,  << INSTR.(4:4)  >>                          01172000
      DPF            = 14,  << INSTR.(4:4)  >>                          01174000
      MVBW           = 4,   << INSTR.(7:4)  >>                          01176000
      DMPY           = 1,   << INSTR.(12:4) >>                          01178000
      CVAD           = 2,   << INSTR.(12:4) >>                          01180000
      CVDA           = 3,   << INSTR.(12:4) >>                          01182000
      CVDB           = 5,   << INSTR.(12:4) >>                          01184000
      MPYD           = 12,  << INSTR.(12:4) >>                          01186000
      PSTA           = 13,  << INSTR.(7:5)  >>                          01188000
      EA'TYPE        = 14,  << INSTR.(7:5)  >>                          01190000
      COBOL'INSTR    = 19,  << INSTR.(7:5)  >>                          01192000
      DDIV           = 23,  << INSTR.(7:5)  >>                          01194000
      MAX'REG'LEN    = 3,   << REG LEN PSHR >>                          01196000
      NUM'REG        = 8;                                               01198000
                                                                        01200000
   BYTE ARRAY OPERAND'OPS(0:NUM'OPERANDOPS*INSTR'LEN-1) = PB :=         01202000
      "LDI LDXICMPIADDISUBIMPYIDIVIPSHRLDNI",                           01204000
      "LDXNCMPNEXF DPF SETR";                                           01206000
                                                                        01208000
   BYTE ARRAY SDEC'OPS(0:NUM'SDECOPS*INSTR'LEN-1) = PB :=               01210000
      "MOVEMOVEMOVEMOVEMVB MVB MVB MVB ",                               01212000
      "MVBLMABSSCW MTDSMVLBMDS SCU MFDS",                               01214000
      "MVBWMVBWMVBWMVBWCMPBCMPBCMPBCMPB";                               01216000
                                                                        01218000
   BYTE ARRAY DECIMALOPS(0:NUM'DECIMALOPS*INSTR'LEN-1) = PB :=          01220000
      "CVADCVDACVBDCVDBSLD ",                                           01222000
      "NSLDSRD ADDDCMPDSUBDMPYD";                                       01224000
                                                                        01226000
   BYTE ARRAY SPECIAL'OPS(0:NUM'SPECIALOPS*INSTR'LEN-1) = PB :=         01228000
      "RSW LLSHPLDAPSTA",                                               01230000
      "LSEASSEALDEASDEA",                                               01232000
      "IXITLOCKPCN UNLK",                                               01234000
      "TADDTSUBTMPYTDIVTNEGTCMP",    <<3-WORD FLPT>>                    01236000
      "EADDESUBEMPYEDIVENEGECMP",    <<4-WORD FLPT>>                    01238000
      "LDWVSTWVMWFVMWTV",            <<VIRTUAL>>                        01240000
      "MBFVMBTVLDBVSTBVMVWV",        <<VIRTUAL>>                        01242000
      "DMULDDIVDMPY";                                                   01244000
                                                                        01246000
   INTEGER ARRAY SPECIALCODES(0:NUM'SPECIALOPS-1) = PB :=               01248000
      %020300,%020301,%020320,%020321,                                  01250000
      %020340,%020341,%020342,%020343,                                  01252000
      %020360,%020361,%020362,%020363,                                  01254000
      %020400,%020401,%020402,%020403,%020404,%020405,                  01256000
      %020410,%020411,%020412,%020413,%020414,%020415,                  01258000
      %020420,%020421,%020422,%020423,                                  01260000
      %020424,%020425,%020426,%020427,%020430,                          01262000
      %020570,%020571,                                                  01264000
      %020601;                                                          01266000
                                                                        01268000
   BYTE ARRAY REG'ARR(0:NUM'REG*MAX'REG'LEN -1) = PB :=                 01270000
      "SB,DB,DL,Z, ST,X, Q, S, ";                                       01272000
                                                                        01274000
   INTEGER ARRAY REG'LEN(0:NUM'REG-1) = PB :=                           01276000
      3,3,3,2,3,2,2,2;                                                  01278000
                                                                        01280000
   INTEGER                                                              01282000
      TYPE,                                                             01284000
      SDEC,                                                             01286000
      BIT,                                                              01288000
      ENDBIT,                                                           01290000
      INC,                                                              01292000
      I;                                                                01294000
   LOGICAL                                                              01296000
      FOUND,                                                            01298000
      APPENDLEN,                                                        01300000
      LEN = OPCODE2;                                                    01302000
                                                                        01304000
   LOGICAL SUBROUTINE ANS(INSTR,STRING);                                01306000
      VALUE INSTR;                                                      01308000
      INTEGER INSTR;                                                    01310000
      BYTE ARRAY STRING;                                                01312000
   BEGIN                                                                01314000
      COMMENT:                                                          01316000
         THIS SUBROUTINE DECODES THE ANS FIELD OF THE                   01318000
         MVBW INSTRUCTION.  IT RETURNS THE LENGTH OF                    01320000
         THE FIELD.;                                                    01322000
      I := -1;                                                          01324000
      IF INSTR.(12:1) = 1 THEN STRING(I:=I+1) := "A";                   01326000
      IF INSTR.(11:1) = 1 THEN STRING(I:=I+1) := "N";                   01328000
      IF INSTR.(13:1) = 1 THEN STRING(I:=I+1) := "S";                   01330000
      IF I<>-1 THEN STRING(I:=I+1) := ",";                              01332000
      ANS := I+1;                                                       01334000
   END; << SUBROUTINE ANS >>                                            01336000
                                                                        01338000
   LOGICAL SUBROUTINE TESTBIT (WORD,BIT);                               01340000
      VALUE WORD,BIT;                                                   01342000
      INTEGER WORD,BIT;                                                 01344000
   BEGIN                                                                01346000
      COMMENT:                                                          01348000
         THIS ROUTINE RETURNS TRUE IF 'BIT' IS                          01350000
         SET IN WORD                                                    01352000
         ;                                                              01354000
      X := BIT;                                                         01356000
      TOS := WORD;                                                      01358000
      ASSEMBLE (TBC 0,X);                                               01360000
      DEL;                                                              01362000
      IF = THEN TESTBIT := FALSE                                        01364000
      ELSE TESTBIT := TRUE;                                             01366000
   END; << SUBROUTINE TESTBIT >>                                        01368000
                                                                        01370000
   LOGICAL SUBROUTINE LIST'REGISTERS(INSTR,TYPE,STRING);                01372000
      VALUE INSTR,TYPE;                                                 01374000
      INTEGER INSTR,TYPE;                                               01376000
      BYTE ARRAY STRING;                                                01378000
   BEGIN                                                                01380000
      COMMENT:                                                          01382000
         THIS SUBROUTINE DECODES THE REGISTER FIELD OF                  01384000
         THE PSHR AND SETR INSTRUCTIONS. TYPE INDICATES                 01386000
         THE TYPE OF INSTR.  IT RETURNS THE LENGTH.                     01388000
         ;                                                              01390000
      IF TYPE = PSHR THEN                                               01392000
         BEGIN  << LIST FROM S,Q ... SB >>                              01394000
         BIT := 16;  <<START BIT PLUS 1 >>                              01396000
         ENDBIT := 8;                                                   01398000
         INC := -1;                                                     01400000
         END                                                            01402000
      ELSE                                                              01404000
         BEGIN       << LIST FROM SB ... Q,S >>                         01406000
         BIT := 7;   << START BIT LESS 1     >>                         01408000
         ENDBIT := 15;                                                  01410000
         INC := 1;                                                      01412000
         END;                                                           01414000
                                                                        01416000
      I := 0;  << LEN >>                                                01418000
      DO                                                                01420000
         BEGIN                                                          01422000
         BIT := BIT + INC; << NEXT BIT >>                               01424000
         IF TESTBIT (INSTR,BIT) THEN                                    01426000
            BEGIN                                                       01428000
            MOVE STRING(I) := REG'ARR((BIT-8)*MAX'REG'LEN),             01430000
                                 (MAX'REG'LEN);                         01432000
            I := I + REG'LEN(BIT-8);                                    01434000
            END;                                                        01436000
         END                                                            01438000
      UNTIL BIT = ENDBIT;                                               01440000
                                                                        01442000
      STRING(I) := " "; << REMOVE LAST COMMA >>                         01444000
      LIST'REGISTERS := I - 1;                                          01446000
   END; << SUBROUTINE LIST'REGISTER >>                                  01448000
                                                                        01450000
                                                                        01452000
   LOGICAL SUBROUTINE PB'DB(INSTR,STRING);                              01454000
      VALUE INSTR;                                                      01456000
      INTEGER INSTR;                                                    01458000
      BYTE ARRAY STRING;                                                01460000
   BEGIN                                                                01462000
      COMMENT:                                                          01464000
         THIS SUBROUTINE DECODES THE P(D)B-DB FIELD OF                  01466000
         THE MOVE AND COMPARE INSTRUCTIONS.  IT RETURNS                 01468000
         THE LENGTH OF THE FIELD.;                                      01470000
      IF INSTR.(11:1) = 1 THEN                                          01472000
         MOVE STRING := "DB-DB,"                                        01474000
      ELSE MOVE STRING := "PB-DB,";                                     01476000
      PB'DB := 6;                                                       01478000
   END; << SUBROUTINE PB'DB >>                                          01480000
                                                                        01482000
   << *****START OF PROCEDURE***** >>                                   01484000
                                                                        01486000
   RESULT := OK;                                                        01488000
   IF INSTR.(4:3) <> 0 THEN                                             01490000
      BEGIN << INSTRUCTION WITH OPERAND >>                              01492000
      TYPE := INSTR.(4:4);                                              01494000
      MOVE STRING := OPERAND'OPS((TYPE-2) & LSL(2)),(4);                01496000
      IF TYPE = PSHR OR TYPE = SETR THEN                                01498000
         LEN := COL2 + LIST'REGISTERS(INSTR,TYPE,STRING(COL2))          01500000
      ELSE IF TYPE = EXF OR TYPE = DPF THEN                             01502000
         BEGIN                                                          01504000
         << CONSTRUCT  START:LENGTH FIELD >>                            01506000
         LEN := COL2 + OCTAL(INSTR.(8:4),STRING(COL2));                 01508000
         STRING(LEN) := ":";                                            01510000
         LEN := LEN + 1 + OCTAL(INSTR.(12:4),STRING(LEN+1));            01512000
         END                                                            01514000
      ELSE LEN := COL2 + OCTAL(INSTR.(8:8),STRING(COL2));               01516000
      END                                                               01518000
   ELSE IF INSTR.(7:3) < 3 THEN                                         01520000
      BEGIN << INSTRUCTION WITH SDEC >>                                 01522000
      MOVE STRING := SDEC'OPS((INSTR.(7:6)) & LSL(2)),(4);              01524000
      IF INSTR.(7:3) = 1 THEN                                           01526000
         BEGIN << MVBL/MFDS >>                                          01528000
         APPENDLEN := 0;                                                01530000
         SDEC := IF INSTR.(12:1) = 1 THEN INSTR.(13:3)                  01532000
                 ELSE INSTR.(14:2);                                     01534000
         END                                                            01536000
      ELSE                                                              01538000
         BEGIN << MVBW, MOVE, MVB, & CMPB >>                            01540000
         APPENDLEN := IF INSTR.(7:4) = MVBW THEN                        01542000
                         ANS (INSTR,STRING(COL2))                       01544000
                      ELSE PB'DB (INSTR,STRING(COL2));                  01546000
         SDEC := INSTR.(14:2);                                          01548000
         END;                                                           01550000
      LEN := COL2+APPENDLEN+OCTAL(SDEC,STRING(COL2+APPENDLEN));         01552000
      END                                                               01554000
   ELSE IF INSTR.(7:3) >= 6 AND                                         01556000
           CVAD <= INSTR.(12:4) <= MPYD THEN                            01558000
      BEGIN << DECIMAL OPS -- CVAD/MPYD >>                              01560000
      TYPE := INSTR.(12:4);                                             01562000
      MOVE STRING := DECIMALOPS((TYPE-2) & LSL(2)),(4);                 01564000
      IF TYPE = CVDA AND INSTR.(9:2) <> 0 THEN                          01566000
         BEGIN << SIGN CONTROL >>                                       01568000
         IF INSTR.(9:2) = 1 THEN                                        01570000
            MOVE STRING(COL2) := "ABS, "                                01572000
         ELSE                                                           01574000
            MOVE STRING(COL2) := "NABS,";                               01576000
         LEN := COL2 + 5;                                               01578000
         END                                                            01580000
      ELSE LEN := COL2;                                                 01582000
      IF CVAD <= TYPE <= CVDB THEN SDEC := INSTR.(11:1)                 01584000
      ELSE SDEC := INSTR.(10:2);                                        01586000
      LEN := LEN + OCTAL(SDEC,STRING(LEN));                             01588000
      END                                                               01590000
   ELSE                                                                 01592000
      BEGIN << SPECIALS -- RSW/DMPY& COBOL INSTR. >>                    01594000
      TYPE := INSTR.(7:5);                                              01596000
      IF TYPE = COBOL'INSTR THEN                                        01598000
         LEN := COBOL'1WORD (RESULT,STRING,INSTR)                       01600000
      ELSE                                                              01602000
         BEGIN                                                          01604000
         << ZERO ANY 'IGNORED' FIELDS IN THE SPECIALS >>                01606000
         IF TYPE <= PSTA THEN INSTR.(12:3) := 0                         01608000
         ELSE IF TYPE <= EA'TYPE THEN INSTR.(12:2) := 0                 01610000
         ELSE IF TYPE > DDIV THEN INSTR.(9:3) := 0;                     01612000
         I := 0;                                                        01614000
         FOUND := FALSE;                                                01616000
         WHILE I < NUM'SPECIALOPS AND NOT FOUND DO                      01618000
            BEGIN                                                       01620000
            IF SPECIALCODES(I) = INSTR THEN                             01622000
               BEGIN                                                    01624000
               MOVE STRING := SPECIAL'OPS(I & LSL(2)),(4);              01626000
               FOUND := TRUE;                                           01628000
               END                                                      01630000
            ELSE I := I+1;                                              01632000
            END;                                                        01634000
         IF NOT FOUND THEN RESULT := INVALID'OPCODE;                    01636000
         LEN := OPCODE'LEN (STRING);                                    01638000
         END;                                                           01640000
      END; << SPECIALS >>                                               01642000
                                                                        01644000
END; << PROCEDURE OPCODE2 >>                                            01646000
                                                                        01648000
                                                                        01650000
$PAGE              "               ***** OPCODE3 *****"                 01652000
<<********************************************************************>>01654000
<<  P R O C E D U R E   O P C O D E 3  >>                               01656000
                                                                        01658000
LOGICAL PROCEDURE OPCODE3(RESULT,STRING,INSTR);                         01660000
   VALUE INSTR;                                                         01662000
   INTEGER RESULT,INSTR;                                                01664000
   BYTE ARRAY STRING;                                                   01666000
   OPTION UNCALLABLE;                                                   01668000
BEGIN                                                                   01670000
   COMMENT:                                                             01672000
      THIS PROCEDURE DISASSEMBLES I/O, LINKAGE, AND                     01674000
      CONTROL INSTRUCTIONS (OPCODE = 3).                                01676000
                                                                        01678000
      PARAMETERS:                                                       01680000
         INSTR:   INSTRUCTION TO BE DECODED                             01682000
         STRING:  DESTINATION STRING                                    01684000
         RESULT:  OK                                                    01686000
                  INVALID'OPCODE                                        01688000
                                                                        01690000
      RETURNS:    LENGTH OF STRING                                      01692000
      ;                                                                 01694000
   EQUATE                                                               01696000
      NUM'SPECIALS   = 10,                                              01698000
      NUM'IOOPS      = 16,                                              01700000
      NUM'OPERANDOPS = 16,                                              01702000
      IO'OR'SPECIAL  = 0,                                               01704000
      SED            = 2,   << SUBTYPES:  INSTR.(8:4) >>                01706000
      RCLK           = 5,                                               01708000
      PAUS           = 1,                                               01710000
      LST            = 0,                                               01712000
      SST            = 13,                                              01714000
      SIO            = 7,                                               01716000
      CMD            = 12,                                              01718000
      SIN            = 14,                                              01720000
      HALT           = 15,                                              01722000
      SCAL           = 1,   << TYPES:  INSTR.(4:4) >>                   01724000
      PCAL           = 2,                                               01726000
      LLBL           = 7,                                               01728000
      LDPP           = 8,                                               01730000
      LDPN           = 9,                                               01732000
      SPARE          = 12;                                              01734000
   BYTE ARRAY SPECIAL'OPS(0:NUM'SPECIALS*INSTR'LEN-1) = PB :=           01736000
      "SED SED XCHDPSDBDISPPSEBSMSKSCLKRMSKRCLK";                       01738000
   BYTE ARRAY IO'OPS(0:NUM'IOOPS*INSTR'LEN-1) = PB :=                   01740000
      "LST PAUS----------------XEQ SIO RIO WIO TIO CIO ",               01742000
      "CMD SST SIN HALT";                                               01744000
   BYTE ARRAY OPERAND'OPS(0:NUM'OPERANDOPS*INSTR'LEN-1) = PB :=         01746000
      "----SCALPCALEXITSXITADXISBXILLBLLDPPLDPNADDSSUBS",               01748000
      "----ORI XORIANDI";                                               01750000
   INTEGER ARRAY SPECIALCODES(0:NUM'SPECIALS-1) = PB :=                 01752000
      %030040,%030041,%030060,%030061,%030062,%030063,                  01754000
      %030100,%030101,%030120,%030121;                                  01756000
   INTEGER                                                              01758000
      I,                                                                01760000
      TYPE,                                                             01762000
      SUBTYPE;                                                          01764000
   LOGICAL                                                              01766000
      FOUND,                                                            01768000
      LEN = OPCODE3;                                                    01770000
                                                                        01772000
   TYPE := INSTR.(4:4);                                                 01774000
   SUBTYPE := INSTR.(8:4);                                              01776000
                                                                        01778000
   IF TYPE = IO'OR'SPECIAL THEN                                         01780000
      BEGIN                                                             01782000
      IF SED <= SUBTYPE <= RCLK THEN                                    01784000
         BEGIN << SPECIAL >>                                            01786000
         I := 0;                                                        01788000
         FOUND := FALSE;                                                01790000
         WHILE I < NUM'SPECIALS AND NOT FOUND DO                        01792000
            BEGIN                                                       01794000
            IF SPECIALCODES(I) = INSTR THEN                             01796000
               BEGIN                                                    01798000
               MOVE STRING := SPECIAL'OPS(I & LSL(2)),(4);              01800000
               FOUND := TRUE;                                           01802000
               IF SUBTYPE = SED THEN                                    01804000
                  BEGIN                                                 01806000
                  STRING(COL2) := IF INSTR.(15:1) = 1 THEN "1"          01808000
                                  ELSE "0";                             01810000
                  LEN := COL2 + 1;                                      01812000
                  END                                                   01814000
               ELSE LEN := OPCODE'LEN (STRING);                         01816000
               END                                                      01818000
            ELSE I := I+1;                                              01820000
            END;                                                        01822000
          END                                                           01824000
      ELSE                                                              01826000
         BEGIN << IO'OPS >>                                             01828000
         MOVE STRING := IO'OPS(SUBTYPE & LSL(2)),(4);                   01830000
         IF SUBTYPE = PAUS OR SUBTYPE = HALT THEN                       01832000
            LEN := COL2 + OCTAL (INSTR.(12:4),STRING(COL2))             01834000
         ELSE IF SUBTYPE = LST OR SUBTYPE = SST THEN                    01836000
            LEN := COL'REG +                                            01838000
                   REGISTER (SYS'REL,INSTR,STRING(COL'REG))             01840000
         ELSE IF THISCPU = SERIES'33 AND                                01842000
                 ( (SIO <= SUBTYPE <= CMD) OR SUBTYPE = SIN ) THEN      01844000
            LEN := 0                                                    01846000
         ELSE LEN := COL'REG +                                          01848000
                     REGISTER (S'REG,INSTR,STRING(COL'REG));            01850000
         END;                                                           01852000
      END                                                               01854000
   ELSE                                                                 01856000
      BEGIN << OPERAND OP >>                                            01858000
      MOVE STRING := OPERAND'OPS(TYPE & LSL(2)),(4);                    01860000
      IF TYPE = LLBL OR TYPE = SCAL OR TYPE = PCAL THEN                 01862000
         LEN := COL'REG + REGISTER(STT,INSTR,STRING(COL'REG))           01864000
      ELSE IF TYPE = LDPP OR TYPE =LDPN THEN                            01866000
         LEN := COL'REG + REGISTER(PDQS,INSTR,STRING(COL'REG))          01868000
      ELSE IF TYPE <> SPARE THEN                                        01870000
         LEN := COL2 + OCTAL(INSTR.(8:8),STRING(COL2))                  01872000
      ELSE LEN := 0;                                                    01874000
      END;                                                              01876000
   IF LEN = 0 THEN RESULT := INVALID'OPCODE                             01878000
   ELSE RESULT := OK;                                                   01880000
                                                                        01882000
                                                                        01884000
END; << PROCEDURE OPCODE3 >>                                            01886000
                                                                        01888000
                                                                        01890000
$PAGE              "               ***** OPCODE'MEM *****"              01892000
<<********************************************************************>>01894000
<<  P R O C E D U R E   O P C O D E ' M E M  >>                         01896000
                                                                        01898000
LOGICAL PROCEDURE OPCODE'MEM(RESULT,STRING,INSTR);                      01900000
   VALUE INSTR;                                                         01902000
   INTEGER RESULT,INSTR;                                                01904000
   BYTE ARRAY STRING;                                                   01906000
   OPTION UNCALLABLE;                                                   01908000
BEGIN                                                                   01910000
   COMMENT:                                                             01912000
      THIS PROCEDURE DISASSEMBLE MEMORY REFERENCE                       01914000
      INSTRUCTIONS (OPCODE >= 4).                                       01916000
                                                                        01918000
      PARAMETERS:                                                       01920000
         INSTR:   INSTRUCTION TO BE DECODED                             01922000
         STRING:  DESTINATION STRING                                    01924000
         RESULT:  OK                                                    01926000
                  INVALID'OPCODE                                        01928000
                                                                        01930000
      RETURNS:    LENGTH OF STRING                                      01932000
      ;                                                                 01934000
   EQUATE                                                               01936000
      NUM'MEM      = 24,                                                01938000
      NUM'BCC      = 8,                                                 01940000
      NUM'LOOPCONT = 4,                                                 01942000
      INC'DEC      = %12,                                               01944000
      LDB'LDD      = %15,                                               01946000
      STB'STD      = %16;                                               01948000
   BYTE ARRAY MEMORYREF(0:NUM'MEM*INSTR'LEN-1) = PB :=                  01950000
      "LOADLOAD----STORCMPMCMPMADDMADDMSUBMSUBMMPYMMPYM",               01952000
      "INCMDECMLDX LDX BR  BR  LDB LDD STB STD LRA LRA ";               01954000
   BYTE ARRAY BRANCHCOND(0:NUM'BCC*INSTR'LEN-1) = PB :=                 01956000
      "BNOPBL  BE  BLE BG  BNE BGE BALL";                               01958000
   BYTE ARRAY LOOPCONT(0:NUM'LOOPCONT*INSTR'LEN-1) = PB :=              01960000
      "TBA MTBATBX MTBX";                                               01962000
   INTEGER                                                              01964000
      OPCODE,                                                           01966000
      ADDR'MODE;                                                        01968000
   LOGICAL                                                              01970000
      LEN = OPCODE'MEM;                                                 01972000
                                                                        01974000
   LOGICAL SUBROUTINE I'X(INSTR,STRING);                                01976000
      VALUE INSTR;                                                      01978000
      INTEGER INSTR;                                                    01980000
      BYTE ARRAY STRING;                                                01982000
   BEGIN                                                                01984000
      << DISASSEMBLE I,X >>                                             01986000
      ADDR'MODE := INSTR.(4:2);                                         01988000
      CASE ADDR'MODE OF                                                 01990000
         BEGIN                                                          01992000
         <<0>> TOS := @STRING;                                          01994000
         <<1>> MOVE STRING := ",I",2;                                   01996000
         <<2>> MOVE STRING := ",X",2;                                   01998000
         <<3>> MOVE STRING := ",I,X",2;                                 02000000
         END;                                                           02002000
      << GET LENGTH OF MOVE--IX := TOS-@STRING >>                       02004000
      S4 := TOS - S2;                                                   02006000
   END; << SUBROUTINE I'X >>                                            02008000
                                                                        02010000
   OPCODE := INSTR.(0:4);                                               02012000
                                                                        02014000
   RESULT := OK;                                                        02016000
   IF OPCODE = %14 AND INSTR.(5:2) = 1 THEN                             02018000
      BEGIN << BCC >>                                                   02020000
      MOVE STRING := BRANCHCOND((INSTR.(7:3) & LSL(2))),(4);            02022000
      LEN := COL'REG + REGISTER(P'32,INSTR,STRING(COL'REG));            02024000
      IF LOGICAL(INSTR.(4:1)) THEN                                      02026000
         BEGIN                                                          02028000
         MOVE STRING(LEN) := ",I";                                      02030000
         LEN := LEN + 2;                                                02032000
         END;                                                           02034000
      END                                                               02036000
   ELSE IF OPCODE <> 5 OR INSTR.(6:1) = 1  THEN                         02038000
      BEGIN << MEMORY REF INSTR >>                                      02040000
      MOVE STRING := MEMORYREF(((OPCODE-4)*2+INSTR.(6:1)) & LSL(2)),(4);02042000
      IF OPCODE=INC'DEC OR LDB'LDD <= OPCODE <= STB'STD THEN            02044000
         INSTR.(6:1) := 1; << MARK AS DQS INSTRUCTION >>                02046000
      LEN := COL'REG + REGISTER(PDQS,INSTR,STRING(COL'REG));            02048000
      LEN := LEN + I'X(INSTR,STRING(LEN));                              02050000
      END                                                               02052000
   ELSE                                                                 02054000
      BEGIN << LOOP CONTROL INSTRUCTIONS >>                             02056000
      MOVE STRING := LOOPCONT(INSTR.(4:2) & LSL(2)),(4);                02058000
      LEN := COL'REG + REGISTER(PDQS,INSTR,STRING(COL'REG));            02060000
      END;                                                              02062000
                                                                        02064000
END; << PROCEDURE OPCODE'MEM >>                                         02066000
                                                                        02068000
                                                                        02070000
$PAGE              "               ***** DEASSEMBLE *****"              02072000
<<********************************************************************>>02074000
<<  P R O C E D U R E   D E A S S E M B L E  >>                         02076000
                                                                        02078000
LOGICAL PROCEDURE DEASSEMBLE(RESULT,STRING,INSTR,INSTR'WORD2);          02080000
   VALUE INSTR,INSTR'WORD2;                                             02082000
   INTEGER RESULT,INSTR,INSTR'WORD2;                                    02084000
   BYTE ARRAY STRING;                                                   02086000
   OPTION VARIABLE,UNCALLABLE,PRIVILEGED;                               02088000
BEGIN                                                                   02090000
   COMMENT:                                                             02092000
      RETURN IN STRING THE MNEUMONIC FORM OF                            02094000
      THE INSTRUCTION CONTAINED IN INSTR (INSTR'WORD2).    R            02096000
                                                                        02098000
      PARAMETERS:                                                       02100000
         RESULT:       RESULT OF DEASSEMBLE (REQUIRED)                  02102000
                       0:  OK                                           02104000
                       1:  INVALID OPCODE                               02106000
                       2:  2ND WORD OF 2 WORD INSTR. NOT PASSED         02108000
                       3:  2ND WORD OF 2 WORD INSTR. IS INVALID         02110000
                      -1:  1 WORD INSTR, WORD 2 PASSED BUT              02112000
                           IGNORED                                      02114000
         STRING:       DESTINATION STRING - AT LEAST 25 BYTES LONG      02116000
                       (REQUIRED PARAMETER)                             02118000
         INSTR:        WORD 1 OF INSTRUCTION (REQUIRED)                 02120000
         INSTR'WORD2:  WORD 2 OF INSTR (OPTIONAL)                       02122000
                                                                        02124000
      RETURNS:         LENGTH OF DECODED INSTRUCTION                    02126000
      ;                                                                 02128000
   DEFINE                                                               02130000
      WORD2'PRESENT = PARMMASK.(15:1) #,                                02132000
      OP'FIELD      = (0:4) #;                                          02134000
                                                                        02136000
   LOGICAL                                                              02138000
      LEN = DEASSEMBLE;                                                 02140000
                                                                        02142000
   LOGICAL SUBROUTINE TWO'WORDINST (INSTR);                             02144000
      VALUE INSTR;                                                      02146000
      INTEGER INSTR;                                                    02148000
   BEGIN                                                                02150000
      COMMENT: THIS ROUTINE DETERMINES WHETHER                          02152000
         INSTR IS THE 1ST WORD OF 2 WORD INSTR.                         02154000
         ;                                                              02156000
      IF INSTR = %20477 OR                                              02158000
         THISCPU = SERIES'33 AND                                        02160000
         (INSTR = %20104 OR INSTR = %20302)                             02162000
      THEN TWO'WORDINST := TRUE                                         02164000
      ELSE TWO'WORDINST := FALSE;                                       02166000
   END; << SUBROUTINE TWO'WORDINST >>                                   02168000
                                                                        02170000
   << DEBLANK STRING >>                                                 02172000
   STRING := " ";                                                       02174000
   MOVE STRING(1) := STRING,(24);                                       02176000
                                                                        02178000
   IF TWO'WORDINST (INSTR) THEN                                         02180000
      BEGIN                                                             02182000
      IF NOT WORD2'PRESENT THEN RESULT := MISSING'2NDOP                 02184000
      ELSE                                                              02186000
         LEN := OPCODE'2WD (RESULT,STRING,INSTR,INSTR'WORD2);           02188000
      END                                                               02190000
   ELSE                                                                 02192000
      BEGIN                                                             02194000
      CASE INSTR.OP'FIELD OF                                            02196000
         BEGIN                                                          02198000
         LEN := OPCODE0 (RESULT,STRING,INSTR);                          02200000
         LEN := OPCODE1 (RESULT,STRING,INSTR);                          02202000
         LEN := OPCODE2 (RESULT,STRING,INSTR);                          02204000
         LEN := OPCODE3 (RESULT,STRING,INSTR);                          02206000
         END;                                                           02208000
      IF INSTR.OP'FIELD >= 4 THEN                                       02210000
         LEN := OPCODE'MEM (RESULT,STRING,INSTR);                       02212000
      << IF INSTR'WORD2 WAS PASSED GIVE WARNING ... >>                  02214000
      << UNLESS A MORE SERIOUS ERROR OCCURED        >>                  02216000
      IF WORD2'PRESENT AND RESULT = OK THEN                             02218000
         RESULT := IGNORED'2NDOP;                                       02220000
      END;                                                              02222000
                                                                        02224000
END; << PROCEDURE DEASSEMBLE >>                                         02226000
$CONTROL SEGMENT=MAIN                                                   02228000
END.                                                                    02230000
