Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50517/rpgiia.mac
There is 1 other file named rpgiia.mac in the archive. Click here to see a list.
TITLE RPGIIA FOR RPGII %1
SUBTTL RPGII INITIALIZATION BOB CURRIER
;WITH CREDIT DUE TO AL BLACKINGTON FOR HIS COBOL INITIALIZATION
; ROUTINES, WHICH I STOLE MOST OF. MAY THE GREAT BIRD OF MAYNARD
; OVERLOOK SUCH LITTLE THINGS AS COPYRIGHTS.
;
; PHASE A FOR RPGII COMPILER
;
; PHASE A IS THE PHASE THAT THE USER INTERACTS WITH. IT
; IS THIS PHASE WHICH ACCEPTS THE USERS COMMAND STRING
; AND SETS UP ALL THE FILES, AS WELL AS INITIALIZING
; THE TABLES, PDL, DEVICES ETC. NOTE THAT THE COMMAND
; ANALYZER IS NOT THE STANDARD SCAN/WILD AS IT SHOULD
; BE, BUT IS INSTEAD THE COBOL STYLE COMMAND SCANNER.
; OH WELL.
;
; JUNE 17, 1975 13:59:12
;
; Copyright (C) 1975, 1976 Bob Currier and Cerritos College
; All rights reserved (See reservations above)
;
TWOSEG
RELOC 400000
.REQUIRE HELPER
;
;START 'ER UP
;
RPGIIA: PORTAL START ; COMMANDS FROM TTY
PORTAL COMDSK ; COMMANDS FROM DSK
PORTAL RPGLAR ; RESTART
START: MOVEM 7,RUNPPN ; SAVE DEVICE AND PPN OF RUN
IFN %CPU-%20,<
TRNE 11,777777 ; did we get a device?
>
HRLZI 11,'DSK' ; no - default to DSK
MOVEM 11,RUNDEV
MOVEI SW,0 ; CLEAR FLAGS
;START A BRAND NEW COMPILATION
RPGLAR: TSWF FDSKC ; INPUT COMMANDS FROM TTY?
JRST RPGLAS ; NO
RESET ; YES--RESET ALL DEVICES
IFN DEBUG,<PUSHJ PP,MOVSYM> ; FOR DEBUGGING PURPOSES, MOVE SYMBOLS BELOW .JBFF
INIT COM,1 ; GET TTY FOR COMMANDS
SIXBIT "TTY"
XWD 0,COMBH
HALT .-3 ; NO TTY? (WOT THE...)
INBUF COM,2 ; GET TWO COMMAND BUFERS
SETZM SAVJFF ; IF RESTART, FORCE SAVING .JBFF
RPGLAS: CPUCHK TB ; verify what CPU we're on
SKIPN TA,SAVJFF ; SAVE .JBFF IF IT WASN'T DONE ALREADY
MOVE TA,.JBFF
MOVEM TA,SAVJFF
MOVEM TA,.JBFF ; RESTORE .JBFF
MOVE TA,RUNDEV ; IS RUN DEVICE A REAL DISK?
DEVCHR TA,
TLNN TA,$DSK
JRST NOTDSK ; NO--GO CRY ABOUT IT
;SET UP THE IMPURE AREA
;GET A COMMAND STRING AND BOP OFF LEADING CARRIAGE RETURNS
SETFAZ A;
TSWF FDSKC;
JRST TYST1
MSG <
*>
TYST1: PUSHJ PP,SETIMP ; SET UP IMPURE AREA
PUSHJ PP,GETDT ; SET UP DATE AND TIME
PUSHJ PP,GETVER ; SET UP VERSION
MOVEI TB,^D100 ; INITIALIZE ERROR COUNT
MOVEM TB,BADCNT##
JRST TESTCR
TYPEST: TSWF FDSKC;
JRST TESTCR
MSG <
*>
TESTCR: PUSHJ PP,COMKAR ; GET FIRST CHAR FROM COMMAND STRING
TSWF FECOM; ; END OF COMMAND FILE?
EXIT ; YES--QUIT
JUMPE CH,TYPEST ; NO--NULL?
CAIN CH,15 ; NO-CARRIAGE RETURN?
JRST TYPEST ; YES--LOOP ON THRU
SWON FCOMCH; ; NO--SET THE "REGET CHARACTER" FLAG
SWON FTERA ; SET "WE ARE TYPING ERRORS"
SETZM CREFSW ; CLEAR /C
;SET UP THE BINARY DEVICE
SETBIN: MOVEI DA,BINDEV
PUSHJ PP,GETFIL ; GET FIRST FILE
TSWT FDSKC ; INPUT FROM TTY?
JRST SETBNC
MSG <RPGII: >; ; NO -
SETBNC: CAIE CH,"-" ; IS IT A NULL FILE?
JRST SETBNB ; NO--
SETZM BINDEV ; YES IT IS--
PUSHJ PP,COMKAR
CAIE CH,","
CAIN CH,"="
JRST SETLST
JRST TUMANY
SETBNA: MOVSI TA,'DSK' ; USE DEVICE 'DSK'
MOVEM TA,BINDEV ;
JRST SETLST
SETBNB: JUMPE TA,SETBNA
TRNE TA,$BIN ; BINARY MODE LEGAL?
TLNN TA,$OUT ; YES--OUTPUT DEVICE?
JRST BADBIN ; NO--TYPETH THY ERROR
;SET UP LISTING DEVICE
SETLST: CAIN CH,"=" ; ANY FILE THERE?
JRST SETLSA ; NO--
CAIN CH,15 ; END OF STRING?
JRST NOSRC ; YES--ERROR
MOVEI DA,LSTDEV
PUSHJ PP,GETFIL ; GET SECOND FILE
CAIE CH,"-" ; NULL FILE?
JRST SETLSB ; NO--
SWON FNOLST ; YES--SAY NO LISTING FILE
PUSHJ PP,COMKAR ; GET ANOTHER CHARACTER
CAIE CH,"="
JRST TUMANY
SETLSA: MOVSI TA,'DSK' ; NO DEVICE--USE DISK
MOVEM TA,LSTDEV ; SET LISTING DEVICE
JRST SETSRC ; IT MUST BE LEGAL
SETLSB: JUMPE TA,SETLSA
TLNN TA,$OUT ; OUTPUT DEVICE?
JRST BADOUT ; NOPE--ERROR
;SET UP SOURCE DEVICE
SETSRC: CAIN CH,15 ; END OF COMMAND STRING?
JRST NOSRC ; YES--ERROR
CAIE CH,"=" ; ANY MORE OUTPUT TYPE FILES?
JRST TUMANY ; YESS--ANOTHER ERROR
PUSHJ PP,SCNCOM ; SCAN ALL SOURCE FILES
PUSHJ PP,STINFL ; SET UP FIRST SOURCE FILE
TSWTZ FHELP ; /H?
JRST SETSR1 ; NO--
HELP: MOVE 1,[SIXBIT "RPGII"] ; YES--PRINT RPGII.HLP
PUSHJ PP,.HELPR
JRST BADC2 ; IGNORE ALL ELSE IN COMMAND STRING
SETSR1: SKIPN SRCDEV ; ANY FILE THERE?
JRST NOSRC ; NO--ERROR
;FILE NAMES HAVE ALL BEEN READ - FINISH UP
MOVE TA,SRCDEV+1
SKIPN LSTDEV+1 ; ANY LIST FILE-NAME?
MOVEM TA,LSTDEV+1 ; NO--JAM SOURCE NAME
SKIPN BINDEV+1 ; ANY BINARY FILENAME?
MOVEM TA,BINDEV+1 ; NO--JAM SOURCE NAME
MOVSI TA,'REL'
SKIPN BINDEV+2 ; ANY BINARY EXTENSION?
MOVEM TA,BINDEV+2 ; NO--USE "REL"
MOVSI TA,'LST'
SKIPN LSTDEV+2 ; ANY LISTING EXTENSION?
MOVEM TA,LSTDEV+2 ; NO--USE "LST"
;INITIALIZE BINARY DEVICE
INITB: MOVEI I1,14
MOVEI DA,BINDEV
MOVEI DC,BIN
SKIPN BINDEV ; ANY BINARY FILE?
JRST INITL ; NO--
PUSHJ PP,OPNOUT
MOVE TA,BINSWS ; REWIND?
TRNE TA,2
MTAPE BIN,$REW
TRNE TA,4 ; CLEAR DIRECTORY?
UTPCLR BIN,
SETOM BINBLK
;INITIALIZE LISTING DEVICE
INITL: MOVEI I1,0
MOVEI DA,LSTDEV
MOVEI DC,LST
TSWF FNOLST; ; ANY LISTING DEVICE?
JRST INITS ; NO--
MOVE TA,LSTDEV ; YES--TTY:?
DEVCHR TA,
TLNE TA,$AVAIL
TLNN TA,$CONSL
JRST INITL1 ; NO--
SWON FLTTY; ; YES--
INITL1: PUSHJ PP,OPNOUT
MOVE TA,.JBFF
MOVEM TA,LSTBUF
OUTBUF LST,2
MOVE TA,LSTSWS ; REWIND?
TRNE TA,2
MTAPE LST,$REW
TRNE TA,4 ; CLEAR DIRECTORY?
UTPCLR LST,
SETOM LSTBLK
;INITIALIZE SCRATCH FILES
INITS: TSWF FNOLST ; IF NO LISTING
SETZM CREFSW ; CLEAR "/C"
PJOB TC, ; GET JOB NUMBER INTO LH OF TA, DECIMAL
MOVEI TD,3
IDIVI TC,^D10
ADDI TB,"0"-40
LSHC TB,-6
SOJG TD,.-3
MOVE TB,DEVXWD
OPNSCR: MOVE DA,DEVTAB(TB)
MOVSI TC,'DSK' ; SCRATCH DEVICE
MOVEM TC,DEVDEV(DA)
HLR TA,DEVTAB(TB) ; CREATE A FILENAME
MOVEM TA,DEVFIL(DA)
MOVSI TC,'TMP' ; SCRATCH FILE EXTENSION
MOVEM TC,DEVEXT(DA)
MOVEI DC,FSC(TB) ; SET CHANNEL NUMBER
CAIE DC,CRF ; IF THIS IS THE CREF FILE
JRST OPNSC0 ; AND THERE IS NO "/C"
SKIPN CREFSW ; DON'T OPEN THE CREF FILE
JRST OPNSC1
OPNSC0: MOVEI I3,DEVBHI(DA)
HRLI I3,3(I3)
MOVEI I4,0
MOVEI I1,14 ; USUALLY IS BINARY MODE
CAIE DC,CAL ; CALFIL?
CAIN DC,CPY ; OR CPYFIL?
MOVEI I1,0 ; YES--ASCII MODE
CAIE DC,NAM ; NAMFIL?
CAIN DC,LIT ; OR LITFIL?
MOVEI I1,17 ; YES--DUMP MODE
PUSHJ PP,OPNTMP
SETOM DEVBLK(DA) ; SET BLOCK COUNT TO -1
CAIE DC,LIT ; LITFIL?
CAIN DC,AS3 ; AS3FIL?
JRST OPNSC1 ; YES--NO BUFFER RIGHT NOW
CAIN DC,NAM ; DO THE SAME FOR
JRST OPNSC1 ; NAMFIL
HRRZ I0,.JBFF ; NO--SET BUFFER ADDRESS
MOVEM I0,DEVBUF(DA)
MOVE I0,OUTBOP
DPB DC,I0CHAN
XCT I0 ; DO AN OUTBUF
OPNSC1: AOBJN TB,OPNSCR
MOVE TA,SRCBUF ; AS3 OVERLAYS SRCFIL
MOVEM TA,AS3BUF
MOVE TA,GENBUF ; BINFIL OVERLAYS GENFIL
MOVEM TA,BINBUF
;SET UP ALL WORK AREAS EXCEPT NAMTAB
SETWRK: HRRZ TA,.JBFF
MOVEM TA,FREESP
MOVE TA,WRKXWD
STWRK1: MOVE TB,(TA)
MOVE TC,TB
HRR TC,FREESP
MOVEM TC,(TB)
MOVEM TC,1(TB)
HLRE TC,TB
MOVMS TC
ADDI TC,1
ADDB TC,FREESP
STWRK3: CAMG TC,TOPLOC
JRST STWRK2
PUSHJ PP,ADDCOR
MOVE TC,FREESP
JRST STWRK3
STWRK2: AOBJN TA,STWRK1
JRST SETNAM
;SET UP INITIAL ENTRIES IN NAMTAB
;ENTER AT SETNAM
PUSHJ PP,ADDCOR ; GRAB ANOTHER K OF CORE
SETNAM: MOVE TA,TOPLOC ; ROOM FOR
SUBI TA,NAMPSZ+1 ; NAMTAB
SUB TA,NTSIZE ; + NM1TAB
SUB TA,NTSIZE ; + NM2TAB ?
CAMGE TA,FREESP
JRST SETNAM-1 ; NO - GRAB SOME MORE ROOM
MOVE TE,[XWD NTSIZE,SIZTAB]
MOVNI TD,NTNSIZ
BLT TE,SIZTAB-1(TD)
MOVE TE,NTSIZE
MOVEM TE,NM12SZ
MOVE TE,[XWD NTNSIZ,SIZTAB]
MOVEM TE,NSZPTR
HRLI TA,TC
MOVEM TA,NM1LOC
MOVSI TE,(TA)
HRRI TE,1(TA)
SETOM (TA)
ADD TA,NM12SZ
BLT TE,-1(TA)
MOVEM TA,NM2LOC
MOVSI TE,(TA)
HRRI TE,1(TA)
SETZM (TA)
ADD TA,NM12SZ
BLT TE,-1(TA)
HRLI TA,NAMNSZ-1
MOVEM TA,NAMLOC
MOVEM TA,NAMNXT
HRRZ TA,NM1LOC ; RESET LEFT HALF OF FREESP
SUB TA,FREESP
HRLM TA,FREESP
;SET UP INITIAL ENTRIES IN EXTAB
SETEXT: SETZM NAMWRD+1 ; CLEAR NAMWRD'S LAST 4 LOC'S
MOVE TA,[XWD NAMWRD+1,NAMWRD+2]
BLT TA,NAMWRD+4
MOVS TE,EXTLOC ; CLEAR EXTAB
HRR TE,EXTLOC+3
SUBI TE,1
PUSHJ PP,CLRSOM
MOVE LN,EXTPTR ; GET TABLE POINTER
SETEX1: MOVE TA,[POINT 6,(LN)]
MOVE TB,[POINT 6,NAMWRD]
SETX1A: ILDB CH,TA
CAIN CH,"."-40
MOVEI CH,";"-40 ; REPLACE SIXBIT PERIODS WITH SIXBIT SEMI'S
IDPB CH,TB ; STORE IT AGAIN
TLNE TA,770000
JRST SETX1A
PUSHJ PP,TRYNAM ; IS IT IN NAMTAB ALREADY?
JRST SETEX2 ; NO -
JRST DBLNAM ; YES - ERROR
SETEX2: PUSHJ PP,BLDNAM ; ADD IT TO NAMTAB
SETEX3: MOVE TB,EXTNXT
AOBJP TB,SETEX4 ; ROOM FOR FIRST WORD?
TLO TA,500000 ; YES - PUT NAMTAB CHAIN IN EXTAB
HLLZM TA,(TB)
HRRZI TD,(TB) ; SET UP EXTAB LINK
HRRZ TE,EXTLOC
SUBI TD,(TE)
IORI TD,<CD.EXT>B20
AOBJP TB,SETEX4 ; ROOM FOR SECOND WORD?
SETZM (TB) ; YES - ZERO IT
MOVEM TB,EXTNXT ; RESTORE EXTNXT
AOBJN LN,SETEX1 ; ANYMORE ENTRIES?
JRST FINISH ; NO -
SETEX4: PUSH PP,TA ; EXPAND EXTAB
PUSHJ PP,XPNEXT
POP PP,TA
JRST SETEX3
;FINISH UP PHASE A
FINISH: HLLZS SW ; CLEAR RH OF SWITCHES
IFN DEBUG,<TSWC FOBJEC>
TSWF FNOLST ; IF NO LISTING,
SWOFF FOBJEC!FMAP ; THEN NO MAPS OR ASSEMBLY LISTING
TSWF FNOLST ; IF NO LISTING
SETZM LSTDEV ; CLEAR DEVICE NAME
TSWF FLTTY ; IF LISTING ON TTY
SWOFF FTERA ; WE DON'T TYPE ERRORS TWICE
ENDFAZ A;
;SCAN REMAINDER OF SOURCE FILES IN COMMAND STRING
SCNCOM: MOVSI DA,(SIXBIT "DSK")
MOVEM DA,LASTDV
MOVEI DA,IOSRCS ; SET SRCEND & DA
MOVEM DA,SRCEND
SCNCM1: TSWF FESRC ; ANY MORE SOURCE FILES?
JRST SCNCM5 ; NO--
PUSHJ PP,GETFIL ; YES--GET NEXT ONE
JUMPN TA,SCNCM3 ; JUMP IF DEVICE FOUND
SKIPN DEVFIL(DA) ; NO DEVICE - ANY FILE?
SKIPE DEVEXT(DA)
JRST SCNCM2 ; YES--
JRST SCNCM6 ; NO--ERROR
SCNCM2: MOVE TA,LASTDV
MOVEM TA,DEVDEV(DA)
DEVCHR TA,
SCNCM3: PUSHJ PP,CHEKIN ; CHECK VALIDITY OF FILE
ADDI DA,DEVSZ ; [316] BOP UP TO NEXT ENTRY
MOVEM DA,SRCEND
CAIE DA,SRCEND ; TABLES FULL?
JRST SCNCM1 ; NO-- LOOP
TSWT FESRC ; YES--ANY MORE SOURCES?
JRST NOROOM ; YES--ERROR
SCNCM5: MOVEI TA,IOSRCS ; RESET SRCEND
MOVEM TA,SRCEND
POPJ PP,
SCNCM6: CAIN CH,15 ; END OF LINE?
CAIE DA,IOSRCS ; YES--ANY SOURCE FILES?
JRST SCNCM2 ; YES
JRST NOSRC ; NO-ERROR
;OPEN UP OUTPUT DEVICE
;ENTER WITH DA POINTING TO A FILE ENTRY SET UP BY GETFIL
OPNOUT: MOVSI I3,DEVBH(DA) ; ENTRY FOR BIN, LST
MOVE I4,DEVPP(DA)
OPNTMP: PUSHJ PP,OPENIT ; OPEN AND SET UP ENTER
CAIN DC,LIT ; DON'T ENTER IF IT IS
POPJ PP, ; LITFIL
MOVE I0,ENTROP ; CREATE AN ENTER
DPB DC,I0CHAN
XCT I0 ; ENTER....
JRST NOENTR ; COULDN'T -
POPJ PP,
;CHECK VALIDITY OF SOURCE FILE.
;ENTER WITH CHARACTERISTICS IN TA
CHEKIN: TLNN TA,$IN ; INPUT DEVICE?
JRST NOTIN ; NO - ERROR
TLNE TA,$DIREC ; DIRECTORY DEVICE?
SKIPE DEVFIL(DA) ; YES - ANY FILE NAME?
SKIPA
JRST NOFILE ; NO - ERROR
POPJ PP,
;SET UP TO GET COMMANDS FROM DISK
COMDSK: MOVEM 7,RUNPPN ; SAVE DEV AND PPN OF RUN COMMAND
MOVEM 11,RUNDEV
MOVSI SW,FDSKC/1000000 ; CLEAR FLAGS - SET "COMMANDS FROM DISK"
RESET
MOVSI TA,(SIXBIT "RPG") ; SET UP FIRST
MOVEM TA,COMBH+1 ; WORD FOR TMPCOR UUO
MOVE TA,.JBFF ; SET UP
SUBI TA,1 ; SECOND
HRLI TA,-200 ; WORD
MOVEM TA,COMBH+2 ; FOR TMPCOR UUO
MOVE TA,[XWD 1,COMBH+1] ; GET FILE IN
TMPCOR TA, ; CORE
JRST CMDSK5 ; WAS NONE - TRY DISK
MOVE TB,.JBFF ; SET UP
HRLI TB,(POINT 7,0) ; BYTE POINTER TO
MOVEM TB,COMBH+1 ; COMMAND
ADDM TA,.JBFF ; UPDATE .JBFF WITH SIZE OF INPUT
IMULI TA,5 ; CALCULATE
ADDI TA,1 ; NUMBER OF CHARACTERS + 1
MOVEM TA,COMBH+2 ; STASH THAT
SETZM COMBH ; CLEAR COMBH TO INDICATE TMPCOR
JRST CMDSK9 ; RETURN
CMDSK5: INIT COM,0
SIXBIT /DSK/
XWD 0,COMBH
JRST RPGIIA ; NO DSK - USE TTY:
MOVEI I1,(SIXBIT "RPG") ; SET LOOKUP PARAMETERS
MOVSI I2,(SIXBIT "TMP")
SETZB I3,I4
HLRZM I2,COMEXT
PJOB TC, ; PUT IN JOB NUMBER
MOVEI I0,3
IDIVI TC,^D10
ADDI TB,"0"-40
LSHC TB,-6
SOJG I0,.-3
HLL I1,TA
INBUF COM,1 ; GET A SINGLE BUFFER
MOVE I0,LOOKOP ; LOOKUP "JJJRPG.TMP"
MOVEI DC,COM
DPB DC,I0CHAN
XCT I0
JRST RPGIIA ; NOT FOUND - USE TTY:
CMDSK9: MOVE TE,.JBFF
MOVEM TE,SAVJFF
JRST RPGLAS
;SETIMP SET UP IMPURE AREA
;
;
;
SETIMP: MOVE TA,[XWD %WEDID,WEDIED] ; MOVE "GETSEG" ROUTINE TO LOW-SEGMENT
IFN DEBUG,<
BLT TA,-1+DDTSTP##
MOVE TA,[XWD %GTFNM,GETFNM]
>
BLT TA,GETEND
IFE ONESEG,<
MOVE TA,RUNPPN ; GETSEG WILL USE DEV AND PPN
MOVEM TA,GETFNM+4 ; OF RUN COMMAND
MOVE TA,RUNDEV
MOVEM TA,GETFNM
>
SETI2: MOVE TB,[XWD FSTCLR,FSTCLR+1]
SETZM FSTCLR
IFN %CPU-%20,<
HLRZ TE,.JBSA
>
IFE %CPU-%20,<
HRRZ TE,.JBSYM
>
IFN DEBUG,<
IFN %CPU-%20,<
MOVEI TD,(TB)
CAIG TD,DDT##
MOVEI TE,DDT
>>
BLT TB,-1(TE)
HRLZ TE,.JBFF ; get start of free core
HRR TE,.JBREL ; get the end
PUSHJ PP,CLRSOM ; and zero it all
HRRZ TE,.JBSYM ; IF SYMBOLS
TRNE TE,1B18 ; ARE IN HI-SEG,
TDCA TE,TE ; USE ZERO LENGTH,
HLRE TE,.JBSYM ; ELSE USE LENGTH OF SYMBOL TABLE
MOVMS TE
IFN DEBUG,<
IFN %CPU-%20,<
ADDI TE,^D50+DDTEND## ; LEAVE ROOM FOR DDT
SUBI TE,DDT
>>
ADDI TE,-1+WRKSIZ
PJRST SETCOR
;CLEAR SOME CORE
;ENTER WITH FIRST ADDRESS IN LH OF "TE", LAST ADDRESS IN RH OF "TE"
CLRSOM: HLRZ TD,TE
SETZM (TD)
HLL TD,TE
ADDI TD,1
BLT TD,(TE)
POPJ PP,
;MOVE SYMBOLS DOWN BELOW .JBFF, IF WE ARE DEBUGGING
IFN DEBUG,<
MOVSYM: HLRE TC,.JBSYM
JUMPGE TC,MOVSY2
MOVMS TC
HRRZ TE,.JBSYM ; IF SYMBOLS ARE IN HI-SEG,
TRNE TE,1B18
POPJ PP, ; FORGET IT -
HRRZ TD,.JBFF ; SYMBOLS WILL BE
ADDI TD,^D50 ; MOVED TO THIS LOC
CAIL TD,(TE) ; UNLESS THAT MOVES
JRST MOVSY1 ; THEM UP INSTEAD OF DOWN
HRRM TD,.JBSYM ; RESET .JBSYM
HRLI TD,(TE) ; TO <XWD .JBSYM,.JBFF>
ADDI TC,(TD) ; SET TC TO FIRST LOC AFTER SYMBOLS
BLT TD,-1(TC) ; BLIIIIIIIIT THOSE SYMBOLS...
MOVSY1: HLRE TE,.JBSYM ; RESET
MOVMS TE ; JOFF
ADD TE,.JBSYM ; TO BE
HRRM TE,.JBFF ; AFTER SYMBOLS
MOVSY2: POPJ PP,
>
;GET CURRENT DATE AND TIME
GETDT: DATE TC, ; GET DATE FROM SYSTEM
IDIVI TC,^D31 ; TB_(DAY-1)
PUSHJ PP,DECONV ; CONVERT TO TWO DECIAML DIGITS
DPB TB,[POINT 14,STDATE,13]
IDIVI TC,^D12 ; TB_(MONTH-1)
MOVE TB,MOTABL(TB) ; CONVERT TO ASCII MONTH
LSHC TB,-16
IORM TB,STDATE
LSHC TB,-1
MOVEM TA,STDATE+1
MOVEI TB,^D63(TC) ;TB_(YEAR-1)
CAIL TB,^D100-1 ; CHECK FOR YEAR 2000+
SUBI TB,^D100 ; IF SO, CHANGE TO 00+
PUSHJ PP,DECONV
DPB TB,[POINT 14,STDATE+1,27]
MSTIME TC, ; GET TIME OF DAY
IDIVI TC,^D1000*^D60 ; CONVERT TO MINUTES
IDIVI TC,^D60 ; TB_MINUTES, TC_HOURS
PUSHJ PP,DECONV+1
LSH TB,1
IOR TB,[ASCII " :"]
MOVEM TB,STTIME
MOVE TB,TC
PUSHJ PP,DECONV+1
DPB TB,[POINT 14,STTIME,13]
POPJ PP,
;CONVERT A NUMBER TO DECIMAL
DECONV: ADDI TB,1 ; ADD 1 TO IT
IDIVI TB,^D10 ; TA_UNITS, TB_TENS
LSH TB,7
ADDI TB,14060(TA) ; CONVERT TO ASCII
POPJ PP,
;SET UP VERSION NUMBER
GETVER: SETZM VERZUN
SETZM VERZUN+1
SETZM VERZUN+2
MOVE TC,[POINT 6,VERZUN]
LDB TE,[POINT 9,.JBVER,11] ; GET VERSION NUMBER
SKIPE TE ; IF NON-ZERO,
PUSHJ PP,GTVER8 ; PRINT IT
LDB TE,[POINT 6,.JBVER,17] ; GET MINOR VERSION NUMBER
JUMPE TE,GTVER4 ; IF ZERO, NO LETTER
CAIG TE,^D26 ; IF LESS THAN 27,
SOJA TE,GTVER3 ; IT IS A SINGLE LETTER
MOVEI CH,"A"-40 ; IT IS A DOUBLE LETTER
MOVEI TE,-1(TE)
GTVER1: SUBI TE,^D26
CAILE TE,^D25
AOJA CH,GTVER1
GTVER2: IDPB CH,TC
GTVER3: ADDI TE,"A"-40
IDPB TE,TC
GTVER4: HRRZ TE,.JBVER ; GET PATCH NUMBER
JUMPE TE,GTVER5 ; IF ZERO DON'T PRINT IT
MOVEI CH,"("-40
IDPB CH,TC
PUSHJ PP,GTVER8
MOVEI CH,")"-40
IDPB CH,TC
GTVER5: LDB TE,[POINT 3,.JBVER,2] ; GET EDITOR
JUMPE TE,GTVER9 ; IF MAYNARD CRAZIES, DON'T PRINT IT
MOVEI CH,"-"-40
IDPB CH,TC
GTVER8: LDB TD,[POINT 3,TE,35]
HRLM TD,(PP)
LSH TE,-3
SKIPE TE
PUSHJ PP,GTVER8
HLRZ TE,(PP)
ADDI TE,"0"-40
IDPB TE,TC
GTVER9: POPJ PP,
;GET IN "DEV:FILE.EXT[PROJ,PROG]/X"
GETFIL: MOVEI TA,1(DA)
HRLI TA,(DA)
SETZM (DA)
BLT TA,DEVSZ-1(DA) ; [316]
TSWFZ FCOMWD; ; DEVICE WAITING?
JRST GETFL6 ; YUP -
GETFL1: PUSHJ PP,GETSIX ; NO - GET ONE
CAIN CH,":" ; ":"?
JRST GETFL7 ; SHO 'NUF
GETFL2: CAIE CH,"=" ;"="?
CAIN CH,"," ;","?
JRST GTFL4A ; YA
CAIN CH,"." ; "."?
JRST GETFL5 ; YES
CAIN CH,"[" ; "["?
JRST GETFL8 ; YES
CAIN CH,15 ; END OF COMMAND?
JRST GETFL4 ; YES
CAIN CH,"/" ; SWITCH?
JRST GETFL9 ; YES--
CAIN CH,"-" ; NULL FILE?
JRST GTFL8C ; YES
CAIN CH,"(" ; MULTI SWITCH?
JRST GTFL13 ; YES
CAIN CH,"@" ; INDIRECT?
JRST GTFL12 ; YES--
CAIN CH,"!" ; CUSP CALL?
JRST GTFL14 ; YES
CAIE CH," " ; SPACE?
JRST BADKAR ; NO--BAD CHARACTER
PUSHJ PP,COMKAR ; YES--GET NEXT CHARACTER
GTFL2A: CAIN CH," " ; ANOTHER SPACE?
JRST .-2 ; YES - LOOP BACK AND SAVE SOME TIME
CAIG CH,"Z" ; NO-LETTER?
CAIGE CH,"A"
SKIPA
JRST GETFL3 ; YES - TREAT LIKE A COMMA
CAIG CH,"9" ; NOT A LETTER - DIGIT?
CAIGE CH,"0"
JRST GETFL2 ; NO - TRY PUNCTUATION
GETFL3: MOVEI CH,"," ; LETTER OF DIGIT - TREAT LIKE COMMA
SWON FCOMCH; ; SET "REGET CHARACTER"
JRST GTFL4A
;STASH FILE-NAME AND LEAVE
GETFL4: SWON FESRC; ; END OF COMMAND STRING
GTFL4A: PUSHJ PP,GTFL4B
SKIPN TA,DEVDEV(DA) ; ANY DEVICE?
POPJ PP, ; NO - RETURN
DEVCHR TA, ; YES - GET CHARACTERISTICS
JUMPE TA,NOTDEV ; IS IT A LEGAL DEVICE?
POPJ PP,
GTFL4B: JUMPE TA,GTFL4C
SKIPE DEVFIL(DA)
JRST BADSTR
MOVEM TA,DEVFIL(DA)
GTFL4C: POPJ PP,
;DOT - STASH FILE NAME, GET EXTENSION
GETFL5: SKIPE DEVEXT(DA)
JRST BADSTR
PUSHJ PP,GTFL4B
PUSHJ PP,GETSIX
HLLZM TA,DEVEXT(DA)
MOVEI TA,0
JRST GETFL2
;GET PREVIOUS DEVICE
GETFL6: SKIPA TA,LASTDV ;GET PREVIOUS DEVICE
;COLON - STASH DEVICE NAME
GETFL7: MOVEM TA,LASTDV ; STASH AS LAST DEVICE
SKIPE DEVDEV(DA) ; IS THERE ONE ALREADY?
JRST GTFL7A ; YES
MOVEM TA,DEVDEV(DA) ; NO - STASH IN DEVICE ENTRY
JRST GETFL1
GTFL7A: SWON FCOMWD; ; YES - GET "REGET WORD"
POPJ PP,
;BRACKET - GET PROJ,PROG
GETFL8: PUSHJ PP,GTFL4B
PUSHJ PP,GETNUM ; GET PROJ
CAIE CH,"," ; COMMA SEPERATOR?
JRST BADPPN ; NO - ERROR
MOVSM TA,DEVPP(DA) ; YES - STASH
PUSHJ PP,GETNUM ; GET PROG
HRRM TA,DEVPP(DA) ; STASH
CAIE CH,"]" ; "]" TERMINATOR?
JRST BADPPN ; NO - ERROR
JRST GETFL1
;HYPHEN - IT SHOULD BE ALONE
GTFL8C: JUMPN TA,BADKAR
SKIPN DEVDEV(DA)
SKIPE DEVFIL(DA)
JRST BADKAR
SKIPN DEVPP(DA)
SKIPE DEVEXT(DA)
JRST BADKAR
POPJ PP,
;SWITCH (/ TYPE)
GETFL9: PUSHJ PP,GTFL4B
PUSHJ PP,COMKAR
PUSHJ PP,SWICH
GTFL10: MOVEI TA,0
SKIPE DEVDEV(DA)
JRST GTFL11
SKIPN DEVFIL(DA) ; IS THERE ANY FILE?
SKIPE DEVEXT(DA)
SKIPA
JRST GETFL1 ; NO - LOOP
GTFL11: PUSHJ PP,COMKAR ; YES - GET NEXT CHARACTER
JRST GTFL2A
;"@" SEEN - SET UP INDIRECT COMMAND FILE
GTFL12: PUSHJ PP,GTFL4B ; STASH FILE NAME
SKIPN DEVDEV(DA) ; ANY ENTRY?
SKIPE DEVFIL(DA)
JRST GTF12A ; YES
SKIPN DEVPP(DA) ; NOT YET - TRY SOME MORE
SKIPE DEVEXT(DA)
JRST GTF12B ; YES -
PUSHJ PP,GETFIL ; NO - SCAN SOME MORE
JRST GTF12B
GTF12A: PUSHJ PP,COMKAR
GTF12B: CAIE CH,15
JRST BADSTR
RESET
SKIPN I2,DEVDEV(DA)
MOVSI I2,(SIXBIT "DSK")
MOVEI I1,0
MOVEI I3,COMBH
OPEN COM,I1
JRST NOCOMD
SKIPE I1,DEVFIL(DA)
JRST GTF12D
MOVEI I2,3
PJOB I3,
IDIVI I3,^D10
MOVEI I0,"0"-40(I4)
LSHC I0,-6
SOJG I2,.-3
HRRI I1,(SIXBIT "RPG")
GTF12D: HLLZ I2,DEVEXT(DA)
GTF12E: MOVEI I3,0
MOVE I4,DEVPP(DA)
JUMPE I2,GTF12H
GTF12F: LOOKUP COM,I1
JRST NOCOMF
GTF12G: HLRZM I2,COMEXT
INBUF COM,1
MOVE TE,.JBFF
MOVEM TE,SAVJFF
MOVSI SW,FDSKC/1000000
JRST GETFIL
GTF12H: MOVSI I2,(SIXBIT "CCL")
LOOKUP COM,I1
SKIPA
JRST GTF12G
MOVEI I2,0
MOVE I4,DEVPP(DA)
JRST GTF12F
;SWITCH ( ( TYPE )
GTFL13: PUSHJ PP,GTFL4B
PUSHJ PP,COMKAR
GTF13A: PUSHJ PP,SWICH
PUSHJ PP,COMKAR
CAIE CH,")"
JRST GTF13A
JRST GTFL10
;"!" SEEN - CALL CUSP
GTFL14: MOVSI TE,(SIXBIT "SYS")
MOVE TD,TA
SETZB TC,TB
SETZB TA,PP
MOVE CH,[XWD 1,TE] ; [303] [373] enter at CCL entry point
RUN CH,
JRST 4.,
MSG <?RPGMNE Monitor error - RUN UUO returned to RPGII
>
EXIT
;DETERMINE TYPE OF SWITCH
SWICH: CAIN CH,"S"
JRST SWICHS
CAIN CH,"M"
JRST SWICHM
CAIN CH,"L"
JRST SWICHL
CAIN CH,"A"
JRST SWICHA
CAIN CH,"E"
JRST SWICHE
CAIN CH,"H"
JRST SWICHH
CAIN CH,"C"
JRST SWICHC
CAIN CH,"Z"
JRST SWICHZ
CAIN CH,"W"
JRST SWICHW
CAIN CH,"R"
JRST SWICHR
CAIN CH,"N"
JRST SWICHN
CAIN CH,"P"
JRST SWICHP
JRST BADCSW ; ILLEGAL SWITCH
;SWITCH HANDLEING ROUTINES
SWICHP: SETOM PRODSW ; SET '/P'
POPJ PP,
IFN CREF,<
SWICHC: SETOM CREFSW ; SET '/C'
POPJ PP,>
IFE CREF,<
SWICHC: MSG <
?RPGCNS CREF not supported this version
>
JRST BADC1 >
SWICHE: SWON FFATAL ; TURN ON '/E'
POPJ PP,
SWICHH: SWON FHELP ; TURN ON '/H'
POPJ PP,
SWICHS: SWON FSEQ ; TURN ON '/S'
POPJ PP,
IFN MAPS,<
SWICHM: SWON FMAP ; TURN ON '/M'
POPJ PP, >
IFE MAPS,<
SWICHM: MSG <
?RPGMNS Maps not supported this version
>
JRST BADC1 >
SWICHL: MOVEI TA,1 ; SET 'L' FLAG IN TABLE
JRST SWZWL
SWICHA: SWON FOBJEC ; TURN ON '/A'
POPJ PP,
SWICHZ: MOVEI TA,4 ; SET 'Z' FLAG IN TABLE
JRST SWZWL
IFN REENT,<
SWICHR: SWON FREENT ; TURN ON '/R'
POPJ PP, >
IFE REENT,<
SWICHR: MSG <
?RPGRNS Reentrant code not supported this version
>
JRST BADC1 >
SWICHN: SWOFF FTERA ; TURN OFF "WE'RE TYPING ERRORS"
POPJ PP,
SWICHW: MOVEI TA,DEVSW(DA) ; SET 'W' FLAG IN TABLE
SWZWL: IORM TA,DEVSW(DA)
POPJ PP,
;PICK UP A SIXBIT WORD FROM COMMAND STRING
GETSIX: MOVEI TA,0
MOVE TB,[POINT 6,TA]
GETSX1: PUSHJ PP,COMKAR ; NO GET NEXT
GETSX2: CAIG CH,"Z" ; LETTER?
CAIGE CH,"A"
JRST GETSX4 ; NO --
GETSX3: TLNN TB,770000
JRST BADNAM
SUBI CH,40 ; YES--STASH IT
IDPB CH,TB
JRST GETSX1
GETSX4: CAIG CH,"9" ; NOT A LETTER - A DIGIT?
CAIGE CH,"0"
POPJ PP, ; NO - RETURN
JRST GETSX3 ; YES - STASH IT
;PICK UP AN OCTAL NUMBER
GETNUM: MOVEI TA,0 ; CLEAR THE SUMMER
PUSHJ PP,COMKAR ; GET FIRST CHARACTER
CAIN CH," " ; SPACE?
JRST .-2 ; YES - SO IGNORE IT ALREADY
GETNM1: CAIG CH,"7" ; OCTAL DIGIT?
CAIGE CH,"0"
JRST GETNM2 ; NO -
LSH TA,3 ; YES ADD TO SUM
IORI TA,-"0"(CH)
TLNE TA,-1 ; SUM > 777777 ?
JRST BADPPN ; YES - NOT SO GOOD
PUSHJ PP,COMKAR ; NO - GET ANOTHER DIGIT
JRST GETNM1 ; LOOP ON THRU
GETNM2: JUMPE TA,BADPPN ; SUM = 0?
POPJ PP, ; NO - SO RETURN
;GET A CHARACTER FROM COMMAND STRING
COMKAR: TSWFZ FCOMCH ; REGET SAME CHARACTER
JRST COMKR6 ; YES -
COMKR0: SOSG COMBH+2 ; GET CHARACTER FROM DISK OR TMPCOR
JRST COMKR2
COMKR1: ILDB CH,COMBH+1
JUMPE CH,COMKAR ; IGNORE NULLS
CAIN CH,15 ; IGNORE CARRIAGE RETURNS
JRST COMKAR
CAIG CH,172 ; BETWEEN LC Z AND LC A ?
CAIGE CH,141
CAIA ; NOT LC
SUBI CH,40 ; YES - CONVERT TO UPPER CASE
DPB CH,COMBH+1 ; [303] store new character
CAIE CH,175 ; SOME KIND OF ALTMODE?
CAIN CH,176
JRST COMKR9 ; YES -
CAIE CH,32 ; END-OF-FILE?
CAIN CH,33 ; STILL ANOTHER KIND OF ALTMODE?
JRST COMKR9 ; YES - IS ALT
CAIE CH,12
CAIN CH,14
JRST COMK99
CAIE CH,"_" ; IS IT "_" ?
POPJ PP, ; NO - RETURN
MOVEI CH,"=" ; YES, CHANGE TO "="
DPB CH,COMBH+1 ; STASH BACK INTO BUFFER FOR NEXT TIME (IF ANY)
POPJ PP,
;GET NEXT BUFFER FULL OF COMMANDS
COMKR2: SKIPN COMBH ; FROM TMPCOR?
JRST COMK2B ; YES - NO MORE
IN COM, ; GET NEXT BUFFER FULL
JRST COMKR1 ; NO ERRORS - RETURN
GETSTS COM,CH ; ERROR - GET DEVICE STATUS
TRNE CH,$ERAS ; ANY ERROR FLAGS UP?
JRST COMKR8 ; YES - YOU LOSE!
CLOSE COM, ; NO - CLOSE COMMAND FILE
MOVE CH,COMEXT ; IS EXTENSION "TMP"?
CAIE CH,(SIXBIT "TMP")
JRST COMK2A ; NO - DON'T DELETE
MOVEI CH,0 ; DELETE COMMAND FILE
RENAME COM,CH
JFCL
COMK2A: RELEASE COM, ; RELEASE IT
JRST COMKR3
;GET RID OF TMPCOR AREA
COMK2B: MOVSI CH,(SIXBIT "RPG")
MOVEM CH,COMBH+1
MOVS CH,.JBSA
SUBI CH,1
HRLI CH,-200
MOVEM CH,COMBH+2
MOVE CH,[XWD 2,COMBH+1]
TMPCOR CH,
JFCL
;END OF COMMAND FILE
COMKR3: SWON FECOM ; TURN ON "END OF COMMAND"
COMKR4: MOVEI CH,15 ; RETURN A CARRIAGE RETURN
POPJ PP,
;REGET SAME CHARACTER
COMKR6: LDB CH,COMBH+1 ; FROM DISK OR TMPCR
POPJ PP,
;READ ERROR
COMKR8: MSG <?RPGTEC Transmission error on command file
>
EXIT
;AN ALTMODE WAS SEEN
COMKR9: PUSHJ PP,COMK99
JRST COMKR3
;TYPE OUT A CRLF IN INPUT FROM TTY
COMK99: TSWT FDSKC;
MSG <
>
JRST COMKR4
;ERROR ROUTINES
;"DSK" IS NOT THE DISK
NOTDSK: MSG <?RPGDND "DSK" is not the disk
>
EXIT
;TOO MANY OUTPUT FILES
TUMANY: MOVEI TB,[ASCIZ "?RPGIRC Improper RPGII command"]
JRST BADCOM
;BINARY DEVICE CANNOT DO BINARY
BADBIN: MOVEI TB,[ASCIZ ": cannot do binary output"]
MOVE TA,[SIXBIT "RPGCDB"]
JRST TYPEIT
;OUTPUT DEVICE CANNOT DO OUTPUT
BADOUT: MOVEI TB,[ASCIZ ": cannot do output"]
MOVE TA,[SIXBIT "RPGCDO"]
JRST TYPEIT
;SOURCE FILE IS NOT AN INPUT DEVICE
NOTIN: MOVEI TB,[ASCIZ ": cannot do input"]
MOVE TA,[SIXBIT "RPGCDI"]
TYPEIT: MSG <?>;
PUSHJ PP,SIXOUT ; OUTPUT RPGxxx
MSG < >; ; A SPACE
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT
JRST BADCOM
;MORE ERROR ROUTINES
;SOMETHING A BIT ODD ABOUT STRING
BADSTR: MOVEI TB,[ASCIZ "?RPGIRC improper RPGII command"]
JRST BADCOM
;COMMAND DEVICE IS UNAVAILABLE
NOCOMD: MOVEI [ASCIZ "?RPGCDU Indirect command device unavailable"]
JRST BADCOM
;COMMAND FILE CANNOT BE FOUND
NOCOMF: MOVEI TB,[ASCIZ "?RPGCFC Cannot find command file"]
JRST BADCOM
;NAME TOO LONG
BADNAM: MOVEI TB,[ASCIZ "?RPGNMS Name of more than six characters"]
JRST BADCOM ; [267] type error message
;BAD PPN
BADPPN: MOVEI TB,[ASCIZ "?RPGIPP Improper Project-Programmer Number"]
JRST BADCOM
;IMPROPER CHARACTER IN STRING
BADKAR: MOVEI TB,[ASCIZ "?RPGICC Improper character in command"]
JRST BADCOM
;BAD SWITCH
BADCSW: MSG <?RPGNLS >;
CHROUT CH
MOVEI TB,[ASCIZ " is not a legal switch"]
JRST BADCOM
;ERROR WHILE INITIALIZING THE DEVICE
;NOT A LEGAL DEVICE
NOTDEV: MOVEI TB,[ASCIZ ": is not a legal device"]
MSG <?RPGNLD >;
MOVE TA,DEVDEV(DA)
PUSHJ PP,SIXOUT
JRST BADCOM
;STILL MORE ERROR ROUTINES
;NO FILE FOR DIRECTORY DEVICE
NOFILE: MSG <?RPGNFN No file name for >;
MOVE TA,DEVDEV(DA) ; GET DEVICE
PUSHJ PP,SIXOUT ; OUTPUT IT
MSG <:
>; ; BE NEAT
JRST BADC1 ; GO FINISH
;TOO MANY SOURCE FILES
NOROOM: MOVEI TB,[ASCIZ "?RPGTMS Too many source files"]
JRST BADCOM
;NO SOURCE FILES AT ALL
NOSRC: TSWFZ FHELP ; IS /H ON?
JRST HELP ; YES - OK
MOVEI TB,[ASCIZ "?RPGNSF No source files specified"]
;TYPE OUT MESSAGES AND RESTART COMPILATION
BADCOM: OUTSTR (TB)
BADC0: MSG <
>
BADC1: TSWF FESRC!FECOM ; END OF COMMAND STRING?
JRST BADC2 ; YES
PUSHJ PP,COMKAR ; NO - GET CHARACTER
CAIE CH,15 ; CARRIAGE RETURN?
JRST BADC1 ; NO - LOOP
BADC2: TSWT FDSKC ; COMMANDS FROM TTY?
JRST RPGIIA ; YES -
AND SW,[EXP FDSKC] ; NO - CLEAR ALL SWITCHES EXCEPT FDSKC
JRST RPGLAS
;AND EVEN MORE ERROR ROUTINES
DBLNAM: MSG <?RPGNED NAMTAB entry duplicated
>
JRST KILL
;CANNOT ENTER A FILE
NOENTR: MSG <?RPGCEF Cannot enter file >;
JRST ERATYP
;This routine gets moved to the Low-segment
%WEDID: JRST @WEDIED+1 ; Go to KILL routine
Z
%GETLD: MOVEM 17,SAVEAC+17 ; Save
MOVEI 17,SAVEAC ; all
BLT 17,SAVEAC+16 ; AC's
MOVEI 1,WEDIED+%CANT-%WEDID ; Set up "REENTER" to go to error
HRRM 1,.JBREN
HRRM 1,.JBSA
MOVSI 1,1 ; Throw away
CORE 1, ; the hi-seg
JRST 4,WEDIED+.-%WEDID ; couldn't - monitor problem
MOVEI 1,GETFNM ; call
GETSEG 1, ; GETSEG
JRST 4,WEDIED+.-%WEDID ; Error
MOVSI 17,SAVEAC ; Restore AC's
BLT 17,16
MOVE 17,SAVEAC+17
%DDTST: JRST @GETFST ; Go to HiSeg
%GTFNM: Z
Z
SIXBIT "SHR"
Z
Z
Z
%GTFST: Z
%CANT: OUTSTR WEDIED+%CANT+2-%WEDID
EXIT
ASCIZ "?Cannot restart"
;TABLE OF SCRATCH DEVICES
;LH IS NAME OF A FILE, IN SIXBIT
;RH IS THE ADDRESS OF AN ENTRY TO CONTAIN DEVICE NAME, ETC.
DEVTAB: XWD 'CAL',CALDEV
XWD 'NAM',NAMDEV
XWD 'ERA',ERADEV
XWD 'GEN',GENDEV
XWD 'CPY',CPYDEV
XWD 'AS1',AS1DEV
XWD 'AS2',AS2DEV
XWD 'AS3',AS3DEV
XWD 'LIT',LITDEV
XWD 'CRF',CRFDEV
DEVXWD: XWD DEVTAB-.,0
;TABLE OF MONTHES
MOTABL: ASCII "-Jan-"
ASCII "-Feb-"
ASCII "-Mar-"
ASCII "-Apr-"
ASCII "-May-"
ASCII "-Jun-"
ASCII "-Jul-"
ASCII "-Aug-"
ASCII "-Sep-"
ASCII "-Oct-"
ASCII "-Nov-"
ASCII "-Dec-"
;TABLE OF WORK TABLES
DEFINE TABSET (A,B,C,E,F,G),<
IFDIF <NAM>,<A>,<IFN ^D'B,<
XWD -^D'B-1,A'LOC
EXTERNAL A'LOC
>>>
XALL
WRKTAB: TABLES;
WRKXWD: XWD WRKTAB-.,WRKTAB
SALL
EXTERNAL SRCDEV,LSTDEV,BINDEV,ERADEV,GENDEV,CPYDEV,NAMDEV,CALDEV
EXTERNAL AS1DEV,AS2DEV,AS3DEV,LITDEV,CRFDEV
EXTERNAL SRCBUF,LSTBUF,BINBUF,AS1BUF,AS2BUF,AS3BUF
EXTERNAL GENBUF
EXTERNAL COMBH,I0CHAN,LSTBLK,BINBLK
EXTERNAL PPOINT,ENTROP,LOOKOP,OUTBOP,TOPLOC,LASTDV
EXTERNAL STDATE,STTIME,PHASEN,FSTCLR,FREESP
EXTERNAL NAMLOC,EXTPTR,CREFSW,PRODSW
EXTERNAL NAMVAL,NAMWRD,NAMNXT,NAMNSZ,NM12SZ,NAMBAS,NM1SIZ,NSZPTR
EXTERNAL NM1LOC,NM2LOC,NAMPSZ,NTSIZE,NTNSIZ,SIZTAB
EXTERNAL GETLOD,GETFNM,GETFST
EXTERNAL DEVDEV,DEVFIL,DEVEXT,DEVBHI,DEVBH,DEVBLK,DEVBUF,DEVPP,DEVSW,DEVSZ
EXTERNAL SRCTOP,LSTSWS,BINSWS,IOSRCS,SRCEND,COMEXT
EXTERNAL RUNPPN,RUNDEV,STINFL,.HELPR,OPENIT,ADDCOR,TRYNAM
EXTERNAL .JBFF,SAVJFF,GETEND,GETFNM,.JBSA,WRKSIZ,SETCOR,.JBSYM
EXTERNAL .JBVER,SIXOUT,ERATYP,.JBREN
EXTERNAL BLDNAM,EXTNXT,XPNEXT
EXTERNAL WEDIED,SAVEAC,VERZUN,KILL
END RPGIIA