Trailing-Edge
-
PDP-10 Archives
-
bb-d549g-sb
-
rederr.mac
There are no other files named rederr.mac in the archive.
TITLE REDERR -- SUBPROGRAM CALLED BY COBOL TO TRANSLATE ERROR.SYS
SUBTTL V1 L. EMLICH
SUBTTL UNIVERSAL SEARCHES, AC DEFS, PROGRAM DESCRIPTION
; COPYRIGHT (C) 1980 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
; ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH ERRUNV ;REDERR'S UNIVERSAL FILE. USED DIFFERENTLY
;DEPENDING ON WHETHER REDERR IS TO BE CALLED BY
;A MACRO PROGRAM OR A COBOL PROGRAM.
;IF MACRO (OR COBOL WITH NO TRANSLATION):
; THE BEST WAY IS TO SIMPLY DEFINE
; HICOD==0 SO NO CONTROL TABLES ARE
; GENERATED. ALSO, DON'T DEFINE ANY
; ERROR CODES.
;IF COBOL:
; DEFINE EACH DESIRED ERROR CODE AS:
; ERX==-1 WHERE X IS THE OCTAL ERROR CODE
; ALSO DEFINE HICOD==Y WHERE Y IS THE
; HIGHEST DEFINED ERROR CODE.
;IF READING AVAIL FILES:
; DEFINE AVAIL==-1.
;IF READING ERROR FILES:
; DON'T DEFINE AVAIL.
SEARCH SYRUNV ;SYSERR'S UNIVERSAL FILE CONTAINING AC
;DEFINITIONS, ERROR FILE DESCRIPTIONS, CONTROL
;TABLES FOR TRANSLATION, AND DUMMY MACROS
;WHICH WE USE TO GENERATE THE CONTROL TABLES
;EXTRA AC DEFS (OTHERS COME FROM SYRUNV)
C=15
ARG=16
;MACRO CONTROL
MAXTYP==777 ;LENGTH OF RAW BUFFER AND HIGHEST ENTRY CODE
IFNDEF HICOD, <HICOD==MAXTYP> ;SHOULD BE DEFINED IN ERRUNV TO AVOID LENGTH
;THIS ROUTINE CAN BE CALLED BY EITHER MACRO OR COBOL PROGRAMS TO READ
;ERROR.SYS RECORDS INTO THE CALLER'S BUFFER. IF CALLED BY MACRO, THIS
;ROUTINE WILL TRANSLATE ONLY THE HEADER INFORMATION. THE ENTRY BODY
;WILL BE RETURNED EXACTLY AS IT APPEARS ON DISK. IF CALLED BY COBOL
;AND ERRUNV DESCRIBES THE CODE, THE BODY WILL BE TRANSLATED ACCORDING TO
;DATA TYPE AND BREAKDOWN. THE COBOL DATA DESCRIPTIONS FOR EACH ENTRY TYPE CAN
;BE COPIED FROM ERRLIB.LIB (COPY ENTX WHERE X = ENTRY CODE).
;TO AVOID UNNECESSARY LENGTH, REDERR SHOULD BE COMPILED ONLY AFTER
;ERRUNV.MAC IS COMPILED AND ERRUNV SHOULD DESCRIBE ONLY THE DESIRED
;ENTRY CODES. IF THE COBOL PROGRAM WANTS TO READ ENTRIES
;WITHOUT TRANSLATION, IT CAN SIMPLY COMPILE REDERR WITH A ERRUNV
;FILE CONTAINING ONLY A HICOD==0. IF SOME ENTRIES SHOULD BE TRANSLATED
;BUT OTHERS SHOULD NOT, SIMPLY SUPPLY TABLES ONLY FOR THOSE THAT SHOULD.
;ALSO COBOL PROGRAMS CAN TRANSLATE DAY/JIFFY COMP WORDS TO TWO
;SIXBIT WORDS GIVING (YYMMDD, HRMISE) BY USING REDERR-FUNCTION 3.
;DO THIS BY:
; ENTER MACRO REDERR USING COMP-DAYS, COMP-JIFFYS, SIX-DATE,
; SIX-TIME, 3.
;ANOTHER AVAILABLE FUNCTION IS: ADDING AND SUBTRACTING OF DAY/JIFFY
;COMBINATIONS.
;TO SUBTRACT Y FROM X:
; ENTER MACRO REDERR USING X-DAYS, X-JIFFS, Y-DAYS, Y-JIFFS,
; 4, OUT-DAYS, OUT-JIFFS.
;TO ADD X TO Y:
; ENTER MACRO REDERR USING X-DAYS, X-JIFFS, Y-DAYS, Y-JIFFS,
; 5, OUT-DAYS, OUT-JIFFS.
;FOLLOWING IS A SUMMARY OF ALL CURRENT FUNCTIONS
; -1 -- OPEN SELECTED ERROR OR AVAIL FILE AND READ THE FIRST
; DESIRED RECORD.
; -2 -- SAME AS ABOVE BUT DO NOT TRANSLATE THE ENTRY HEADER.
; -3 -- OPEN SELECTED ERROR OR AVAIL FILE, TRANSLATE THE
; HEADER, BUT DO NOT READ THE FIRST ENTRY.
; 1 -- READ THE NEXT DESIRED RECORD.
; 2 -- SAME AS ABOVE BUT DO NOT TRANSLATE THE RECORD HEADER.
; 3 -- TRANSLATE UNIVERSAL DATE/TIME TO SIXBIT YYMMDDHHMMSS.
; 4 -- SUBTRACT TWO UNIVERSAL DATE/TIMES.
; 5 -- ADD TWO UNIVERSAL DATE/TIMES.
SUBTTL ARGUMENT DESCRIPTION
;OFFSETS INTO ARGUMENTS PASSED BY COBOL
;EXAMPLES OF USE:
; MOVE T1,@FLGLOC(ARG) ;LOAD FLAG WORD INTO T1
; MOVE T2,@BEGDES(ARG) ;LOAD BYTE POINTER TO BEGINNING DATE/TIME
;************* DATE CHECK ARGUMENTS *************************
; BOTH BEGINNING AND END DATE/TIME ARGUMENTS
; POINT TO A DESCRIPTOR WHICH POINTS TO TWO
; WORDS IN THE FOLLOWING FORMAT:
; YYMMDD -- (YEAR,MONTH,DAY)
; HHMISS -- (HOURS,MINUTES,SECOND)
; THESE MUST BE IN SIXBIT FORMAT -- NO NULLS
BEGDES==0 ;ADDRESS OF BEGINNING DATE/TIME DESCRIPTOR
;READ BY REDERR ONLY WHEN INITIALIZING
;IF CALLER DOESN'T CARE ABOUT BEGINNING DATE,
;HE SHOULD SPECIFIY ZERO (IN SIXBIT)
ENDDES==1 ;ADDRESS OF END DATE/TIME DESCRIPTOR
;AS ABOVE, READ ONLY WHEN INITIALIZING.
;IF CALLER DOESN'T CARE ABOUT ENDING, HE
;SHOULD SPECIFY THE YEAR 1999
;*********************************************************
BUFDES==2 ;ADDRESS OF OUTPUT BUFFER DESCRIPTOR
;DESCRIPTOR INCLUDES A BYTE COUNT SHOWING
;HOW MANY SIXBIT BYTES CAN BE LOADED. CALLER
;SHOULD INSURE THIS IS A MULTIPLE OF 6
;REDERR CLEARS THIS BUFFER SO THAT COMP
;ITEMS WON'T BE SIXBITIZED
DEVDES==3 ;ADDRESS OF DESCRIPTOR OF FILE/DEVICE LOCATOR
FLGLOC==4 ;ADDRESS OF THE FLAG WORD FROM COBOL
;THIS WORD IS SET BY THE CALLING PROGRAM TO
;TELL REDERR WHAT TO DO. IT IS A COMP ITEM
LSTWRD==5 ;ADDRESS OF FIRST DESIRED ENTRY
;THIS IS A VARIABLE LIST OF DESIRED ENTRY CODES
;SHOULD NOT BE SUPPLIED IF USER WANTS ALL CODES.
;*****************************************************************
;THE FOLLOWING ARGUMENT OFFSETS ARE FOR SPECIAL CALLS FROM THE COBOL
;PROGRAM NOT RELATED TO ERROR FILE READING (SPECIAL USER SERVICES)
;SPECIAL CALL FROM COBOL FOR TRANSLATION OF A UNIVERSAL DATE/TIME
;(FUNCTION 3)
DAYS==0 ;NUMBER OF DAYS IN BINARY
JIFFS==1 ;NUMBER OF JIFFIES IN BINARY
UDATE==2 ;ADDRESS OF DESCRIPTOR OF SIXBIT DATE (YYMMDD)
UTIME==3 ;ADDRESS OF DESCRIPTOR OF SIXBIT TIME (HHMISS)
;SPECIAL CALL FROM COBOL FOR ADDING OR SUBTRACTING TWO DAY/JIFFY
;COMBINATIONS (FUNCTION 4 FOR SUBTRACT, FUNCTION 5 FOR ADD)
DAY1==0 ;NUMBER OF DAYS IN MINUEND
JIF1==1 ;NUMBER OF JIFFIES IN MINUEND
DAY2==2 ;NUMBER OF DAYS IN SUBTRAHEND
JIF2==3 ;NUMBER OF JIFFIES IN SUBTRAHEND
DAYO==5 ;NUMBER OF DAYS IN RESULT
JIFO==6 ;NUMBER OF JIFFIES IN RESULT
SUBTTL OUTPUT ENTRY BUFFER DEFINITIONS
TYPE==0 ;FIRST WORD IS ERROR CODE IN DECIMAL (COMP)
;TRANSLATED BY REDERR TO DECIMAL EQUIVALENT
;IF REDERR ENCOUNTERS EOF, THIS IS SET TO 0
;IF FILE NOT FOUND, THIS IS SET TO -1.
UDAYS==1 ;TIME-STAMP DAYS
UJIFFS==2 ;TIME-STAMP JIFFIES
DATE==3 ;ENTRY DATE IN SIXBIT (YY,,MM,,DD)
TIME==4 ;ENTRY TIME IN SIXBIT (H,M,S)
UPDAYS==5 ;UPTIME IN DAYS (BINARY)
UPJIFF==6 ;AND JIFFS (BINARY)
UPTIM==7 ;UPTIME IN SIXBIT (DAYS)
UPTM1==10 ;(H,M,S)
CPUSN==11 ;CPU SN IN COMP FORMAT
ENTBOD==12 ;THIS IS THE BEGINNING OF THE ENTRY BODY. IF PROGRAM
;CALLING REDERR IS MACRO, IT BEGINS THE RAW BODY
;(NO TRANSLATION). IF COBOL CALLS US, THE BODY
;WILL BE TRANSLATED ACCORDING TO SYRUNV AND ANY
;ADDITIONAL CONTROLS WE'VE ADDED.
;THE COBOL FORMATS FOR THESE ENTRIES SHOULD BE IN
;ERRLIB UNLESS TRANSLATION IS NOT WANTED.
;SPECIAL MACRO FOR FATAL ERRORS
DEFINE FATL (A), <
SALL
JRST [OUTSTR [ASCIZ/A/]
EXIT]
XALL
>;END FATL MACRO
SUBTTL SYRUNV INTERFACE
;THE FOLLOWING MACROS INTERFACE WITH DUMMY MACROS IN SYRUNV
;THIS ALLOWS AUTOMATIC TRACKING OF SYSERR CHANGES (MOSTLY)
; MACRO TO GENERATE CONTROL TABLE FOR ALL ENTRIES
DEFINE TBLENT (A,B,C,D,E) <
IFDIF <C><0>,<
IFDEF C, <XWD C,A>
>>;END TBLENT
;THE FOLLOWING MACROS EXIST TO GENERATE ONLY THE ERROR TABLES WE
;REALLY NEED BASED ON PRESET DEFINITIONS IN ERRUNV
; DEFINITION OF MACRO IN SYRUNV TO SET UP CONTROL TABLE ENTRIES
;A-- OCTAL ERROR CODE. NOT USED BY THIS PROGRAM
;B-- OFFSET INTO ENTRY BUFFER FOR POINTER TO DATA
;C-- OFFSET INTO ENTRY BUFFER OR FROM POINTER TO DATA
;D-- ADDRESS OF TRANSLATE ROUTINE OR "SPECL" IF UNUSUAL
;E-- LINES OF PRINT. NOT USED BY THIS PROGRAM
;F-- IF D WAS "SPECL" THIS IS ADDRESS OF SPECIAL ROUTINE
;IN REDERR, ALL ROUTINES ARE SPECIAL. IF NOT SPECIFICALLY
;WRITTEN, WE DISPATCH TO OCTLE (OCTAL TO SIXBIT OCTAL)
DEFINE TBLWRD (A,B,C,D,E,F) <
IFDIF <D><SPECL>, <
IFDEF D, <BYTE (9)B,C(18)D>
IFNDEF D, <BYTE (9)B,C(18)<OCTLE>>
>
IFIDN <D><SPECL>, <
IFDEF F, <BYTE (9)B,C(18)F>
IFNDEF F, <BYTE (9)B,C(18)<OCTLE>>
>>;END TBLWRD
;MACRO TO IDENTIFY DESIRED ENTRY TYPES
;DEFINE AS FOLLOWS
;A-- ER, PREFIX FOR ERROR CODE DEFINED IN ERRUNV
;B-- .CT, PREFIX FOR CONTROL TABLE ADDRESS
;C-- DUM, PREFIX FOR MACROS IN SYRUNV DEFINING CONTROL TABLES
;D-- \ZZ, VALUE OF COUNTER USED TO GEN CONTROL TABLE MACRO
DEFINE DUMCOD <
CHKCOD (ER,.CT,DUM,\ZZ)
>
DEFINE CHKCOD (A,B,C,D) <
IFDEF A'D < ;;IF ENTRY IS DESIRED (IN SYRUNV)
XALL
IFGE ZZ-100 <
B'D: C'D ;;NO LEADING ZEROS. GEN CONTROL TABLE
>
IFGE ZZ-10 <
IFL ZZ-100 <
B'0'D: C'0'D ;;ONE LEADING ZERO. GEN CONTROL TABLE
>>
IFL ZZ-10 <
B'00'D: C'00'D ;;TWO LEADING ZEROS. GEN CONTROL TABLE
>
IFDEF DMY'D <DMY'D> ;;IF WE'VE ADDED TO CONTROL TABLE
EXP 0 ;;NOW INDICATE END OF TABLE
SALL
>>;;END OF CHKCOD MACRO AND IFDEF A'D
SUBTTL WORKING STORAGE
BEGDAT: 0 ;DATE THE COBOL PROGRAM WANTS TO CHECK (BEGINNING)
BEGTIM: 0 ;AND BEGINNING TIME
ENDDAT: 0 ;AND END
ENDTIM: 0 ;TIME
ARGCNT==-4 ;COUNT OF FUNCT. ARGUMENTS
FUNARG: 4 ;FUNCTION IS GET AN I/O CHANNEL
FUNERR: 0 ;ERROR FLAG PUT HERE BY FUNCT.
FUNSTS: 0 ;THIS IS 0, IF FUNCT. GAVE US CHANNEL
FUNAR1: 0 ;HOLDS I/O CHANNEL
LASLOC: 0 ;LAST LOCATION OF WORK BUFFER
OPNFLG: Z ;FLAG TO INDICATE FILE IS OPEN
UUOTAB: ;TABLE OF I/O INSTRUCTIONS
OPNUUO: OPEN 0,OPNBLK
LUKUUO: LOOKUP 0,LUKBLK
INUUO: IN 0,
CLSUUO: CLOSE 0,
STDSK: STATZ 0,740000
OPNBLK: 10 ;IMAGE BUFFERED MODE
SIXBIT/DSK/
0,,IBUF
IBUF: 0
DSKPNT: 0
DSKCNT: 0
LUKBLK: BLOCK 4
CURUDT: 0 ;UDT OF ENTRY SAVED HERE IN CASE NEEDED
BODLEN: 0 ;BODY LENGTH FROM ERROR FILE
RAWBUF: BLOCK MAXTYP ;RAW DATA BUFFER
SUBTTL MAINLINE CODE
REDERR::HLRZ S,-1(ARG) ;GET # OF ARGUMENTS
CAILE S,-4 ;ENOUGH ARGUMENTS?
FATL DIDN'T PASS ENOUGH ARGUMENTS
SKIPN T1,@FLGLOC(ARG) ;DOES COBOL WANT US TO STOP?
JRST RDEREX ;YES. LEAVE AFTER CLOSING
CAIN T1,3 ;JUST WANT UDT TRANSLATED?
JRST GETUDT ;YES. GO DO IT.
CAIN T1,4 ;DOING DAY/JIFFY SUBTRACT?
JRST SUBJIF ;YES.
CAIN T1,5 ;DOING DAY/JIFFY ADD?
JRST ADDJIF ;YES
JUMPG T1,NXTENT ;GO READ NEXT ENTRY IF CONTINUE
AOSN OPNFLG ;CHECK FOR ALREADY OPEN
XCT CLSUUO ;IT WAS. CLOSE IT.
MOVE P1,@BEGDES(ARG) ;YES. GET INDEX TO START DATE
MOVE T1,(P1) ;LOAD YY,MM,DD
MOVE T2,1(P1) ;AND HH,MM,SS
MOVEM T1,BEGDAT ;SAVE BEGINNING DATE
MOVEM T2,BEGTIM ;AND TIME
MOVE P1,@ENDDES(ARG) ;GET POINTER TO END CHECK
MOVE T1,(P1) ;THEN GET END DATE
MOVE T2,1(P1) ;AND TIME
MOVEM T1,ENDDAT ;SAVE THEM TOO
MOVEM T2,ENDTIM
PUSH P,ARG ;SAVE ARGUMENT POINTER
MOVEI ARG,FUNARG ;BECAUSE WE MUST CALL LIBOL
HRLI ARG,ARGCNT ;# OF ARGUMENTS
PUSHJ P,FUNCT.## ;TO GET AN I/O CHANNEL FOR ESK
JFCL ;IGNORE POSSIBLE ERROR RETURN
SKIPE FUNSTS ;DID WE GET ONE?
FATL CANNOT GET I-O CHANNEL
POP P,ARG ;RESTORE COBOL ARGUMENT POINTER
MOVE T1,FUNAR1 ;LOAD OUR I/O CHANNEL
MOVEI T2,4 ;AND COMPLETE OUR UUOS
DPB T1,[POINT 4,UUOTAB(T2),12]
SOJGE T2,.-1
MOVE T1,@DEVDES(ARG) ;GET POINTER TO FILE LOCATOR
MOVE T2,(T1) ;GET DEVICE
MOVEM T2,OPNBLK+1 ;AND SAVE IT
SETZM LUKBLK+2 ;CLEAR ANY OLD DATE AND PROT
MOVE T2,1(T1) ;PICK UP REQUESTED FILE NAME
MOVEM T2,LUKBLK ;AND SAVE IT
MOVE T2,2(T1) ;AND EXTENSION
MOVEM T2,LUKBLK+1
SKIPL @BEGDES(ARG) ;CALLED BY COBOL
JRST BINPPN ;NO. PPN IS ALREADY IN BINARY
PUSH P,T1 ;SAVE POINTER
MOVE T1,4(T1) ;GET SIXBIT PROGRAMMER #
PUSHJ P,SIXOCT ;CONVERT IT TO OCTAL
POP P,T1 ;GET POINTER BACK
MOVE T1,3(T1) ;GET PROJECT #
PUSHJ P,SIXOCT ;CONVERT. (PROGRAMMER # SAVED)
JRST SAVPPN ;PPN IS IN T2
BINPPN: HRL T2,3(T1) ;GET POSSIBLE PROJECT #
HRR T2,4(T1) ;AND PROGRAMMER #
SAVPPN: MOVEM T2,LUKBLK+3 ;AND SAVE IT
XCT OPNUUO ;NOW OPEN THE DSK
FATL CAN'T OPEN DISK ;IF POSSIBLE
SETOM OPNFLG ;INDICATE CHANNEL IS OPEN.
XCT LUKUUO
JRST NOFILE ;REQUESTED FILE NOT THERE
MOVM T1,@FLGLOC(ARG) ;GET FUNCTION AGAIN
CAIN T2,3 ;WAS IT -3 (LOOKUP ONLY)?
JRST RDEREX ;YES. CLOSE FILE AND LEAVE
IFDEF AVAIL, <
MOVEI T1,6 ;IF AVAIL FILE, SKIP FIRST FIVE BLOCKS
XCT INUUO
JRST [SOJG T1,.-1 ;LOOP TILL GOOD BLOCK
PUSHJ P,GETWRD ;IGNORE SYNC WORD
JRST NXTENT] ;AND PROCEED
XCT STDSK ;GOT SOMETHING WRONG
OUTSTR [ASCIZ/?FILE ERROR
/]
JRST BEYOND ;ERROR OR EOF
>;END IFDEF AVAIL
;FALL INTO NXTENT
;HERE TO PROCESS AN ENTRY
NXTENT: SKIPL OPNFLG ;SEE IF FILE IS OPEN
FATL DIDN'T OPEN FILE BEFORE READING IT
HRRZ WKINDX,BUFDES(ARG) ;GET ADDRESS OF BUFFER DESCRIPTOR
HRRZ T2,1(WKINDX) ;GET BYTE COUNT OF BUFFER
IDIVI T2,6 ;MAKE IT A WORD COUNT
HRRZ WKINDX,@BUFDES(ARG) ;THEN GET INDEX TO BUFFER
ADD T2,WKINDX ;AND LAST LOCATION OF IT
SOS T2 ;MAKE IT BE LAST LOCATION
HRLI T1,(WKINDX) ;MAKE BLT POINTER
HRRI T1,1(WKINDX)
SETZM (WKINDX) ;AND CLEAR THE BUFFER
BLT T1,(T2) ;CLEAR THE BUFFER
MOVEM T2,LASLOC ;SAVE LAST FOR LATER
GETENT: HLRE S,-1(ARG) ;GET ARGUMENT COUNT
ADDI S,LSTWRD ;AND MAKE AN AOBJ POINTER
HRLZS S ;TO DESIRED ENTRY LIST
HRRI S,LSTWRD(ARG)
PUSHJ P,LODHED ;READ IN THE HEADER
CAIE CTINDX,ER.EOF ;IS THIS AN EOF RECORD?
AOSE F ;OR DID WE GET REAL EOF?
JRST FNDEOF ;YES. GO CHECK FOR DONE
SETZ T3, ;WE MUST CONVERT IT TO DECIMAL FOR COBOL
MOVE F,[POINT 3,CTINDX,26] ;POINT TO OCTAL ENTRY TYPE
OCTDEC: ILDB T1,F ;GET NEXT OCTAL BYTE
IMULI T3,^D10 ;DECIMATE
ADD T3,T1
TLNE F,770000 ;TILL END OF THE WORD
JRST OCTDEC
SKIPL S ;DO WE REALLY CARE ABOUT ENTRY TYPES
JRST ALLTYP ;NO. READ ALL TYPES
CODLUP: MOVE T4,(S) ;GET DESIRED TYPE
CAME T3,(T4) ;IS THIS ONE OF THEM?
AOBJN S,CODLUP ;NOT YET
JUMPGE S,SKIPIT ;DON'T WANT IT
ALLTYP: MOVEM T3,TYPE(WKINDX) ;MIGHT WANT IT
MOVEI P4,RAWBUF ;SET TO READ VIA SYRUNV
MOVE T1,HDRDAT(P4) ;GET DATE OF ENTRY
MOVEM T1,CURUDT ;SAVE IT POSSIBLE USE BY XLATER
HLRZM T1,UDAYS(WKINDX) ;SAVE FOR COBOL
HRRZM T1,UJIFFS(WKINDX)
PUSHJ P,UNVSIX ;GO CHANGE DATE TO COBOL FORMAT
MOVEM T1,DATE(WKINDX) ;AND SAVE IT FOR COBOL
MOVEM T2,TIME(WKINDX)
MOVEI T4,ENDDAT ;TELL CHKDT TO LOOK AT END
PUSHJ P,CHKDT ;IS ENTRY BEYOND WHAT WE WANT?
JRST BEYOND ;YES. TELL CALLER IT'S EOF
MOVEI T4,BEGDAT ;NOW LOOK AT BEGINNING PARAM
PUSHJ P,CHKDT ;STILL TOO OLD?
JRST SKIPIT ;YES. SKIP THIS RECORD.
;FALL INTO NEXT PAGE TO PROCESS THE RECORD SINCE WE WANT IT
;HERE TO PROCESS THE RECORD ONCE WE DECIDE TO KEEP IT
MOVM T1,@FLGLOC(ARG) ;CHECK FOR NO HEADER TRANSLATION
CAIN T1,2 ;SHOULD WE TRANSLATE THE HEADER?
JRST [HRLI T1,RAWBUF ;NO. JUST BLT IT IN
HRR T1,WKINDX
BLT T1,3(WKINDX) ;IN RAW FORM
ADDI WKINDX,4 ;SET INDEX TO BODY
JRST GETBOD] ;AND GO GET IT
MOVE T1,HDRUPT(P4) ;NOW GET THE UPTIME
HLRZM T1,UPDAYS(WKINDX) ;SAVE FOR COBOL
HRRZM T1,UPJIFF(WKINDX)
PUSHJ P,UPTSIX ;CONVERT IT
MOVEM T1,UPTIM(WKINDX) ;AND SAVE IT
MOVEM T2,UPTM1(WKINDX)
MOVE T1,HDRPSN(P4) ;NOW GET THE CPU SERIAL NUMBER
MOVEM T1,CPUSN(WKINDX) ;AND SAVE LAST WORD OF HEADER
SETZ T3, ;PREPARE FOR CONTROL TABLE SEARCH
ADDI WKINDX,ENTBOD ;FIRST SET OUTPUT INDEX TO BODY
GETBOD: PUSHJ P,LODRAW ;AND READ ENTRY BODY
JUMPE F,FNDEF1 ;EOF IN BODY. GIVE ERROR
SKIPGE @BEGDES(ARG) ;WERE WE CALLED BY MACRO?
FNDTAB: SKIPN T1,DSPENT(T3) ;PICK UP CONTROL TABLE
JRST NOTRAN ;MACRO OR NO TRANSLATION WANTED
CAIE CTINDX,(T1) ;IS THIS THE ONE WE WANT
AOJA T3,FNDTAB ;NO. KEEP LOOKING
HLRZ CTINDX,T1 ;YES. THIS IS IT
PROCES: SKIPN P1,(CTINDX) ;PICK UP DISPATCH
POPJ P, ; END OF CALL
LDB P2,[POINT 9,P1,8] ;PICK UP POSSIBLE POINTER LOC
JUMPE P2,LDOFFS ;NO POINTER
HRRZ P2,RAWBUF(P2) ;GET POINTER
LDOFFS: LDB T2,[POINT 9,P1,17] ;GET OFFSET
ADDI P2,RAWBUF(T2) ;P2 POINTS TO ITEM IN RAW BUFFER
HRRZS WKINDX ;GET RID OF BYTE POINTER STUFF
CAMLE WKINDX,LASLOC ;TOO BIG?
FATL ENTRY TOO LONG FOR BUFFER ;YES
PUSHJ P,(P1) ;CALL WORD PROCESSOR
AOJA CTINDX,PROCES ;AND GET NEXT ONE
;ALL WORD PROCESSORS RETURN WITH
;WKINDX POINTING TO THE NEXT OUTPUT WORD
SUBTTL WORD PROCESSING
;ROUTINE TO MOVE AN ASCII FIELD FROM THE RAW DATA BUFFER TO THE OUTPUT BUFFER
TASCI: MOVE P2,(P2) ;GET REAL POINTER
ASCIE: MOVE T3,WKINDX ;SAVE CURRENT INDEX IF ENTER HERE
JUMPE P2,OUTASC ;LEAVE IF NO REAL POINTER
MOVEI T2,^D45 ;ASCII FIELDS ALWAYS X(45)
HRLI WKINDX,440700 ;MAKE A BYTE POINTER TO OUTPUT
HRLI P2,440700 ;AND INPUT
ASCLUP: ILDB T1,P2 ;PICK UP ASCII BYTE
JUMPE T1,SPCFIL ;COBOL DOESN'T LIKE NULLS
IDPB T1,WKINDX ;AND STORE IT
SOJG T2,ASCLUP ;IGNORE ALL BEYOND MAX
OUTASC: MOVEI WKINDX,^D9(T3) ;POINT TO NEXT FIELD
POPJ P, ;RETURN FOR NEXT FIELD
SPCFIL: MOVEI T1," " ;SPACE FILL REST OF FIELD
IDPB T1,WKINDX
SOJG T2,.-1
JRST OUTASC ;THEN RETURN
;ROUTINE TO MOVE SINGLE WORDS FROM INPUT TO OUTPUT
SEKINC:
LBNDCD:
SIXBT:
DECML: MOVE MASTWD,(P2) ;PICK UP RAW DATA
MOVEM MASTWD,(WKINDX) ;SAVE IT
AOJA WKINDX,RET ;AND RETURN
;ROUTINE TO CONVERT OCTAL TO OCTAL SIXBIT AND SEND IT TO OUTPUT BUFFER
; (ONE 36 BIT WORD)
OCTLE: MOVE MASTWD,(P2) ;PICK UP RAW WORD
HRLI WKINDX,440600 ;STORE SIXBIT OCTAL
HRLI P2,440300 ;LOAD OCTAL
SIXLUP: ILDB T1,P2 ;GET BYTE
TRO T1,20 ;SIXBITIZE IT
IDPB T1,WKINDX ;STORE IT
TLNE P2,770000 ;TILL ONE WORD DONE
JRST SIXLUP
AOJA WKINDX,RET ;THEN RETURN
;ROUTINE TO CONVERT SIXBIT OCTAL NUMBERS TO OCTAL NUMBERS
;CALL WITH SIXBIT # IN T1. RESULTS IN LH OF T2 (ALLOWS DOUBLING)
;DESTROYS T1,T2,T3
SIXOCT: MOVEI T3,6
LSHC T1,-3 ;GET DIGIT (OCTIT?)
LSH T1,-3 ;IGNORE SIXBIT
SOJG T3,.-2 ;GO TILL DONE
POPJ P,
SUBTTL SPECIAL WORD PROCESSING ROUTINES
;RETRYS FOR ERROR CODE 10
RETRYS: MOVE MASTWD,(P2) ;GET THE WORD
TLZN MASTWD,400000 ;IS BIT 0 SET? (INDICATING LATER OPS GOOD)
TDZA T1,T1 ;NO. CLEAR FLAG
SETO T1, ;YES. SET FLAG
MOVEM T1,(WKINDX) ;AND SAVE IT FOR COBOL
TLZN MASTWD,200000 ;HARD ERROR?
TDZA T1,T1 ;NO. CLEAR FLAG
SETO T1, ;YES. SET IT
MOVEM T1,1(WKINDX) ;AND SAVE IT
MOVEM MASTWD,2(WKINDX) ;THEN SAVE RETRY COUNT
ADDI WKINDX,3 ;UPDATE INDEX INTO COOBL BUFFER
POPJ P,
;RETRIES AND CONTROLLER INFO FOR ERROR CODE 11
E11TYP: MOVE MASTWD,(P2) ;GET WORD
HRRZM MASTWD,(WKINDX) ;SAVE THE RETRY COUNT
TLZN MASTWD,200000 ;IS HARD FLAG SET?
TDZA T1,T1 ;NO. CLEAR IT
SETO T1, ;YES. SET IT
MOVEM T1,1(WKINDX) ;AND SAVE IT
ADDI WKINDX,2
MOVE F,[POINT 3,MASTWD,11] ;SET UP TO READ KON
KONTYP: PUSHJ P,.+1 ;DO TWICE
ILDB T1,F ;GET TYPE OR NUMBER
MOVEM T1,(WKINDX) ;AND STORE IT
AOJA WKINDX,RET
;ROUTINE TO COPY DRIVE REGISTERS AND STUFF
MDEBLT: MOVEI C,^D21 ;21 WORDS TO GO
PUSHJ P,OCTLE ;AS SIXBIT
SOSLE C ;DECREMENT COUNT
AOJA P2,.-2 ;AND KEEP GOING TILLDONE
POPJ P,
;ROUTINE TO COPY SOME BYTES OVER AS FULL WORDS
DISKPR: MOVEI T1,^D12 ;BYTE SIZE 12
PUSHJ P,SPCBYT ;GO COPY
PUSHJ P,SPCBYT ;AND DO IT
HRLI T1,HDEFIL(P4) ;NOW COPY USER FILE INFO
HRRI T1,-1(WKINDX)
BLT T1,2(WKINDX)
ADDI WKINDX,3
MOVE P2,HDECCT(P4) ;AND BAT INFO
JRST SOFTER ;BYTES TO WORDS
;ROUTINES TO COPY BYTES OVER AS FULL WORDS
SOFDET: MOVEI T1,^D12 ;BYTE SIZE 12
JRST SPCBYT
SOFHNG: TDZA T1,T1 ;BYTE SIZE 9
HARDER:
SOFTER: MOVEI T1,^D9 ;BYTE SIZE 18
ADDI T1,^D9
SPCBYT: HRLI P2,440000 ;SET UP POINTER
DPB T1,[POINT 6,P2,11] ;COMPLETE IT AS CALLER DESIRES
BYTLUP: ILDB MASTWD,P2 ;GET BYTE FROM RAW BUFFER
MOVEM MASTWD,(WKINDX) ;AND SAVE IT
TLNE P2,770000 ;WORD DONE?
AOJA WKINDX,BYTLUP ;NO
AOJA WKINDX,RET
;ROUTINE TO SAVE DAYS AND JIFFIES OF UDT THEN SAVE TRANSLATE DATE/TIME
MRVDAT: PUSHJ P,SOFTER ;SAVE DAYS/JIFFIES AS TWO WORDS
MOVE T1,(P2) ;GET UDT
PUSHJ P,UNVSIX ;CONVERT IT TO SIXBIT
MOVEM T1,(WKINDX) ;THEN SAVE THE DATE
MOVEM T2,1(WKINDX) ;AND THE TIME
AOJA WKINDX,INCIDX ;AND THAT'S IT
;ROUTINE TO CALCULATE START DATE/TIME FROM RELOAD ENTRY
MRVUPX: PUSHJ P,SOFTER ;GET DAYS/JIFFS
MOVE T1,MRVCTM(P4) ;NOW GET CRASH TIME
SUB T1,MRVUPT(P4) ;MAKE START DAYS/JIFFS
PUSHJ P,UNVSIX ;TRANSLATE IT
MOVEM T1,(WKINDX) ;SAVE DAYS AS (YYMMDD)
MOVEM T2,1(WKINDX) ;SAVE HHMISE
AOS WKINDX ;MOVE POINTER
INCIDX: AOJA WKINDX,RET ;AND RETURN
;ROUTINE TO HANDLE THE ENTIRE ENTRY CODE 15 ENTRY (STATUS CHANGE)
CSCLST: MOVE T2,CSCSTS(P4) ;GET REASON WORD
MOVEI P2,-2(P2) ;SET P2 TO FIRST WORD
MOVSI T1,777700 ;MASK OUT SIXBIT REASON
ANDM T2,T1 ;INTO T1
TLZ T2,777700 ;T2 HAS THE NUMERIC CODE
MOVEM T1,5(WKINDX) ;SAVE SIXBIT REASON FOR COBOL
HLRZM T2,2(WKINDX) ;AND THE NUMERIC CODE
LSHC T2,-^D19 ;MAKE DISPATCH INDEX
MOVE MASTWD,(P2) ;ASSUME WE WANT FIRST WORD
MOVE T1,1(P2) ;AND SECOND
CAIG T2,4 ;CODE WITHIN RANGE?
JRST @CSCDSP(T2) ;YES. GO HANDLE.
MOVE MASTWD,[SIXBIT/UNKNWN/] ;NO. SAY THIS IS UNKNOWN
JRST ATTDET ;FINISH UP
CSCDSP: ATTDET ;ATTACH OR DETACH
EXORDT ;EXCHANGE OR DATE/TIME CHANGE
CPUONF ;CPU ON/OFF LINE
NODONF ;NODE ON/OFF LINE
MEMONF ;MEMORY ON/OFF LINE
MEMONF: SKIPA MASTWD,[SIXBIT/MEM/] ;TELL COBOL DEVICE IS MEMORY
CPUONF: MOVE MASTWD,[SIXBIT/CPU/] ;OR CPU
JRST ATTDET ;GO MOVE WORD
EXORDT: JUMPL T3,DTCHNG ;JUMP IF DATE/TIME CHANGE
NODONF: MOVEM T1,1(WKINDX) ;SAVE SECOND DEVICE OR NODE NAME
SOJE T2,ATTDET ;JUMP IF EXCHANGE
PUSH P,WKINDX ;HERE IF NODE. SAVE INDEX
MOVEI WKINDX,T2 ;POINT OCTLE TO T2,T3
PUSHJ P,OCTLE ;SIXBITIZE NODE NUMBER
POP P,WKINDX ;SO COBOL WON'T SCREAM
MOVE MASTWD,T3 ;JUST USE RIGHT HALF
ATTDET: MOVEM MASTWD,(WKINDX) ;SAVE FIRST NAME
MOVE MASTWD,CURUDT ;NOW GET UDT OF ENTRY
HLRZM MASTWD,3(WKINDX) ;SAVE DAYS IN COMP FORMAT
HRRZM MASTWD,4(WKINDX) ;AND JIFFIES
POPJ P, ;AND DON'T WORRY ABOUT WKINDX
DTCHNG: HLRE MASTWD,(P2) ;CHANGE MIGHT BE NEGATIVE
MOVEM MASTWD,3(WKINDX) ;SO KEEP THE SIGN
HRR MASTWD,(P2) ;FOR BOTH DAYS AND JIFFIES
MOVEM MASTWD,4(WKINDX) ;SO THE CHANGE WILL WORK EITHER WAY
POPJ P, ;AND RETURN TO CALLER
SUBTTL GENERAL ROUTINES
;ROUTINE TO CHECK DATE AND TIME
CHKDT: EXCH T1,ENDDAT ;ASSUME CALLED FOR END FIRST
EXCH T2,ENDTIM
CAMGE T1,(T4) ;DATE OK?
POPJ P, ;NO. GIVE ERROR RETURN
CAMN T1,(T4) ;DATES =? (REQUIRES TIME CHECK)
CAML T2,1(T4) ;YES. TIMES OK?
RET1: AOS (P) ;DATE/TIME OK
POPJ P,
;ROUTINE TO SKIP OVER AN UNWANTED RECORD
SKIPIT: PUSHJ P,LODRAW ;GET AROUND NEXT ENTRY
JUMPE F,FNDEF1 ;DIE IF EOF NOW
JRST GETENT ;THEN GO READ NEXT
;ROUTINE TO LOAD RAW BUFFER
LODHED: PUSHJ P,GETWRD ;GET ENTRY HEADER TYPE
JUMPE F,RET ;NONE LEFT IF JUMP
MOVEM T1,RAWBUF ;SAVE IT IN CASE NO HEADER XLATE
LDB CTINDX,[POINT 9,T1,8] ;PUT ENTRY CODE AWAY FOR CALLER
LDB T2,[POINT 3,T1,26] ;READ HEADER LENGTH
MOVNS T2 ;NEGATE IT
LDB T3,[POINT 9,T1,35] ;GET BODY LENGTH
MOVNM T3,BODLEN ;AND SAVE IT
HRLI T2,RAWBUF+1 ;LOAD REST OF HEADER
AOJA T2,RAWSWP ;VIA LODRAW
LODRAW: MOVE T2,BODLEN ;ENTER HERE FOR BODY
HRLI T2,RAWBUF
RAWSWP: MOVSS T2
RAWLUP: PUSHJ P,GETWRD ;GET WORD FROM DISK BUFFER
JUMPE F,RET ;LEAVE EARLY IF EOF FOUND
MOVEM T1,(T2) ;SAVE IT IN THE RAW BUFFER
AOBJN T2,RAWLUP ;AND LOOP
POPJ P, ;RETURN WITH HEADER OR BODY IN RAWBUF
;ROUTINE TO COPY RAW DATA TO WORKING BUFFER WITHOUT TRANSLATION
NOTRAN: HRLI WKINDX,RAWBUF ;NO TRANSLATION DESIRED.
BLT WKINDX,@LASLOC ;SO JUST COPY RAW
POPJ P, ;RETURN TO MAIN PROGRAM
;ROUTINE TO READ FROM THE DISK BUFFER
FIXBUF: PUSHJ P,GETWRD ;IGNORE SYNC WORD
GETWRD: SETO F, ;SET FLAG FOR EOF CHECK
SOSGE DSKCNT ;SEE IF ANY BYTES IN CURRENT BUFFER
JRST ADVBFF ;NO. GO GET ANOTHER BUFFER
ILDB T1,DSKPNT ;LOAD A BYTE (36 BITS)
RET: POPJ P, ;AND RETURN
ADVBFF: XCT INUUO ;READ A NEW BUFFER
JRST FIXBUF ;AND GET RID OF SYNC WORD
XCT STDSK ;STATZ FOR EOF
OUTSTR [ASCIZ/?FILE ERROR/] ;ERROR HAPPENED
AOJA F,RET ;FLAG THAT THERE IS NO MORE
;HERE TO RETURN BECAUSE OF ENCOUNTERD EOF
FNDEF1: OUTSTR [ASCIZ/?EOF BEFORE END OF RECORD/]
FNDEOF: XCT INUUO
JRST [OUTSTR [ASCIZ/%EOF IN BODY OF ERROR FILE
/]
JRST GETENT]
BEYOND: TDZA T1,T1 ;SET TO CLEAR FIRST BUFFER WORD
NOFILE: SETO T1, ;HERE IF FILE NOT FOUND
HRRZ WKINDX,@BUFDES(ARG) ;GET ADDRESS OF BUFFER
MOVEM T1,(WKINDX) ;FLAG IT -1 OR 0
RDEREX: AOSN OPNFLG ;CHECK FOR FILE OPEN.
XCT CLSUUO ;CLOSE THE CHANNEL
POPJ P, ;AND TELL CALLER WHAT HAPPENED
;ROUTINE TO GET UPTIME FROM ERROR FILE IN SIXBIT FORMAT.
;CALL WITH T1 = DAYS,,TIME EXIT WITH T1 = DAYS T2 = TIME (SIXBIT)
UPTSIX: PUSHJ P,GETIM ;GO ACT LIKE THIS IS UNIVERSAL
HLRZ P2,T2 ;GET DAYS
MOVEI C,3 ;DO 3 TIMES
PUSHJ P,BIN2 ;TO MAKE SIXBIT DAYS
SOJG C,.-1
POPJ P,
SUBTTL SPECIAL USER FUNCTIONS
;THE FOLLOWING FUNCTIONS ARE CALLED BY COBOL PROGRAMS TO DO VARIOUS
;THINGS WITH INFORMATION EXTRACTED FROM THE ERROR FILE.
;CALLED BY COBOL TO TRANSLATE UDT TO SIXBIT YYMMDDHRMISE
GETUDT: HRL T1,@DAYS(ARG) ;GET BINARY DAYS
HRR T1,@JIFFS(ARG) ;AND JIFFIES
PUSHJ P,UNVSIX ;CONVERT TO SIXBIT
MOVE P1,@UDATE(ARG) ;GET POINTER TO SIXBIT DATE
MOVE P2,@UTIME(ARG) ;AND TIME
MOVEM T1,(P1) ;SAVE DATE
MOVEM T2,(P2) ;AND TIME
POPJ P, ;AND RETURN TO COBOL
;THE FOLLOWING IS CALLED WITH FUNCTION 4 FOR SUBTRACT AND FUNCTION 5 FOR
;ADD TO DEAL WITH TIME DIFFERENCES.
ADDJIF: SKIPA P1,[ADD T1,T2] ;HERE TO ADD TIMES
SUBJIF: MOVE P1,[SUB T1,T2] ;HERE TO SUBTRACT TIMES
HRL T1,@DAY1(ARG) ;GET SUBTRAHEND DAYS
HRR T1,@JIF1(ARG) ;AND JIFFIES
HRL T2,@DAY2(ARG) ;GET MINUEND DAYS
HRR T2,@JIF2(ARG) ;AND JIFFIES
XCT P1 ;ADD OR SUBTRACT TIMES
SKIPGE T1 ;DON'T ALLOW NEGATIVES
MOVEI T1,^D1080 ;ASSUME 6 MINUTES IF NEGATIVE
HLRZM T1,@DAYO(ARG) ;SAVE RESULT
HRRZM T1,@JIFO(ARG)
POPJ P, ;AND RETURN TO COBOL PROGRAM
;ROUTINE TO CONVERT A UNIVERSAL DATE/TIME INTO A 2 WORD SIXBIT ITEM
;INPUT -- T1 = UNIVERSAL DATE/TIME
;OUTPUT -- T1 = YYMMDD T2 = HHMMSS
;USES ALL 4 TEMPORARY REGISTERS AND P1-P3
UNVSIX: PUSHJ P,GETIM ;GET TIME
HLRZ T4,T2 ;GET DAYS
SUBI T4,^D774 ;MAKE # DAYS SINCE END OF 1860
IDIVI T4,^D1461 ;FIND # OF LEAPS IN THIS PERIOD
MOVEI P2,1 ;ASSUME WE'RE SITTING ON AN EVEN LEAP YEAR
SKIPE P1 ;SKIP IF WE ARE AT THE END OF A LEAP QUAD
IDIVI P1,^D365 ;AND EXCESS YEARS
IMULI T4,4 ;FORM # OF YEARS
ADDI P1,^D1861(T4) ;AND MAKE CORRECT YEAR
SETZ T3, ;ASSUME THERE ARE SOME DAYS LEFT OVER
JUMPN P2,MONLUP ;THERE ARE SOME
MOVEI T3,^D12 ;NONE LEFT. MUST BE DEC31
MOVEI T4,^D31
SOJA P1,LSTDAY ;OF THE LAST YEAR
MONLUP: AOS T4,T3 ;INCREMENT MONTH
TRNE T4,10 ;AUGUST OR LATER?
TRC T4,1 ;YES. 31 DAYS HATH AUGUST ETC.
ANDI T4,1 ;GET 31ST DAY IF ANY
MOVEI T4,^D30(T4) ;MAKE DAYS IN THIS MONTH
CAIE T3,2 ;UNLESS FEBRUARY
JRST NOTFEB ;NOT FEB
MOVEI T4,^D28 ;FEB AS WE KNOW HAS 28 DAYS
TRNN P1,3 ;UNLESS IT'S TIME FOR GIRLS TO ASK
AOS T4 ;THIS IS LEAP YEAR
NOTFEB: SUB P2,T4 ;DECREMENT DAYS LEFT BY DAYS IN THIS MONTH
JUMPG P2,MONLUP ;JUMP IF THIS ISN'T THE RIGHT MONTH
LSTDAY: ADD P2,T4 ;MONTH FOUND. MAKE DAY OF MONTH
PUSHJ P,BIN2 ;THEN SAVE IT
HRRZ P2,T3 ;AND GET MONTH
JRST BINB ;GO STORE MONTH AND YEAR
GETIM: HRRZ P1,T1 ;GRAB TIME
IMULI P1,^D24*^D60*^D60 ;RH NOW FRACTIONAL SECONDS
HLRZS P1
IDIVI P1,^D60*^D60 ;MAKE P1 HORS
IDIVI P2,^D60 ;P3 SECONDS
EXCH P2,P3 ;SAVE SECONDS FIRST
PUSH P,P3
PUSHJ P,BIN2
POP P,P2 ;NOW SAVE MINUTES AND HOURS
BINB: PUSHJ P,BIN2 ;ENTER HERE TO DEPOSIT P2,P1
BIN1: MOVE P2,P1 ;ENTER HERE TO DEPOSIT P1
BIN2: PUSHJ P,.+1 ;ENTER HERE TO DEPOSIT P2
LSHC T1,-6 ;SHIFT OUTPUT ARGUMENT
IDIVI P2,^D10 ;GET A REMAINDER
TRO P3,20 ;SIXBITIZE IT
DPB P3,[POINT 6,T1,5] ;AND SAVE IT AWAY
POPJ P, ;EXIT
SUBTTL TABLE AND STORAGE
;ECTRA CONTROL TABLE LOCATIONS WE NEED ARE DEFINED HERE WHEN SYRUNV IS DEFICIENT
DEFINE DMY11 (A,B,C,D,E,F), <
TBLWRD (11,0,MDEMID,SIXBT,0,0)
TBLWRD (11,0,MDESTR,SIXBT,0,0)
TBLWRD (11,0,MDELOC,DECML,0,0)
TBLWRD (11,0,MDETYP,SPECL,0,<E11TYP>)
TBLWRD (11,0,MDECNI,OCTLE,0,0)
TBLWRD (11,0,MDECNF,OCTLE,0,0)
TBLWRD (11,0,MDESF1,SPECL,0,<SOFHNG>)
TBLWRD (11,0,MDESF2,DECML,0,0)
TBLWRD (11,0,MDESF3,SPECL,0,<SOFDET>)
TBLWRD (11,0,MDEFIL,SIXBT,0,0)
TBLWRD (11,0,MDEEXT,SIXBT,0,0)
TBLWRD (11,0,MDEUID,OCTLE,0,0)
TBLWRD (11,0,MDEPGM,SIXBT,0,0)
TBLWRD (11,0,MDEDTI,SPECL,0,<MDEBLT>)
TBLWRD (11,0,MDECCT,SPECL,0,<SOFTER>)
>;NOW THAT THE MACROS ARE GENERATED, GENERATE THE DESIRED TABLES
ZZ=0
SALL
REPEAT HICOD, <
ZZ=ZZ+1
DUMCOD
>
XALL
DSPENT: IFDEF .CT044,<XWD .CT044,44> ;THIS ENTRY NOT IN SYRUNV
DUMENT ;MAKE SYRUNV DEFINED TABLES
0 ;END OF TABLE
LIT
END