Retro1.org codex

NDAS

[00002] PROC NDAS
[00019] PROC ABORT
[00020] PROC MESSAGE
[00021] PROC READSR
[00022] PROC RECALL
[00023] PROC RETERN
[00024] PROC REWIND
[00025] PROC WRITEF
[00026] PROC WRITEH
[00027] PROC WRITER
[00028] PROC WRITESR
[00029] PROC OPENSIO
[00030] PROC CLOSSIO
[00031] PROC FINDRI
[00032] PROC READRI
[00033] PROC WRITERI
[00034] PROC READH
[00035] PROC READ
[00036] PROC BKSP
[00037] PROC MOVE
[00038] FUNC XCHD C(10)
[00039] FUNC XCDD C(10)
[00040] FUNC XCOD C(10)
[00729] PROC CRACK
[01098] PROC BADPARM(NUMBER,(VALUE),COUNT)
[01160] PROC FINDZERO¹⁾ [03647] PROC GETRAN ²⁾ [03738] PROC PRINTH(OUTBUF,OUTLEN) [03792] PROC HEADING [03851] PROC DISHEX(DISIN,HEXOUT,CHARLEN,ERRORI) [03922] PROC HEXDIS³⁾ [03986] PROC PTRMISS⁴⁾ [04039] PROC WRITERR(FNAME,REC,(CODE)) [04087] PROC PRDFILE </WRAP> === Source Code ===
NDAS.txt
*DECK NDAS
      PROC NDAS; # NDA - NETWORK DUMP ANALYZER #
*IF DEF,IMS 
 #
**
*E
*     NETWORK PRODUCTS DOCUMENTATION
* 
*     NETWORK UTILITY INTERNAL MAINTAINENCE SPECIFICATION 
* 
*     NETWORK DUMP ANALYZER (NDA)          83/01/27 
* 
 #
*ENDIF
      BEGIN 
 
        XREF
          BEGIN 
          PROC ABORT;    #ABORT CONTROL POINT # 
          PROC MESSAGE;  #MESSAGE TO DAYFILE #
          PROC READSR;   #READ SEQUENTIAL FILE #
          PROC RECALL;   #PLACE ITEM IN RECALL STATUS # 
          PROC RETERN;   #RETURN DUMP INDEX AND DUMP FILES #
          PROC REWIND;   #REWIND FILE # 
          PROC WRITEF;   #WRITE END OF FILE # 
          PROC WRITEH;   #WRITE LINE TO OUTPUT #
          PROC WRITER;   #WRITE END OF RECORD ON FILE # 
          PROC WRITESR;  #WRITE SEQ FILE #
          PROC OPENSIO;  # OPEN SUPIO RANDOM FILE # 
          PROC CLOSSIO;  # CLOSE SUPIO RANDOM FILE #
          PROC FINDRI;   # SEARCH RECORD IDENT #
          PROC READRI;   # READ A RECORD BY RECORD IDENT #
          PROC WRITERI;  # WRITE A RECORD BY RECORD IDENT # 
          PROC READH;    # READ A LINE FROM INPUT # 
          PROC READ;     # READ A RECORD #
          PROC BKSP;     # BACKSPACE ONE RECORD # 
          PROC MOVE;     # MOVE A BLOCK OF MEMORY # 
          FUNC XCHD C(10);         # CONVERT OCTAL TO HEXADECIMAL # 
          FUNC XCDD C(10);         # CONVERT OCTAL TO DECIMAL # 
          FUNC XCOD C(10); #CONVERT OCTAL TO DISPLAY# 
          ITEM FDMP;     #DUMP FILES #
          ITEM OUTNDAS;  #OUTPUT FILE # 
          ITEM INPFIL;   # INPUT DIRECTIVE FILE # 
          ITEM NEUFILE;   # RANDOM WORKING FILE # 
          ITEM XLINP;    #LINES / PRINTER PAGE-- FROM SYSCOM# 
          END 
 
*CALL CRCOM 
# 
      DATA ITEMS USED IN NDA
# 
*CALL NDANSDD 
                                                          CONTROL EJECT;
          STATUS ECODE       #ERROR CODE INDEX FOR PARAMETERS # 
                 ILLPARAM,
                 ILLVAL,
                 NOVALUE, 
                 INVCHAR; 
 
