Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-153/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