*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 = PARAREA; # PARAMETER AREA STARTS FROM RA+2 # P = 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 ( CCPARVAL[I] LS DISPLA ) OR ( CCPARVAL[I] GR DISNINE ) THEN # ILLEGAL FILE NAME # BEGIN BADPARM(ECODE"ILLVAL",CPARVAL[I-1],CCOUNT2); GOTO TESTTER; END END P = 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 (CCPARVAL[I] LS DISPLA) OR (CCPARVAL[I] GR DISNINE) THEN #ILLEGAL FILE NAME # BEGIN BADPARM(ECODE"ILLVAL",CPARVAL[I-1],CCOUNT2); GOTO TESTTER; END END P = 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 = BCPARVAL[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 CCPARVAL[I] EQ "R" THEN BEGIN REGISTERS = TRUE; PAGEREG = TRUE; END ELSE BEGIN IF CCPARVAL[I] EQ "M" THEN MACROMEM = TRUE; ELSE BEGIN IF CCPARVAL[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 ( CCPARVAL[I] LS DISPLA ) OR ( CCPARVAL[I] GR DISNINE ) THEN # ILLEGAL FILE NAME # BEGIN BADPARM(ECODE"ILLVAL",CPARVAL[I-1],1); GOTO TESTTER; END END P = 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 CSRCHVAL 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 = 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 = 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 = 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 = 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 = O"70"; # CONTROL CARD IMAGE AREA # PRDN2[0] = DFNAME; # SET UP DUMP FILE NAME FOR HEADER # FOR ICD=0 STEP 1 WHILE CCCRD[0] NQ O"00" DO # MOVE CHARACTERS UNTIL END OF CARD # CPRDN3[0] = CCCRD[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 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 = 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 = 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 = 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 # CSTRING = 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 # CSTRING = 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 = 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 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 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 = 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); COUTLIN1[0] = TEMPC1; COUTLIN2[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 EQ LOC(OUTLINE8) THEN # LOCATE ANOTHER WORKING BUFFER # P = LOC(OUTLINE9); ELSE P = 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 = 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); CSTRING = TEMPC1; CSTRING = "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 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 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 CSTRING = "LCB"; ELSE CSTRING = "TCB"; HEXDIS(TCBNUM[I02],TEMPC1,3); CSTRING = 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 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 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 = 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 STRING = "PORT"; C STRING = TEMPC1; C 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 STRING = TEMPC1; IF PTADDR[I02*2+1] NQ 0 THEN BEGIN HEXDIS(PTADDR[I02*2+1],TEMPC1,4); C 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 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 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 = 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 = LOC(FILE1REC); # LOCATE BUFFER # PBUFIN = TRUE; END ELSE BEGIN # NOT FILE1 DUMP REC # IF PREG AND WODADR LQ 32 # PAGE REGISTER # THEN BEGIN P = 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 BWODOUT = BBUFWD[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 EQ LOC(DMPBUF1) THEN # LOCATE BUFFER ADDRESS # P = LOC(DMPBUF2); ELSE P = 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 = LOC(NEUFILE); # LOCATE FET ADDRESS # P = 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 CDISIN LQ "F" AND CDISIN GQ "A" THEN BHEXOUT = CDISIN + 9; ELSE IF (CDISIN GQ DISZERO) AND (CDISIN LQ DISNINE) THEN BHEXOUT = CDISIN - 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 CDISOUT = B<(15+I-LEN)*4,4>HEXIN + DISZERO; ELSE CDISOUT = 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