*CALL SIODEFS 
 
 
          DEF LOCAL #3#;     # SEND MESSAGE TO LOCAL DAYFILE           #
          DEF NBWORD   #60#;     #NUMBER OF BITS IN ONE CM WORD # 
          DEF CWRDSIZE #10#;     #NUMBER OF CHARACTERS IN ONE CM WORD # 
          DEF LNSIZE    #16#;     #NO OF 16 BIT WORDS IN OUTPUT LINE #
          DEF DNTABL  #4#;         #MAX NUM OF DUMPS SELECTED - 1 # 
          DEF BIGPARM  #3#;        #MAX LENGTH OF ANY PARAMETER # 
          DEF PNLEN #6#;     #MAX NUM OF CHAR IN SOME VALUES #
          DEF DISZERO  #O"33"#;  #DISPLAY CODE FOR ZERO # 
          DEF DISNINE  #O"44"#;  #DISPLAY CODE FOR NINE # 
          DEF DISPLA  #O"01"#;    # DISPLAY CODE FOR A #
          DEF DISPLF  #O"06"#;    # DISPLAY CODE FOR F #
          DEF DISPLZ  #O"32"#;    # DISPLAY CODE FOR Z #
          DEF DISPLUS  #O"45"#;  #DISPLAY CODE FOR PLUS # 
          DEF BLANK    #" "#;    #CHARACTER BLANK # 
          DEF PARAREA  #O"2"#;   #LOC OF PARAM AREA # 
          DEF NUMPAREA  #O"64"#;   #LOC OF NUMBER OF PARAMS PRESENT # 
          DEF EQUAL  #O"02"#;      #EQUALS SIGN CODE #
          DEF CONT  #O"00"#;       #CONTINUATION MARK CODE #
          DEF COMMA  #O"01"#;      #COMMA CODE #
          DEF PARTERM  #O"17"#;    #PARAM TERMINATING CODE #
          DEF NR  #O"16220000000000"#;
          DEF LO  #O"14170000000000"#;
          DEF DN  #O"04160000000000"#;
          DEF NPU  #O"16202500000000"#; 
          DEF B  #O"02000000000000"#; 
          DEF E  #O"05000000000000"#; 
          DEF AD #O"01040000000000"#; 
          DEF OPTION # 0 #;  # MESSAGE DISPLAY TO SYSTEM AND LOCAL     #
                             #  DAYFILE AND A AND B DISPLAY            #
          DEF OUTFILE  #" OUTPUT"#; #NAME OF OUTPUT FILE #
          DEF DMPFILE  #"DMPFILE"#; #DUMP FILE ERROR NAME # 
          DEF DMPINDX  #"NDA4IND"#; #DIRECTORY FILE NAME #
          DEF OUTPUT   # OUTNDAS #; 
          DEF INPUT # INPFIL #; 
          DEF MAXTCB #50#;   # MAXIMUM NUMBER OF TCBS PER LCB # 
          DEF MAXPGREG # 10 #;     # MAX LENGTH OF PAGE REG IN CM WORDS#
 
      COMMON FDMPB; 
        BEGIN 
          ARRAY FDMPBF [0:O"3500"] S(1);  # CONTAINS 64*28 + 1         #
          BEGIN 
          ITEM FDMPBUF U(0,0,60); 
          END 
        END 
                                                          CONTROL EJECT;
 
 
      ITEM EBCDIC       B;           # *EBCDIC* CONVERSION FLAG # 
 
          ITEM ERRFLG  B=FALSE;  #ERROR ON CALL CARD FLAG#
          ITEM ERROR B=FALSE;  #EXIT LOOP-PROCESS ANOTHER DUMP FILE#
          ITEM ILLVALF B=FALSE;   # FLAGS ILLEGAL PARAMETER VALUE # 
          ITEM MACROMEM B=TRUE;    #LIST MACRO MEMORY FLAG #
          ITEM NONPU B=TRUE;   #FLAG TO INDICATE NO DUMPS FOUND#
          ITEM NOPARAM B=FALSE;    #ILLEGAL PARAMETER FLAG #
          ITEM NOTMAC B=FALSE;  # NOT MACRO MEMORY RECORD FLAG #
          ITEM PBUFIN B=FALSE;  # BUFIN IN ONEWORD NOT POINTED YET     #
          ITEM PREG B;       # PAGE REGISTER EXISTS FLAG               #
          ITEM PRINTIT B;    # INDICATES LINE IS NOT A DUPLICATE       #
          ITEM REGISTERS B=TRUE;   #LIST REGISTERS FLAG # 
          ITEM PAGEREG B=TRUE;         # LIST PAGE REGISTERS FLAG      #
          ITEM R7 B;         # TRUE IF ITS AN R7 DUMP FILE             #
          ITEM STATSRCH B;       #STATUS RECORD FLAG #
          ITEM WRCH B;             #FLAG TO INDICATE DUMP OF REMOTE NPU#
          ITEM INPDIR B=TRUE;      # FLAG TO INDICATE INPUT DIRECTIVE # 
          ITEM EXPAND B=FALSE;         # EXPAND LISTING FLAG #
          ITEM IEOF B=FALSE; # END OF FILE FLAG # 
          ITEM SUPERR B;     # SUPIO ERROR INDICATOR #
          ITEM HEADRB B;     # HEAD RECORD EXIST FLAG # 
          ITEM FILE1B B;     # FILE 1 RECORD EXIST FLAG # 
          ITEM NDFFIRSTRD B = TRUE;  # NDF FIRST READ INDICATOR        #
          ITEM IFIRSTRD B = TRUE;  # INPUT FILE FIRST READ INDICATOR   #
          ITEM STATRB B;     # STATUS RECORD EXIST FLAG # 
          ITEM CKSUMB B;     # CHECKSUM RECORD EXIST FLAG # 
          ITEM MACROB B;     # MACRO MEMORY EXIST FLAG #
          ITEM TEMPB B;      # TEMP FLAG #
          ITEM ERRIND B;     # ERROR FLAG # 
 
 
          ITEM IOSTAT U;         #STATUS RETURNED ON SUPIO FUNCTIONS #
          ITEM BEGADD  U=0;  #BEGINNING ADDRESS FOR FORM2 # 
          ITEM ENDADD  U=0;  #ENDING ADDRESS FOR FORM2 #
          ITEM CHNUM  U=0;   #VARIABLE SET FOR INPUT INTO XCOD# 
          ITEM EQNUM  U=0;   #VARIABLE SET FOR INPUT INTO XCOD# 
          ITEM CKSM U;           #INPUT ITEM FOR NUMBER CONVERSION #
          ITEM INWD U=0;     #DATA HOLDING VAR FOR PROC CALLS # 
          ITEM ASCN U;       #CHAR INDEX FOR ASCII OUTPUT # 
          ITEM DNI U;            #DUMP INDEX #
          ITEM SRCHIND U;    #DUMMY VARIABLE FOR SEARCH # 
          ITEM RECKEY U;     # RECORD KEY FOR RANDOM FILE # 
          ITEM RULES U;      # RULE FROM INPUT DIRECTIVES # 
          ITEM STATREC U;    # STATUS RECORD FROM DUMP FILE # 
          ITEM CKSUMREC U;   # CHECKSUM RECORD FROM DUMP FILE # 
          ITEM TEMPU1 U;     # TEMP AREA FOR U TYPE ITEM #
          ITEM TEMPU2 U;     # TEMP AREA FOR U TYPE ITEM #
          ITEM CCIND  I;     #CONVERSION BOUNDARY INDEX # 
          ITEM CIND     I;        #INDEX FOR SEARCH#
          ITEM DNTABIX I;         #INDEX #
          ITEM FINDI I ;           #INDEX # 
          ITEM FINDNEXT I;       #INDEX # 
          ITEM I I;                #INDEX # 
          ITEM ICD I;        # INDEX #
          ITEM IND I;        # INDEX #
          ITEM IX1    I;     #INDEX # 
          ITEM J I;              #INDEX # 
          ITEM K I;          #INDEX # 
          ITEM STIND I;          #INDEX # 
          ITEM CCOUNT I;           #CHAR COUNT FOR PARAMETERS # 
          ITEM CCOUNT2 I;    #HOLDS CHAR COUNT FOR PARAMETERS#
          ITEM RC I;             #REASON CODE RETURNED ON ATTACH CALL # 
          ITEM LENGTH I;         #LENGTH OF READ/WRITE BUFFER # 
          ITEM RCCT I;       # WAIT TIME BETWEEN ATTACH CALLS          #
 
          ITEM I01 I;        # INDEX #
          ITEM I02 I;        # INDEX #
          ITEM I03 I;        # INDEX #
          ITEM I04 I;        # INDEX #
          ITEM I05 I;        # INDEX #
          ITEM LOOP01 I;     # LOOP COUNTER # 
          ITEM LOOP02 I;     # LOOP COUNTER # 
          ITEM PAGENO I=0;   # CURRENT PAGE NUMBER IN OUTPUT LISTING #
          ITEM LINENO I;     # CURRENT LINE NUMBER IN OUTPUT LISTING #
          ITEM DUMMYI I;     # DUMMY INDEX #
          ITEM INSPLN I=16;  # INSTANCES PER LINE IN RULE 3 # 
          ITEM CBWPLN I=26;  # WORDS PER LINE # 
          ITEM WODPLN I=16;  # WORDS PER LINE IN OUTPUT # 
          ITEM LCBPLN I=8;   # NUMBER OF LCB PER LINE # 
          ITEM TCBPLN I=15;  # NUMBER OF TCB PER LINE # 
          ITEM PTBPLN I=8;   # PORT TABLES PER LINE # 
          ITEM TEMPC1 C(10); # TEMP AREA FOR C TYPE ITEM #
          ITEM TEMPC2 C(10); # TEMP AREA FOR C TYPE ITEM #
 
          ITEM TEMP C(10);   #HOLDS OCTAL VALUE TO BE CONVERTED#
          ITEM XNPU C(7) = 0;      #SPECIFIED NPU NAME #
          ITEM DFNAME C(8);   # NPU DUMP FILE NAME          # 
          ITEM FILEREC C(1);     #DUMP FILE RECORD TYPE CODE #
          ITEM BEGADDR C(6) = "      ";  #BEGIN ADDRESS IN HEX #
          ITEM ENDADDR C(6) = "      ";  #END ADDRESS IN HEX #
          ITEM GDATE C(7); # DATE PASSED BY NDA CALL                   #
 
          ARRAY ASCIITAB [0:127] S(1);   # ASCII CONVERSION TABLE      #
            BEGIN 
            ITEM ASCVAL U(0,54,6);
            ITEM ASCCHR C(0,54,1) = [ 
                                     32(" "), 
                                        " ",
                                        "!",
                                        """", 
                                        "#",
                                        "$",
                                        "%",
                                        "&",
                                        "'",
                                        "(",
                                        ")",
                                        "*",
                                        "+",
                                        ",",
                                        "-",
                                        ".",
                                        "/",
                                        "0",
                                        "1",
                                        "2",
                                        "3",
                                        "4",
                                        "5",
                                        "6",
                                        "7",
                                        "8",
                                        "9",
                                        ":",
                                        ";",
                                        "<",
                                        "=",
                                        ">",
                                        "?",
                                        "@",
                                        "A",
                                        "B",
                                        "C",
                                        "D",
                                        "E",
                                        "F",
                                        "G",
                                        "H",
                                        "I",
                                        "J",
                                        "K",
                                        "L",
                                        "M",
                                        "N",
                                        "O",
                                        "P",
                                        "Q",
                                        "R",
                                        "S",
                                        "T",
                                        "U",
                                        "V",
                                        "W",
                                        "X",
                                        "Y",
                                        "Z",
                                        "[",
                                        "\",
                                        "]",
                                        "^",
                                        "_",
                                        " ",
                                        "A",
                                        "B",
                                        "C",
                                        "D",
                                        "E",
                                        "F",
                                        "G",
                                        "H",
                                        "I",
                                        "J",
                                        "K",
                                        "L",
                                        "M",
                                        "N",
                                        "O",
                                        "P",
                                        "Q",
                                        "R",
                                        "S",
                                        "T",
                                        "U",
                                        "V",
                                        "W",
                                        "X",
                                        "Y",
                                        "Z",
                                      5(" ")
                                    ];
            END 
 
      ARRAY EBCDICTAB [0:255] S(1);  # *EBCDIC* CONVERSION TABLE #
        BEGIN 
        ITEM EBCDVAL    U(00,54,06) = 
          [ 
          72(O"55"),                                        # 00 - 47 # 
          O"55",O"55",O"61",O"57",O"72",O"51",O"45",O"66",  # 48 - 4F # 
          O"67",O"55",O"55",O"55",O"55",O"55",O"55",O"55",  # 50 - 57 # 
          O"55",O"55",O"62",O"53",O"47",O"52",O"77",O"76",  # 58 - 5F # 
          O"46",O"50",O"55",O"55",O"55",O"55",O"55",O"55",  # 60 - 67 # 
          O"55",O"55",O"75",O"56",O"63",O"65",O"73",O"71",  # 68 - 6F # 
          8(O"55"),                                         # 70 - 77 # 
          O"55",O"74",O"00",O"60",O"74",O"70",O"54",O"64",  # 78 - 7F # 
          O"55",O"01",O"02",O"03",O"04",O"05",O"06",O"07",  # 80 - 87 # 
          O"10",O"11",O"55",O"55",O"55",O"55",O"55",O"55",  # 88 - 8F # 
          O"55",O"12",O"13",O"14",O"15",O"16",O"17",O"20",  # 90 - 97 # 
          O"21",O"22",O"55",O"55",O"55",O"55",O"55",O"55",  # 98 - 9F # 
          O"55",O"76",O"23",O"24",O"25",O"26",O"27",O"30",  # A0 - A7 # 
          O"31",O"32",O"55",O"55",O"55",O"55",O"55",O"55",  # A8 - AF # 
          16(O"55"),                                        # B0 - BF # 
          O"61",O"01",O"02",O"03",O"04",O"05",O"06",O"07",  # C0 - C7 # 
          O"10",O"11",O"55",O"55",O"55",O"55",O"55",O"55",  # C8 - CF # 
          O"62",O"12",O"13",O"14",O"15",O"16",O"17",O"20",  # D0 - D7 # 
          O"21",O"22",O"55",O"55",O"55",O"55",O"55",O"55",  # D8 - DF # 
          O"75",O"55",O"23",O"24",O"25",O"26",O"27",O"30",  # E0 - E7 # 
          O"31",O"32",O"55",O"55",O"55",O"55",O"55",O"55",  # E8 - EF # 
          O"33",O"34",O"35",O"36",O"37",O"40",O"41",O"42",  # F0 - F7 # 
          O"43",O"44",O"55",O"55",O"55",O"55",O"55",O"55",  # F8 - FF # 
          ];
        END 
 
          ITEM HEAD C(140)="0ADDRESS  0     1     2     3     4     5 
  6     7     8     9     A     B     C     D     E     F   ";
                                 #ADDRESS HEADER FOR OUTPUT OF DUMP # 
          ITEM TTL1 C(70)="1                                        BASE
 FILE 1 REGISTERS        ";            # REPORT HEADING # 
          ITEM TTL4 C(60)="1
 MACRO MEMORY  ";                #REPORT HEADING #
          ITEM TTL2 C(60)="1                                           P
AGE REGISTERS  ";              # REPORT HEADER                         #
           CONTROL EJECT; 
 
*CALL SIOBASE 
 
          BASED ARRAY CPARAMS;
            BEGIN            #IMAGE OF CALL PARAMETER AREA #
            ITEM CPARCODE U(0,56,4);
            ITEM CPARREC U(0,0,42); 
            ITEM CPARVAL C(0,0,7);
            END 
 
          BASED ARRAY PRA64;
            BEGIN            #PARAMETER COUNT AREA #
            ITEM NOCPWDS U(0,42,18);
            END 
 
          BASED ARRAY CCARD [0:0] S(1); 
            BEGIN            #CONTROL CARD IMAGE #
            ITEM CCRD C(0,0,80);
            END 
 
 
          ARRAY TTL [0:0] S(14);
            BEGIN            # HEADING INFORMATION #
            ITEM TTL0 C(0,0,100); 
            ITEM TTL01 C(10,0,17)=[" "];
            ITEM TTL02 C(11,42,4)=["PAGE"]; 
            ITEM PAGNUM C(12,6,8);   # PAGE NUMBER #
            ITEM TTL03 C(12,54,9)=[" "];
            ITEM TTL04 U(13,42,18)=[0]; 
            END 
 
          ARRAY INPBUF [0:0] S(8);
            BEGIN            # INPUT BUFFER FOR INPUT DIRECTIVE FILE #
            ITEM INPBUFC C(0,0,80);  # INPUT DIRECTIVE STRING # 
            ITEM RULEI   C(0,0,1);   # RULE SPECIFIED IN DIRECTIVE #
            END 
 
          ARRAY HEADREC [0:2] S(1); 
            BEGIN            # SAVE AREA FOR HEAD RECORD IN DUMP FILE # 
            ITEM HEADREC0 U(0,0,60);
            END 
 
          ARRAY FILE1REC [0:70] S(1); 
            BEGIN            # SAVE AREA FOR FILE 1 RECORD IN DUMP FILE#
            ITEM FILE1REC1 U(0,0,60); 
            END 
 
          ARRAY PAGREGREC [0:10] S(1);
            BEGIN            # SAVE AREA FOR PAGE REGISTER IN DUMP FILE#
            ITEM PAGREGREC1 U(0,0,60);
            END 
 
          ARRAY PARAMI [0:15] S(1); 
            BEGIN            # INPUT PARAMETERS IN DIRECTIVE #
            ITEM PARAMT U(0,0,60);
            END 
 
          ARRAY OUTBUF [0:0] S(14); 
            BEGIN            # WORKING AREA FOR FILE OUTPUT # 
            ITEM CCNTRL C(0,0,1) = [" "];      # CARRIAGE CONTROL # 
            ITEM STRING C(0,0,137)=[" "]; 
            ITEM ZEROED U(13,42,18) = [0];     # ZERO FILLED #
            END 
 
          BASED ARRAY DMPBUF [0:BUFLEN] S(1); 
            BEGIN            #DUMP FILE RECORDS # 
              ITEM DMPWD U(0,0,60); 
            END 
          ARRAY DMPBUF1 [0:BUFLEN] S(1);
            BEGIN            # CIO BUFFER AREA FOR DUMP FILE RECORD # 
              ITEM DMPWD1 U(0,0,60);
            END 
 
          ARRAY DMPBUF2 [0:BUFLEN] S(1);
            BEGIN            # CIO BUFFER AREA FOR DUMP FILE #
              ITEM DMPWD2 U(0,0,60);
            END 
 
 
          ARRAY BUFIND [0:15] S(1); 
            BEGIN            #INDEX INTO 16 WORD BUFFER # 
              ITEM BUFWD U(0,0,30)=[0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,4]; 
              ITEM BUFBIT U(0,30,30)=[0,16,32,48,4,20,36,52,8,24,40,56, 
                                      12,28,44,0];
            END 
 
          ARRAY PARMSG [0:0] S(4);     #ERROR MESSAGE OUTPUT FORMAT#
            BEGIN 
              ITEM ERRMESS  C(0,0,30); #ERROR MESSAGE TEXT# 
              ITEM ERRPARAM C(3,0,7);  #PARAMETER IN ERROR# 
              ITEM ENDBLK   U(3,42,18)=[0]; #ZERO FILL REST OF WORD#
            END 
 
          ARRAY BLLINE [0:0] S(3);
            BEGIN            # PRINT 3 BLANK LINES  # 
              ITEM BLFILL C(0,0,30) = [O"00"];
            END 
 
 
          ARRAY PRDN [0:0] S(10); 
            BEGIN            #PRINT DUMP NUMBER AND CALL CARD IMAGE # 
              ITEM PRDN1 C(0,0,17)=["1NPU DUMP FILE = "]; 
              ITEM PRDN2 C(1,42,8); 
              ITEM PRDN3 C(2,0,60) = [" "];      # CARD IMAGE          #
              ITEM NDAVER C(8,0,13) = [" NDA VER 2.0-"];  #NDA VERSION #
              ITEM NDALEV C(9,18,5);                      # AND LEVEL  #
              ITEM NDAZR C(9,48,2) = ["  "];
            END 
 
          ARRAY PRDATE [0:0] S(2);
            BEGIN            #DATE DUMP WAS GENERATED # 
              ITEM PRDATE1 C(0,0,12)=["0DATE       "];
              ITEM PRDATE2 C(1,12,8); 
            END 
 
          ARRAY PRNPU [0:0] S(2); 
            BEGIN            #NPU NAME OF DUMP #
              ITEM PRNPU1 C(0,0,12)=["0NPU NAME   "]; 
              ITEM PRNPU2 C(1,12,7);
              ITEM PRNPU3 C(1,54,1)=[" "];
            END 
 
          ARRAY PRTIME [0:0] S(2);
            BEGIN            #TIME DUMP WAS GENERATED # 
              ITEM PRTIME1 C(0,0,12)=["0TIME       "];
              ITEM PRTIME2 C(1,12,7); 
              ITEM PRTIME3 C(1,54,1); 
            END 
 
      ARRAY PRNNODE [0:0] S(2); 
        BEGIN 
        ITEM PRNNODE1 C(0,0,15) = ["0NPU NODE     "]; 
        ITEM PRNNODE2 C(1,12,2);
        ITEM PRNNODEZ U(1,30,30) = [ 0 ]; 
        END 
 
      ARRAY PRHALT [0:0] S(2);
        BEGIN 
        ITEM PRHALT1 C(0,0,16) = ["0HALT CODE      "];
        ITEM PRHALT2 C(1,12,4); 
        ITEM PRHALTZ U(1,36,24) = [ 0 ];
        END 
 
      ARRAY PRPREG [0:0] S(2);
        BEGIN 
        ITEM PRPREG1 C(0,0,16) = ["0P REGISTER     "];
        ITEM PRPREG2 C(1,12,4); 
        ITEM PRPREGZ U(1,36,24) = [ 0 ];
        END 
 
          ARRAY SEQLINE [0:0] S(4); 
            BEGIN 
              ITEM SEQQ C(0,0,40)=["-*****RECORD SEQUENCING ERROR*****
    "]; 
            END 
 
      ARRAY PRCOMP [0:0] S(5);
        BEGIN 
        ITEM PRCOMP1 C(0,0,31) =
          ["PROCESSING COMPLETE ON XXXXXXX."];
        ITEM PRCOMP2 C(2,18,7); 
        ITEM PRCOMPZ U(3,6,54) = [ 0 ]; 
        END 
 
          ARRAY ERRARRY [0:3] S(3); # ARRAY OF ERROR MESSAGES # 
            ITEM ERRTEXT C(0,0,30) =
              ["   ILLEGAL NDA CALL PARAMETER ",
               "  PARAMETER VALUE ILLEGAL FOR ",
               "   VALUE NEEDED FOR PARAMETER ",
               " INVALID CHARACTER AFTER ITEM "]; 
 
 
          ARRAY WRERR [0:0] S(5); 
            BEGIN            # ERROR MESSAGE FOR SUPIO #
              ITEM WRMESS C(0,0,32)=["   I/O ERROR      IN         ON"];
              ITEM WRCODE C(1,18,4);   # ERROR CODE # 
              ITEM WRFILE C(2,6,7);    # FILE NAME #
              ITEM WRREC C(3,12,8);    # ACTION # 
              ITEM WRZERO U(4,0,60)=[0];
            END 
 
          ARRAY OUTBUFI  [0:0] S(9);
            BEGIN            # A COPY OF DIRECTIVE WHEN ERROR # 
              ITEM CCNTRLI  C(0,0,1)=[" "];      # CARRIAGE CONTROL # 
              ITEM INPBUFD  C(0,6,80);
              ITEM ZEROI1   U(8,6,54)=[0];
            END 
 
          ARRAY HEADERR [0:0] S(5); 
            BEGIN            # HEADER RECORD MISSING IN DUMP FILE # 
              ITEM HEADERR1 C(0,0,48)=["1*** ERROR --- HEAD RECORD NOT I
N DUMP FILE. ***"]; 
              ITEM HEADERR2 U(4,48,12)=[0]; 
            END 
 
          ARRAY DIRMES1  [0:0] S(6);
            BEGIN            # DIRECTIVE ERROR MESSAGE #
              ITEM DIRMES12 C(0,6,20)=["*** ERROR IN FIELD ("]; 
              ITEM ERRFIELD C(2,6,5);  # ERROR FIELD #
              ITEM DIRMES13 C(2,36,25)=["), MUST BE 5 HEX. DIGITS."]; 
              ITEM ZEROI2   U(5,6,54)=[0];
            END 
 
          ARRAY DIRMES2  [0:0] S(6);
            BEGIN            # DIRECTIVE ERROR MESSAGE #
              ITEM DIRMES21 C(0,0,1)=["0"]; 
              ITEM DIRMES22 C(0,6,20)=["*** ERROR IN COLUMN "]; 
              ITEM DIRMES23 C(2,6,4);  # ERROR FIELD #
              ITEM DIRMES24 C(2,30,25)=[", MUST BE BLANK OR COMMA."]; 
              ITEM ZEROI3   U(5,0,60)=[0];
            END 
 
          ARRAY COL1ERR [0:0] S(5); 
            BEGIN  # RULE ERROR IN DIRECTIVE #
              ITEM COL1ER1 C(0,0,42)=[" *** ERROR IN INPUT DIRECTIVE COL
UMN 1 ***"];
              ITEM COL1ER2 U(4,12,48)=[0];
            END 
 
          ARRAY CBSERR [0:0] S(6);
            BEGIN            # CONTINUOUS STRUCTURES DIRECTIVE ERROR #
              ITEM CBSER1 C(0,0,51)=[" PARAMETER FIRST IS GREATER THAN L
AST IN DIRECTIVE."];
              ITEM CBSER2 U(5,06,54)=[0]; 
            END 
 
          ARRAY CIOERR [0:0] S(7);
            BEGIN            # CIRCULAR BUFFER DIRECTIVE ERROR #
              ITEM CIOER1 C(0,0,60)=[" PARAMETER OLDEST MUST BE BETWEEN 
FWA AND LWA OF CIO BUFFER."]; 
              ITEM CIOER2 I(6,00,60)=[0]; 
            END 
 
          ARRAY NOMEAN [0:0] S(4);
            BEGIN            # NO MEANINGFUL DATA IN CIO BUFFER # 
              ITEM NOMEA1 C(0,0,38)=[" *** NO MEANINGFUL DATA IN BUFFER 
 ***"]; 
              ITEM NOMEA2 U(3,48,12)=[0]; 
            END 
 
          ARRAY CIOLIM [0:0] S(4);
            BEGIN            # SIZE EXCEED CIO BUFFER LIMIT # 
              ITEM CIOLI1 C(0,0,38)=[" *** SIZE EXCEED CIO BUFFER LIMIT.
 ***"]; 
              ITEM CIOLI2 U(3,48,12)=[0]; 
            END 
 
          ARRAY NOPATT [0:0] S(4);
            BEGIN            # DESIRED PATTERN NOT FOUND #
              ITEM NOPAT1 C(0,0,35)=[" *** DESIRED PATTERN NOT FOUND ***
 "];
              ITEM NOPAT2 U(3,30,30)=[0]; 
            END 
 
          ARRAY LCBERR [0:0] S(7);
            BEGIN 
              ITEM LCBER1 C(0,0,63)=[" PARAMETER FTCB/NTCB MUST BE LESS 
THAN LCBL/TCBL IN DIRECTIVE. "];
              ITEM LCBER2 U(6,18,42)=[0]; 
            END 
 
          ARRAY TCBERR [0:0] S(6);
            BEGIN            # TCB CHAINS EXCEED MAXIMUM #
              ITEM TCBER1 C(0,0,50)=[" TCB CHAINS EXCEED MAXIMUM NUMBER 
OF TCBS PER LCB."]; 
              ITEM TCBER2 U(5,0,60)=[0];
            END 
 
          ARRAY PTBERR [0:0] S(6);
            BEGIN            # PORT TABLE DIRECTIVE ERROR # 
              ITEM PTBER1 C(0,0,50)=[" PARAMETER MUXP AND/OR MUXID IS GR
EATER THAN PTTL."]; 
              ITEM PTBER2 U(5,0,60)=[0];
            END 
 
*CALL NAMLEV
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*     1. PROC NAME:             AUTHOR:               DATE: 
*        NDAS                E. SULLIVAN            77/01/31
*                            JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        NDAS IS THE MAIN ENTRY POINT INTO THE SYMPL PORTION OF NDA.
*        THIS PROCEDURE CONTROLS THE TOP LEVEL OF NDA PROCESSING. 
* 
*     3. METHOD USED: 
*        CALL THE ROUTINE (CRACK) TO CHECK THE NDA CALL PARAMETERS. 
*        IF I PARAMETER IS SPECIFIED, THE INPUT DIRECTIVES ARE
*        COPIED ONTO THE OUTPUT FILE. 
*        IF THERE ARE NO ERRORS, THEN DUMPS ARE PROCESSED.  DNPROC IS 
*        CALLED TO PROCESS THE DUMP INFORMATION.
* 
*     4. ENTRY PARAMETERS:  
*        NONE 
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        CRACK      CONTROL CARD CRACKING PROCEDURE - SYMPL 
*        DNPROC     PROCESS DUMP FILE - SYMPL 
*        READDIR    COPY INPUT DIRECTIVES TO OUTPUT 
*        RETERN     RETURN FILE 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
      BEGIN 
 
      XREF
        ITEM ZZZZINP; 
 
      ITEM EOF B = FALSE;    # END OF INPUT DUMP FILE INDICATOR        #
 
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
      CRACK;
      IF INPDIR 
      THEN                   # COPY INPUT DIRECTIVES TO OUTPUT FILE    #
        READDIR;
      FOR I = 1 WHILE NOT EOF DO
        BEGIN 
        DNPROC(EOF);
        END 
      RETERN(ZZZZINP);
      END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        CRACK               E. SULLIVAN            77/01/31
*                            W. L. CHENG            80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        PROCESS NDA CALL PARAMETERS. 
* 
*     3. METHOD USED: 
*        THE CRACKED PARAMETER AREA AT RA+2 IS USED TO DETERMINE
*        THE VALIDITY AND VALUE OF PARAMETERS PRESENT. THE ENTIRE 
*        PARAMETER LIST IS EXAMINED EACH TIME CRACK IS CALLED.
*        VALID PARAMETERS CAUSE FLAGS TO BE SET AND/OR VALUES TO
*        BE PLACED IN CERTAIN VARIABLES.  ANY ERROR CAUSES NDA TO 
*        ABORT. 
* 
*     4. ENTRY PARAMETERS:  
*        NONE 
* 
*     5. EXIT PARAMETERS: 
*        INPUTFN   CONTAINS THE NAME OF DIRECTIVE FILE
*        BEGADD    CONTAINS BEGINNING DUMP ADDRESS OF MACRO MEMORY
*        ENDADD    CONTAINS ENDING DUMP ADDRESS OF MACRO MEMORY 
*        REGISTERS FALSE IF FILE REGISTER DUMP NOT WANTED 
*        MACROMEM  FALSE IF MACRO MEMORY DUMP NOT WANTED
*        INPDIR    TRUE  IF DIRECTIVE PROCESSING SELECTED 
*        EXPAND    TRUE  IF EXPANSION OF DUPLICATE LINES SPECIFIED
* 
*     6. COMDECKS CALLED
*        NONE 
* 
*     7. ROUTINES CALLED
*        FINDZERO  GET LENGTH OF CURRENT PARAMETER/VALUE - SYMPL
*        BADPARM   PROCESS CALL PARAMETER ERRORS - SYMPL
*        DISHEX    CONVERT DISPLAY CODE TO HEXADECIMAL - SYMPL
*        MESSAGE   WRITE MESSAGE TO DAYFILE - SUPIO 
*        PRDFILE   FLUSH OUTPUT BUFFER TO ASSURE DAYFILE - SYMPL
*        ABORT     ABORT PROGRAM - MACREL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
      PROC CRACK; 
        BEGIN                # NDA CALL PARAMETERS CRACKING # 
          XREF
            BEGIN 
            ITEM INPUT U; 
            ITEM NDF U; 
            ITEM OUTPUT U;
            END 
 
          DEF NDAPARN   # 7 #;       # MAX NUMBER OF *NDA* PARAMETERS # 
 
          SWITCH PAR$RTN ER$RTN,L$RTN,NDF$RTN,BA$RTN,EA$RTN,
                         LO$RTN,CV$RTN,I$RTN; 
          ARRAY NDAPAR[1:NDAPARN];
            BEGIN            # LEGAL KEYWORDS IN NDA CALL STATEMENT # 
              ITEM NDAPARM U(0,0,42)=[O"14000000000000",    # L   # 
                                      O"16040600000000",    # NDF # 
                                      O"02010000000000",    # BA  # 
                                      O"05010000000000",    # EA  # 
                                      O"14170000000000",    # LO  # 
                                      O"03260000000000",    # CV #
                                      O"11000000000000"];   # I   # 
            END 
          ITEM ERFLAG B;     # ERROR FLAG # 
 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          P<CPARAMS> = PARAREA;    # PARAMETER AREA STARTS FROM RA+2   #
          P<PRA64> = NUMPAREA;     # AREA HOLDING NUMBER OF PARAMETERS #
 
          EBCDIC = FALSE;            # PRESET *ASCII* CONVERSION #
 
          DNTABIX = 0;
          IF NOCPWDS NQ 0          # ANY PARAMETER IN CALL STATEMENT   #
          THEN
            FOR I=0 STEP 1 UNTIL NOCPWDS
            DO
              BEGIN                # EXAMINE PARAMETER AREA            #
                NOPARAM = FALSE;
                FINDZERO((CPARVAL[I]),CCOUNT);
                IF CCOUNT GR BIGPARM
                THEN               # TOO MANY CHARACTERS IN PARAMETER  #
                  BADPARM(ECODE"ILLPARAM",(CPARVAL[I]),CCOUNT); 
                ELSE
                  BEGIN 
                    I02 = 0;
                    FOR I01 = 1 STEP 1 UNTIL NDAPARN
                    DO             # SEARCH LEGAL PARAMETER ARRAY # 
                      IF CPARREC[I] EQ NDAPARM[I01] 
                      THEN
                        BEGIN 
                          I02 = I01;
                          I01 = NDAPARN;
                        END 
                    GOTO PAR$RTN[I02];   # GO TO CORRESPONDING ROUTINE #
 TESTTER:                          # TEST FOR TERMINATING CHARACTER # 
                    IF CPARCODE[I] EQ COMMA 
                    THEN           # COMMA FOLLOWS PARAMETER, OK #
                      TEST I; 
                    IF CPARCODE[I] EQ PARTERM 
                    THEN           # QUIT PARMETER PROCESSING # 
                      BEGIN 
                        I = NOCPWDS;
                        TEST I; 
                      END 
                    IF NOT NOPARAM
                    THEN           # INVALID IF OTHER THAN , OR ) # 
                      BADPARM(ECODE"INVCHAR",(CPARVAL[I]),CCOUNT);
                    I = I + 1;
                    FOR FINDI=I STEP 1 UNTIL NOCPWDS
                    DO
                      BEGIN 
                        IF CPARCODE[FINDI] EQ COMMA 
                        THEN       # COMMA FOUND #
                          BEGIN 
                            I = FINDI;
                            FINDI = NOCPWDS;
                            TEST FINDI; 
                          END 
                        IF CPARCODE[FINDI] EQ PARTERM 
                        THEN       # TERMINATOR FOUND # 
                          BEGIN 
                            I = NOCPWDS;
                            FINDI = NOCPWDS;
                          END 
                      END  #FINDI#
                  END 
              END  #I#
          IF BEGADDR NQ "      "
          THEN                     # CONVERT DISPLAY TO HEX # 
            DISHEX(BEGADDR,BEGADD,6,ERFLAG);
          ELSE
            BEGADD = 0; 
          IF ENDADDR NQ "      "
          THEN                     # CONVERT DISPLAY TO HEX # 
            DISHEX(ENDADDR,ENDADD,6,ERFLAG);
          ELSE
            ENDADD = O"777777"; 
          IF BEGADD GR ENDADD 
          THEN
            BEGIN 
              ERRMESS[0] = ERRTEXT[1];
              ERRPARAM[0] = "BA/EA  ";  # BA/EA VALUE IS INVALID #
              MESSAGE(PARMSG,OPTION); 
              PRDFILE;             # FLUSH BUFFER TO ASSURE DAYFILE # 
              ABORT;
            END 
          IF ERRFLG 
          THEN               # ERROR IN CRACKING PARAMETERS # 
            ABORT;
          RETURN;                  # RETURN TO MAIN PROC #
 ER$RTN:                           # PARAMETER NOT RECOGNIZED # 
          BADPARM(ECODE"ILLPARAM",(CPARVAL[I]),CCOUNT); 
          GOTO TESTTER; 
 L$RTN:                      # L PARAMETER WAS SPECIFIED               #
          IF CPARCODE[I] NQ EQUAL 
          THEN               # NO VALUE WAS SPECIFIED                  #
            BEGIN 
            BADPARM(ECODE"NOVALUE",(CPARVAL[I]),CCOUNT);
            END 
          ELSE               # AN EQUAL SIGN WAS PRESENT               #
            BEGIN 
            CCOUNT2 = CCOUNT; 
            I = I + 1;
            FINDZERO((CPARVAL[I]),CCOUNT);  # GET PARAMETER LENGTH     #
            FOR J = 0 STEP 1 UNTIL CCOUNT - 1 DO
              BEGIN          # CHECK FOR VALID FILE NAME               #
              IF ( C<J,1>CPARVAL[I] LS DISPLA ) OR
                ( C<J,1>CPARVAL[I] GR DISNINE ) 
              THEN           # ILLEGAL FILE NAME                       #
                BEGIN 
                BADPARM(ECODE"ILLVAL",CPARVAL[I-1],CCOUNT2);
                GOTO TESTTER; 
                END 
              END 
            P<SIOFET> = LOC(OUTPUT);
            FETLFN[0] = C<0,7>CPARVAL[I]; 
            END 
          GOTO TESTTER; 
 NDF$RTN: 
          IF CPARCODE[I] NQ EQUAL 
          THEN               # NO VALUE WAS SPECIFIED                  #
            BEGIN 
            BADPARM(ECODE"NOVALUE",(CPARVAL[I]),CCOUNT);
            END 
          ELSE
            BEGIN 
            CCOUNT2 = CCOUNT; 
            I = I + 1;
            FINDZERO((CPARVAL[I]),CCOUNT);  # GET PARAMETER LENGTH     #
            FOR J = 0 STEP 1 UNTIL CCOUNT - 1 DO
              BEGIN          # CHECK FOR VALID FILE NAME               #
              IF (C<J,1>CPARVAL[I] LS DISPLA) OR
                (C<J,1>CPARVAL[I] GR DISNINE) 
              THEN           #ILLEGAL FILE NAME                        #
                BEGIN 
                BADPARM(ECODE"ILLVAL",CPARVAL[I-1],CCOUNT2);
                GOTO TESTTER; 
                END 
              END 
            P<SIOFET> = LOC(NDF); 
            FETLFN[0] = C<0,7>CPARVAL[I]; 
            END 
          GOTO TESTTER; 
 BA$RTN:  
 EA$RTN:                           # KEYWORDS BA/EA ARE PROCESS HERE #
          IF CPARCODE[I] NQ EQUAL 
          THEN                     # VALUE EXPECTED FOLLOWED BY = # 
            BADPARM(ECODE"NOVALUE",(CPARVAL[I]),CCOUNT);
          ELSE
            BEGIN 
              CCOUNT2 = CCOUNT; 
              I = I + 1;
              FINDZERO((CPARVAL[I]),CCOUNT);
              K = 0;
              FOR J=0 STEP 1 UNTIL CCOUNT - 1 
              DO
                BEGIN              # CHECK IF VALUE IS LEGAL HEX DIGIT #
                  K = B<J*6,6>CPARVAL[I]; 
                  IF ((K LS DISZERO) OR (K GR DISNINE)) AND 
                     ((K LS DISPLA) OR (K GR DISPLF)) 
                  THEN
                    ILLVALF = TRUE; 
                END 
              IF CCOUNT GR PNLEN OR ILLVALF 
              THEN
                BEGIN              # ILLEGAL VALUE FOUND #
                  ILLVALF = FALSE;
                  BADPARM(ECODE"ILLVAL",(CPARVAL[I-1]),CCOUNT2);
                END 
              ELSE
                BEGIN              # SAVE PARAMETER IN BEGADDR,ENDADDR #
                  IF I02 EQ 3 
                  THEN             # MUST BE B PARAMETER #
                    BEGIN 
                      C<0,6>BEGADDR = "000000"; 
                      C<6-CCOUNT,CCOUNT>BEGADDR = C<0,CCOUNT>CPARVAL[I];
                    END 
                  ELSE
                    BEGIN 
                      C<0,6>ENDADDR = "000000"; 
                      C<6-CCOUNT,CCOUNT>ENDADDR = C<0,CCOUNT>CPARVAL[I];
                    END 
                END 
            END 
          GOTO TESTTER; 
 LO$RTN:                           # LIST OPTION SPECIFIED #
          IF CPARCODE[I] NQ EQUAL  # NO EQUAL SIGN, CHECK AGAIN # 
          THEN
            BADPARM(ECODE"NOVALUE",(CPARVAL[I]),CCOUNT);
          ELSE
            BEGIN 
              REGISTERS = FALSE;   # RESET LIST OPTIONS AT FIRST #
              MACROMEM = FALSE; 
              PAGEREG = FALSE;
              CCOUNT2 = CCOUNT; 
              I = I + 1;
              FINDZERO((CPARVAL[I]),CCOUNT);  # EXAMINE OPTIONS # 
              IF CCOUNT GR BIGPARM
              THEN
                BADPARM(ECODE"ILLVAL",(CPARVAL[I-1]),CCOUNT2);
              ELSE
                BEGIN 
                FOR CCIND=0 STEP 1 UNTIL CCOUNT - 1 
                DO
                  BEGIN 
                  IF C<CCIND,1>CPARVAL[I] EQ "R"
                  THEN
                    BEGIN 
                    REGISTERS = TRUE; 
                    PAGEREG = TRUE; 
                    END 
                  ELSE
                    BEGIN 
                    IF C<CCIND,1>CPARVAL[I] EQ "M"
                    THEN
                      MACROMEM = TRUE;
                    ELSE
                      BEGIN 
                      IF C<CCIND,1>CPARVAL[I] EQ "E"
                      THEN
                        EXPAND = TRUE;
                      ELSE
                        BADPARM(ECODE"ILLVAL",(CPARVAL[I-1]),CCOUNT2);
                      END 
                    END 
                  END 
                END 
              IF EXPAND AND NOT REGISTERS AND NOT MACROMEM
              THEN
                BEGIN 
                REGISTERS = TRUE; 
                MACROMEM = TRUE;
                PAGEREG = TRUE; 
                END 
            END 
          GOTO TESTTER; 
 
CV$RTN:                              # CONVERSION MODE SPECIFIED #
 
          IF CPARCODE[I] NQ EQUAL 
          THEN                       # PARAMETER NOT EQUIVALENCED # 
            BEGIN 
            BADPARM(ECODE"NOVALUE",(CPARVAL[I]),CCOUNT);
            GOTO TESTTER;            # TEST FOR TERMINATOR #
            END 
 
          I = I + 1;                 # SET INDEX TO PARAMETER VALUE # 
          FINDZERO((CPARVAL[I]),CCOUNT);  # GET SIZE OF VALUE # 
 
          IF CCOUNT NQ 2
            OR ((C<0,2>CPARVAL[I] NQ "AS")
              AND (C<0,2>CPARVAL[I] NQ "EB")) 
          THEN                       # ILLEGAL VALUE FOR PARAMETER #
            BEGIN 
            BADPARM(ECODE"ILLVAL",CPARVAL[I-1],2);
            GOTO TESTTER;            # TEST FOR TERMINATOR #
            END 
 
          IF C<0,2>CPARVAL[I] EQ "EB" 
          THEN                       # *EBCDIC* CONVERSION SELECTED # 
            BEGIN 
            EBCDIC = TRUE;           # SET *EBCDIC* CONVERSION FLAG # 
            END 
 
          GOTO TESTTER;              # TEST FOR TERMINATOR #
 
 I$RTN:                            # DIRECTIVE EXISTENCE ACKNOWLEDGED # 
          IF CPARCODE[I] NQ EQUAL 
          THEN
            IF (CPARCODE[I] EQ PARTERM) OR (CPARCODE[I] EQ COMMA) 
            THEN
              INPDIR = TRUE;
            ELSE
              BADPARM(ECODE"NOVALUE",(CPARVAL[I]),CCOUNT);
          ELSE
            BEGIN 
              I = I + 1;
              FINDZERO((CPARVAL[I]),CCOUNT);
              IF (CCOUNT EQ 1) AND (C<0,1>CPARVAL[I] EQ DISZERO)
              THEN           # I=0, NO DIRECTIVE FILE                  #
                BEGIN 
                INPDIR = FALSE; 
                GOTO TESTTER; 
                END 
              FOR J = 0 STEP 1 UNTIL CCOUNT - 1 DO
                BEGIN        # CHECK FOR VALID FILE NAME               #
                IF ( C<J,1>CPARVAL[I] LS DISPLA ) 
                  OR ( C<J,1>CPARVAL[I] GR DISNINE )
                THEN         # ILLEGAL FILE NAME                       #
                  BEGIN 
                  BADPARM(ECODE"ILLVAL",CPARVAL[I-1],1);
                  GOTO TESTTER; 
                  END 
                END 
              P<SIOFET> = LOC(INPUT); 
              FETLFN[0] = C<0,7>CPARVAL[I]; 
              INPDIR = TRUE;
            END 
          GOTO TESTTER; 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        BADPARM             E. SULLIVAN            77/01/31
*                            W. L. CHENG            80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        OUTPUTS ERROR MESSAGES FROM PARAMETER PROCESSING DEPENDING ON
*        THE CODE PASSED TO IT FROM CRACK.
* 
*     3. METHOD USED
*        THE ERROR MESSAGE CODE PASSED FROM CRACK TO BADPARM INDICATES
*        WHICH ERROR MESSAGE IS TO BE OUTPUT.  IF THE PARAMETER WAS 
*        NOT LEGAL, A FLAG IS SET SO THAT ONLY ONE ERROR MESSAGE FOR
*        THE PARAMETER WILL BE OUTPUT.
* 
*     4. ENTRY PARAMETERS:  
*        NUMBER    SUBSCRIPT INDICATING WHICH ERROR HAS OCCURRED
*        VALUE     PARAMETER/VALUE IN ERROR 
*        COUNT     NUMBER OF CHARACTERS IN VALUE
* 
*     5. EXIT PARAMETERS: 
*        ERRFLG    SET TRUE 
*        NOPARAM   SET TRUE TO INDICATE CURRENT PARAM IS ILLEGAL
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        MESSAGE   WRITE MESSAGE TO DAYFILE - SUPIO 
*        PRDFILE   FLUSH OUTPUT BUFFER TO ASSURE DAYFILE MESSAGE- SYMPL 
* 
*     8. DAYFILE MESSAGES:  
*        ILLEGAL NDA CALL PARAMETER XXXXXXX            FATAL ERROR
*        PARAMETER VALUE ILLEGAL FOR XXXXXXX           FATAL ERROR
*        VALUE NEEDED FOR PARAMETER XXXXXXX            FATAL ERROR
*        INVALID CHARACTER AFTER ITEM XXXXXXX          FATAL ERROR
* 
 #
*ENDIF
      PROC BADPARM(NUMBER,(VALUE),COUNT); 
        BEGIN 
          ITEM NUMBER I;          #ERROR MESSAGE SUBSCRIPT# 
          ITEM VALUE  I;          #PARAMETER TO BE PUT IN MESSAGE#
          ITEM COUNT  I;          #PARAMETER CHARACTER COUNT# 
 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
#     THIS PROCEDURE FORMATS AND OUTPUTS THE ERROR MESSAGES 
      ASSOCIATED WITH THE CONTROL CARD CRACKING PROCEDURE             # 
          ERRMESS[0] = "                              ";
          ERRPARAM[0] = "       ";
          ERRMESS[0] = ERRTEXT[NUMBER]; 
          C<0,COUNT>ERRPARAM[0] = C<0,COUNT>VALUE;
          MESSAGE(PARMSG,OPTION); #WRITE ERROR MESSAGE #
          PRDFILE;           # FLUSH OUTPUT BUFFER TO ASSURE DAYFILE  # 
          ERRFLG = TRUE;
          IF NUMBER EQ ECODE"ILLPARAM"
          THEN
            NOPARAM = TRUE; 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FINDZERO            E. SULLIVAN            77/01/31
*                            W. L. CHENG            80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        RETURNS THE CHARACTER COUNT OF A SPECIFIED PARAMETER OR VALUE
*        AS GIVEN BY THE PROCEDURE CRACK. 
* 
*     3. METHOD USED: 
*        THE PARAMETER, AS SPECIFIED IN THE CALL TO FINDZERO IS 
*        SEARCHED UNTIL A CHARACTER WITH VALUE ZERO IS FOUND. 
*        THE NUMBER OF NONZERO CHARACTERS BEFORE THIS FIRST ZERO IS 
*        RETURNED.
* 
*     4. ENTRY PARAMETERS:  
*        SRCHVAU   PARAMETER WHOSE CHARACTERS ARE TO BE COUNTED 
* 
*     5. EXIT PARAMETERS: 
*        NUMCHARS  NUMBER OF CHARACTERS IN SRCHVAL
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        NONE 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
      PROC FINDZERO((SRCHVAL),NUMCHARS);
        BEGIN 
          ITEM NUMCHARS I;        #NUMBER OF NONZERO CHARACTERS#
          ITEM SRCHVAL  C(7);     #PARAMER CHARACTERS TO BE SEARCHED# 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
#     THIS PROCEDURE EXAMINES THE SEVEN CHARACTER FILED SRCHVAL 
      AND COUNTS THE NUMBER OF CHARACTERS PRESENT.  THE SEARCH
      STOPS ON ENCOUNTERING THE FIRST ZERO.                           # 
          NUMCHARS = 0;           #INITIALIZATION#
          FOR CIND = 0 STEP 1 UNTIL 6  DO 
            IF C<CIND,1>SRCHVAL NQ O"00"
            THEN
              NUMCHARS = NUMCHARS + 1;
        END 
CONTROL EJECT;
      PROC READDIR; 
      BEGIN 
*IF DEF,IMS 
# 
**
*E
*     1. PROC NAME:          AUTHOR:             DATE:  
*        READDIR             M.E.VATCHER         81/04/01 
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        COPIES INPUT DIRECTIVES TO OUTPUT FILE AND TO ZZZZINP. 
* 
*     3. METHODS USED:  
*        PRINT A HEADING. CALL READI TO GET A DIRECTIVE AND 
*        PRINTH TO COPY IT TO THE OUTPUT FILE. COPY THE LINES TO
*        THE ZZZZINP FILE. LOOP TILL THE END OF DIRECTIVES. 
* 
*     4. ENTRY PARAMETERS:  
*        NONE 
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        MESSAGE    WRITE MESSAGE TO DAYFILE
*        PRINTH     WRITE A LINE TO OUTPUT FILE 
*        READI      RAD INPUT FILE
*        WRITEH     WRITE A CODED LINE IN H FORMAT
*        WRITER     WRITE END OF RECORD TO FILE 
* 
*     8. DAYFILE MESSAGE: 
*        DIRECTIVE FILE XXXXXXX EMPTY.
* 
* 
# 
*ENDIF
      XREF
        BEGIN 
        FUNC XSFW C(10);
        ITEM ZZZZINP; 
        END 
 
      DEF LOCAL #3#;
 
      ITEM TEMPC C(10); 
 
      ARRAY DIREMPTY [0:0] S(3);
        BEGIN 
        ITEM DIREMPTY1 C(0,0,29) =
          ["DIRECTIVE FILE XXXXXXX EMPTY."];
        ITEM DIREMPTY2 C(1,30,7); 
        ITEM DIREMPTYZ U(2,48,12) = [ 0 ];
        END 
 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
      TTL0 = "1          *** A COPY OF INPUT DIRECTIVES ***"; 
      HEADING;
      STRING = " "; 
      FOR DUMMYI = 0 WHILE NOT IEOF DO
        BEGIN 
        READI;
        IF IEOF 
        THEN                 # END OF INPUT FILE                       #
          BEGIN 
          IF IFIRSTRD 
          THEN               # DIRECTIVE FILE IS EMPTY                 #
            BEGIN 
            TEMPC = XSFW(C<0,7>INPUT);
            DIREMPTY2[0] = C<0,7>TEMPC; 
            MESSAGE(DIREMPTY,LOCAL);
            END 
          TEST DUMMYI;
          END 
        IFIRSTRD = FALSE; 
        INPBUFD = INPBUFC;
        PRINTH(OUTBUFI,9);
        WRITEH(ZZZZINP,INPBUF,8); 
        END 
      WRITER(ZZZZINP,"R");
      END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        DNPROC              JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        DEPENDING ON FLAGS SET BY PROCEDURE CRACK, DNPROC PROCESSES
*        THE DUMP RECORD PASSED BY THE MAIN PROCEDURE. DNPROC CALLS 
*        THE PROCEDURE BLDFILE TO REFORMAT THE DUMP RECORD INTO A 
*        RANDOM FILE. IF THE INPUT DIRECTIVE FILE IS PRESENT, A 
*        DIRECTIVE FILE IS READ AND THE CORRESPONDING FORMAT ROUTINE IS 
*        CALLED TO PROCESS IT.
* 
*     3. METHOD USED: 
*        PROCEDURE PREP IS CALLED TO DETERMINE IF THE DUMP RECORD IS
*        IN MULTI-HOST NPU DUMP RECORD FORMAT. IF SO, THE DUMP RECORD 
*        IS CONVERTED BACK INTO THE PRE-MULTI-HOST FORMAT FOR 
*        SUBSEQUENT PROCESSING. 
*        IF DIRECTIVES FILE PRESENT, READ A DIRECTIVE AND CONVERT THE 
*        PARAMETERS TO OCTAL, THEN GOTO CORRESPONDING FORMAT ROUTINE TO 
*        PROCESS DUMP INFORMATION. IF THERE IS  NO DIRECTIVES FILE, DUMP
*        PROCESS IS  CONTROLED BY PARAMETERS ON NDA CALL. THE DUMP FILE 
*        IS RETURNED WHEN ALL PROCESSING ON THE DUMP FILE IS COMPLETE.
* 
*     4. ENTRY PARAMETERS:  
*        LISTT      SET TRUE IF REPORT LISTING WANTED 
*        REGISTERS  TRUE IF REGISTERS ARE TO BE PROCESSED 
*        MACROMEM   TRUE IF MACRO MEMORY IS TO BE PROCESSED 
* 
*     5. EXIT PARAMETERS: 
*        EOF        END OF FILE INDICATOR 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
* 
*        BLDFILE    COPY DUMP FILE TO RANDOM WORK FILE NEUFILE - SYMPL
*        MOVE       MOVE A BLOCK OF MEMORY WORDS - SUPIO
*        FORM1      FORMAT HEADER RECORD - SYMPL
*        HEADING    PRINT HEADING INFORMATION - SYMPL 
*        READI      READ A INPUT DIRECTIVE - SYMPL
*        SYNCHK     SYNTAX CHECK AND CONVERSION - SYMPL 
*        CLOSSIO    CLOSE SUPIO RANDOM FILE - SUPIO 
*        RETERN     RETURN FILE - SUPIO 
*        REWIND     REWIND FILE - SUPIO 
*        RECALL     PUT PROGRAM OR FUNCTION IN RECALL STATUS - MACREL 
*        MESSAGE    WRITE A MESSAGE TO DAYFILE - MACREL 
*        PREP       DUMP RECORD PREPROCEESOR
*        PRINTH     PRINT A LINE TO OUTPUT - SYMPL
*        FORMAT0    FORMAT COMMENT CARDS - SYMPL
*        FORMAT1    FILE 1 AND MACRO MEMORY INTERPRETER - SYMPL 
*        FORMAT3    FORMAT CONTINUOUS DATA STRUCTURES - SYMPL 
*        FORMAT4    FORMAT CIRCULAR BUFFER - SYMPL
*        FORMAT9    FORMAT FILE 1 AND MACRO MEMORY RECORDS - SYMPL
*        FORMATA    FORMAT LCB/TCB - SYMPL
*        FORMATB    FORMAT PORT/MUX TABLES - SYMPL
*        FORMATF    FINISH - SYMPL
* 
*     8. DAYFILE MESSAGES:  
*        PROCESSING COMPLETE ON DMPAXXX 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         PROCESS DUMP FROM INPUT DIRECTIVES                           #
#                                                                      #
#**********************************************************************#
      PROC DNPROC(EOF); 
        BEGIN 
          XREF
            BEGIN 
            ITEM FDMP;
            ITEM ZZZZINP; 
            END 
          SWITCH RULE RULE0,RULE1,RULE2,RULE3,RULE4,RULE5,RULE6,RULE7,
                      RULE8,RULE9,RULEA,RULEB,RULEC,RULED,RULEE,RULEF;
          ITEM EOF B; 
          ITEM ERRI B;       # ERROR FLAG # 
      CONTROL EJECT;
#*********************************************************************# 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#*********************************************************************# 
 
          PAGENO = 0;        # RESET PAGE NUMBER #
          LINENO = 0;        # RESET LINE NUMBER #
          SUPERR = FALSE;    # INITIAL FLAG # 
          PREP(EOF);         # CALL PREPROCESSOR                       #
          IF EOF
          THEN
            RETURN;          # ***** EXIT *****                        #
 
          BLDFILE;           # COPY DUMP FILE TO A RANDOM FILE #
          IF SUPERR 
          THEN               # ERROR IN BUILDING RANDOM FILE #
            BEGIN 
            RETURN;          # RETURN TO MAIN LOOP #
            END 
          FORM1;             # PRINT TITLE PAGE # 
          STRING = " ";      # CLEAR WORKING BUFFER # 
          IF NOT INPDIR 
          THEN               # DIRECTIVE FILE NOT PRESENT # 
            BEGIN 
            IF REGISTERS
            THEN
              BEGIN        # PRINT FILE 1 REGISTERS TO OUTPUT # 
              TTL0 = TTL1;         # MOVE HEADER #
              RULES = 8;           # SET FILE 1 TO BE DUMPED #
              HEADING;             # WRITE HEADING #
              FORMAT9;             # FORMAT FILE 1 DUMP # 
              FILE1B = FALSE;       # CLEAR FILE1 REG FLAG   #
              END 
            IF PAGEREG AND R7 
            THEN
              BEGIN          # PRINT PAGE REGISTERS TO OUTPUT          #
              TTL0 = TTL2;   # MOVE HEADER                             #
              RULES = 7;     # SET PAGE REGISTERS TO BE DUMPED         #
              HEADING;       # WRITE HEADING                           #
              FORMAT9;       # FORMAT PAGE REG DUMP                    #
              PREG = FALSE;  # CLEAR PAGE REGISTER FLAG                #
              END 
            IF MACROMEM 
            THEN           # PRINT MACRO MEMORY TO OUTPUT # 
              BEGIN 
              TTL0 = TTL4;         # FORMAT TITLE LINE #
              RULES = 9;           # SET MACRO MEMORY TO BE DUMPED #
              HEADING;             # WRITE HEADING #
              FORMAT9;             # FORMAT MACRO MEMORY DUMP # 
              END 
            END 
          ELSE
            BEGIN            # DIRECTIVE CONTROL DUMP # 
            RULES = 0;
            REWIND(ZZZZINP);
            READ(ZZZZINP);
            RECALL(ZZZZINP);
            IEOF = FALSE;  # RESET END OF FILE INDICATOR #
            FOR DUMMYI=0 STEP 1 WHILE NOT IEOF
            DO
              BEGIN 
              LENGTH = 8; 
              READH(ZZZZINP,INPBUF,LENGTH,IOSTAT);
              RECALL(ZZZZINP);
              IF IOSTAT NQ 0
              THEN
                BEGIN 
                IEOF = TRUE;
                TEST DUMMYI;
                END 
            IF RULEI NQ " " 
            THEN       # IF NEW RULE SPECIFIED #
              BEGIN 
              DISHEX(RULEI,RULES,1,ERRI); # CONVERT RULE TO HEX#
              IF ERRI 
              THEN   # RULE ERROR # 
                RULES = 14;    # SET TO INVALID RULE #
              C<0,11>TTL0 = "1";
              C<11,90>TTL0 = C<10,70>INPBUFC; 
              HEADING;         # WRITE HEADING #
              IF RULES LS 5 OR RULES EQ 10 OR RULES EQ 11 
              THEN
                TEST DUMMYI;
              END 
              SYNCHK(ERRI);    # SYNTAX CHECK AND CONVERSION #
              IF ERRI          # DIRECTIVE ERROR THEN NEXT #
              THEN
                TEST DUMMYI;
                  GOTO RULE[RULES];    # GOTO FORMAT ROUTINE BY RULE #
 RULE0: 
                  FORMAT0;             # FORMAT COMMENTS CARD # 
                  TEST DUMMYI;
 RULE1: 
 RULE2: 
                  FORMAT1;             # FILE 1 OR MACROMEM INTERPRETER#
                  TEST DUMMYI;
 RULE3: 
                  FORMAT3;             # FORMAT CONTIGUOUS BLOCK #
                  TEST DUMMYI;
 RULE4: 
                  FORMAT4;             # FORMAT CIRCULAR BUFFERS #
                  TEST DUMMYI;
 RULE7: 
 RULE8: 
 RULE9: 
                  FORMAT9;             # FORMAT FILE 1 OR MACROMEM DUMP#
                  TEST DUMMYI;         # OR PAGE REGISTERS             #
 RULEA: 
                  FORMATA;             # FORMAT LCB/TCB # 
                  TEST DUMMYI;
 RULEB: 
                  FORMATB;             # FORMAT PORT TABLE AND MUXLCBS #
                  TEST DUMMYI;
 RULEF: 
                  FORMATF;             # END OF NDA DIRECTIVES #
                  TEST DUMMYI;
 RULE5: 
 RULE6: 
 RULEC: 
 RULED: 
 RULEE:                                # INVALID RULES #
                  INPBUFD = INPBUFC;   # MOVE DIRECTIVE FOR MESSAGE # 
                  PRINTH(OUTBUFI,9);   # PRINT ERROR DIRECTIVE #
                  PRINTH(COL1ERR,5);   # PRINT ERROR MESSAGE #
                  RULES = 0;
                  TEST DUMMYI;
                END 
            END 
          CLOSSIO(LOC(NEUFILE),"REWIND"); 
          RETERN(NEUFILE);   # RETURN RANDOM WORK FILE #
          RETERN(FDMP); 
          WRITER(OUTPUT,"R");# FLUSH OUTPUT BUFFER                     #
          DMPWD1[0] = 0;     # CLEAR DUMP FILE BUFFER # 
          DMPWD2[0] = 0;     # CLEAR DUMP FILE BUFFER # 
          MESSAGE(PRCOMP,LOCAL);  # PROCESSING COMPLETE ON XXXXXXX     #
        END 
      CONTROL EJECT;
      PROC PREP(EOF); 
      BEGIN 
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:          AUTHOR:             DATE:  
*        PREP                M.E. VATCHER        81/04/13 
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        THIS PROCEDURE WILL REFORMAT A MULTI-HOST NPU DUMP RECORD
*        TO PRE-MULTI-HOST DUMP FILE FORMAT.
* 
*     3. METHODS USED:  
*        INITIATE READ OF NPU DUMP RECORD 
*        IF HEADER RECORD INDICATES A MULTI-HOST FORMAT:  
*          FORMAT PRE-MULTIHOST HEADER RECORD FROM 7700 TABLE,
*          WRITE HEADER TO FILE FDMP, 
*          FOR ALL DUMP BLOCKS IN THE DUMP RECORD:  
*            READ DUMP BLOCK HEADER,
*            BUILD BEGINNING ADDRESS TABLE FOR ADDRESS SEQUENCING,
*            FOR ALL DUMP PACKETS WITHIN THE DUMP BLOCK:  
*              READ DUMP PACKET HEADER, GET BEGINNING ADDRESS, AND
*              USING THE BEGINNING ADDRESS TABLE, FIND PLACE ( IN 
*              IN ASCENDING ADDRESSES ) IN WRITE BUFFER.
*            WRITER DUMP BLOCK RECORD.
* 
*     4. ENTRY PARAMETERS:  
*        NONE 
* 
*     5. EXIT PARAMETERS: 
*        EOF        END OF FILE INDICATOR 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        ABORT      ABORT PROGRAM 
*        MESSAGE    WRITE MESSAGE TO DAYFILE
*        READ       READ FILE 
*        READW      READ WORDS FROM FILE
*        RECALL     GIVE UP CPU 
*        REWIND     REWIND FILE 
*        WRITER     FLUSH FILE AND WRITE EOR
*        XCHD       CONVERT HEXADECIMALS TO DISPLAY CODE
*        XSFW       BLANK-FILLED WORD 
* 
*     8. DAYFILE MESSAGES:  
*        DUMP FILE XXXXXXX EMPTY. 
*        PREMATURE END OF FILE ON XXXXXXX.
* 
 #
*ENDIF
 
      XREF
        BEGIN 
        ITEM FDMP U;
        ITEM NDF U; 
        PROC READW; 
        FUNC XCHD C(10);
        FUNC XSFW C(10);
        END 
 
      DEF LOCAL #3#;
 
      ITEM BA U;             # BEGINNING ADDRESS                       #
      ITEM BC U;             # BATCH COUNT                             #
      ITEM CURBA U;          # CURRENT BEGINNING ADDRESS               #
      ITEM EA U;             # ENDING ADDRESS                          #
      ITEM EOR B = FALSE;    # END OF RECORD INDICATOR                 #
      ITEM EOF B;            # END OF FILE INDICATOR                   #
      ITEM STATIS U;         # RETURNED STATUS FROM READW              #
      ITEM TEMPC C(10); 
      ITEM WC U;             # 60 BIT WORD COUNT                       #
 
      ARRAY DB [0:63] S(1); 
        BEGIN 
        ITEM DBBA U(0,0,24);  # BEGINNING ADDRESS                      #
        ITEM DBLEN U(0,24,12);  # LENGTH OF DUMP PACKET                #
        ITEM DBZ U(0,36,24) = [ 0 ];
        END 
 
      ARRAY NDFBF [0:16] S(1);
        BEGIN 
        ITEM NDFBUF U(0,0,60);
        END 
 
      ARRAY DFE [0:0] S(3); 
        BEGIN 
        ITEM DFE1 C(0,0,25) = [" DUMP FILE XXXXXXX EMPTY"]; 
        ITEM DFE2 C(1,06,7);
        ITEM DFEZ U(2,24,36) = [ 0 ]; 
        END 
 
      ARRAY PEOF [0:0] S(4);
        BEGIN 
        ITEM PEOF1 C(0,0,34) = [" PREMATURE END OF FILE ON XXXXXXX."];
        ITEM PEOF2 C(2,36,7); 
        ITEM PEOFZ U(3,18,42) = [ 0 ];
        END 
 
      BASED ARRAY DBUFFER [0:0] S(1); 
        BEGIN 
        ITEM DBUFFER1 U(0,0,60);
        END 
 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
      READ(NDF);
      RECALL(NDF);
      P<SIOFET> = LOC(NDF); 
      IF FETSTAT[0] EQ RDEOF OR FETSTAT[0] EQ RDEOI 
      THEN
        BEGIN                # END OF FILE                             #
        IF NDFFIRSTRD 
        THEN                 #NDF IS EMPTY                             #
          BEGIN 
          TEMPC = XSFW(C<0,7>NDF);
          DFE2[0] = C<0,7>TEMPC;
          MESSAGE(DFE,LOCAL); 
          ABORT;
 
          END 
        EOF = TRUE; 
        RETURN;              # ***** EXIT *****                        #
 
        END 
      NDFFIRSTRD = FALSE;    # NEXT READ WILL NOT BE THE FIRST         #
      READW(NDF,NDFBF,17,STATIS); 
      IF B<0,12>NDFBUF[0] NQ O"7700"
      THEN                   # SKIP THE PREPROCESSOR                   #
        BEGIN                # ITS AN R5 FORMAT DUMP FILE              #
        R7 = FALSE;          # NOT AN R7 DUMP FILE                     #
        C<0,7>FDMP = C<0,7>NDF;  # PUT DUMP FILE NAME IN FDMP FET      #
        DFNAME = C<0,7>NDF;  # SET DUMP FILE NAME FOR OUTPUT           #
        REWIND(FDMP); 
        RECALL(FDMP); 
        PRCOMP2[0] = C<0,7>NDF;  # FOR PROCESSING COMPLETE MESSAGE     #
        RETURN;              # ***** EXIT *****                        #
 
        END 
      IF STATIS NQ 0
      THEN                   # PREMATURE END OF RECORD                 #
        BEGIN 
        TEMPC = XSFW(C<0,7>NDF);
        PEOF2[0] = C<0,7>TEMPC; 
        MESSAGE(PEOF,LOCAL);
        ABORT;
 
        END 
      R7 = TRUE;             # ITS AN R7 FORMAT DUMP FILE              #
      PRCOMP2[0] = C<0,7>NDFBUF[1];  # FOR PROCESSING COMPLETE MSG     #
      DFNAME = C<0,7>NDFBUF[1];        # SET DUMP FILE NAME FOR OUTPUT #
                                       # IN FORM1 PROC                 #
      B<0,18>FDMPBUF[0] = 0;
      C<3,7>FDMPBUF[0] = C<0,7>NDFBUF[3];  # SET FIRST PART OF TIME    #
      C<0,1>FDMPBUF[1] = C<7,1>NDFBUF[3];  # SET SECOND PART OF TIME   #
      C<2,8>FDMPBUF[1] = C<0,8>NDFBUF[2];  # SET DATE                  #
      C<0,7>FDMPBUF[2] = C<0,7>NDFBUF[15]; # SET NODE NAME             #
      C<7,3>FDMPBUF[2] = 0;                # ZERO FILL REST OF WORD 2  #
      TEMPC = XCHD(B<36,8>NDFBUF[16]);
      PRNNODE2[0] = C<8,2>TEMPC;
      TEMPC = XCHD(B<44,16>NDFBUF[16]); 
      PRHALT2[0] = C<6,4>TEMPC; 
      TEMPC = XCHD(B<44,16>NDFBUF[15]); 
      PRPREG2[0] = C<6,4>TEMPC; 
      P<SIOFET> = LOC(FDMP);
      FETFST[0] = LOC(FDMPBF);
      FETLMT[0] = FETFST[0] + O"3501";
      FETOUT[0] = FETFST[0];
      FETIN[0] = FETFST[0] + 3; 
      WRITER(FDMP); 
 
      EOR = FALSE;
      FOR I=1 WHILE NOT EOR DO
        BEGIN 
        FETIN[0] = FETFST[0];  #RESET FDMP FET POINTERS                #
        FETOUT[0] = FETFST[0];
        READW(NDF,NDFBF,1,STATIS);
        IF STATIS NQ 0
        THEN                 # END OF RECORD                           #
          BEGIN 
          EOR = TRUE; 
          TEST I; 
          END 
 
        B<0,3>FDMPBUF[0] = B<0,3>NDFBUF[0];   # SET RECORD TYPE FIELD  #
        BC = B<4,8>NDFBUF[0];  # GET BATCH COUNT                       #
        BA = B<12,24>NDFBUF[0];  # GET BEGINNING ADDRESS               #
        EA = B<36,24>NDFBUF[0];  # GET ENDING ADDRESS FOR THIS BATCH   #
        B<12,24>FDMPBUF[0] = BA;
        B<36,24>FDMPBUF[0] = EA;
        FETIN[0] = FETIN[0] + 1;  # KEEP TRACK OF PLACE IN FDMP FET    #
        CURBA = BA;          # SET CURRENT BEGINNING ADDRESS           #
        FOR J = 0 STEP 1 WHILE CURBA LQ EA DO 
          BEGIN 
          DBBA[J] = CURBA;
          IF CURBA + 105 GR EA
          THEN               # LAST PACKET OF BATCH                    #
            DBLEN[J] = EA - CURBA + 1;
          ELSE
            DBLEN[J] = 105; 
          CURBA = CURBA + DBLEN[J]; 
          END 
        FOR J = 1 STEP 1 UNTIL BC DO
          BEGIN 
          READW(NDF,NDFBF,1,STATIS);
          IF STATIS NQ 0
          THEN               # PREMATURE END OF FILE                   #
            BEGIN 
            TEMPC = XSFW(C<0,7>NDF);
            PEOF2[0] = C<0,7>TEMPC; 
            MESSAGE(PEOF,LOCAL);
            ABORT;
 
            END 
          WC = B<0,12>NDFBUF[0];  # 60 BIT WORD COUNT OF DUMP PACKET   #
          BA = B<36,24>NDFBUF[0];  # ACTUAL BA OF DUMP PACKET          #
          FOR K=0 STEP 1 UNTIL BC DO
            BEGIN 
            IF BA EQ DBBA[K]
            THEN
              BEGIN          # MOVE DATA TO APPROPRIATE PLACE          #
              P<DBUFFER> = LOC(FDMPBUF[0]) + K*28 + 1;
              READW(NDF,DBUFFER,WC-1,STATIS); 
              IF STATIS NQ 0
              THEN           # PREMATURE END OF RECORD                 #
                BEGIN 
                TEMPC = XSFW(C<0,7>NDF);
                PEOF2[0] = C<0,7>TEMPC; 
                MESSAGE(PEOF,LOCAL);
                ABORT;
 
                END 
              FETIN[0] = FETIN[0] + WC - 1; 
              END 
            END 
          END 
        WRITER(FDMP,"R"); 
        END 
      END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        BLDFILE             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        BLDFILE COPIES THE DUMP FILE DMPAXXX TO A RANDOM WORK FILE 
*        NEUFILE. 
* 
*     3. METHOD USED: 
*        READ RECORDS FROM DUMP FILE DMPAXXX, IF RECORD TYPE OTHER THAN 
*        MACRO MEMORY RECORD,THEN SAVE IN CORE, IF MACRO MEMORY RECORDS 
*        FOUND, THEN COPY THE RECORD TO A SUPIO RANDOM FILE WITH END
*         ADDRESS AND BEGIN ADDRESS OF THIS RECORD FOR KEY VALUE. 
* 
*     4. ENTRY PARAMETERS:  
*        NONE 
* 
*     5. EXIT PARAMETERS: 
*        HEADRB     TRUE IF HEAD RECORD PRESENT IN DUMP FILE
*        FILE1B     TRUE IF FILE 1 RECORD PRESENT IN DUMP FILE
*        STATRB     TRUE IF STATUS RECORD PRESENT IN DUMP FILE
*        CKSUMB     TRUE IF CHECKSUM RECORD PRESENT IN DUMP FILE
*        MACROB     TRUE IF MACRO MEMORY RECORD PRESENT 
* 
*     6. COMDECKS CALLED
*        NONE 
* 
*     7. ROUTINES CALLED
*        REWIND     REWIND FILE 
*        RECALL     PUT PROGRAM IN RECALL STATUS - MACREL 
*        OPENSIO    OPEN SUPIO FILE - SUPIO 
*        CLOSSID    CLOSE SUPIO FILE - SUPIO
*        READSR     READ A SEQUENTIAL RECORD - SUPIO
*        MOVE       MOVE A BLOCK OF MEMORY WORDS - MACREL 
*        WRITERI    WRITE A RANDOM RECORD - SUPIO 
*        WRITERR    WRITE A SUPIO ERROR MESSAGE - SYMPL 
*        PRINTH     PRINT A LINE TO OUTPUT - SYMPL
*        RETERN     RETURN FILE - MACREL
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         PROCEDURE TO COPY DUMP FILE TO A RANDOM FILE                 #
#                                                                      #
#**********************************************************************#
      PROC BLDFILE; 
        BEGIN                # COPY DUMP FILE TO RANDOM FILE NEUFILE #
          ITEM NOTEOF B=TRUE;          # END OF FILE FLAG # 
          ITEM ICODE U=0;    # RECORD TYPE #
          ITEM II;           # INDEX #
          SWITCH RECCOD RECOD0,RECOD1,RECOD2,RECOD3,RECOD4,RECOD5,
                        RECOD6; 
      CONTROL EJECT;
#*********************************************************************# 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          P<DMPBUF> = LOC(DMPBUF1);    # LOCATE DUMP FILE BUFFER #
          HEADRB = FALSE;    # INITIAL FLAG # 
          FILE1B = FALSE; 
          STATRB = FALSE; 
          CKSUMB = FALSE; 
          MACROB = FALSE; 
          PREG = FALSE; 
          NOTEOF = TRUE;
          REWIND(FDMP);      # REWIND DUMP FILE # 
          RECALL(FDMP); 
          OPENSIO(LOC(NEUFILE),"NEW",IOSTAT);    # OPEN RANDOM FILE # 
          IF IOSTAT NQ 0
          THEN               # OPEN ERROR # 
            WRITERR("NEUFILE","OPENING ",IOSTAT);   # ISSUE ERROR MESS# 
          FOR DUMMYI=0 WHILE NOTEOF 
          DO
            BEGIN 
              LENGTH = BUFLEN;         # SET BUFFER LENGTH #
              READSR(LOC(FDMP),LOC(DMPBUF),LENGTH,IOSTAT); # READ A REC#
              IF IOSTAT EQ RDEOF OR IOSTAT EQ RDEOI 
              THEN            # END OF FILE ENCOUNTERED # 
                BEGIN 
                  NOTEOF = FALSE; 
                  TEST DUMMYI;
                END 
              ELSE           # NOT END OF FILE #
                IF IOSTAT NQ 0 AND IOSTAT NQ RDEOR
                  THEN       # READ ERROR # 
                    WRITERR(FDMP,"READING ",IOSTAT);
              ICODE = B<0,3>DMPWD[0];  # GET RECORD TYPE FROM RECORD #
              IF ICODE GR 6 
              THEN           # INVALID RECORD TYPE #
                ICODE = 3;
              GOTO RECCOD[ICODE];      # GO TO CORRESPONDING ROUTINE #
 RECOD0:                     # RECORD TYPE 0, HEADER #
              HEADRB = TRUE;           # HEADER RECORD EXIST #
              MOVE(3,DMPBUF,HEADREC);  # SAVE HEADER #
              TEST DUMMYI;   # TEST END OF FILE CONDITION # 
 RECOD1:                     # RECORD TYPE 1, FILE 1 REGISTERS #
              FILE1B = TRUE;           # FILE 1 EXIST # 
              MOVE(71,DMPBUF,FILE1REC);# SAVE FILE 1 IN CORE #
              B<36,24>FILE1REC1[0] = B<36,24>FILE1REC1[0] - 
                B<12,24>FILE1REC1[0]; 
              B<12,24>FILE1REC1[0] = 0; 
              TEST DUMMYI;   # TEST END OF FILE CONDITION # 
 RECOD2:                   # RECORD TYPE 2, PAGE REGISTER RECORD EXISTS#
              PREG = TRUE;   # PAGE REGISTER RECORD EXISTS             #
              MOVE(MAXPGREG,DMPBUF,PAGREGREC);#SAVE PAG REG IN CORE#
              B<36,24>PAGREGREC1[0] = B<36,24>PAGREGREC1[0] - 
                B<12,24>PAGREGREC1[0];
              B<12,24>PAGREGREC1[0] = 0;
              TEST DUMMYI;   # TEST END OF FILE CONDITION              #
 RECOD3:                     # INVALID RECORD TYPE #
              STRING = " UNRECOGNIZED RECORD IN DUMP FILE ";
              PRINTH(OUTBUF,14);       # PRINT ERROR MESSAGE #
              STRING = " "; 
              TEST DUMMYI;   # TEST END OF FILE CONDITION # 
 RECOD4:                     # RECORD TYPE 4, MACRO MEMORY RECORDS #
              MACROB = TRUE;           # MACRO MEMORY RECORD EXIST #
              B<0,12>RECKEY = 0;       # CONSTRUCT RECORD KEY # 
              B<12,24>RECKEY = B<36,24>DMPWD[0];
              B<36,24>RECKEY = B<12,24>DMPWD[0];
              WRITERI(LOC(NEUFILE),RECKEY,LOC(DMPBUF),LENGTH,IOSTAT); 
                             # WRITE A RECORD TO RANDOM FILE #
              IF IOSTAT NQ 0
              THEN           # WRITE ERROR #
                WRITERR("NEUFILE","WRITING ",IOSTAT); 
              TEST DUMMYI;   # TEST END OF FILE CONDITION # 
 RECOD5:                     # RECORD TYPE 5, CHECKSUM RECORD # 
              CKSUMB = TRUE; # SET CHECKSUM RECORD EXIST FLAG # 
              CKSUMREC = DMPWD[0];     # SAVE CHECKSUM RECORD IN CORE # 
              TEST DUMMYI;   # TEST END OF FILE CONDITION # 
 RECOD6:                     # RECORD TYPE 6, STATUS RECORD # 
              STATRB = TRUE; # SET STATUS RECORD EXIST FLAG # 
              STATREC = DMPWD[0];      # SAVE STATUS RECORD IN CORE # 
              TEST DUMMYI;   # TEST END OF FILE CONDITION # 
            END 
          CLOSSIO(LOC(NEUFILE),"REWIND");        # CLOSE RANDOM FILE #
          OPENSIO(LOC(NEUFILE),"READ",IOSTAT);   # OPEN FILE FOR READ # 
          IF IOSTAT NQ 0
          THEN               # OPEN ERROR # 
            WRITERR("NEUFILE","OPENING ",IOSTAT); 
       END
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORM1               E. SULLIVAN            77/01/31
*                            JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORM1 FORMATS THE INFORMATION IN THE DUMP FILE HEADER AND
*        WRITES THIS TO OUTPUT. 
* 
*     3. METHOD USED: 
*        DATA FIELDS ARE TAKEN FROM THE RECORD IN CORE, CONVERTED TO
*        OCTAL DISPLAY IF NECESSARY, AND WRITTEN TO OUTPUT IN THE PROPER
*        FORMAT.
* 
*     4. ENTRY PARAMETERS:  
*        HEADRB     SET TRUE IF HEADER RECORD PRESENT 
*        STATRB     SET TRUE IF STATUS RECORD PRESENT 
*        CKSUMB     SET TRUE IF CHECKSUM RECORD PRENSET 
*        HEADREC    CONTAINS HEADER RECORD
*        STATREC    CONTAINS STATUS RECORD
*        CKSUMREC   CONTAINS CHECKSUM RECORD
*        DNDIS      CONTAINS DISPLAY CODE OF DUMP FILE NUMBER 
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        XCOD      CONVERT OCTAL TO DISPLAY CODE - SUPIO
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        HEXDIS     CONVERT HEXADECIMAL TO DISPLAY CODE - SYMPL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#         FORMAT HEADER RECORD PROCEDURE                               #
#                                                                      #
#**********************************************************************#
      PROC FORM1; 
        BEGIN 
          IF NOT HEADRB 
          THEN               # HEAD RECORD NOT IN DUMP FILE # 
            BEGIN 
              PRINTH(HEADERR,5);
              RETURN; 
            END 
          P<CCARD> = O"70";  # CONTROL CARD IMAGE AREA #
          PRDN2[0] = DFNAME; # SET UP DUMP FILE NAME FOR HEADER # 
          FOR ICD=0 STEP 1 WHILE C<ICD,1>CCRD[0] NQ O"00" 
          DO                 # MOVE CHARACTERS UNTIL END OF CARD #
            C<ICD+10,1>PRDN3[0] = C<ICD,1>CCRD[0];
          NDAVER[0] = NAMVER[0];       # FILL IN NDA VERSION NO.# 
          C<0,4>NDAVER[0] = " NDA"; 
          NDALEV[0] = NAMLV[0]; 
          MOVE(10,PRDN,TTL); # MOVE HEADING INFORMATION # 
          RULES = 0;
          HEADING;           # WRITE HEADING #
          PRINTH(BLLINE,3); 
          PRINTH(BLLINE,3); 
          PRTIME2[0] = C<3,7>HEADREC0[0]; 
          PRTIME3[0] = C<0,1>HEADREC0[1]; 
          PRINTH(PRTIME,2);  # PRINT TIME LINE #
          PRDATE2[0] = C<2,8>HEADREC0[1]; 
          PRINTH(PRDATE,2);  # PRINT DATE LINE #
          PRNPU2[0] = C<0,7>HEADREC0[2];
          PRINTH(PRNPU,2);   # PRINT NPU NAME LINE #
          IF R7 
          THEN               # ITS AN R7 FORMAT DUMP FILE              #
            BEGIN            # PRINT ADDITIONAL INFORMATION            #
            PRINTH(PRNNODE,2);
            PRINTH(PRHALT,2); 
            PRINTH(PRPREG,2); 
            END 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        SYNCHK              JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        SYNCHK SYNTAX CHECK THE INPUT DIRECTIVES AND CONVERT THE 
*        PARAMETERS ON DIRECTIVE TO HEXADECIMAL.
* 
*     3. METHOD USED: 
*        SYNCHK CALL THE SUBROUTINE DISHEX TO CONVERT PARAMETERS TO 
*        HEXADECIMAL AND SAVE IT IN PARAMETER ARRAY PARAMT. IF ERROR
*        FLAG SET BY DISHEX, THEN PRINT THE ERROR MESSAGE AND SET 
*        DIRECTIVE ERROR FLAG DIRERR. 
* 
*     4. ENTRY PARAMETERS:  
*        RULES      RULE NUMBER OF THIS DIRECTIVE 
* 
*     5. EXIT PARAMETERS: 
*        DIRERR     DIRECTIVE ERROR FLAG
*        PARAMT     ARRAY CONTAINS INPUT PARAMETERS 
* 
*     6. COMDECKS CALLED
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        DISHEX     CONVERT DISPLAY CODE TO HEXADECIMAL - SYMPL 
*        PRINTH     PRINT A LINE TO OUTPUT - SYMPL
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#         INPUT DIRECTIVES SYNTAX CHECK AND CONVERSION                 #
#                                                                      #
#**********************************************************************#
      PROC SYNCHK(DIRERR);
        BEGIN                # INPUT DIRECTIVES SYNTAX CHECK #
          ARRAY NUMPARA [0:15] S(1);
            BEGIN  # NUMBER OF PARAMER FOR CORRESPONDING RULE # 
         ITEM NUMPAR U(0,0,60)=[0,1,1,5,7,0,0,0,0,0,7,8,0,0,0,0]; 
            END 
          ITEM DIRERR B;     # ERROR FLAG # 
          ITEM III I;        # INDEX #
          ITEM I;            # INDEX #
          ITEM WORKCI C(10);           # WORKING AREA # 
          ITEM WORKUI U;               # WORKING AREA # 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          DIRERR = FALSE;    # RESET ERROR FLAG # 
          FOR I= 1 STEP 1 UNTIL NUMPAR[RULES] 
          DO
            BEGIN 
              III = (I - 1) * 6 + 1;   # START POSITION # 
              WORKCI = C<III,5> INPBUFC;
              DISHEX(WORKCI,WORKUI,5,DIRERR);    # CONVERT TO HEX. #
              IF DIRERR 
              THEN           # ERROR IN CONVERSION #
                BEGIN 
                  INPBUFD = INPBUFC;
                  PRINTH(OUTBUFI,9);   # PRINT THE ERROR DIRECTIVE #
                  ERRFIELD = WORKCI;
                  PRINTH(DIRMES1,6);   # PRINT ERROR MESSAGE #
                  PRINTH(BLLINE,1);    # PRINT A BLANK LINE # 
                  RETURN; 
                END 
              IF C<(I-1)*6,1>INPBUFC NQ " " AND C<(I-1)*6,1>INPBUFC 
                 NQ "," 
              THEN           # SEPERATOR ERROR #
                BEGIN 
                  DIRERR = TRUE;
                  INPBUFD = INPBUFC;
                  PRINTH(OUTBUFI,9);
                  III = (I - 1) * 6 + 1;
                  WORKCI = XCDD(III); 
                  DIRMES23 = C<6,4> WORKCI; 
                  PRINTH(DIRMES2,6);   # PRINT ERROR MESSAGE #
                  PRINTH(BLLINE,1);    # PRINT A BLANK LINE # 
                  RETURN; 
                END 
              PARAMT[I-1] = WORKUI;    # SAVE PARAMETER FOR LATER USE # 
            END 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        READI               JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        READI READ A INPUT DIRECTIVE FROM FILE SPECIFIED IN NDA CONTROL
*        STATEMENT. 
* 
*     3. METHOD USED: 
*        READI USE THE NOS DATA TRANSFER MACRO READH TO READ A INPUT
*        DIRECTIVE INTO CORE. 
* 
*     4. ENTRY PARAMETERS:  
*        NONE 
* 
*     5. EXIT PARAMETERS: 
*        IOSTAT     RETURNED STATUS 
*        IEOF       END OF FILE FLAG
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        READH      READ A CODED LINE - MACREL
*        RECALL     PUT THE PROGRAM INTO RECALL STATUS - MACREL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         READ INPUT DIRECTIVE PROCEDURE                               #
#                                                                      #
#**********************************************************************#
      PROC READI; 
        BEGIN                # READ A INPUT DIRECTIVE # 
          LENGTH = 8; 
          READH(INPUT,INPBUF,LENGTH,IOSTAT);     # READ A CARD #
          RECALL(INPUT);
          IF IOSTAT NQ 0
          THEN               # READ ERROR OR END OF FILE #
            IEOF = TRUE;     # SET END OF FILE INDICATOR #
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMAT0             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMAT0 MOVE THE COMMENT LINES TO THE OUTPUT LISTING TO PROCESS
*        DIRECTIVE RULE O.
* 
*     3. METHOD USED: 
*        FORMAT0 MOVE A COMMENT LINE TO THE OUTPUT BUFFER AND CALL
*        SUBROUTINE PRINTH TO PRINT THE LINE. 
* 
*     4. ENTRY PARAMETERS:  
*        INPBUF     THE COMMENT LINE READ FROM INPUT DIRECTIVES.
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         PROCESS COMMENTS CARDS PROCEDURE                             #
#                                                                      #
#**********************************************************************#
      PROC FORMAT0; 
        BEGIN                # PRINT COMMENTS CARDS TO OUTPUT # 
          BASED ARRAY INPBUF0 [0:0] S(8); 
            BEGIN            # COMMENTS FROM INPUT #
              ITEM COMENTI0 C(1,0,60);
            END 
          ARRAY OUTBUF0 [0:0] S(8); 
            BEGIN            # OUTPUT BUFFER #
              ITEM CCNTRL01 C(0,0,1) = [" "];    # CARRIAGE CONTROL # 
              ITEM FILLER01 C(0,6,9) = [" "]; 
              ITEM COMENTO0 C(1,0,60); # COMMENTS # 
              ITEM ZEROEND0 U(7,0,60) = [0];
            END 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          P<INPBUF0> = LOC(INPBUF);    # LOCATE INPUT BUFFER #
          COMENTO0 = COMENTI0;         # MOVE COMMENTS #
          PRINTH(OUTBUF0,8);           # PRINT COMMENT #
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMAT1             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMAT1 ISOLATE AND INTERPRET THE FILE 1 REGISTER LOCATIONS AND
*        MACRO MEMORY LOCATIONS TO PROCESS DIRECTIVE RULE 1 AND 2.
* 
*     3. METHOD USED: 
*        FORMAT1 CALL SUBROUTINE ONEWORD TO GET THE 16-BITS DATA WORD 
*        FROM RANDOM WORK FILE.  EVENTUALLY FORMAT1 CALL PRINTH TO PRINT
*        THE LINE.
* 
*     4. ENTRY PARAMETERS:  
*        INPBUF     CONTAINS THE INPUT DIRECTIVE LINE.
*        RULES      RULE ON DIRECTIVE TO BE PROCESSED.
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        ONEWORD    GET A 16-BITS WORD FROM RANDOM WORK FILE - SYMPL
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         FILE 1 AND MACRO MEMORY INTERPRETER                          #
#                                                                      #
#**********************************************************************#
      PROC FORMAT1; 
        BEGIN                # INTERPRETE THE FILE 1 OR MACRO MEMORY #
          BASED ARRAY INPAR1 [0:0] S(1);
            BEGIN            # INPUT PARAMETER FOR RULES 1 AND 2 #
              ITEM ADDR U(0,0,60);
            END 
          ARRAY OUTBUF1 [0:0] S(9); 
            BEGIN            # OUTPUT BUFFER #
              ITEM CCNTRL11 C(0,0,1) = [" "];    # CARRIAGE CONTROL # 
              ITEM FILLER11 C(0,6,6) = [" (LOC "];
              ITEM REGLOCO1 C(0,42,5); # LOCATION # 
              ITEM FILLER12 C(1,12,2) = [") "]; 
              ITEM REGCONO1 C(1,24,4);
              ITEM FILLER13 C(1,48,2) = ["  "]; 
              ITEM COMENTO1 C(2,0,64); # CONTENTS # 
              ITEM ZEROEND1 U(8,24,36) = [0]; 
            END 
          ITEM WORKC1 C(10); # WORKING AREA # 
          ITEM WORKU1 U;     # WORKING AREA # 
      CONTROL EJECT;
          P<INPAR1> = LOC(PARAMI);    # LOCATE INPUT PARAMETERS # 
          REGLOCO1 = C<1,5>INPBUFC;    # MOVE LOCATION #
          COMENTO1 = C<06,64>INPBUFC;  # MOVE COMMENTS #
          WORKU1 = RULES + 1;       # SET RECORD TYPE. FILE 1 OR MEM# 
          ONEWORD(ADDR,WORKC1,WORKU1);     # GET ONE WORD # 
          REGCONO1 = WORKC1;
          PRINTH(OUTBUF1,9);
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMAT3             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMAT3 ISOLATE AND LIST FIXED LENGTH DATA STRUCTURES HAVING 
*        ONE OR MORE INSTANCE TO PROCESS DIRECTIVE RULE 3.
* 
*     3. METHOD USED: 
*        FORMAT3 CALL ONEWORD TO GET POINTER WORD FROM RANDOM WORK FILE.
*        IF POINTER WORD MISSING THEN PRINT A ERROR MESSAGE AND RETURN
*        TO DNPROC, ELSE CALL ONEWORD TO RETRIEVE DATA FROM RANDOM FILE 
*        FORMAT THE LINE AND CALL PRINTH TO PRINT THE LINE. 
* 
*     4. ENTRY PARAMETERS:  
*        INPBUFC    CONTAINS THE INPUT DIRECTIVE LINE 
*        PARAMI     CONTAINS THE INPUT PARAMETERS ON DIRECTIVE LINE 
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        HEADING    PRINT THE HEADING INFORMATION - SYMPL 
*        ONEWORD    GET A 16-BITS WORD FROM RANDOM WORK FILE - SYMPL
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        PTRMISS    PRINT THE POINTER WORD MISSING MESSAGE - SYMPL
*        XCHD       CONVER OCTAL TO HEXADECIMAL DISPLAY CODE - MACREL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#          PROCESS CONTINUOUS DATA STRUCTURES PROCEDURE                #
#                                                                      #
#**********************************************************************#
      PROC FORMAT3; 
        BEGIN                # FORMAT CONTIGUOUS BLOCK STRUCTURES # 
          BASED ARRAY INPAR3  [0:0] S(5); 
            BEGIN            # PARAMETERS FROM INPUT DIRECTIVES # 
              ITEM PNTR U(0,0,60);
              ITEM SIZE U(1,0,60);
              ITEM INDX U(2,0,60);
              ITEM FIRST U(3,0,60); 
              ITEM LAST U(4,0,60);
            END 
          ITEM PNTRY U; 
      CONTROL EJECT;
          P<INPAR3> = LOC(PARAMI);
          IF FIRST GR LAST
          THEN               # ERROR #
            BEGIN 
              INPBUFD = INPBUFC;       # MOVE DIRECTIVE FOR MESSAGE # 
              PRINTH(OUTBUFI,9);       # PRINT ERROR DIRECTIVE #
              PRINTH(CBSERR,6);        # PRINT ERROR MESSAGE #
              PRINTH(BLLINE,1);        # PRINT A BLANK LINE # 
              RETURN; 
            END 
          ONEWORD(PNTR,PNTRY,1);       # GET THE POINTER WORD FROM MEM #
          IF B<24,1>PNTRY EQ 1
          THEN               # POINTER WORD MISSING # 
            BEGIN 
              PTRMISS(PNTR);
              RETURN; 
            END 
          LOOP01 = (LAST - FIRST) / INSPLN;       # LOOP COUNT #
          FOR I01=0 STEP 1 UNTIL LOOP01 
          DO
            BEGIN 
              IF I01 EQ LOOP01
              THEN
                LOOP02 = (LAST-FIRST)-(LAST-FIRST) / INSPLN * INSPLN; 
              ELSE
                LOOP02 = INSPLN - 1;
              IF (LINENO + SIZE + 3) GR XLINP 
              THEN           # SIZE BEYOND THE BOTTOM OF PRESENT PAGE # 
                HEADING;     # START A NEW PAGE # 
              C<7,40>STRING = C<30,40> INPBUFC; 
              PRINTH(OUTBUF,14); # PRINT THE CURRENT LINE # 
              STRING = " ";      # CLEAR OUTPUT BUFFER #
              C<1,6>STRING = "OFFSET";
              FOR I02=0 STEP 1 UNTIL LOOP02 
              DO             # FORMAT A INDEX TITLE LINE #
                BEGIN 
                  TEMPC1 =XCHD(FIRST+I01*INSPLN+I02); # CONVERT TO HEX #
                  C<I02*7+10,4>STRING = C<6,4>TEMPC1; 
                END 
              PRINTH(OUTBUF,14);       # PRINT INDEX TITLE LINE # 
              STRING = " "; 
              FOR I02=0 STEP 1 UNTIL SIZE - 1 
              DO
                BEGIN        # FORMAT THE DETAIL LINE # 
                  TEMPC1 = XCHD(I02);  # CONVERT OFFSET TO HEX #
                  C<1,6>STRING = C<6,4>TEMPC1;
                  FOR I03=0 STEP 1 UNTIL LOOP02 
                  DO
                   BEGIN
                      TEMPU1 = PNTRY + (I01*INSPLN+I03) * SIZE + I02; 
                      ONEWORD(TEMPU1,TEMPC1,3);  # GET DATA FROM FILE  #
                      C<I03*7+10,4>STRING = TEMPC1; 
                    END 
                  PRINTH(OUTBUF,14);   # PRINT THE DETAIL LINE #
                  STRING = " "; 
                END 
              PRINTH(BLLINE,1);        # PRINT BLANK LINE BETWEEN STRU.#
              PRINTH(BLLINE,1); 
            END 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMAT4             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMAT4 ISOLATE AND LIST THE CONTENT OF CIRCULAR BUFFERS IN
*        CHRONOLOGICAL ORDER TO PROCESS DIRECTIVE RULE 4. 
* 
*     3. METHOD USED: 
*        FORMAT4 CALL ONEWORD TO GET POINTER WORDS FROM RANDOM WORK FILE
*        1 IF POINTER WORDS MISSING THEN PRINT A ERROR MESSAGE AND
*        RETURN TO DNPROC, ELSE CALL ONEWORD TO RETRIEVE DATA WORDS FROM
*        RANDOM WORK FILE, FORMAT THE LINE AND CALL PRINTH TO PRINT THE 
*        LINE.
* 
*     4. ENTRY PARAMETERS:  
*        INPBUFC    CONTAINS THE INPUT DIRECTIVE LINE.
*        PARAMI     CONTAINS THE PARAMETERS ON DIRECTIVE LINE.
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        ONEWORD    GET A 16-BITS WORD FROM RANDOM WORK FILE - SYMPL
*        PTRMISS    PRINT THE POINTER WORD MISSING MESSAGE - SYMPL
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        HEXDIS     CONVERT HEXADECIMAL TO DISPLAY CODE - SYMPL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         FORMAT CIRCULAR BUFFER PROCEDURE                             #
#                                                                      #
#**********************************************************************#
      PROC FORMAT4; 
        BEGIN                # FORMAT CIRCULAR IO BUFFERS # 
          BASED ARRAY INPAR4 [0:0] S(7);
            BEGIN            # INPUT PARAMETERS FOR RULE 4 #
              ITEM FWA  U(0,0,60);     # POINTER TO FWA OF CIO BUFFERS #
              ITEM NEXT U(1,0,60);     # POINTER TO OLDEST ITEM # 
              ITEM LWA  U(2,0,60);     # POINTER TO LWA OF CIO BUFFERS #
              ITEM FLAG U(3,0,60);   # POINTER TO MEANINGFUL DATA FLAG #
              ITEM PTRN U(4,0,60);     # PATTERN OF DELIMITER # 
              ITEM MASK U(5,0,60);     # MASK FOR ISOLATING DELIMITER # 
              ITEM SIZE U(6,0,60);     # LENGTH OF FIXED LENGTH DATA #
            END 
          ITEM BEGNY U;      # FWA ADDRESS OF CIO BUFFERS # 
          ITEM NEXTY U;      # OLDEST ITEM ADDRESS #
          ITEM LASTY U;      # LWA ADDRESS OF CIO BUFFERS # 
          ITEM FLAGY U;      # MEANINGFUL DATA FLAG # 
          ITEM CIOEND B;     # END OF BUFFER FLAG # 
          ITEM WORADR U;     # WORD ADDRESS # 
          ITEM PASSI  B;     # FIRST PASS FLAG #
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          P<INPAR4> = LOC(PARAMI);     # LOCATE INPUT PARAMETERS #
          ONEWORD(FLAG,FLAGY,0);       # GET FLAG WORD #
          IF FLAGY EQ 0 
          THEN               # NO MEANINGFUL DATA IN BUFFERS #
            BEGIN 
              INPBUFD = INPBUFC;       # MOVE DIRECTIVE FOR MESSAGE # 
              PRINTH(OUTBUFI,9);       # PRINT ERROR DIRECTIVE #
              PRINTH(NOMEAN,4);        # PRINT ERROR MESSAGE #
              PRINTH(BLLINE,1);        # PRINT A BLANK LINE # 
              RETURN; 
            END 
          ONEWORD(FWA,BEGNY,0);        # GET FWA ADDRESS #
          ONEWORD(NEXT,NEXTY,0);       # GET OLDEST ITEM ADDRESS #
          ONEWORD(LWA,LASTY,0);        # GET LWA ADDRESS #
          IF B<24,1>FLAGY EQ 1 OR B<24,1>BEGNY EQ 1 OR
             B<24,1>NEXTY EQ 1 OR B<24,1>LASTY EQ 1 
          THEN               # POINTER WORD MISSING # 
            BEGIN 
              IF B<24,1>FLAGY EQ 1 THEN PTRMISS(FLAG);
              IF B<24,1>BEGNY EQ 1 THEN PTRMISS(FWA); 
              IF B<24,1>NEXTY EQ 1 THEN PTRMISS(NEXT);
              IF B<24,1>LASTY EQ 1 THEN PTRMISS(LWA); 
              RETURN;        # RETURN TO PROCESS NEXT DIRECTIVE # 
            END 
          IF NOT ( NEXTY GQ BEGNY AND LASTY GQ NEXTY )
          THEN               # ERROR IN CIO FWA OR LWA OR NEXT ADDRESS #
            BEGIN 
              INPBUFD = INPBUFC;       # MOVE DIRECTIVE FOR MESSAGE # 
              PRINTH(OUTBUFI,9);       # PRINT ERROR DIRECTIVE #
              PRINTH(CIOERR,7);        # PRINT ERROR MESSAGE #
              PRINTH(BLLINE,1); 
              RETURN; 
            END 
          C<10,28> STRING = C<42,28> INPBUFC;    # MOVE HEADER #
          C<3,3> STRING = "LOC";
          PRINTH(OUTBUF,14);           # PRINT HEADER LINE #
          STRING = " "; 
          WORADR = NEXTY; 
          IF SIZE NQ 0
          THEN               # MUST BE FIXED LENGTH DATA STRUCTURES # 
            BEGIN 
              FOR I01 = 0 STEP 1 UNTIL SIZE - 1 
              DO
                BEGIN 
                  I02 = I01 - I01 / CBWPLN * CBWPLN;
                  IF I02 EQ 0 
                  THEN       # FORMAT FIRST WORD ADDRESS #
                    BEGIN 
                      HEXDIS(WORADR,TEMPC1,4);   # CONVERT TO DISPLAY # 
                      C<2,4> STRING = TEMPC1; 
                    END 
                  ONEWORD(WORADR,TEMPC1,3);      # GET ONE DATA WORD #
                   C<I02*5+7,4> STRING = TEMPC1;
                  IF I02 EQ CBWPLN-1 OR I01 EQ SIZE-1 
                  THEN       # LINE FILLED #
                    BEGIN 
                    PRINTH(OUTBUF,14);           # PRINT ONE DATA LINE #
                      STRING = " "; 
                    END 
                  IF WORADR EQ LASTY
                  THEN       # LWA ADDRESS REACHED #
                    WORADR = BEGNY;    # SET ADDRESS TO FWA # 
                  ELSE
                    WORADR = WORADR + 1;         # INCREASE ONE # 
                  IF WORADR EQ NEXTY AND I01 NQ SIZE-1
                  THEN       # CIO LIMITE REACHED # 
                    BEGIN 
              INPBUFD = INPBUFC;       # MOVE DIRECTIVE FOR MESSAGE # 
              PRINTH(OUTBUFI,9);       # PRINT ERROR DIRECTIVE #
              PRINTH(CIOLIM,4);        # PRINT ERROR MESSAGE #
              PRINTH(BLLINE,1);        # PRINT A BLANK LINE # 
                      I01 = SIZE; 
                    END 
                END 
            END 
          ELSE               # VARIABLE LENGTH DATA STRUCTURE # 
            BEGIN 
              CIOEND = FALSE;          # INITIAL FLAG # 
              PASSI = TRUE; 
              FOR I01=0 STEP 1 WHILE NOT CIOEND 
              DO
                BEGIN 
                  ONEWORD(WORADR,TEMPU1,1);      # GET ONE DATA WORD #
                  IF (B<44,16>TEMPU1 LAN B<44,16>MASK) EQ B<44,16>PTRN
                  THEN       # DESIRED PATTERN FOUND #
                    BEGIN 
                      IF PASSI
                      THEN   # FIRST PATTERN THEN SET PROCESS FLAG #
                        BEGIN 
                          I01 = 0;
                          PASSI = FALSE;
                        END 
                      ELSE
                        CIOEND = TRUE;
                    END 
                  IF NOT PASSI
                  THEN       # DESIRED DATA FOUND PROCESS HERE #
                    BEGIN 
                      I02 = I01 - I01 / CBWPLN * CBWPLN;
                      IF I02 EQ 0 
                      THEN   # FORMAT FIRST WORD ADDRESS #
                        BEGIN 
                          HEXDIS(WORADR,TEMPC1,4);
                          C<2,4> STRING = TEMPC1; 
                        END 
                      HEXDIS(TEMPU1,TEMPC1,4);   # CONVERT TO DISPLAY # 
                      C<I02*5+7,4> STRING = TEMPC1; 
                    END 
                      IF WORADR EQ LASTY
                      THEN   # LWA ENCOUNTER THEN SET TO FWA #
                        WORADR = BEGNY; 
                      ELSE
                        WORADR = WORADR + 1;     # INCREASE ONE # 
                      IF WORADR EQ NEXTY
                      THEN   # CIO LIMIT REACHED #
                        CIOEND = TRUE;
                  IF NOT PASSI
                  THEN       # TEST FOR LINE FILLED # 
                    BEGIN 
                      IF I02 EQ CBWPLN-1 OR CIOEND
                      THEN   # LINE FILLED #
                        BEGIN 
                        PRINTH(OUTBUF,14);       # PRINT DATA LINE #
                          STRING = " "; 
                        END 
                    END 
                END 
              IF PASSI
              THEN           # NO DATA FOUND #
                BEGIN 
              INPBUFD = INPBUFC;       # MOVE DIRECTIVE FOR MESSAGE # 
              PRINTH(OUTBUFI,9);       # PRINT ERROR DIRECTIVE #
              PRINTH(NOPATT,4);        # PRINT ERROR MESSAGE #
              PRINTH(BLLINE,1);        # PRINT A BLANK LINE # 
                END 
            END 
              PRINTH(BLLINE,1);        # PRINT A BLANK LINE BETWEEN SEC#
              PRINTH(BLLINE,1); 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME              AUTHOR:               DATE: 
*        FORMAT9             JACOB C. K. CHEN 
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMAT9 FORMAT THE FILE 1 AND MACR MEMORY RECORDS INTO OUTPUT
*        LISTING TO PROCESS DIRECTIVE RULE 8 AND 9. 
* 
*     3. METHOD USED: 
*        FORMAT9 CALL ONEWORD TO RETRIEVE DATA WORDS FROM RANDOM WORK 
*        FILE OR FROM CORE, CONVERT THEM INTO ASCII DISPLAY CODE, FORMAT
*        THEM IN OUPUT LISTING LINE, CALL PRINTH TO PRIN THE LINE.
* 
*     4. ENTRY PARAMETERS:  
*        RULES
*        BEGADD     OCTAL VALUE OF REPORT BEGINNING ADDRESS SET 
*        ENDADD     OCTAL VALUE OF REPORT ENDING ADDRESS SET
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        HEXDIS     CONVERT HEXADECIMAL TO DISPLAY CODE - SYMPL 
*        ONEWORD    GET A 16-BITS WORD FROM RANDOM WORK FILE - SYMPL
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        MOVE       MOVE A BLOCK OF MEMORY WORDS - MACREL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         FORMAT MACRO MEMORY RECORDS AND FILE 1 RECORD PROCEDURE      #
#                                                                      #
#**********************************************************************#
      PROC FORMAT9; 
        BEGIN                # FORMAT FILE 1 AND MACRO MEM RECORDS #
          BASED ARRAY OUTLINE [0:0] S(14);
            BEGIN            # WORKING AREA FOR OUTPUT LISTING #
              ITEM DISADR C(0,6,6);    # ADDRESS OF THIS LINE # 
              ITEM DUPLIC C(0,42,2);   # DUPLCATED LINE INDICATOR # 
              ITEM OUTLIN C(0,0,140); 
              ITEM OUTLIN1 C(0,54,96); # HEX DISPLAY CODE PORTION # 
              ITEM OUTLIN2 C(10,30,32);# ASCII DISPLAY CODE PORTION # 
            END 
 
          ARRAY OUTLINE8 [0:0] S(14); 
            BEGIN            # WORKING AREA FOR OUTPUT LISTING #
              ITEM OUTLIN8 C(0,0,137)=[" "];
              ITEM LIN8END U(13,42,18)=[0]; 
            END 
 
          ARRAY OUTLINE9 [0:0] S(14); 
            BEGIN            # WORKING AREA FOR OUTPUT LISTING #
              ITEM OUTLIN9 C(0,0,137)=[" "];
              ITEM LIN9END U(13,42,18)=[0]; 
            END 
 
          ARRAY DISPOSP [0:15] S(1);
            BEGIN            # HEX. DISPLAY CODE POSITION # 
              ITEM DISPOS U(0,52,8)=[0,6,12,18,24,30,36,42,48,54,60,66, 
                                     72,78,84,90];
            END 
 
          ARRAY ASCPOSP [0:15] S(1);
            BEGIN            # ASCII DISPLAY CODE POSITION #
              ITEM ASCPOS U(0,52,8)=[0,2,4,6,8,10,12,14,16,18,20,22,24, 
                                     26,28,30]; 
            END 
 
          ITEM TYPE9 I;      # FLAG TO INDICATE FILE 1 OR MACRO MEM#
          ITEM DMPBEG U;     # BEGIN ADDRESS TO BE PRINTED #
          ITEM DMPEND U;     # END   ADDRESS TO BE PRINTED #
          ITEM LINEADR U=0;  # CURRENT LINE ADDRESS # 
          ITEM LASTADR U=0;  # ADDRESS OF LAST LINE PRINTED # 
          ITEM DATAMISS C(110)="          --    --    --    --    --
--    --    --    --    --    --    --    --    --    --    --        ";
                             # DATA MISSING IN DUMP FILE #
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          IF RULES EQ 8 
          THEN               # FILE 1 REGISTERS TO BE PRINTED # 
            BEGIN 
              TYPE9 = 6;     # FILE 1 RECORD AND CONVERSION WANTED #
              DMPBEG = B<12,24>FILE1REC1[0];
              DMPEND = B<36,24>FILE1REC1[0];
            END 
          ELSE               # MACRO MEMORY RECORDS TO BE PRINTED # 
            BEGIN 
            IF RULES EQ 7    # PAGE REGISTER RECORDS TO BE PRINTED     #
            THEN
              BEGIN 
              TYPE9 = 6;
              DMPBEG = B<12,24>PAGREGREC1[0];# SET BEGIN ADDRESS       #
              DMPEND = B<36,24>PAGREGREC1[0]; 
              END 
            ELSE
              BEGIN 
              TYPE9 = 7;     # MACRO MEM RECORDS AND CONVERSION WANTED #
              DMPBEG = BEGADD;         # SET BEGIN ADDRESS #
              DMPEND = ENDADD;         # SET END ADDRESS #
              DMPWD1[0] = 0; # CLEAR BUFFER TO FORCE READ IN GETRAN # 
              DMPWD2[0] = 0;
              END 
            END 
          I01 = DMPBEG - DMPBEG / WODPLN * WODPLN;
          IF I01 NQ 0 
          THEN               # ROUND BEGIN ADDRESS #
            DMPBEG = DMPBEG - I01;
          P<OUTLINE> = LOC(OUTLINE8);  # LOCATE OUTPUT WORKING AREA # 
          FOR I01=DMPBEG STEP 1 UNTIL DMPEND
          DO                 # FORMAT DUMP RECORDS HERE # 
            BEGIN 
              I02 = I01 - I01 / WODPLN * WODPLN;
              IF I02 EQ 0 
              THEN           # CONVERT LINE ADDRESS TO DISPLAY #
                BEGIN 
                  HEXDIS(I01,TEMPC1,6); 
                  DISADR = TEMPC1;
                  LINEADR = I01;       # SAVE LINE ADDRESS #
                END 
              ONEWORD(I01,TEMPC1,TYPE9);
              C<DISPOS[I02],4>OUTLIN1[0] = TEMPC1;
              C<ASCPOS[I02],2>OUTLIN2[0] = C<5,2>TEMPC1;
              IF I02 EQ WODPLN - 1 OR I01 EQ DMPEND 
              THEN           # LINE FILLED #
                BEGIN 
                  IF I01 EQ DMPEND
                  THEN
                    BEGIN    # PRINT LAST LINE #
                      PRINTIT = TRUE;  # SET PRINT FLAG # 
                      I03 = WODPLN - I02 - 1; 
                      IF I03 NQ 0 
                      THEN   # CLEAR BUFFER OF DATAS AFTER END ADDRESS #
                        BEGIN 
                          C<(I02+1)*6,I03*6>OUTLIN1 = " ";
                          C<(I02+1)*2,I03*2>OUTLIN2 = " ";
                        END 
                    END 
                  ELSE       # TEST FOR DUPLICATED LINE # 
                    BEGIN 
                      PRINTIT = FALSE; # INITIAL FLAG # 
                      IF C<9,94>OUTLIN8 NQ C<9,94>OUTLIN9 
                      THEN   # NOT A DUPLICATED LINE #
                        PRINTIT = TRUE; 
                      IF NOT PRINTIT AND EXPAND 
                      THEN   # TEST FOR DATA MISSING IN DUMP FILE # 
                        IF C<9,94>OUTLIN NQ C<9,94>DATAMISS 
                        THEN # NOT DATA MISSING # 
                          PRINTIT = TRUE;   # EXPAND LISTING WANTED # 
                    END 
                  IF PRINTIT
                  THEN       # PRINT THE LINE # 
                    BEGIN 
                      IF LINEADR GR LASTADR + WODPLN
                      THEN   # SET DUPLICATED LINE SYMBOL ** IN OUTPUT #
                        DUPLIC = "**";
                      ELSE
                        DUPLIC = "  ";
                      LASTADR = LINEADR;         # RESET LAST LINE ADDR#
                      PRINTH(OUTLINE,14); 
                       IF P<OUTLINE> EQ LOC(OUTLINE8) 
                      THEN   # LOCATE ANOTHER WORKING BUFFER #
                        P<OUTLINE> = LOC(OUTLINE9); 
                      ELSE
                        P<OUTLINE> = LOC(OUTLINE8); 
                    END 
                END 
              IF IOSTAT EQ RDEOI
              THEN           # END OF FILE #
                I01 = DMPEND;          # SET INDEX TO END # 
            END 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMATA             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMATA ISOLATE AND LIST THE CONTENT OF LCBS WITH ITS
*        SUBORDINATE TCBS TO PROCESS DIRECTIVE RULE A.
* 
*     3. METHOD USED: 
*        FORMATA COUNT THE NUMBER OF TCBS WITH A LCB TO DECIDE HOW MANY 
*        LCB-TCB WE MUST FORMAT IN ONE LINE. IF A LCB WITH MORE 
*        THAN 15 TCBS THEN CALL FORMATA1 TO FORMAT IT, ELSE CALL
*        FORMATA2 TO FORMAT ONE OR MORE THAN ONE LCBS IN ONE LINE.
* 
*     4. ENTRY PARAMETERS:  
*        INPBUFC    CONTAINS THE INPUT DIRECTIVE LINE.
*        PARAMI     CONTAINS THE INPUT PARAMETERS ON DIRECTIVE LINE.
* 
*     5. EXIT PARAMETERS: 
*        TCBCNT     TCB COUNT WITH A LCB
*        TCBADR     LCB/TCB ADDRESS POINTER 
*        CNT        COUNT OF LCB WE MUST FORMAT THEM IN ONE LINE
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        ONEWORD    GET A 16-BITS WORD FROM RANDOM WORK FILE - SYMPL
*        PTRMISS    PRINT THE POINTER WORD MISSING MESSAGE - SYMPL
*        HEADING    PRINT THE HEADING INFORMATION - SYMPL 
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        FORMATA1   FORMAT A LCB WITH MORE THAN 15 TCBS - SYMPL 
*        FORMATA2   FORMAT ONE OR MORE THAN ONE LCB IN ONE LINE - SYMPL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         FORMAT LCB/TCB PROCEDURE                                     #
#                                                                      #
#**********************************************************************#
      PROC FORMATA; 
        BEGIN  #FORMATA#     # FORMAT LCB/TCB OR LCB/CCB               #
          BASED ARRAY INPARA [0:0] S(7);
            BEGIN            # INPUT PARAMETERS FOR RULE A #
              ITEM LCBP U(0,0,60);     # POINTER TO FIRST LCB # 
              ITEM LCBL U(1,0,60);     # LENGTH OF LCB DATA STRUCTURE # 
              ITEM FTCB U(2,0,60);     # INDEX TO FIRST TCB # 
              ITEM TCBL U(3,0,60);     # LENGTH OF TCB STRUCTURE #
              ITEM NTCB U(4,0,60);     # INDEX TO NEXT TCB #
              ITEM NLCB U(5,0,60);     # NUMBER OF LCB TO BE LISTED # 
              ITEM LCBX U(6,0,60);     # FIRST LCB TO BE LISTED # 
            END 
 
          ARRAY TCBADDR[0:15] S(1); 
            BEGIN            # TCB ADDRESS #
              ITEM TCBADR U(0,0,60);   # TCB ADDRESS #
            END 
 
          ARRAY TCBNUMB [0:15] S(1);
            BEGIN 
              ITEM TCBNUM U(0,0,60);   # TCB NUMBER # 
            END 
 
          ARRAY TCBCOUNT [0:7] S(1);
            BEGIN 
              ITEM TCBCNT U(0,0,60);   # TCB COUNT #
            END 
 
          ITEM LCBPY  U;     # FIRST LCB ADDRESS #
          ITEM NLCBY  U;     # NUMBER OF LCB TO BE LISTED # 
          ITEM CNT    I;     # COUNT #
          ITEM TCBPTR U;     # TCB POINTER #
          ITEM NXTTCB U;     # NEXT TCB POINTER # 
          ITEM LCBADR U;     # LCB ADDRESS #
          ITEM TOTALT I;     # TOTAL OF TCB # 
      CONTROL EJECT;
          P<INPARA> = LOC(PARAMI);     # LOCATE INPUT PARAMETERS #
          IF FTCB GR LCBL OR NTCB GR TCBL 
          THEN               # ERROR IN DIRECTIVE # 
            BEGIN 
              INPBUFD = INPBUFC;       # MOVE DIRECTIVE FOR MESSAGE # 
              PRINTH(OUTBUFI,9);       # PRINT ERROR DIRECTIVE #
              PRINTH(LCBERR,7);        # PRINT ERROR MESSAGE #
              PRINTH(BLLINE,1);        # PRINT A BLANK LINE # 
              RETURN; 
            END 
          ONEWORD(LCBP,LCBPY,1);       # GET LCB ADDRESS FROM DUMP FILE#
          IF NLCB EQ 0
          THEN               # JUST ONE LCB TO BE LISTED #
            NLCBY = 1;
          ELSE               # GET THE NUMBER OF LCBS TO BE LISTED #
            ONEWORD(NLCB,NLCBY,0);     # GET NUMBER OF LCBS FROM FILE # 
          IF NLCBY EQ 0 
          THEN               # SET NUMBER TO MINIMUM #
            NLCBY = 1;
          IF B<24,1>LCBPY EQ 1 OR B<24,1>NLCBY EQ 1 
          THEN               # POINTER WORD MISSING # 
            BEGIN 
              IF B<24,1>LCBPY EQ 1 THEN PTRMISS(LCBP);
              IF B<24,1>NLCBY EQ 1 THEN PTRMISS(NLCB);
              RETURN; 
            END 
          FOR I01=0 STEP 1 UNTIL 15 
          DO                 # INITIAL VALUE #
            BEGIN 
              TCBNUM[I01] = 0;
              TCBADR[I01] = 0;
            END 
          FOR I01=LCBX STEP 1 UNTIL NLCBY + LCBX - 1
          DO
            BEGIN 
              LCBADR = LCBPY + LCBL * I01;
              FOR I02=0 STEP 1 UNTIL 7
              DO             # INITIAL TCB COUNT ARRAY #
                TCBCNT[I02] = 0;
              TOTALT = 0; 
              FOR I02=0 STEP 1 UNTIL LCBPLN-1 
              DO             # DETERMINE HOW MANY LCBS IN ONE LINE #
                BEGIN 
                  IF (I01 + I02) LQ NLCBY + LCBX - 1
                  THEN
                    BEGIN 
                      TCBPTR = LCBADR + I02 * LCBL + FTCB;
                      ONEWORD(TCBPTR,NXTTCB,1);  # GET NEXT TCB POINTER#
                      FOR I03=0 STEP 1 WHILE B<44,16>NXTTCB NQ 0
                      DO     # COUNT TCB #
                        BEGIN 
                          TCBPTR = NXTTCB + NTCB;# NEXT TCB POINTER # 
                          ONEWORD(TCBPTR,NXTTCB,1);   # GET NEXT TCB #
                          IF NXTTCB NQ 0
                          THEN         # SAVE TCB POINTER # 
                            TCBCNT [I02] = TCBCNT [I02] + 1;
                          IF TCBCNT[I02] GQ MAXTCB
                          THEN         # TCB CHAINS EXCEED MAXIMUM #
                            BEGIN      # ERROR IN TCB CHAIN # 
                              IF I02 EQ 0 
                              THEN
                                BEGIN 
                                  INPBUFD = INPBUFC;
                                  PRINTH(OUTBUFI,9);
                                  PRINTH(TCBERR,6); 
                                  PRINTH(BLLINE,1); 
                                END 
                              NXTTCB = 0;        # FORCE LOOP END # 
                            END 
                        END 
                      IF TCBCNT[I02] EQ 0 
                      THEN
                        TCBCNT[I02] = 1;
                      TOTALT = TOTALT + TCBCNT[I02] + 1;  # COUNT TOTAL#
                      IF TOTALT EQ LCBPLN * 2 
                      THEN   # EACH LCB WITH ONE TCB #
                        BEGIN 
                          CNT = I02;
                          I02 = LCBPLN - 1; 
                         END
                       IF TOTALT GR LCBPLN * 2
                       THEN  # EXCEED LINE SIZE # 
                        BEGIN 
                         IF I02 GR 0
                          THEN
                            CNT = I02 - 1;       # ROUND COUNT TO LAST #
                          ELSE
                            CNT = 0;
                          I02 = LCBPLN - 1; 
                        END 
                    END 
                  ELSE
                    BEGIN 
                      CNT = I02 - 1;
                      I02 = LCBPLN - 1; 
                    END 
                END 
              IF LCBL GQ TCBL 
              THEN           # SET LENGTH TO LCB LENGTH # 
                I05 = LCBL - 1; 
              ELSE           # SET LENGTH TO TCB LENGTH # 
                I05 = TCBL - 1; 
              IF (LINENO + I05 + 3) GR XLINP
              THEN           # STRUCTURE EXCEED PAGE SIZE # 
                HEADING;     # PRINT HEADER INFORMATION # 
              C<10,28> STRING = C<42,28> INPBUFC; 
              PRINTH(OUTBUF,14); # PRINT HEADER LINE #
              STRING = " "; 
              IF CNT EQ 0 AND TCBCNT[0] GR TCBPLN 
              THEN           # FORMAT ONE LCB WITH MORE THAN 15 TCBS #
                BEGIN 
                  FORMATA1; 
                END 
              ELSE           # ONE OR MORE THAN ONE LCBS IN ONE LINE #
                BEGIN 
                  FORMATA2; 
                  I01 = I01 + CNT;     # RESET COUNTER #
                END 
            END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMATA1            JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMATA1 FORMAT THE LCB WITH MORE THAN 15 TCBS AND PRINT THEM
*        INTO OUTPUT LISTING. 
* 
*     3. METHOD USED: 
*        FORMATA1 CALL ONEWORD TO GET DATA WORDS FROM RANDOM WORK FILE, 
*        CALL HEXDIS TO CDNVERT HEXADECIMAL TO DISPLAY, FORMAT THEM INTO
*        OUTPUT LINE AND CALL PRINTH TO PRINT IT. 
* 
*     4. ENTRY PARAMETERS:  
*        TCBCNT     CONTAINS NUMBER OF TCBS WITH THIS LCB.
*        TCBADR     CONTAINS LCB/TCB ADDRESS POINTER. 
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        HEXDIS     CONVERT HEXADECIMAL TO DISPLAY - SYMPL
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        ONEWORD    GET A 16-BITS WORD FROM RANDOM WORK FILE - SYMPL
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         PROCESS MORE THAN 15 TCBS WITH ONE LCB FOR RULES A.          #
#                                                                      #
#**********************************************************************#
      PROC FORMATA1;
        BEGIN  #FORMATA1#    # FORMAT LCB WITH MORE THAN 15 TCBS #
          LOOP01 = TCBCNT[0] / TCBPLN; # LOOP COUNTER # 
          FOR I02=0 STEP 1 UNTIL LOOP01 
          DO
            BEGIN 
              IF I02 EQ LOOP01
              THEN
                LOOP02 = TCBCNT[0] - TCBCNT[0] / TCBPLN * TCBPLN; 
              ELSE
                LOOP02 = TCBPLN;
              C<1,6> STRING = "OFFSET"; 
              IF I02 EQ 0 
              THEN           # FORMAT OFFSET LINE # 
                BEGIN 
                  C<10,3>STRING = "LCB";
                  HEXDIS(I01,TEMPC1,3); 
                  C<13,3>STRING = TEMPC1; 
                END 
              FOR I03=0 STEP 1 UNTIL LOOP02 - 1 
              DO
                BEGIN 
                  I04 = I02 * TCBPLN + I03; 
                  HEXDIS(I04,TEMPC1,3); 
                  C<I03*7+20,3>STRING = TEMPC1; 
                  C<I03*7+17,3>STRING = "TCB";
                END 
              PRINTH(OUTBUF,14);
              STRING = " "; 
              C<2,5> STRING = "LOC..";
              IF I02 EQ 0 
              THEN           # FORMAT ADDRESS LINE #
                BEGIN 
                  HEXDIS(LCBADR,TEMPC1,4);       # CONVERT TO DISPLAY # 
                  C<10,4> STRING = TEMPC1;
                  TCBADR[0] = LCBADR; 
                END 
              FOR I03=1 STEP 1 UNTIL LOOP02 
              DO
                BEGIN 
                  IF I03 EQ 1 AND I02 EQ 0
                  THEN
                    TEMPU1 = TCBADR[I03 - 1] + FTCB;
                  ELSE
                    TEMPU1 = TCBADR[I03 - 1] + NTCB;
                  ONEWORD(TEMPU1,TEMPC1,3); 
                  B<0,44> TCBADR[I03] = 0;
                  B<44,16> TCBADR[I03] = B<44,16> TEMPC1; 
                  C<I03*7+10,4> STRING = TEMPC1;
                END 
              PRINTH(OUTBUF,14);
              STRING = " "; 
              FOR I03=0 STEP 1 UNTIL I05
              DO             # FORMAT OFFSET #
                BEGIN 
                  TEMPC1 = XCHD(I03); 
                  C<3,4> STRING = C<6,4> TEMPC1;
                  FOR I04=0 STEP 1 UNTIL LOOP02 
                  DO         # FORMAT DATA LINE # 
                    BEGIN 
                      IF (I04 EQ 0 AND I03 LS LCBL AND I02 EQ 0) OR 
                       (I04 NQ 0 AND I03 LS TCBL) 
                      THEN
                        BEGIN 
                          ONEWORD(TCBADR[I04]+I03,TEMPC1,3);
                          C<I04*7+10,4> STRING = TEMPC1;
                        END 
                   END
                  PRINTH(OUTBUF,14);   # PRINT DATA LINE #
                  STRING = " ";        # CLEAR OUTPUT BUFFER #
                END 
              TCBADR[0] = TCBADR[LOOP02]; 
              PRINTH(BLLINE,1);        # BLANK LINE BETWEEN SECTION # 
              PRINTH(BLLINE,1); 
              IF (LINENO + I05 + 3) GR XLINP
              THEN           # SIZE EXCEED PAGE LIMIT # 
                HEADING;     # START A NEW PAGE # 
                  C<10,28> STRING = C<42,28> INPBUFC; 
                  PRINTH(OUTBUF,14); # PRINT HEADER LINE #
                  STRING = " "; 
            END 
        END  #FORMATA1# 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMATA2            JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMATA2 FORMAT ONE OR MORE THAN ONE LCBS IN A OUTPUT LINE, AND
*        PRINT THE LINE TO OUTPUT LISTING.
* 
*     3. METHOD USED: 
*        FORMATA2 CALL ONEWORD TO GET DATA WORDS FROM RANDOM WORK FILE, 
*        CALL HEXDIS TO CONVERT HEXADECIMAL TO DISPLAY, FORMAT THEM INTO
*        OUTPUT LINE AND CALL PRINTH TO PRINT IT. 
* 
*     4. ENTRY PARAMETERS:  
*        CNT        COUNT OF LCBS IN ONE LINE 
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        ONEWORD    GET A 16-BIT  WORD FROM RANDOM WORK FILE - SYMPL
*        HEXDIS     CONVERT HEXADECIMAL TO DISPLAY - SYMPL
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        XCHD       CONVERT OCTAL TO HEXADECIMAL DISPLAY - SUPIO
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         FORMAT ONE OR MANY LCB WITH ITS TCB IN ONE LINE.             #
#                                                                      #
#**********************************************************************#
      PROC FORMATA2;         # FORMAT MORE THAN ONE LCBS IN ONE LINE #
        BEGIN  #FORMATA2# 
          I04 = 0;
          FOR I02=I01 STEP 1 UNTIL CNT + I01
          DO
            BEGIN 
              TCBNUM[I04] = I02;
              B<0,1> TCBNUM[I04] = 1; 
              TCBADR[I04] = LCBPY + LCBL * I02; 
              I04 = I04 + 1;
              FOR I03=1 STEP 1 UNTIL TCBCNT[I02 - I01]
              DO
                BEGIN        # GET LCB/TCB ADDRESS #
                  TCBNUM[I04] = I03 - 1;         # SAVE TCB NUMBER #
                  IF I03 EQ 1 
                  THEN       # GET TCB POINTER FROM LCB # 
                    TEMPU1 = TCBADR[I04-1] + FTCB;
                  ELSE       # GET TCB POINTER FROM LAST TCB #
                    TEMPU1 = TCBADR[I04-1] + NTCB;
                  ONEWORD(TEMPU1,TEMPU2,1); # GET POINTER FROM FILE # 
                  TCBADR[I04] = TEMPU2;     # SAVE LCB/TCB ADDRESS #
                  I04 = I04 + 1;
                END 
            END 
          C<1,6> STRING = "OFFSET"; 
          FOR I02=0 STEP 1 UNTIL I04-1
          DO                 # FORMAT LCB NUMBER LINE # 
            BEGIN 
              IF B<0,1>TCBNUM[I02] EQ 1 
              THEN
                C<I02*7+10,3>STRING = "LCB";
              ELSE
                C<I02*7+10,3>STRING = "TCB";
              HEXDIS(TCBNUM[I02],TEMPC1,3); 
              C<I02*7+13,3>STRING = TEMPC1; 
            END 
          PRINTH(OUTBUF,14); # PRINT LCB NUMBER LINE #
          STRING = " "; 
          C<2,5> STRING = "LOC..";
          FOR I02=0 STEP 1 UNTIL I04 - 1
          DO                 # FORMAT LOCATION LINE # 
            IF TCBADR[I02] NQ 0 
            THEN
            BEGIN 
              HEXDIS(TCBADR[I02],TEMPC1,4); 
              C<I02*7+10,4> STRING = TEMPC1;
            END 
          PRINTH(OUTBUF,14);           # PRINT LOCATION LINE #
          STRING = " ";      # CLEAR OUTPUT BUFFER #
          FOR I02=0 STEP 1 UNTIL I05
          DO                 # FORMAT DATA LINE # 
            BEGIN 
              TEMPC1 = XCHD(I02);      # CONVERT TO HEX. DIS. # 
              C<3,4> STRING = C<6,4> TEMPC1;
              FOR I03=0 STEP 1 UNTIL I04-1
              DO             # FORMAT DATA LINE # 
                BEGIN 
                  IF (B<0,1>TCBNUM[I03] EQ 1 AND I02 LS LCBL) OR
                      (B<0,1>TCBNUM[I03] NQ 1 AND I02 LS TCBL AND 
                       TCBADR[I03] NQ 0)
                  THEN
                    BEGIN 
                      TEMPU1 = TCBADR[I03] + I02; 
                      ONEWORD(TEMPU1,TEMPC1,3); 
                      C<I03*7+10,4> STRING = TEMPC1;
                    END 
                END 
              PRINTH(OUTBUF,14);       # PRINT DATA LINE #
              STRING = " ";            # CLEAR OUTPUT BUFFER #
            END 
          PRINTH(BLLINE,1);            # BLANK LINE BETWEEN SECTION # 
          PRINTH(BLLINE,1); 
        END  #FORMATA2# 
        END  #FORMATA#
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMATB             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMATB ISOLATE AND LIST THE CONTENT OF THE PORT TABLE WITH ITS
*        SUBORDINATE MUX LCBS TO PROCESS DIRECTIVE RULE B.
* 
*     3. METHOD USED: 
*        FORMATB CALL ONEWORD TO GET POINTER WORDS FROM RANDOM WORK FILE
*        , IF POINTER WORDS MISSING THEN CALL PTRMISS TO PRINT THE ERROR
*        MESSAGE AND RETURN TO DNPROC,ELSE CALL ONEWORD TO RETREIVE DATA
*        WORDS FROM RANDOM WORK FILE, CALL HEXDIS TO CONVERT DATA TO
*        DISPLAY AND CALL PRINTH TO PRINT THE FORMATTED LINE. 
* 
*     4. ENTRY PARAMETERS:  
*        INPBUFC    CONTAINS THE INPUT DIRECTIVE LINE 
*        PARAMI     CONTAINS THE PARAMETERS ON DIRECTIVE LINE.
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        ONEWORD    GET A 16-BITS WORD FROM RANDOM WORK FILE - SYMPL
*        PTRMISS    PRINT THE POINTER WORD MISSING MESSAGE - SYMPL
*        HEADING    PRINT THE HEADING INFORMATION - SYMPL 
*        PRINTH     PRINT A LINE TO OUTPUT LISTING - SYMPL
*        HEXDIS     CONVERT HEXADECIMAL TO DISPLAY CODE - SYMPL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         FORMAT PORT TABLES AND ITS  ASSOCIATED MUX TABLES PROCEDURE  #
#                                                                      #
#**********************************************************************#
      PROC FORMATB; 
        BEGIN                # FORMAT PORT AND MUX TABLES # 
          BASED ARRAY INPARB [0:0] S(8);
            BEGIN            # INPUT PARAMETERS FOR RULE B #
              ITEM PTTP U(0,0,60);     # FIRST PORT TABLE POINTER # 
              ITEM PTTL U(1,0,60);     # PORT TABLE LENGTH #
              ITEM MUXP U(2,0,60);         # MUX TABLE POINTER #
              ITEM MUXL U(3,0,60);     # MUX TABLE LENGTH # 
              ITEM PTRN U(4,0,60);     # PATTERN FOR VALID MUX TABLE #
              ITEM MASK U(5,0,60);     # MASK FOR ISOLATING PATTERN # 
              ITEM TSTX U(6,0,60);     # VALIDITY TESTING WORD INDEX #
              ITEM NPTT U(7,0,60);     # POINTER TO NO. OF PORT TABLE # 
            END 
 
          ARRAY PTADR  [0:15] S(1); 
            BEGIN            # PORT AND MUX TABLE ADDRESS # 
              ITEM PTADDR U(0,0,60);
            END 
 
          ITEM PTTPY U;      # CONTENT OF PORT TABLE POINTER #
          ITEM NPTTY U;      # NUMBER OF PORT TO BE LISTED #
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          P<INPARB> = LOC(PARAMI);     # LOCATE INPUT PARAMETER # 
          ONEWORD(PTTP,PTTPY,0);       # GET PORT TABLE POINTER # 
          IF MUXP GR PTTL OR TSTX GR PTTL 
          THEN               # ERROR IN DIRECTIVE # 
            BEGIN 
              INPBUFD = INPBUFC;       # MOVE DIRECTIVE FOR MESSAGE # 
              PRINTH(OUTBUFI,9);       # PRINT ERROR DIRECTIVE #
              PRINTH(PTBERR,6);        # PRINT ERROR MESSAGE #
              PRINTH(BLLINE,1);        # PRINT A BLANK LINE # 
              RETURN; 
            END 
          ONEWORD(NPTT,NPTTY,0);       # GET NUMBER OF PORTS TO BE LIST#
          IF B<24,1>PTTPY EQ 1 OR B<24,1>NPTTY EQ 1 
          THEN               # POINTER WORD MISSING # 
            BEGIN 
              IF B<24,1>PTTPY EQ 1 THEN PTRMISS(PTTP);
              IF B<24,1>NPTTY EQ 1 THEN PTRMISS(NPTT);
              RETURN; 
            END 
          IF PTTL GQ MUXL 
          THEN
            I03 = PTTL - 1; 
          ELSE
            I03 = MUXL - 1; 
          LOOP01 = (NPTTY - 1) / PTBPLN;
          FOR I01=0 STEP 1 UNTIL LOOP01 
          DO
            BEGIN 
              IF I01 EQ LOOP01
              THEN           # LAST LOOP #
                LOOP02 = (NPTTY - 1) - (NPTTY - 1) / PTBPLN * PTBPLN; 
              ELSE           # NOT LAST LOOP #
                LOOP02 = PTBPLN - 1;
              IF (LINENO + I03 + 3) GR XLINP
              THEN           # STRUCTURE BEYOND END OF PAGE # 
                HEADING;
              C<10,22> STRING = C<48,22> INPBUFC;    # MOVE HEADING # 
              PRINTH(OUTBUF,14); # PRINT THE HEDER LINE # 
              STRING = " "; 
              FOR I02=0 STEP 1 UNTIL LOOP02 
              DO             # FORMAT IDENTIFICATION LINE # 
                BEGIN 
                  HEXDIS(I01*PTBPLN+I02,TEMPC1,3);
                  C<I02*14+10,4> STRING = "PORT"; 
                  C<I02*14+14,3> STRING = TEMPC1; 
                  C<I02*14+18,3> STRING = "MUX";
                END 
              C<1,6> STRING = "OFFSET"; 
              PRINTH(OUTBUF,14);       # PRINT ID LINE #
              STRING = " ";            # CLEAR OUTPUT BUFFER #
              C<2,5> STRING = "LOC..";
              FOR I02=0 STEP 1 UNTIL LOOP02 
              DO             # FORMAT STRUCTURE ADDRESS LINE #
                BEGIN 
                  PTADDR[I02*2] = PTTPY + (I01*PTBPLN+I02) *PTTL; 
                  ONEWORD(PTADDR[I02*2]+TSTX,TEMPU2,1); 
                  IF (TEMPU2 LAN MASK) EQ PTRN
                  THEN       # GET MUX POINTER FROM DUMP FILE # 
                    BEGIN 
                      ONEWORD(PTADDR[I02*2]+MUXP,TEMPU1,1); 
                      PTADDR[I02*2+1] = TEMPU1; 
                    END 
                  ELSE       # NOT A VALID MUX TABLE #
                    PTADDR[I02*2+1] = 0;         # SET ADDRESS TO ZERO #
                  HEXDIS(PTADDR[I02*2],TEMPC1,4);# CONVERT TO DIS. #
                  C<I02*14+10,4> STRING = TEMPC1; 
                  IF PTADDR[I02*2+1] NQ 0 
                  THEN
                    BEGIN 
                      HEXDIS(PTADDR[I02*2+1],TEMPC1,4); 
                      C<I02*14+17,4> STRING = TEMPC1; 
                    END 
                END 
              PRINTH(OUTBUF,14);       # PRINT ADDRESS LINE # 
              STRING = " ";  # CLEAR OUTPUT BUFFER #
              FOR I04=0 STEP 1 UNTIL I03
              DO             # FORMAT DETAIL DATA LINE #
                BEGIN 
                  TEMPC1 = XCHD(I04);  # CONVERT OFFSET TO HEX. DIS. #
                  C<3,4> STRING = C<6,4> TEMPC1;
                  FOR I02=0 STEP 1 UNTIL LOOP02 
                  DO
                    BEGIN 
                      IF I04 LS PTTL
                      THEN
                        BEGIN          # RETRIVE DATA FROM DUMP FILE #
                          ONEWORD(PTADDR[I02*2]+I04,TEMPC1,3);
                          C<I02*14+10,4> STRING = TEMPC1; 
                        END 
                      IF I04 LS MUXL AND PTADDR[I02*2+1] NQ 0 
                      THEN
                        BEGIN          # GET MUX TABLE DATA # 
                          ONEWORD(PTADDR[I02*2+1]+I04,TEMPC1,3);
                          C<I02*14+17,4> STRING = TEMPC1; 
                        END 
                    END 
                  PRINTH(OUTBUF,14);   # PRINT DETAIL DATA LINE # 
                  STRING = " ";        # CLEAR OUTPUT BUFFER #
                END 
              PRINTH(BLLINE,1);         # BLANK LINE #
              PRINTH(BLLINE,1); 
            END 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        FORMATF             JACOB C. K. CHEN      80/02/01 
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        FORMATF PROCESS THE FINISH DIRECTIVE.
* 
*     3. METHOD USED: 
*        FORMATF SET THE END OF FILE FLAG ON TO FORCE END OF DIRECTIVES 
*        PROCESSING.
* 
*     4. ENTRY PARAMETERS:  
*        NONE 
* 
*     5. EXIT PARAMETERS: 
*        IEOF       END OF FILE FLAG OF INPUT DIRECTIVES FILE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED
*        NONE 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         PROCESS FINISH DIRECTIVE PROCEDURE                           #
#                                                                      #
#**********************************************************************#
      PROC FORMATF; 
        BEGIN                # PROCESS FINISH DIRECTIVE # 
          IEOF = TRUE;
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        ONEWORD             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        GET ONE 16-BIT WORD FROM RANDOM FILE AND CONVERT IT TO DISPLAY 
*        CODE SUITABLE FOR OUTPUT 
* 
*     3. METHOD USED: 
*        USE ONE FLAG AS FILE 1 REGISTER OR MACRO MEMORY DUMP INDICATOR,
*        ANOTHER FLAG AS CONVERSION INDICATOR. IF DATA MISSING SET NO 
*        DATA FLAG ON THEN RETURN TO CALLING PROCEDURE
* 
*     4. ENTRY PARAMETERS:  
*        WODADR     WORD ADDRESS IN DUMP RECORD.
*        TYPE       USE BIT 59 AND 58 AS DUMP TYPE AND CONVERSION FLAG
* 
*     5. EXIT PARAMETERS: 
*        WODOUT     FOR DATA OUTPUT AND NO DATA FLAG BIT
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        HEXDIS     CONVERT HEX TO DISPLAY CODE - SYMPL 
*        GETRAN     GET A RANDOM RECORD FROM NEVFILE - SYMPL
* 
*     8. DAYFILE MESSAGES:  
*        NONE.
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         GET A 16 BITS WORD RROM RANDOM FILE                          #
#                                                                      #
#**********************************************************************#
      PROC ONEWORD((WODADR),WODOUT,(TYPE)); 
        BEGIN                # GET A 16 BITS WORD FROM RANDOM FILE #
          BASED ARRAY BUFIN [0:0] S(1); 
            BEGIN            # DUMP FILE BUFFER # 
              ITEM BUFWD U(0,0,60); 
              ITEM BUFBEG U(0,12,24);  # BEGIN ADDRESS OF BUFFER #
              ITEM BUFEND U(0,36,24);  # END ADDRESS OF BUFFER #
            END 
          ITEM WODPOS U;     # WORD POSITION #
          ITEM BITPOS U;     # BIT POSITION # 
          ITEM WODADR U;     # ADDRESS #
          ITEM TEMPC1 C(10);           # WORK AREA #
          ITEM TYPE I;       # INDEX #
          ITEM NODATA C(10)=" -- ";    # DATA MISSING IN DUMP FILE #
          ITEM WODOUT U;               # WORD RETURN #
          ITEM I;            # INDEX #
      CONTROL EJECT;
#*********************************************************************# 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#*********************************************************************# 
 
          WODOUT = 0;        # CLEAR OUTPUT WORD #
          IF PBUFIN 
          THEN
            BEGIN 
            IF RULES EQ 9 
              AND B<0,3>BUFWD[0] EQ MACREC
              AND WODADR GR BUFBEG[0] 
              AND WODADR LQ BUFEND[0] 
            THEN               # DISIRED WORD ALREADY IN BUFFER # 
              GOTO MOVEDATA;
 
            END 
          IF B<59,1> TYPE EQ 1
          THEN               # MARO MEMORY RECORD WANTED #
            BEGIN 
              IF NOT MACROB 
              THEN           # NO MEMORY RECORD IN DUMP FILE #
                BEGIN 
                  B<0,24>WODOUT = B<0,24>NODATA; # DATA MISSING # 
                  B<24,1>WODOUT = 1;   # SET FLAG TO INDICATE DATA MISS#
                  B<30,6>WODOUT = " ";
                  B<36,6>WODOUT = " ";
                  RETURN; 
                END 
              GETRAN(WODADR);          # GET A RECORD BY KEY #
              IF IOSTAT EQ 0
              THEN
                BEGIN 
                P<BUFIN> = LOC(DMPBUF);# LOCATE RECORD BUFFER # 
                PBUFIN = TRUE;
                END 
              ELSE                     # RECORD NOT IN FILE # 
                BEGIN 
                  B<0,24> WODOUT = B<0,24> NODATA;    # DATA MISSING #
                  B<24,1> WODOUT = 1;  # SET DATA MISSING FLAG #
                  B<30,6>WODOUT = " ";
                  B<36,6>WODOUT = " ";
                  RETURN; 
                END 
            END 
          ELSE
            BEGIN    # NOT MACRO MEM,THEN MUST BE FILE1 OR PAGE REG   # 
              IF FILE1B AND WODADR LQ 255 
              THEN
                BEGIN 
                P<BUFIN> = LOC(FILE1REC);        # LOCATE BUFFER #
                PBUFIN = TRUE;
                END 
              ELSE
                BEGIN        # NOT FILE1 DUMP REC # 
                  IF PREG AND WODADR LQ 32          # PAGE REGISTER # 
                  THEN
                    BEGIN 
                    P<BUFIN> = LOC(PAGREGREC);
                    PBUFIN = TRUE;
                    END 
                  ELSE       # DATA NOT IN DUMP FILE                   #
                    BEGIN 
                    B<0,24> WODOUT = B<0,24> NODATA;
                    B<24,1> WODOUT = 1;#SET FLAG TO INDICATE DATA MISS# 
                    B<30,6>WODOUT = " ";
                    B<36,6>WODOUT = " ";
                    RETURN; 
                    END 
                END 
            END 
          WODADR = WODADR - BUFBEG[0]; # COUNT DATA ADDRESS IN BUFFER # 
          WODPOS = WODADR * 16 / 60;   # CACULATE WORD POSITION # 
          BITPOS = WODADR * 16 - WODPOS * 60;    # BIT POSITION # 
 MOVEDATA:  
          FOR I=0 STEP 1 UNTIL 3
          DO                 # MOVE A 16 BITS WORD TO WORD OUT #
            BEGIN 
              B<I*4+44,4>WODOUT = B<BITPOS,4>BUFWD[WODPOS+1]; 
              IF BITPOS GQ 56 
              THEN           # SPAN TO NEXT WORD #
                BEGIN 
                  BITPOS = 0;          # RESET BIT POSITION # 
                   WODPOS = WODPOS + 1;          # SET WORD POSITION #
                END 
              ELSE
                BITPOS = BITPOS + 4;
            END 
          IF B<58,1> TYPE EQ 1
          THEN               # CONVERTION TO DISPLAY CODE DESIRED # 
            BEGIN 
              HEXDIS(WODOUT,TEMPC1,4); # CONVERT TO DISPLAY # 
              B<0,24> WODOUT = B<0,24> TEMPC1;
            END 
          IF B<57,1>TYPE EQ 1 
            AND NOT EBCDIC
          THEN               # CONVERT TO ASCII WANTED #
            BEGIN 
              IF B<44,1>WODOUT EQ 1 
              THEN
                B<30,6>WODOUT = " ";
              ELSE
                B<30,6>WODOUT = ASCVAL[B<44,8>WODOUT];
              IF B<52,1>WODOUT EQ 1 
              THEN
                B<36,6>WODOUT = " ";
              ELSE
                B<36,6>WODOUT = ASCVAL[B<52,8>WODOUT];
            END 
 
          ELSE                       # NOT *ASCII* CONVERSION # 
            BEGIN  # NOT *ASCII* #
 
            IF B<57,1>TYPE EQ 1 
              AND EBCDIC
            THEN                     # *EBCDIC* CONVERSION SELECTED # 
              BEGIN 
              B<30,6>WODOUT = EBCDVAL[B<44,8>WODOUT]; 
              B<36,6>WODOUT = EBCDVAL[B<52,8>WODOUT]; 
              END 
 
            END  # NOT *ASCII* #
 
        END 
                                                         CONTROL EJECT; 
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        GETRAN              JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        GET A RANDOM RECORD FROM NEUFILE WITH ADDRESS SPECIFIED
* 
*     3. METHOD USED: 
*        USE TWO BUFFERS AS DUMP BUFFERS FOR INCREASED I/O SPEED
*        IF RECORD NOT FOUND IN TWO BUFFERS TRY TO GET ANOTHER
*        RECORD FROM RANDOM FILE NEUFILE WITH RECORD ID AND ADDRESS 
*        SPECIFIED. 
* 
*     4. ENTRY PARAMETERS:  
*        ADDRES     KEY ADDRESS 
*        MACREC     MACRO MEMORY RECORD TYPE
*        DMPBUF1    DUMP FILE RECORDS BUFFER 1
*        DMPBUF2    DUMP FILE RECORDS BUFFER 2
* 
*     5. EXIT PARAMETERS: 
*        IOSTAT     STATUS RETURNED ON SUPIO FUNCTIONS
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        FINDRI     GET RECORD ID - SYMPL 
*        READRI     READ A RECORD FROM RANDOM FILE - SYMPL
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         GET A RANDOM RECORD FROM NEUFILE WITH BEGIN ADDRESS          #
#                                                                      #
#**********************************************************************#
      PROC GETRAN ((ADDRES)); 
        BEGIN                # GET A RECORD BY KEY #
          ITEM ADDRES U;     # KEY ADDRESS #
      CONTROL EJECT;
          IF B<0,3>DMPWD[0] EQ MACREC AND ADDRES GQ B<12,24>DMPWD[0]
             AND ADDRES LQ B<36,24>DMPWD[0] 
          THEN
            BEGIN            # RECORD ALREADY IN BUFFER # 
              IOSTAT = 0;    # RESET RETURN CODE #
              RETURN; 
            END 
          ELSE
            BEGIN            # CHECK ANOTHER BUFFER # 
              IF P<DMPBUF> EQ LOC(DMPBUF1)
              THEN           # LOCATE BUFFER ADDRESS #
                P<DMPBUF> = LOC(DMPBUF2); 
              ELSE
                P<DMPBUF> = LOC(DMPBUF1); 
              IF B<0,3>DMPWD[0] EQ MACREC AND ADDRES GQ B<12,24>DMPWD[0]
                 AND ADDRES LQ B<36,24>DMPWD[0] 
              THEN
                BEGIN        # RECORD IN THIS BUFFER #
                  IOSTAT = 0;     # RESET STATUS #
                  RETURN; 
                END 
            END 
          P<SIOFET> = LOC(NEUFILE);    # LOCATE FET ADDRESS # 
          P<SIOINDX> = FETINDX[0];     # LOCATE SUPERVISOR INDEX #
          RECKEY = 0;        # RESET KEY VALUE #
          B<12,24>RECKEY = ADDRES;
          FINDRI (LOC(SIOINDX),RECKEY,TEMP,TEMPB);    # GET RECORD ID # 
          IF TEMP LQ LINDX[0] 
          THEN               # RECORD FOUND # 
            BEGIN 
              IF B<36,24>RI[TEMP] GR ADDRES 
              THEN
                IOSTAT = BADRI;        # SET BAD RECORD STATUS #
              ELSE
                BEGIN 
                  RECKEY = RI[TEMP];             # MOVE RECORD ID # 
                  LENGTH = BUFLEN;
                  READRI(LOC(NEUFILE),RECKEY,LOC(DMPBUF),LENGTH,IOSTAT);
                             # READ A RECORD FROM RANDOM FILE # 
                END 
            END 
          ELSE               # RECORD AFTER LAST RECORD # 
            IOSTAT = RDEOI;  # SET END OF FILE STATUS # 
          IF IOSTAT EQ RDEOR
          THEN
            IOSTAT = 0; 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        PRINTH              JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        WRITE A DETAIL LINE TO OUTPUT WITH HEADING ON EACH PAGE
* 
*     3. METHOD USED: 
*        WRITE A FORMATTED LINE TO CIO BUFFER WITH 140 CHARACTERS LONG
*        IF TOTAL LINE IN A PAGE EXCEED XLINP THEN START A NEW PAGE 
*        WITH SUITABLE HEADING AT THE TOP OF EACH PAGE
* 
*     4. ENTRY PARAMETERS:  
*        OUTLEN     LINE LENGTH 
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        WRITEH     WRITE THE LINE TO CIO BUFFER--SUPIO 
*        RECALL     SET PROGRAM/FUNCTION IN RECALL STATUS--MACREL 
*        HEADING    WRITE HEADING INFORMATION--SYMPL
* 
*     8. DAYFILE MESSAGE: 
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         WRITE A DETAIL LINE TO OUTPUT                                #
#                                                                      #
#**********************************************************************#
      PROC PRINTH(OUTBUF,OUTLEN); 
        BEGIN                # WRITE A LINE TO OUTPUT # 
          ITEM OUTBUF C(140);          # OUTPUT LINE #
          ITEM OUTLEN U;     # LINE LENGTH #
      CONTROL EJECT;
          WRITEH(OUTPUT,OUTBUF,OUTLEN);# WRITE THE LINE TO CIO BUFFER # 
          RECALL(OUTPUT); 
          LINENO = LINENO + 1;         # COUNT LINE NUMBER #
          IF LINENO GR XLINP
          THEN               # START A NEW PAGE # 
            HEADING;         # PRINT HEADING INFORMATION #
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        HEADING             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        PROCESS HEADING INFORMATION FOR EACH PAGE
* 
*     3. METHOD USED: 
*        USE TTL0 AS  DIFFERENT KIND OF OUTPUT TITLE BUFFER, IF MACRO 
*        MEMORY OR FILE 1 REGISTER DUMP, THEN WRITE ANOTHER OUTPUT
*        TITLE FROM HEAD FOR THEM 
* 
*     4. ENTRY PARAMETERS:  
*        TTL0       HEADING INFORMATION BUFFER
*        HEAD       HEADING INFORMATION FOR MACRO MEM AND FILE 1 REG. 
*        BLLINE     BLANK LINE. 
*        RULES      MACRO MEM OR FILE 1 DUMP INDICATOR
* 
*     5. EXIT PARAMETERS: 
*         LINENO    CURRENT LINE NUMBER IN LISTING
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        WRITEH     WRITE A LINE OF DATA TO FILE--SUPIO 
*        RECALL     SET PROGRAM/FUNCTION IN RECALL STATUS--MACREL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         PROCESS HEADING INFORMATION                                  #
#                                                                      #
#**********************************************************************#
      PROC HEADING; 
        BEGIN                # PRINT HEADING INFORMATION #
          PAGENO = PAGENO + 1;
          TEMPC2 = XCDD(PAGENO);
          PAGNUM = C<2,8>TEMPC2;
          WRITEH(OUTPUT,TTL,14);
          RECALL(OUTPUT); 
          WRITEH(OUTPUT,BLLINE,1);     # PRINT A BLANK LINE # 
          RECALL(OUTPUT); 
          IF RULES EQ 7 OR RULES EQ 8 OR RULES EQ 9 
          THEN     # IF MACRO MEM FILE 1, OR PAGE REG THEN ANOTHER LINE#
            BEGIN 
              WRITEH(OUTPUT,HEAD,14); 
              RECALL(OUTPUT); 
              LINENO = 5;    # RESET LINE NUMBER #
            END 
          ELSE
            LINENO = 3; 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        DISHEX              JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        CONVERT DISPLAY CODE TO HEXADECIMAL
* 
*     3. METHOD USED: 
*        THIS PROCEDURE CONVERTS 6-BIT DISPLAY CODE TO 4-BIT HEXADECIMAL
*        DEPENDING ON THE CHARACTER LENGTH ( CHARLEN ) DEMAND, IF INPUT 
*        DISIN OUT OF RANGE THEN SET ERROR FLAG ERRORI TRUE 
* 
*     4. ENTRY PARAMETERS:  
*        DISIN      INPUT DISPLAY CODE TO BE CONVERTED
*        CHARLEN    LENGTH OF DISPLAY CODE TO BE CONVERTED
* 
*     5. EXIT PARAMETERS: 
*        HEXOUT     OUTPUT HEXADECIMAL. 
*        ERRORI     ERROR FLAG FOR UNSUITABLE DISPLAY CODE
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        NONE 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         CONVERT THE DISPLAY CODE TO HEXADECIMAL                      #
#                                                                      #
#**********************************************************************#
      PROC DISHEX(DISIN,HEXOUT,CHARLEN,ERRORI); 
        BEGIN                # CONVERT DISPLAY TO HEX. #
          ITEM DISIN C(10);  # DISPLAY CODE TO BE CONVERTED # 
          ITEM HEXOUT U;     # CONVERTED HEXADECIMAL #
          ITEM CHARLEN U;    # LENGTH TO BE CONVERTED # 
          ITEM ERRORI B;     # ERROR FLAG # 
          ITEM I;            # INDEX #
          ITEM IPOS;         # INDEX #
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          ERRORI = FALSE;    # INITIAL FLAG # 
          HEXOUT = 0;        # CLEAR OUTPUT WORD #
          FOR I=0 STEP 1 UNTIL CHARLEN-1
          DO
            BEGIN 
              IPOS = (15 + I - CHARLEN) * 4;
              IF C<I,1>DISIN LQ "F" AND C<I,1>DISIN GQ "A"
              THEN
                B<IPOS,4>HEXOUT = C<I,1>DISIN + 9;
              ELSE
                IF (C<I,1>DISIN GQ DISZERO) AND (C<I,1>DISIN LQ DISNINE)
                THEN
                  B<IPOS,4>HEXOUT = C<I,1>DISIN - DISZERO;
                ELSE         # THERE ARE NON HEX. DIGIT # 
                  ERRORI = TRUE;       # SET ERROR FLAG # 
            END 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        HEXDIS              JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        CONVERT HEXADECIMAL TO DISPLAY CODE
* 
*     3. METHOD USED: 
*        THIS PROCEDURE CONVERT 4-BIT HEXADECIMAL TO 6-BIT DISPLAY CODE 
*        DEPENDING ON THE LENGTH ( LEN ) DEMAND, PUT CONVERTED DISPLAY
*        CODE IN DISOUT 
* 
*     4. ENTRY PARAMETERS:  
*        HEXIN     INPUT HEXADECIMAL TO BE CONVERTED
*        LEN        LENGTH FOR CONVERSION 
* 
*     5. EXIT PARAMETERS: 
*        DISOUT     OUTPUT DISPLAY CODE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        NONE 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         CONVERT THE HEXADECIMAL TO DISPLAY CODE                      #
#                                                                      #
#**********************************************************************#
      PROC HEXDIS((HEXIN),DISOUT,(LEN));
        BEGIN                # CONVERT HEX. TO DISPLAY CODE # 
          ITEM DISOUT C(10); # CONVERTED DISPLAY CODE # 
          ITEM HEXIN U;      # HEX. TO BE CONVERTED # 
          ITEM LEN I;        # INDEX #
          ITEM I;            # INDEX #
      CONTROL EJECT;
#*********************************************************************# 
#                                                                      #
#                            CODE BEGINS HERE                          #
#                                                                      #
#**********************************************************************#
 
          FOR I=0 STEP 1 UNTIL LEN - 1
          DO
            BEGIN 
              IF B<(15+I-LEN)*4,4>HEXIN LQ 9
              THEN
                C<I,1>DISOUT = B<(15+I-LEN)*4,4>HEXIN + DISZERO;
              ELSE
                C<I,1>DISOUT = B<(15+I-LEN)*4,4>HEXIN - 9;
            END 
        END 
          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        PTRMISS             JACOB C. K. CHEN       80/02/01
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        PRINT POINTER MISSING ERROR MESSAGE
* 
*     3. METHOD USED: 
*        IF POINTER MISSING THEN PRINT INPUT ERROR DIRECTIVE TOGETHER 
*        WITH OTHER PROPER ERROR MESSAGE
* 
*     4. ENTRY PARAMETERS:  
*        POINTER     POINTER WHICH IS NOT IN THE DUMP FILE
*        BLLINE      BLANK LINE 
*        INPBUFC     INPUT DIRECTIVE BUFFER 
*        OUTBUF      OUTPUT ERROR DIRECTIVE/MESSAGE BUFFER
* 
*     5. EXIT PARAMETERS: 
*        NONE 
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        PRINTH      WRITE A DETAIL LINE TO OUTPUT. - SYMPL 
*        HEXDIS      CONVERT HEXADECIMAL TO DISPLAY CODE. - SYMPL 
* 
*     8. DAYFILE MESSAGES:  
*        NONE 
* 
 #
*ENDIF
#**********************************************************************#
#                                                                      #
#         PRINT POINTER WORD MISSING ERROR MESSAGE                     #
#                                                                      #
#**********************************************************************#
      PROC PTRMISS((POINTER));
        BEGIN                # PRINT POINTER WORD MISSING MESSAGE # 
          ITEM POINTER U;    # POINTER THAT NOT IN DUMP FILE #
          ITEM WORKCP C(10); # WORKING AREA # 
      CONTROL EJECT;
          STRING = " ";      # CLEAR OUTPUT BUFFER #
          C<1,80>STRING = INPBUFC;     # PRINT ERROR DIRECTIVE #
          PRINTH(BLLINE,1);  # PRINT A BLANK LINE # 
          PRINTH(OUTBUF,14);
          STRING = " ERROR IN POINTER(    ), DATA MISSING IN DUMP FILE";
          HEXDIS(POINTER,WORKCP,4);    # CONVERT TO DISPLAY CODE #
          C<18,4>STRING = WORKCP; 
          PRINTH(OUTBUF,14); # PRINT ERROR MESSAGE #
          PRINTH(BLLINE,1);  # PRINT A BLANK LINE # 
          STRING = " "; 
        END 
                                                          CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME:             AUTHOR:               DATE: 
*        WRITERR              E. SULLIVAN           77/01/31
* 
*     2. FUNCTIONAL DESCRIPTION:  
*        PROCESSES ERRORS RETURNED FROM CALLS TO SUPIO FUNCTION WRITESR.
* 
*     3. METHOD USED: 
*        AN UNSATISFACTORY STATUS CODE RETURNED FROM WRITESR CAUSES 
*        WRITERR TO BE CALLED.  AN ERROR MESSAGE IS FORMATTED AND 
*        WRITTEN TO OUTPUT AFTER WHICH AN ERROR IS FLAGGED. 
* 
*     4. ENTRY PARAMETERS:  
*        FNAME      FILE ON WHICH WRITESR ERROR WAS RETURNED
*        REC        RECORD TYPE CURRENTLY BEING PROCESSED 
*        CODE       ERROR CODE RESPONSE FROM WRITESR
* 
*     5. EXIT PARAMETERS: 
*        WERRFLG    SET TRUE
* 
*     6. COMDECKS CALLED: 
*        NONE 
* 
*     7. ROUTINES CALLED: 
*        MESSAGE    WRITE MESSAGE TO DAYFILE--SUPIO 
*        PRDFILE    FLUSH OUTPUT BUFFER TO ASSURE A DAYFILE MESSAGE 
*        XCOD       CONVERT OCTAL TO DISPLAY - MACREL 
* 
*     8. DAYFILE MESSAGES:  
*        SUPIO ERROR XXXX IN XXXXXXX WHEN WRITING RECORD X
* 
 #
*ENDIF
      PROC WRITERR(FNAME,REC,(CODE)); 
        BEGIN 
          ITEM FNAME C(7);   #FILE IN ERROR # 
          ITEM REC C(8);
          ITEM CODE U;       #ERROR CODE RETURNED # 
      CONTROL EJECT;
          WRREC[0] = REC;    #FORMAT MESSAGE #
          TEMP = XCOD(CODE);
          WRCODE[0] = C<6,4>TEMP; 
          WRFILE[0] = FNAME;
          MESSAGE(WRERR,OPTION);       #OUTPUT MESSAGE #
          PRDFILE;           # FLUSH OUTPUT BUFFER TO ASSURE DAYFILE   #
          SUPERR = TRUE;
        END 
      CONTROL EJECT;
*IF DEF,IMS 
 #
**
*E
*     1. PROC NAME           AUTHOR              DATE 
*        PRDFILE             S.D.LEE             78/02/24 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        PRDFILE WILL ASSURE THAT THE DAYFILE IS PRINTED WHEN NDA ABORTS
*        WITH AN ERROR LOGGED IN THE DAYFILE. 
* 
*     3. METHOD USED
*        THREE BLANK LINES ARE WRITTEN TO THE OUTPUT FILE AND 
*        THE OUTPUT BUFFER IS FLUSHED TO ASSURE THE ERROR IN THE
*        DAYFILE ARE PRINTED. 
* 
*     4. ENTRY PARAMETERS 
*        NONE 
* 
*     5. EXIT PARAMETERS
*        NONE 
* 
*     6. COMDECKS CALLED
*        NONE 
* 
*     7. ROUTINES CALLED
*        WRITEH     WRITE A LINE OF DATA TO FILE
*        WRITER     WRITE A RECORD OF DATA TO FILE
* 
*     8. DAYFILE MESSAGES 
*        NONE 
 #
*ENDIF
      PROC PRDFILE; 
        BEGIN 
          WRITEH(OUTPUT,BLLINE,3);     # OUTPUT 3 BLANK LINES  #
          RECALL(OUTPUT); 
          WRITER(OUTPUT,0);            # FLUSH OUT CIO BUFFER  #
          RECALL(OUTPUT); 
        END 
        END 
      TERM
¹⁾
SRCHVAL),NUMCHARS)
[01180] PROC READDIR
[01221] FUNC XSFW C(10)
[01341] PROC DNPROC(EOF)
[01491] PROC PREP(EOF)
[01549] PROC READW
[01550] FUNC XCHD C(10)
[01551] FUNC XSFW C(10)
[01789] PROC BLDFILE
[01935] PROC FORM1
[02014] PROC SYNCHK(DIRERR)
[02106] PROC READI
[02153] PROC FORMAT0
[02218] PROC FORMAT1
[02291] PROC FORMAT3
[02408] PROC FORMAT4
[02617] PROC FORMAT9
[02808] PROC FORMATA
[03005] PROC FORMATA1
[03129] PROC FORMATA2
[03249] PROC FORMATB
[03417] PROC FORMATF
[03462] PROC ONEWORD((WODADR),WODOUT,(TYPE
²⁾
ADDRES
³⁾
HEXIN),DISOUT,(LEN
⁴⁾
POINTER
NDAS

Table Of Contents
