*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