Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/cobola.mac
There are 7 other files named cobola.mac in the archive. Click here to see a list.
; UPD ID= 816 on 2/8/83 at 4:12 PM by NIXON                             
TITLE	COBOLA FOR COBOL V13
SUBTTL	COBOL INITIALIZATION		AL BLACKINGTON/CAM

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P
	DBMS==:DBMS
	DEBUG==:DEBUG
	MPWCEX==:MPWCEX
	ONESEG==:ONESEG

	IFE TOPS20,<SEARCH MACTEN,UUOSYM>
	IFN TOPS20,<SEARCH MONSYM,MACSYM>

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
	SALL

IFE TOPS20,<
DEFINE	TYPE(ADDR),<
	OUTSTR	ADDR
>>
IFN TOPS20,<
DEFINE	TYPE(ADDR),<
	PUSH	PP,T1
	HRROI	T1,ADDR
	PSOUT%
	POP	PP,T1
>>

ENTRY	COBOLA
IFN TOPS20,<
	INTERN	SETIMP		;CLEAR IMPURE AREA
>

	EXTERN	AS7482,SAVJFF,CREFSW
IFE TOPS20,<
	EXTERN	COMBH,DEVBH,DEVDEV,DEVEXT,DEVFIL,IOCHAN,LSTDEV,OPENIT
>
;EDIT HISTORY

;V12B****************
;NAME	DATE		COMMENTS
;DMN	 3-Dec-82	[1435] Prevent TI wait state after error message is printed.

;V12*****************
;NAME	DATE		COMMENTS
;CLRH	31-MAY-79	[713] DO TMPCOR IN THE RIGHT ADDRESS IF CORE UUO IS NEEDED.
;DMN	19-SEP-78	[556] FIX GETTAB 135 IF FILDAEMON IS TURNED OFF

;V10*****************
;NAME	DATE		COMMENTS
;EHM	2-MAR-78	[530] FIX COMMAND SCANNER TO LOOK FOR NUL FILE 
;			IF USER TYPES   =FILE.
;SSC	28-SEPT-77	ADDED KEYWORDS FOR DBMS-V6: TRANSACTION, VIA, MEMBERS
;SSC	29-JUL-76	ADDED KEYWORD JOURNAL FOR DBMS S. U.
;GPS	12/23/74	ADD KEYWORDS FOR SIMULTAUEOUS UPDATE
;ACK	12-JAN-75	1.  ALTMODE/BACKARROW CODE REMOVAL.
;			2.  "/X" CODE FOR EBCDIC/COMP-3.
;			3.  "/D:SIZE" SWITCH FOR MULTIPLE PERFORMS.
;			4.  ADD KEYWORDS "STANDARD-ASCII" AND "FILE-STATUS".
;SSC	MAR-5-75	PUT 6A EDIT %316 DIRECTLY INTO V10
;********************
; EDIT 344 FIX "DSK NOT DSK MSG IF NO COMMAND FILE.
; EDIT 255 FIX TO ALWAYS ACCEPT LC LETTERS IN COMMAND STRING
; EDIT 144 FIXES DSK IS NOT THE DSK
;TOPS-10 programs start here.
;TOPS-20 programs start in COBSCN and call here to start phase A.

COBOLA:
IFE TOPS20,<
	PORTAL	START		;COMMANDS FROM TTY
	PORTAL	COMDSK		;COMMANDS FROM DISK
	PORTAL	COBLAR		;RESTART

IFN ONESEG,<
;RESTART DUE TO "START" CONSOLE COMMAND

REDO:	MOVEI	SW,0

;RESTART DUE TO "REENTER" CONSOLE COMMAND
;	ALSO USED BY COBOLG, COBOLK, AND QUITS			[506]

RESTRT:	TSWF	FECOM;		;ANY MORE COMMANDS?
	CALLI	$EXIT		;NO--QUIT

	AND	SW,[EXP FDSKC]	;TURN OFF ALL FLAGS EXCEPT FDSKC
	JRST	COBLAR		;RESTART
>


START:
IFE ONESEG,<
	SKIPN	11		;[144] CHECK RUN-TIME DEVICE
	MOVSI	11,'DSK'	;[144] IF NONE USE DSK
	MOVEM	7,RUNPPN##	;SAVE DEV AND PPN OF RUN COMMAND
	MOVEM	11,RUNDEV##
>

START1:	SETZB	SW,CCLSW##	;CLEAR FLAGS AND SIGNAL ENTERED FROM NORMAL ENTRY POINT

;START A NEW COMPILATION

COBLAR:	TSWF	FDSKC		;INPUT COMMAND FROM TTY?
	JRST	COBLAS		;NO

	OPEN	COM,[.IOASL	;GET TTY FOR COMMAND CHANNEL
		SIXBIT /TTY/
		XWD 0,COMBH##]
	  HALT	.-1		;NO TTY?

	INBUF	COM,2		;GET 2 COMMAND BUFFERS
	SETZM	SAVJFF		;IF RESTART, FORCE SAVING JOBFF

;ENTER HERE FROM CCL ENTRY POINT, ALL PATHS REJOIN HERE

COBLAS:

IFE ONESEG,<
	MOVE	TA,RUNDEV	;IS RUN DEVICE REALLY A DISK?
	DEVCHR	TA,
	TXNN	TA,DV.DSK
	JRST	NOTDSK		;NO--ERROR
> ;END IFE ONESEG
	SKIPN	TA,SAVJFF	;SAVE JOBFF IF IT WASN'T DONE ALREADY
	MOVE	TA,.JBFF
	MOVEM	TA,SAVJFF
	MOVEM	TA,.JBFF	;RESTORE JOBFF

	; ZERO ALL OF FREE CORE
	CAMG	TA,.JBREL##
	SETZM	(TA)
	AOS	TA
	HRL	TA,.JBFF##
	HRRZ	TB,.JBREL
	CAMLE	TB,.JBFF
	BLT	TA,(TB)
>;END IFE TOPS20
;SET UP IMPURE AREA.
;GET RID OF LEADING CARRIAGE-RETURNS IN COMMAND STRING.

	SETFAZ	A;

IFE TOPS20,<
	TSWT	FDSKC		;[266] DSK INPUT FOR COMMANDS
	PUSHJ	PP,TTYON##	;[266] NO, TURN ON TTY IF USER TYPED CONT O

	PUSHJ	PP,SETIMP	;SET UP IMPURE AREA
>;END IFE TOPS20
	PUSHJ	PP,GETDT	;SET UP DATE, TIME AND DEFAULT PATH
	PUSHJ	PP,GETVER	;SET UP VERSION NUMBER
IFE TOPS20,<
TYPEST:	TSWT	FDSKC;
	TYPE	[ASCIZ/
*/]

TESTCR:	PUSHJ	PP,COMKAR	;GET FIRST CHARACTER FROM COMMAND
	TSWF	FECOM;		;END OF COMMAND FILE?
	CALLI	$EXIT		;YES--QUIT
	JUMPE	CH,TYPEST	;NO--NULL?
	CAIN	CH,$CR		;NO--CARRIAGE-RETURN?
	JRST	TYPEST		;YES--LOOP


	SWON	FCOMCH;		;NO--SET "REGET CHARACTER"
	SWON	FTERA		;SET 'WE ARE TYPING ERRORS'
	SETZM	CREFSW##	;CLEAR '/C'

;SET UP BINARY DEVICE

SETBIN:	MOVEI	DA,BINDEV##
	PUSHJ	PP,GETFIL	;GET FIRST FILE
	HLLZS	DEVEXT(DA)	;[530] CLEAR .(DOT) SEEN FLAG IF SET

	TSWF	FDSKC		;INPUT FROM TTY?
	TYPE	[ASCIZ/COBOL:	/];NO

	CAIE	CH,"-"		;IS IT "NULL FILE"?
	JRST	SETBNB		;NO
	SETZM	BINDEV		;YES
	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
	TXNE	TA,DV.M14	;BINARY LEGAL?
	TXNN	TA,DV.OUT	;YES--OUTPUT DEVICE?
	JRST	BADBIN		;NO--ERROR
;SET UP LISTING DEVICE

SETLST:	CAIN	CH,"="		;ANY FILE THERE?
	JRST	SETLSA		;NO

	CAIN	CH,$CR		;END OF STRING?
	JRST	NOSRC		;YES--ERROR

	MOVEI	DA,LSTDEV##
	PUSHJ	PP,GETFIL	;GET SECOND FILE
	HLLZS	DEVEXT(DA)	;[530] CLEAR .(DOT) SEEN FLAG IF SET

	CAIE	CH,"-"		;IS IT A "NULL FILE"?
	JRST	SETLSB		;NO

	SWON	FNOLST		;YES
	PUSHJ	PP,COMKAR
	CAIE	CH,"="
	JRST	TUMANY

SETLSA:	MOVSI	TA,'DSK'	;NO DEVICE--USE "DSK"
	MOVEM	TA,LSTDEV	;SET LIST DEVICE
	JRST	SETSRC		;IT MUST BE LEGAL

SETLSB:	JUMPE	TA,SETLSA
	TXNN	TA,DV.OUT	;OUTPUT DEVICE?
	JRST	BADOUT		;NO--ERROR
;SET UP SOURCE DEVICE

SETSRC:	CAIN	CH,$CR		;END OF STRING?
	JRST	NOSRC		;YES--ERROR
	CAIE	CH,"="		;ANY MORE OUTPUT FILES?
	JRST	TUMANY		;YES--ERROR


	PUSHJ	PP,SCNCOM	;SCAN ALL SOURCE FILES
	PUSHJ	PP,STINFL##	;SET UP FIRST SOURCE FILE
	TSWFZ	FHELP		;/H?
	JRST	HELP		;YES

	SKIPN	SRCDEV##	;ANY FILE THERE?
	JRST	NOSRC		;NO--ERROR

;FILE NAMES HAVE BEEN READ--FINALIZE

	MOVE	TA,SRCDEV+1
	SKIPN	LSTDEV+1	;ANY LIST FILE-NAME?
	MOVEM	TA,LSTDEV+1	;NO--JAM SOURCE NAME
	SKIPN	BINDEV+1	;ANY BINARY FILE-NAME?
	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"

	SKIPE	LIBSWS##	;ANY LIBRARY?
	JRST	INITB		;YES

	MOVE	TA,[LIBSET,,LIBDEV##]	;NO--TRY "DSK:LIBARY.LIB"
	BLT	TA,LIBDEV+3
	SETZM	LIBPP##
	MOVEI	DA,LIBDEV
	MOVEI	I1,.IOASC
	MOVEI	I3,DEVBH##(DA)
	MOVEI	DC,LIB
	PUSHJ	PP,OPENIT##

	HRRZ	TA,.JBFF
	MOVEM	TA,LIBBUF##
	INBUF	LIB,1

	LOOKUP	LIB,I1
	  SETZM	LIBDEV
;INITIALIZE BINARY DEVICE

INITB:
	MOVEI	I1,.IOBIN
	MOVEI	DA,BINDEV
	MOVEI	DC,BIN
	SKIPN	BINDEV		;ANY BINARY FILE?
	JRST	INITL		;NO

	PUSHJ	PP,OPNOUT
	MOVE	TA,BINSWS##	;REWIND?
	TRNE	TA,FL.REW
	MTREW.	BIN,
	TRNE	TA,FL.ZRO	;CLEAR DIRECTORY?
	UTPCLR	BIN,
	SETOM	BINBLK##

;INITIALIZE LISTING DEVICE

INITL:	MOVEI	I1,.IOASC
	MOVEI	DA,LSTDEV
	MOVEI	DC,LST
	TSWF	FNOLST;		;ANY LISTING DEVICE?
	JRST	INITS		;NO

	MOVE	TA,LSTDEV	;YES--TTY?
	DEVCHR	TA,
	TXNE	TA,DV.AVL
	TXNN	TA,DV.TTU
	JRST	INITL1		;NO
	TXNN	TA,DV.MTA	;TEST FOR NUL:
	SWON	FLTTY;		;YES

INITL1:	PUSHJ	PP,OPNOUT
	MOVE	TA,.JBFF
	MOVEM	TA,LSTBUF##
	OUTBUF	LST,2
	MOVE	TA,LSTSWS##	;REWIND?
	TRNE	TA,FL.REW
	MTREW.	LST,
	TRNE	TA,FL.ZRO	;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 FILE NAME
	MOVEM	TA,DEVFIL##(DA)
	MOVSI	TC,'TMP'	;SCRATCH FILES EXTENSION
	MOVEM	TC,DEVEXT##(DA)
	MOVEI	DC,FSC(TB)	;SET CHANNEL NUMBER

	CAIE	DC,CRF		;IF THIS IS
	JRST	OPNSC0		;  CREF FILE
	SKIPN	CREFSW		;  AND THERE IS NO '/C',
	JRST	OPNSC1		;  DON'T OPEN THE CREF FILE

OPNSC0:	MOVEI	I3,DEVBHI##(DA)
	HRLI	I3,3(I3)
	MOVEI	I4,0

	MOVEI	I1,.IOBIN	;USUALLY BINARY MODE
	CAIN	DC,CPY		;CPYFIL?
	MOVEI	I1,.IOASC	;YES--ASCII MODE
	CAIE	DC,NAM		;NAMFIL
	CAIN	DC,LIT		;  OR LITFIL?
	MOVEI	I1,.IODMP	;YES--DUMP MODE
	PUSHJ	PP,OPNTMP
	SETOM	DEVBLK##(DA)	;SET BLOCK COUNT TO -1

	CAIE	DC,LIT		;"LIT"?
	CAIN	DC,AS3		;"AS3"?
	JRST	OPNSC1		;YES--NO BUFFER NOW
	CAIN	DC,NAM		;LIKEWISE 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##	;AS3FIL OVERLAYS SRCFIL
	MOVEM	TA,AS3BUF##
	MOVE	TA,GENBUF##	;BINFIL OVERLAYS GENFIL
	MOVEM	TA,BINBUF##

>;END IFE TOPS20
;SET UP LISTING IF WE ARE DEBUGGING

IFN DEBUG,<
	PUSHJ	PP,HDROUT##
	>


;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 1K OF CORE
SETNAM:	MOVE	TA,TOPLOC	;ROOM FOR
	SUBI	TA,1+NAMPSZ##	;  NAMTAB
	SUB	TA,NTSIZE##	;  + NM1TAB
	SUB	TA,NTSIZE	;  + NM2TAB?
	CAMGE	TA,FREESP
	JRST	SETNAM-1	;NO--GRAB 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,-1+NAMNSZ##
	MOVEM	TA,NAMLOC##
	MOVEM	TA,NAMNXT##

	MOVEI	LN,NAMDAT	;BEGINNING OF TABLE IN "RESVWD"
;SET UP NAMTAB (CONT'D)

SETN1:	SETZM	NAMWRD##	;CLEAR NAMWRD
	MOVE	TB,[XWD NAMWRD,NAMWRD+1]
	BLT	TB,NAMWRD+4

	HLRZ	TB,(LN)		;GET <SIZE OF ENTRY> + 1
	MOVEI	TC,NAMWRD	;SET UP <XWD 1(LN),NAMWRD>
	HRLI	TC,1(LN)
	BLT	TC,NAMWRD-2(TB)	;MOVE ENTRY TO NAMWRD

	PUSHJ	PP,TRYNAM##	;SEE IF IT IS THERE
	  JRST	SETN2		;NO--OK
	JRST	DBLNAM		;YES--ERROR

SETN2:	PUSHJ	PP,BLDNAM##	;CREATE AN ENTRY IN NAMTAB
	HRLZ	TB,(LN)
	TLO	TB,NAMRSV/1B17
	MOVEM	TB,(TA)

	HLRZ	TA,(LN)		;STEP TO NEXT NAMDAT ENTRY
	ADD	LN,TA
	SKIPGE	AS7482		;DO WE WANT JUST COBOL-74?
	CAIGE	LN,NAMD82	;AND HAVE WE FINISHED ALL BUT 8x RESERVED WORDS?
	SKIPN	(LN)		;NO, BUT ARE WE DONE WITH FULL TABLE?
	JRST	SETN3		;YES
	JRST	SETN1		;NO--LOOP

SETN3:	HRRZ	TA,NM1LOC	;YES--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 LOCS
	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	TB,[POINT 6,NAMWRD]
	MOVSI	TA,(POINT 6,(LN))

SETX1A:	ILDB	CH,TA
	CAIN	CH,'.'
	MOVEI	CH,';'
	IDPB	CH,TB
	TLNE	TA,770000
	JRST	SETX1A

	PUSHJ	PP,TRYNAM
	  JRST	SETEX2
	JRST	DBLNAM		;YES--ERROR

SETEX2:	PUSHJ	PP,BLDNAM	;NO--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--CLEAR IT

	MOVEM	TB,EXTNXT	;YES--RESTORE EXTNXT

	AOBJN	LN,SETEX1	;ANY MORE 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
	PUSHJ	PP,GETFCH##	;SET UP SRCFIL
	SWON	FREGCH;
	SETZM	WASERC##	;LAST WORD WAS NOT 'SEARCH', OBVIOUSLY

	MOVEI	TA,"."		;SET "DECIMAL POINT IS PERIOD"
	MOVEM	TA,DCPNT.##
	MOVEI	TA,","
	MOVEM	TA,COMA.##

	MOVEI	TA,100
	MOVEM	TA,GENWRD##

IFE TOPS20,<
IFN DEBUG,<TSWC FOBJEC>
	TSWF	FNOLST		;IF NO LISTING,
	SWOFF	FOBJEC!FMAP	;  THEN NO MAPS NOR 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;
IFE TOPS20,<

;SCAN REMAINDER OF SOURCE FILES IN COMMAND STRING

SCNCOM:	MOVSI	DA,'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
	MOVE	TB,DEVSW##(DA)	;NO--IS THIS A LIBRARY?
	TRNN	TB,FL.LIB
	JRST	SCNCM6		;NO--ERROR

SCNCM2:	MOVE	TA,LASTDV
	MOVEM	TA,DEVDEV(DA)
	DEVCHR	TA,

SCNCM3:	PUSHJ	PP,CHEKIN	;CHECK VALIDITY OF FILE

	ADDI	DA,DEVSIZ	;KICK 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,$CR		;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
	PUSHJ	PP,OPENIT	;OPEN AND SET UP ENTER
	JRST	OPNTM1

OPNTMP:	PUSHJ	PP,OPENIT	;OPEN AND SET UP ENTER

	CAIN	DC,LIT		;DON'T ENTER IF
	POPJ	PP,		;  LITFIL

	MOVSI	I3,(100B8)	;SET NO PROTECTION, SO WE CAN ALWAYS
				; READ AND DELETE THIS FILE
OPNTM1:	MOVE	I0,ENTROP##	;CREATE AN ENTER
	DPB	DC,I0CHAN
	XCT	I0		;ENTER
	  JRST	NOENTR		;CANNOT
	POPJ	PP,


;CHECK VALIDITY OF SOURCE FILE.
;ENTER WITH CHARACTERISTICS IN TA.

CHEKIN:	TXNN	TA,DV.IN	;INPUT DEVICE?
	JRST	NOTIN		;NO--ERROR

	TXNE	TA,DV.DIR	;DIRECTORY DEVICE?
	SKIPE	DEVFIL(DA)	;YES--ANY FILE NAME?
	SKIPA	TB,DEVSW(DA)	;YES, LIBRARY FILE?
	JRST	NOFILE		;NO--ERROR
	TRNE	TB,FL.LIB
	TXNE	TA,DV.DSK	;YES--IS IT DSK?
	POPJ	PP,		;YES
	JRST	BADLIB		;NO--ERROR
;SET UP TO GET COMMANDS FROM DISK

COMDSK:
IFE ONESEG,<
	MOVEM	7,RUNPPN	;SAVE DEV AND PPN OF RUN COMMAND
	MOVEM	11,RUNDEV
>

	MOVX	SW,FDSKC	;CLEAR FLAGS--SET "COMMANDS FROM DISK"
	MOVEI	TA,1
	MOVEM	TA,CCLSW
	CALLI	$RESET

	MOVSI	TA,'COB'		;SET UP FIRST
	MOVEM	TA,COMBH+1		;  WORD FOR TMPCOR UUO
	MOVE	TA,.JBFF		;CHECK IF THERE IS ENOUGH CORE
	ADDI	TA,200-1
	CAMG	TA,.JBREL##		;ENOUGH FREE SPACE?
	JRST	COREOK			;YES
	MOVE	TB,TA
	CORE	TB,			;GET MORE CORE
	  JRST	NOTNUF			;NOT ENOUGH
;[713]	MOVEM	TA,.JBFF		;RESET JBFF
COREOK:	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 JOBFF 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:	OPEN	COM,[.IOASC
		SIXBIT /DSK/
		XWD 0,COMBH]
	  JRST	START1		; [344] NO DSK -- USE TTY
	MOVEI	I1,'COB'	;SET UP LOOKUP PARAMETERS
	MOVSI	I2,'TMP'
	SETZB	I3,I4
	HLRZM	I2,COMEXT##

	PJOB	TC,		;PUT IN JOB NUMBER
	MOVEI	I0,3
	IDIVI	TC,^D10
	ADDI	TB,'0'
	LSHC	TB,-6
	SOJG	I0,.-3
	HLL	I1,TA

	INBUF	COM,1		;GET A SINGLE BUFFER
	LOOKUP	COM,I1		;LOOKUP "JJJCOB.TMP"
	  JRST	START1		; [344] NOT FOUND -- USE TTY.
CMDSK9:	MOVE	TE,.JBFF##
	MOVEM	TE,SAVJFF##
	JRST	COBLAS

>;END IFE TOPS20
;SET UP IMPURE AREA

SETIMP:
IFE ONESEG,<
	MOVE	TA,[XWD %WEDID,WEDIED##]	;MOVE "GETSEG" ROUTINE TO LOW-SEGMENT
 IFN DEBUG,<
	BLT	TA,-1+DDTSTP##			;DON'T OVERWRITE BREAKPOINT THAT MIGHT BE AT DDTSTP
 >
 IFE DEBUG,<
	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##
	HRROI	TA,.GTRDV
	GETTAB	TA,		;GET DEVICE
	  JRST	SETI2		;PRE 6.03
	JUMPE	TA,SETI2	;[556] NOT IMPLEMENTED
	MOVEM	TA,GETFNM	;SAVE ACTUAL DEVICE
	HRROI	TA,.GTRDI
	GETTAB	TA,		;GET DIRECTORY
	  JRST	SETI2
	MOVEM	TA,GETFNM+4	;SAVE ACTUAL PPN
	HRROI	TA,.GTRS0
	GETTAB	TA,		;GET SFD #1
	  JRST	SETI2		;PRE 6.04
	JUMPE	TA,SETI2	;NO SFD
	MOVEM	TA,GETPTH+.PTSFD	;SAVE SFD
	MOVEI	TA,GETPTH##	;GET POINTER
	EXCH	TA,GETFNM+4	;SWAP WITH PPN
	MOVEM	TA,GETPTH+.PTPPN	;SAVE PPN
	HRROI	TA,.GTRS1
	GETTAB	TA,		;NEXT SFD
	  JRST	SETI2
	MOVEM	TA,GETPTH+.PTSFD+1
	JUMPE	TA,SETI2	;ALL DONE
	HRROI	TA,.GTRS2
	GETTAB	TA,		;NEXT SFD
	  JRST	SETI2
	MOVEM	TA,GETPTH++.PTSFD+2
	JUMPE	TA,SETI2	;ALL DONE
	HRROI	TA,.GTRS3
	GETTAB	TA,		;NEXT SFD
	  JRST	SETI2
	MOVEM	TA,GETPTH+.PTSFD+3
	JUMPE	TA,SETI2	;ALL DONE
	HRROI	TA,.GTRS4
	GETTAB	TA,		;NEXT SFD
	  JRST	SETI2
	MOVEM	TA,GETPTH+.PTSFD+4
	SETZM	GETPTH+.PTSFD+5	;TERMINATE WITH ZERO
SETI2:>

IFN TOPS20,<
;ZERO ALL OF FREE CORE HERE (I.E. .JBFF THROUGH .JBREL)
	HRRZ	TA,.JBFF
	CAMG	TA,.JBREL##
	SETZM	(TA)
	AOS	TA
	HRL	TA,.JBFF##
	HRRZ	TB,.JBREL
	CAMLE	TB,.JBFF
	BLT	TA,(TB)
>
	MOVE	TB,[XWD FSTCLR##,FSTCLR+1]
	SETZM	FSTCLR
	BLT	TB,LSTCLR##	;CLEAR ALL LOWSEG LOCS
	MOVE	TE,[SETI3,,RVBLT##]
	BLT	TE,RVBLT+2	;SETUP REVERSE BLT
	HLRZ	TE,.JBSA##	;GET INITIAL .JBFF
	ADDI	TE,WRKSIZ##	; SET SIZE FOR THE SMALLEST PROGRAM TO USE
	IORI	TE,777		;ROUND UP TO NEAREST PAGE
	JRST	SETCOR##

SETI3:	POP	TE,0(TE)	;STANDARD POP REVERSE BLT CODE
	JUMPL	TE,RVBLT	;I.E. JUMPL TE,.-1
	POPJ	PP,
;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,

;GET CURRENT DATE AND TIME

GETDT:
IFN TOPS20,<
	HRROI	T1,STDATE##	;WHERE TO RETURN DATE AND TIME
	SETO	T2,		; OF NOW
	MOVX	T3,OT%NSC	; NO SECONDS
	ODTIM%
	MOVEI	TA,377
	ANDCAM	TA,STDATE+1	;CLEAR LAST SPACE FOR COMPATABILITY
>
IFE TOPS20,<
	DATE	TC,		;GET DATE
	IDIVI	TC,^D31		;TB_(DAY-1)
	PUSHJ	PP,DECONV	;CONVERT TO TWO DECIMAL DIGITS
	DPB	TB,[POINT 14,STDATE,13]

	IDIVI	TC,^D12		;TB_(MONTH-1)
	MOVE	TB,MOTABL(TB)
	LSHC	TB,-16
	IORM	TB,STDATE##
	LSHC	TB,-1
	MOVEM	TA,STDATE+1

	MOVEI	TB,^D63(TC)	;TB_(YEAR-1)
	CAIL	TB,^D100-1	;CK FOR YEAR 2000+
	SUBI	TB,^D100	;IF SO, CHANGE TO 00+
	PUSHJ	PP,DECONV
	DPB	TB,[POINT 14,STDATE+1,27]
	CALLI	TC,$TIME	;GET TIME
	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]
	SETOM	MYPATH##	;MY JOB,,GET PATH FUNCTION
	MOVE	TA,[11,,MYPATH]
	PATH.	TA,		;GET DEFAULT PATH
	  SETZM	MYPPN##		;FAILED
>
	POPJ	PP,


IFE TOPS20,<
;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 SINGLE LETTER
	MOVEI	CH,'A'		;IT IS DOUBLE LETTER
	MOVEI	TE,-1(TE)
GTVER1:	SUBI	TE,^D26
	CAILE	TE,^D25
	AOJA	CH,GTVER1
GTVER2:	IDPB	CH,TC
GTVER3:	ADDI	TE,'A'
	IDPB	TE,TC

GTVER4:	HRRZ	TE,.JBVER##	;GET PATCH NUMBER
	JUMPE	TE,GTVER5	;IF ZERO, DON'T PRINT IT
	MOVEI	CH,'('
	IDPB	CH,TC
	PUSHJ	PP,GTVER8
	MOVEI	CH,')'
	IDPB	CH,TC

GTVER5:	LDB	TE,[POINT 3,.JBVER,2] ;GET EDITOR
	JUMPE	TE,CPOPJ##	;IF PDP-10 DEVELOPMENT, DON'T PRINT IT
	MOVEI	CH,'-'
	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'
	IDPB	TE,TC
	POPJ	PP,
IFE TOPS20,<

;GET IN "DEV:FILE.EXT[PROJ,PROG]/X"

GETFIL:	MOVEI	TA,1(DA)
	HRLI	TA,(DA)
	SETZM	(DA)
	BLT	TA,-1+DEVSIZ##(DA)

	TSWFZ	FCOMWD;		;DEVICE WAITING?
	JRST	GETFL6		;YES

GETFL1:	PUSHJ	PP,GETSIX	;NO--GET ONE
	CAIN	CH,":"		;":"?
	JRST	GETFL7		;YES

GETFL2:	CAIE	CH,"="		;"="?
	CAIN	CH,","		;","?
	JRST	GTFL4A		;YES

	CAIN	CH,"."		;"."?
	JRST	GETFL5		;YES

	CAIN	CH,"["		;"["?
	JRST	GETFL8		;YES

	CAIN	CH,$CR		;END OF COMMAND?
	JRST	GETFL4		;YES

	CAIN	CH,"/"		;SWITCH?
	JRST	GETFL9		;

	CAIN	CH,"-"
	JRST	GTFL8H

	CAIN	CH,"("
	JRST	GTFL13

	CAIN	CH,"@"
	JRST	GTFL12

	CAIN	CH,"!"
	JRST	GTFL14

	CAIE	CH," "		;SPACE?
	JRST	BADKAR		;NO--BAD CHARACTER

	PUSHJ	PP,COMKAR	;YES--GET NEXT CHARACTER

GTFL2A:	CAIN	CH," "		;ANOTHER SPACE?
	JRST	.-2		;YES--LOOP

	CAIG	CH,"Z"		;NO--LETTER?
	CAIGE	CH,"A"
	SKIPA			;NO
	JRST	GETFL3		;TREAT IT LIKE COMMA

	CAIG	CH,"9"		;NOT LETTER--DIGIT?
	CAIGE	CH,"0"
	JRST	GETFL2		;NO--TRY PUNCTUATION
GETFL3:	MOVEI	CH,","		;LETTER OR 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,CPOPJ
	SKIPE	DEVFIL(DA)
	JRST	BADSTR
	MOVEM	TA,DEVFIL(DA)
	POPJ	PP,

;DOT--STASH FILE-NAME, GET EXTENSION

GETFL5:	SKIPE	DEVEXT(DA)
	JRST	BADSTR
	PUSHJ	PP,GTFL4B
	PUSHJ	PP,GETSIX
	HLLZM	TA,DEVEXT(DA)
	AOS	DEVEXT(DA)	;[530] TURN ON .(DOT) SEEN FLAG 
	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
	MOVEM	TA,DEVDEV(DA)	;NO--STASH IN DEVICE ENTRY
	JRST	GETFL1

GTFL7A:	SWON	FCOMWD;		;YES--SET "REGET WORD"
	POPJ	PP,
;BRACKET--GET PROJ,PROG

GETFL8:	PUSHJ	PP,GTFL4B
	PUSHJ	PP,GETNUM	;GET PROJ
	  JRST	[CAIN	CH,"-"		;HYPHEN?
		JRST	[SETZB	TA,DEVPP(DA)	;YES, MEANS DEFAULT
			PUSHJ	PP,COMKAR	;GET NEXT
			JRST	GTFL8A]		;CHECK END
		CAIE	CH,","		;COMMA?
		JRST	BADPPN		;ERROR
		HLRZ	TA,MYPPN	;GET DEFAULT
		JRST	.+1]
	CAIE	CH,","		;COMMA SEPERATOR?
	JRST	BADPPN		;NO--ERROR

	MOVSM	TA,DEVPP##(DA)	;YES--STASH

	PUSHJ	PP,GETNUM	;GET PROG
	  JRST	[CAIE	CH,","		;COMMA?
		CAIN	CH,"]"		;OR END?
		SKIPA	TA,MYPPN	;GET DEFAULT
		JRST	BADPPN		;ERROR
		JRST	.+1]
	HRRM	TA,DEVPP(DA)	;STASH
	CAIE	CH,","		;SFD'S TO FOLLOW?
	JRST	GTFL8A		;NO
	MOVEI	TA,DEVPTH##(DA)	;GET PATH POINTER
	EXCH	TA,DEVPP(DA)	;SWAP WITH PPN
	MOVEM	TA,DEVDIR##(DA)	;AND PUT IN PATH BLOCK
	PUSH	PP,DA
	HRLI	DA,-5		;FORM AOBJN POINTER
GTFL8B:	PUSHJ	PP,GETSIX	;YES, GET IT
	MOVEM	TA,DEVSFD##(DA)
	CAIN	CH,","		;MORE?
	AOBJN	DA,GTFL8B	;YES
	POP	PP,DA
GTFL8A:	CAIE	CH,"]"		;"]"?
	JRST	BADPPN		;NO--ERROR
	JRST	GETFL1


;HYPHEN -- IT SHOULD BE ALONE

GTFL8H:	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	GTF12A		;YES

	PUSHJ	PP,GETFIL	;NO--SCAN SOME MORE
	HLLZS	DEVEXT(DA)	;[530] CLEAR .(DOT) SEEN FLAG IF SET
	JRST	GTF12B

GTF12A:	PUSHJ	PP,COMKAR

GTF12B:	CAIE	CH,$CR
	JRST	BADSTR

	CALLI	$RESET

	SKIPN	I2,DEVDEV(DA)
	MOVSI	I2,'DSK'
	MOVEI	I1,.IOASC
	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'(I4)
	LSHC	I0,-6
	SOJG	I2,.-3
	HRRI	I1,'COB'

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
	PUSHJ	PP,GETFIL	;[530]
	HLLZS	DEVEXT(DA)	;[530] CLEAR .(DOT) SEEN FLAG IF SET
	POPJ	PP,		;[530]

GTF12H:	MOVSI	I2,'CCL'
	LOOKUP	COM,I1
	  TDZA	I2,I2
	JRST	GTF12G
	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:	SKIPN	TE,DEVDEV(DA)	;GET USER DEVICE
	MOVSI	TE,'SYS'	;DEFAULT TO SYS
	SKIPN	TD,DEVFIL(DA)	;FILE
	MOVE	TD,TA		;IT HAS'NT BEEN STORED YET
	HLLZ	TC,DEVEXT(DA)	;EXTENSION
	SETZB	TB,PP		;CLEAR PROT/DATE AND CORE ARG
	MOVE	TA,DEVPP(DA)	;PPN
	MOVE	CH,[XWD 1,TE]
	RUN	CH,
	  HALT	.+1

	TYPE	[ASCIZ /?CBLRUR RUN UUO returned to COBOL: Monitor error
/]
	CALLI	$EXIT

;DETERMINE TYPE OF SWITCH

SWICH:	CAIL	CH,"A"		;RANGE CHECK SWITCH
	CAILE	CH,"Z"
	JRST	BADCSW		;NOT IN RANGE
	XCT	SWTAB-"A"(CH)	;SET SWITCH
	POPJ	PP,
SWTAB:
	SWON	FOBJEC;		;A - TURN ON "/A"
	SETOM	DEBSW##		;B - GENERATE DEBUG CODE
	SETOM	CREFSW		;C - SET '/C'
	JRST	SWICHD		;D - SET /D:nnnnnn 
	SWON	FFATAL;		;E - TURN ON "/E"
IFN DEBUG,<
	JRST	SWICHF		;F -
>
IFE DEBUG,<
	JRST	BADCSW
>
	SETOM	NOCPYL##	;G - TURN ON DON'T LIST LIBRARY FILE
	SWON	FHELP		;H - TURN ON /H
	JRST	SWICHI		;I - DO NOT GENERATE START ADDRESS
	JRST	SWICHJ		;J - GENERATE START ADDRESS NO MATTER WHAT
IFN DEBUG,<
	JRST	SWICHK		;K -
>
IFE DEBUG,<
	JRST	BADCSW
>
	JRST	SWICHL		;L -
	SWON	FMAP;		;M - TURN ON "/M"
	SWOFF	FTERA		;N - TURN OFF 'WE'R TYPING ERRORS'
	SETOM	OPTSW##		;O - SET /O - OPTIMIZATION REQUIRED
	SETOM	PRODSW##	;P - SET '/P' - PRODUCTION MODE REQUIRED
	JRST	SWICHQ		;Q - SET '/Q' - QUICK MODE (NO ERROR CHECKING + /P + /O)

	JRST	SWICHR		;R - TURN ON "/R"
	SWON	FSEQ;		;S - TURN ON "/S"
IFN DEBUG,<
	JRST	SWICHT		;T - TRACE
>
IFE DEBUG,<
	JRST	BADCSW
>
	JRST	SWICHU		;U - TURN OFF "/R"
	JRST	SWICHV		;V - SET ANSI STANDARD (74 OR 82)
	JRST	SWICHW		;W -
	JRST	SWICHX		;X - DEFAULT THINGS TO EBCDIC INSTEAD OF SIXBIT.
	JRST	SWICHY		;Y - SET FIPS FLAGGER LEVEL
	JRST	SWICHZ		;Z -
SWICHI:	SKIPE	SLASHJ		;IF WE HAVE ALREADY SEEN /J
	JRST	BADIJ		;GIVE ERROR MESSAGE
	SETOM	SUBPRG		;DO NOT GENERATE START ADDRESS
	POPJ	PP,

SWICHJ:	SKIPE	SUBPRG		;IF WE HAVE ALREADY SEEN /I
	JRST	BADIJ		;GIVE ERROR MESSAGE
	SETOM	SLASHJ		;GENERATE START ADDRESS NO MATTER WHAT
	POPJ	PP,

BADIJ:	MOVEI	TB,[ASCIZ \?Switches /I and /J are mutually exclusive.\]
	JRST	BADCOM

SWICHR:	SKIPGE	SEENRU##	;IF WE HAVE ALREADY SEEN /U
	JRST	BADRU		;GIVE ERROR MESSAGE
	SWON	FREENT		;R - TURN ON "/R"
	AOS	SEENRU		;SET FLAG +1
	POPJ	PP,

SWICHU:	SKIPLE	SEENRU		;IF WE HAVE ALREADY SEEN /R
	JRST	BADRU		;GIVE ERROR MESSAGE
	SWOFF	FREENT		;U - TURN OFF "/R"
	SETOM	SEENRU		;SET FLAG -1
	POPJ	PP,


BADRU:	MOVEI	TB,[ASCIZ \?Switches /R and /U are mutually exclusive.\]
	JRST	BADCOM

SWICHL:	MOVEI	TA,FL.LIB	;SET "L" FLAG IN TABLE
	JRST	SWZWL

SWICHQ:	SETOM	OPTSW		;/O
	SETOM	PRODSW		;/P
	SETOM	QUIKSW##	;/Q
	POPJ	PP,

SWICHV:	PUSHJ	PP,COMKAR	;/V
	CAIE	CH,":"		;IS NEXT CHAR A ":"
	JRST	SWCHV1		;NO TOGGLE THE DEFAULT
	PUSHJ	PP,COMKAR	;GET THE NEXT CHARACTER
	CAIN	CH,"7"		;CHECK FOR 74
	JRST	SWCHV7		;ITS 74
	CAIN	CH,"8"		;TRY FOR 82
	JRST	SWCHV8		;FOUND IT
SWCHVE:	MOVEI	TB,[ASCIZ /?Bad V switch/]
	JRST	BADCOM

SWCHV1:
IFL ANS82,<
	MOVEI	TA,1
	MOVEM	TA,AS7482	;DEFAULT TO ANS 82 STANDARD
	MOVSI	TA,(SW.A74)
>
IFG ANS82,<
	SETOM	AS7482		;DEFAULT TO ANS 74 STANDARD
	MOVSI	TA,(SW.A82)
>
	IORM	TA,COBXSW##	;WILL STORE IN FEATURE TEST LATER
	JRST	SWCHVR		;REGET THE CHARACTER

SWCHV7:	SETOM	AS7482##	;SET TO ANS 74 STANDARD
	MOVSI	TA,(SW.A74)
	IORM	TA,COBXSW
	PUSHJ	PP,COMKAR	;SEE IF USER TYPED /V:74
	CAIE	CH,"4"
	JRST	SWCHV9		;NO
	POPJ	PP,		;YES

SWCHV8:	MOVEI	TA,1
	MOVEM	TA,AS7482	;SET TO ANS 82 STANDARD
	MOVSI	TA,(SW.A82)
	IORM	TA,COBXSW
	PUSHJ	PP,COMKAR	;SEE IF USER TYPED /V:8x
	CAIL	CH,"0"		;ALLOW ANY DIGIT FOR NOW
	CAILE	CH,"9"
	CAIN	CH,"X"		;OR 8X
	POPJ	PP,		;YES
SWCHV9:	PUSHJ	PP,SWCHD5	;SEE IF VALID TERMINATOR
SWCHVR:	  SWONS	FCOMCH		;YES, REGET THE CHARACTER
	JRST	SWCHVE		;NO, GIVE ERROR
	POPJ	PP,

SWICHZ:	MOVEI	TA,FL.ZRO	;SET "Z" FLAG IN TABLE
	JRST	SWZWL

SWICHW:	MOVEI	TA,FL.REW	;SET "W" FLAG IN TABLE

SWZWL:	IORM	TA,DEVSW(DA)
	POPJ	PP,

SWICHX:	HRROI	TA,%US.EB	;DISPLAY-9
	MOVEM	TA,DEFDSP##	;SET DEFAULT MODE
	POPJ	PP,

IFE MPWCEX,<
SWICHD:	MOVEI	TB,	[ASCIZ -?/D is not allowed, for multiple PERFORMs with a common exit
reassemble the compiler and OTS with MPWCEX==1-]
	JRST		BADCOM
>
IFN MPWCEX,<
SWICHD:	PUSHJ	PP,	COMKAR		;GET THE NEXT CHAR.
	CAIE	CH,	":"		;IF IT'S NOT ":"
	JRST		SWCHD3		; IT'S AN ERROR.
	MOVEI	TA,	6		;SET THE MAXIMUM NUMBER OF
	MOVEM	TA,	OJPPSZ+1	; DIGITS ALLOWED.
	PUSHJ	PP,	COMKAR		;GET THE FIRST ONE.
	CAIG	CH,	"7"		;IS IT OCTAL?
	CAIGE	CH,	"0"
	JRST		SWCHD2		;NO, ERROR.

SWCHD1:	MOVE	TA,	OJPPSZ##	;GET THE OLD SIZE.
	LSH	TA,	3		;MULTIPLY IT BY 8.
	ADDI	TA,	-"0"(CH)	;ADD IN THIS DIGIT.
	MOVEM	TA,	OJPPSZ		;SAVE IT.
	SOSG		OJPPSZ+1	;CAN THERE BE MORE?
	POPJ	PP,			;NO, RETURN.
	PUSHJ	PP,	COMKAR		;GET THE NEXT CHAR.
	CAIG	CH,	"7"		;OCTAL DIGIT?
	CAIGE	CH,	"0"
	JRST		SWCHD4		;NO, GO SEE WHAT IT IS.
	JRST		SWCHD1		;GO ADD IT IN.

;COME HERE IF THE FIRST CHAR IN THE VALUE FIELD IS NOT AN OCTAL DIGIT.

SWCHD2:	PUSHJ	PP,	SWCHD5		;GO SEE WHAT IT IS.
	SKIPA	TB,	[Z	[ASCIZ	-?Missing value in /D switch.-]]
SWCD2A:	MOVEI	TB,	[ASCIZ -?Bad value in /D switch.-]
	JRST		BADCOM

SWCHD3:	MOVEI	TB,	[ASCIZ -?Missing ":" in /D:nnnnnn switch.-]
	JRST		BADCOM

;COME HERE IF WE FIND A NON OCTAL DIGIT.

SWCHD4:	PUSHJ	PP,	SWCHD5		;GO SEE WHAT IT IS.
SWCHRC:	  SWONS		FCOMCH		;REMEMBER TO REGET THE CHAR.
	JRST		SWCD2A		;BAD VALUE.
	POPJ	PP,			;RETURN.

SWCHD5:	AOS		(PP)
	CAIE	CH,	","
	CAIN	CH,	"="
	SOS		(PP)
	CAIE	CH,	$CR
	CAIN	CH,	"/"
	SOS		(PP)
	POPJ	PP,
>
SWICHY:	SETZM	FLGSW##		;START OFF CLEAN
	PUSHJ	PP,COMKAR	;GET NEXT CHAR.
	CAIE	CH,":"		;MUST BE COLON
	JRST	SWCHYE		;IF NOT ITS AN ERROR
	PUSHJ	PP,COMKAR	;GET THE FIRST CHAR.
	CAIN	CH,"-"		;MINUS IS SPECIAL
	JRST	[PUSHJ	PP,SWCHYA	;YES, GET THE SWITCH MASK
		MOVE	CH,FLGSW	;GET THE MASK
		TRNE	CH,%LV.L	;NOW TURN ON ALL INCLUDED FIPS FLAGS
		TROA	CH,%LV.LI	;LOW IMPLIES LOW-INTERMEDIATE ETC
		TRNE	CH,%LV.LI
		TROA	CH,%LV.HI
		TRNE	CH,%LV.HI
		TRO	CH,%LV.H
		SETCAM	CH,FLGSW	;COMPLIMENT IT
		POPJ	PP,]
	PUSHJ	PP,SWCHYB	;NO, GET THE MASK
	MOVE	CH,FLGSW	;GET THE MASK
	TRNE	CH,%LV.H	;NOW TURN ON ALL INCLUDED FIPS FLAGS
	TROA	CH,%LV.HI	;HIGH IMPLIES HIGH-INTERMEDIATE ETC
	TRNE	CH,%LV.HI
	TRO	CH,%LV.LI
	TRO	CH,%LV.L	;ALWAYS TURN ON LOW-LEVEL
	MOVEM	CH,FLGSW	;PUT FLAGS BACK
	POPJ	PP,

SWCHYA:	PUSHJ	PP,COMKAR	;GET THE CHAR.
SWCHYB:	CAIG	CH,"9"		;IS IT A DIGIT?
	CAIGE	CH,"0"		;...
	JRST	SWCHYC		;NO
	XCT	[JRST	SWCHYE		;0 - ILLEGAL
		MOVEI	CH,%LV.L	;1 - LOW
		MOVEI	CH,%LV.LI	;2 - LOW-INTERMEDIATE
		MOVEI	CH,%LV.HI	;3 - HIGH-INTERMEDIATE
		MOVEI	CH,%LV.H	;4 - HIGH
		JRST	SWCHYE		;5 - ERROR
		MOVEI	CH,%LV.68	;6 - COBOL-68
		JRST	SWCHYE		;7 - ERROR
		MOVEI	CH,%LV.8	;8 - COBOL-8x
		JRST	SWCHYE		;9 - ERROR
		]-"0"(CH)
SWCHYD:	IORM	CH,FLGSW	;STORE NEW MASK BITS
	JRST	SWCHYA		;LOOP

SWCHYC:	CAIG	CH,"Z"		;IS IT A LETTER?
	CAIGE	CH,"A"		;...
	JRST	SWCHRC		;NO
	CAIN	CH,"D"		;DBMS?
	MOVSI	CH,%LV.DB	;YES
	CAIN	CH,"I"		;IBM  COMPATIBILITY?
	MOVSI	CH,%LV.IB	;YES
	CAIN	CH,"N"		;NON-STANDARD EXTENSION?
	MOVSI	CH,%LV.NS	;YES
	CAIN	CH,"R"		;REPORT WRITER?
	MOVSI	CH,%LV.RP	;YES
	CAIN	CH,"V"		;VAX-COBOL?
	MOVSI	CH,%LV.VX	;YES
	TRNE	CH,-1		;DID WE FIND SOMETHING?
	JRST	SWCHYE		;NO
	MOVS	CH,CH
	JRST	SWCHYD		;YES

SWCHYE:	MOVEI	TB,[ASCIZ /?Bad Y switch/]
	JRST	BADCOM
IFN DEBUG,<
;TO HANDLE "T" SWITCHES WHEN DEBUGGING

SWICHT:	PUSHJ	PP,COMKAR
	CAIN	CH,":"		;IF ITS A COLON
	PUSHJ	PP,COMKAR	;EAT IT UP
	MOVEI	TA,0
	CAIN	CH,"A"		;TEST FOR ALL
	MOVEI	TA,TRACEI!TRACEE!TRACED!TRACEP
	CAIN	CH,"I"
	HRRZI	TA,TRACEI
	CAIN	CH,"E"
	HRRZI	TA,TRACEE
	CAIN	CH,"D"
	HRRZI	TA,TRACED
	CAIN	CH,"P"
	HRRZI	TA,TRACEP

	IORM	TA,CORESW##
	JUMPE	TA,SWCHTE	;ERROR
	SETOM	TRACFL##	;INIT ALLOW SYNTAX SCAN TRACING
	PUSHJ	PP,COMKAR	;GET NEXT CHARACTER
	CAIE	CH,":"		;RANGE TO FOLLOW?
	JRST	SWCHRC		;NO
	PUSHJ	PP,GETDEC	;GET FIRST LINE NUMBER
	MOVEM	TA,TRCLN1##	;STORE FIRST
	PUSHJ	PP,COMKAR	;GET HYPHEN
	CAIE	CH,"-"
	JRST	SWCHTE		;NO!
	PUSHJ	PP,GETDEC	;GET SECOND LINE NUMBER
	MOVEM	TA,TRCLN2##	;STORE IT
	POPJ	PP,		;RETURN

SWCHTE:	MOVEI	TB,[ASCIZ /?Bad T switch/]
	JRST	BADCOM

;PICK UP AN DECIMAL NUMBER

GETDEC:	MOVEI	TA,0		;CLEAR THE SUM
	PUSHJ	PP,COMKAR	;GET FIRST CHARACTER
	CAIN	CH," "		;SPACE?
	JRST	.-2		;YES--IGNORE IT

GETDC1:	CAIG	CH,"9"		;DECIMAL DIGIT?
	CAIGE	CH,"0"
	JRST	SWCHRC		;NO
	IMULI	TA,^D10		;YES--ADD TO SUM
	ADDI	TA,-"0"(CH)
	PUSHJ	PP,COMKAR	;GET NEXT DIGIT
	JRST	GETDC1		;LOOP
;TO HANDLE "K" SWITCH WHEN DEBUGGING

SWICHK:	PUSHJ	PP,COMKAR
	CAIN	CH,":"		;IF ITS A COLON
	PUSHJ	PP,COMKAR	;EAT IT UP
	CAIG	CH,"G"
	CAIGE	CH,"A"
	JRST	SWCHKA

	HRLZI	TA,%KILLA
SWCHKB:	LSH	TA,-"A"(CH)
	IORM	TA,CORESW
	POPJ	PP,

SWCHKA:	MOVEI	TB,[ASCIZ /?Bad K switch/]
	JRST	BADCOM

;TO HANDLE "F" SWITCH WHEN DEBUGGING

SWICHF:	PUSHJ	PP,COMKAR
	CAIN	CH,":"		;IF ITS A COLON
	PUSHJ	PP,COMKAR	;EAT IT UP
	CAIG	CH,"G"
	CAIGE	CH,"A"
	JRST	SWCHFA

	HRLZI	TA,%KILFA
	JRST	SWCHKB

SWCHFA:	MOVEI	TB,[ASCIZ /?Bad F switch/]
	JRST	BADCOM
>
;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 LETTER--DIGIT?
	CAIGE	CH,"0"
	POPJ	PP,		;NO--RETURN
	JRST	GETSX3		;YES--STASH IT


;PICK UP AN OCTAL NUMBER

GETNUM:	MOVEI	TA,0		;CLEAR THE SUM
	PUSHJ	PP,COMKAR	;GET FIRST CHARACTER
	CAIN	CH," "		;SPACE?
	JRST	.-2		;YES--IGNORE IT
	CAIE	CH,","		;COMMA?
	CAIN	CH,"-"		;OR HYPHEN?
	POPJ	PP,		;YES, THEY ARE SPECIAL
	CAIN	CH,"]"		;SO IS ]
	POPJ	PP,		;IF FIRST

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 GT. 777777?
	JRST	BADPPN		;YES--ERROR

	PUSHJ	PP,COMKAR	;NO--GET NEXT DIGIT
	JRST	GETNM1		;LOOP

GETNM2:	JUMPE	TA,BADPPN	;SUM = 0?
	AOS	(PP)		;SKIP RETURN IF OK
	POPJ	PP,		;NO--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,$CR		;IGNORE CARRIAGE-RETURNS
	JRST	COMKAR

COMKRA:	CAIG	CH,"z"		;[255] BETWEEN LC Z AND LC A?
	CAIGE	CH,"a"
	CAIA			;NOT LC
	SUBI	CH,40		;YES, CONVERT TO UC

	CAIN	CH,$CZ		;END-FILE?
	JRST	COMKR9		;YES

	CAIE	CH,$LF
	CAIN	CH,$FF
	JRST	COMK99

	CAIN	CH,$ALT		;TREAT ALTMODE AS EOL
	JRST	COMK99

	POPJ	PP,
;GET NEXT BUFFER FULL OF COMMANDS

COMKR2:	SKIPN	COMBH		;FROM TMPCOR?
	JRST	COMK2B		;YES--NO MORE

	IN	COM,		;GET NEXT BUFFER
	  JRST	COMKR1		;NO ERRORS--RETURN

	GETSTS	COM,CH		;ERROR--GET DEVICE STATUS
	TXNE	CH,IO.ERR	;ANY ERROR FLAGS UP?
	JRST	COMKR8		;YES--WE LOSE

	CLOSE	COM,		;CLOSE COMMAND FILE

	MOVE	CH,COMEXT	;IS EXTENSION
	CAIE	CH,'TMP'	;  "TMP"?
	JRST	COMK2A		;NO--DON'T DELETE

	MOVEI	CH,0		;DELETE
	RENAME	COM,CH		;  COMMAND
	  JFCL			;  FILE
COMK2A:	RELEASE	COM,		;RELEASE IT
	JRST	COMKR3

;GET RID OF TMPCOR AREA

COMK2B:	MOVSI	CH,'COB'
	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,$CR		;RETURN A CARRIAGE-RETURN
	POPJ	PP,
;REGET SAME CHARACTER

COMKR6:	LDB	CH,COMBH+1	;FROM DISK OR TMPCOR
	JRST	COMKRA		; GO CHECK FOR LC [255]


;READ ERROR--WE LOSE

COMKR8:	TYPE	[ASCIZ/?CBLTEC Transmission error on command file/]
	CALLI	$EXIT


;AN EOF WAS SEEN

COMKR9:	PUSHJ	PP,COMK99
	JRST	COMKR3


;TYPE OUT <C.R.>, <L.F.> IF INPUT FROM TTY

COMK99:	TSWT	FDSKC;
	TYPE	CRLF
	JRST	COMKR4

CRLF:	ASCIZ/
/
;HELP ROUTINE

HELP:	MOVE	1,[SIXBIT "COBOL"]	;YES, PRINT COBOL.HLP
	PUSHJ	PP,.HELPR##
				;[1435] IGNORE ALL ELSE IN COMMAND STRING
	AND	SW,[EXP FDSKC]	;[1435] CLEAR ALL SWITCHES EXCEPT FDSKC
	JRST	COBLAR		;[1435] GET NEXT LINE
;ERROR ROUTINES

IFE ONESEG,<
;"DSK" IS NOT A DISK

NOTDSK:	TYPE	[ASCIZ/?CBLDND "DSK" is not a disk
/]
	CALLI	$EXIT
>

;TOO MANY OUTPUT FILES

TUMANY:	MOVEI	TB,[ASCIZ /?CBLICC Improper COBOL command/]
	JRST	BADCOM

;BINARY DEVICE CANNOT DO BINARY

BADBIN:	MOVEI	TB,[ASCIZ/: cannot write in binary/]
	JRST	TYPEIT

;OUTPUT DEVICE CANNOT DO OUTPUT

BADOUT:	MOVEI	TB,[ASCIZ/: cannot do output/]
	JRST	TYPEIT

;SOURCE FILE IS NOT AN INPUT DEVICE

NOTIN:	MOVEI	TB,[ASCIZ/: cannot do input/]

TYPEIT:	MOVEI	CH,"?"
	OUTCHR	CH
	MOVE	TA,DEVDEV(DA)
	PUSHJ	PP,SIXOUT##
	JRST	BADCOM
;ERROR ROUTINES (CONT'D)

;SOMETHING STRANGE ABOUT STRING
BADSTR:	MOVEI	TB,[ASCIZ/?CBLICC improper COBOL command/]
	JRST	BADCOM

;COMMAND DEVICE UNAVAILABLE
NOCOMD:	MOVEI	TB,[ASCIZ/?CBLCDA Indirect command device unavailable/]
	JRST	BADCOM

;COMMAND FILE CANNOT BE FOUND
NOCOMF:	MOVEI	TB,[ASCIZ/?CBLCFC Cannot find command file/]
	JRST	BADCOM

;NAME TOO LONG

BADNAM:	MOVEI	TB,[ASCIZ/?CBLNM6 Name of more than six characters/]
	JRST	BADCOM

;BAD PROJECT-PROGRAMMER NUMBER
BADPPN:	MOVEI	TB,[ASCIZ/?CBLIPP Improper project-programmer number/]
	JRST	BADCOM

;IMPROPER CHARACTER IN STRING
BADKAR:	MOVEI	TB,[ASCIZ/?CBLICC Improper character in command/]
	JRST	BADCOM

;BAD SWITCH
BADCSW:	MOVEI	TB,"?"
	OUTCHR	TB
	OUTCHR	CH
	MOVEI	TB,[ASCIZ/ is not a legal switch/]
	JRST	BADCOM

;ERRORS WHILE INITIALIZING THE DEVICE

;NOT A LEGAL DEVICE
NOTDEV:	MOVEI	TB,[ASCIZ/: is not a legal device/]

	MOVEI	CH,"?"
	OUTCHR	CH
	MOVE	TA,DEVDEV(DA)
	PUSHJ	PP,SIXOUT
	JRST	BADCOM
;ERROR ROUTINES  (CONT'D).

;NO FILE FOR DIRECTORY DEVICE
NOFILE:	TYPE	[ASCIZ/?CBLNFN No file name for /]
	PUSHJ	PP,FILOUT##	;[1435] TYPE DEVICE
	JRST	BADC0

;TOO MANY SOURCE FILES
NOROOM:	MOVEI	TB,[ASCIZ/?CBLTMS Too many source files/]
	JRST	BADCOM

;NO SOURCE FILES AT ALL
NOSRC:	TSWFZ	FHELP		;IS /H ON?
	JRST	HELP		;YES, OK
	MOVEI	TB,[ASCIZ/?CBLNSF No source files specified/]

;TYPE OUT MESSAGE AND RESTART COMPILATION

BADCOM:: TYPE	<(TB)>
BADC0:	TYPE	CRLF

	TSWT	FDSKC		;[1435] IF COMMANDS ARE FROM TTY: RESTORE LAST CHAR
	SWON	FCOMCH		;[1435] IN CASE <CR-LF> WAS ILLEGAL CHARACTER
BADC1:	TSWF	FESRC!FECOM	;END OF COMMAND STRING?
	JRST	BADC2		;YES
	PUSHJ	PP,COMKAR	;NO--GET CHARACTER
	CAIE	CH,$CR		;CARRIAGE-RETURN?
	JRST	BADC1		;NO--LOOP

BADC2:	TSWT	FDSKC		;COMMANDS FROM TTY?
	JRST	START1		; [344] YES
	EXIT			;[1435] NO, GIVE UP
;ERROR ROUTINES  (CONT'D).
;LIBRARY DEVICE IMPROPER
BADLIB:	MOVEI	TB,[ASCIZ/?CBLMBD Library device must be DSK/]
	JRST	BADCOM


;CANNOT ENTER A FILE

NOENTR:	TYPE	[ASCIZ/?CBLCEF Cannot ENTER /]
	JRST	ERATYP##


;NOT ENOUGH CORE TO CONTINUE COMPILATION
NOTNUF:	TYPE	[ASCIZ/?CBLNEC Not enough core to continue compilation
/]
	JRST	RESTRT##
>;END IFE TOPS20

;DOUBLE NAMTAB ENTRY

DBLNAM:	TYPE	[ASCIZ/?COBOLA: NAMTAB entry duplicated
/]
	JRST	KILL##
;THIS ROUTINE IS MOVED TO THE LOW-SEGMENT
;NOTE, IMPURE MUST BE CHANGED TO MATCH ANY CHANGES TO THESE DEFINITIONS

IFE ONESEG,<

%WEDID:	JRST	@WEDIED+1	;GO TO "KILL" ROUTINE
	Z

%CANT:	TYPE	<WEDIED+%CANT+2-%WEDID>
	CALLI	$EXIT
	ASCIZ	/?CBLCNR Cannot restart/

%GETLD:	MOVEM	17,SAVEAC##+17	;SAVE
	MOVEI	17,SAVEAC	;  ALL
	BLT	17,SAVEAC+16	;  AC'S
	MOVEI	1,WEDIED+%CANT-%WEDID	;SET UP "REENTR" TO GO TO ERROR
	HRRM	1,.JBREN##
	HRRM	1,.JBSA
	MOVSI	1,1		;THROW AWAY
	CORE	1,		;  THE HI-SEGMENT
	  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
IFN DEBUG,<SETZM	.JBSYM##>

%DDTST:	JRST	COBEXO##	;GO TO HI-SEGMENT
>;END ONESEG CONDITIONAL
IFE TOPS20,<
;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	'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

;DEFAULT FOR LIBRARY FILE

LIBSET:	SIXBIT "DSK"
	SIXBIT "LIBARY"
	SIXBIT "LIB"
	Z

;TABLE OF MONTHS

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,H),<
	IFDIF <NAM>,<A>,<IFN ^D'B,<
	XWD -^D'B-1,A'LOC
	EXTERNAL A'LOC
	>>>


	XALL

WRKTAB:	TABLES
WRKXWD:	XWD	WRKTAB-.,WRKTAB
	DEFINE PUTVAL (C,D), <Z==.
		XWD X'D,C>

	DEFINE SETVAL (E), <
		.XCREF X'E
		X'E==.-Z>

	DEFINE NTVAL (A,B), <
		XLIST
		PUTVAL A,\I
		SIXBIT "'B' "
		SETVAL \I
		I==I+1
		LIST
		>

	DEFINE PURGIT (E), <
	PURGE	X'E
	>

	SALL
	.XCREF	I,Z
	I==0

NAMDAT:	NTVAL ACCEP.,ACCEPT
	NTVAL ACCES.,ACCESS
	NTVAL ADD.,ADD
	NTVAL ADVAN.,ADVANCING
	NTVAL AFTER.,AFTER
	NTVAL ALL.,ALL
	NTVAL ALLOW.,ALLOWING
	NTVAL ALPHB.,ALPHABETIC
	NTVAL ALSO.,ALSO
	NTVAL ALTER.,ALTER
	NTVAL ALTRN.,ALTERNATE
	NTVAL AND.,AND
	NTVAL ANY.,ANY
	NTVAL APPLY.,APPLY
	NTVAL ARE.,ARE
	NTVAL AREA.,AREA
	NTVAL AREA.,AREAS
	NTVAL ASCND.,ASCENDING
	NTVAL ASCII.,ASCII
	NTVAL ASSGN.,ASSIGN
	NTVAL AT.,AT
	NTVAL AUTHR.,AUTHOR
	NTVAL BASLK.,BASIC:LOCKING
	NTVAL BEFOR.,BEFORE
	NTVAL BINRY.,BINARY
	NTVAL BLANK.,BLANK
	NTVAL BLANK.,BLANKS
	NTVAL BLOCK.,BLOCK
	NTVAL BOTTO.,BOTTOM
	NTVAL BY.,BY
	NTVAL BYTE.,BYTE
	NTVAL CALL.,CALL
	NTVAL CAN.,CANCEL
	NTVAL CD.,CD
	NTVAL CF.,CF
	NTVAL CH.,CH
	NTVAL CHANN.,CHANNEL
	NTVAL CHARA.,CHARACTER
	NTVAL CHARA.,CHARACTERS
	NTVAL CHECK.,CHECK
	NTVAL CHKPT.,CHECKPOINT
	NTVAL CLASS.,CLASS
	NTVAL CLOSE.,CLOSE
	NTVAL COBOL.,COBOL
	NTVAL CODE.,CODE
	NTVAL CDSET.,CODE:SET
	NTVAL COLLA.,COLLATING
	NTVAL COL.,COLUMN
	NTVAL COMMA,COMMA
	NTVAL COMM.,COMMUNICATION
	NTVAL COMP.,COMP
	NTVAL COMP1.,COMP:1
	NTVAL COMP2.,COMP:2
	NTVAL COMP3.,COMP:3
IFN DBMS,<NTVAL COMPIL.,COMPILE>
IFN DEBUG,<NTVAL COMPB.,COMPILER:BREAK:IN:PHASE>
	NTVAL COMP.,COMPUTATIONAL
	NTVAL COMP1.,COMPUTATIONAL:1
	NTVAL COMP2.,COMPUTATIONAL:2
	NTVAL COMP3.,COMPUTATIONAL:3
	NTVAL COMPU.,COMPUTE
	NTVAL CONFG.,CONFIGURATION
	NTVAL CONSL.,CONSOLE
	NTVAL CONTA.,CONTAINS
	NTVAL CONTR.,CONTROL
	NTVAL CONTR.,CONTROLS
	NTVAL COPY.,COPY
	NTVAL CORR.,CORR
	NTVAL CORR.,CORRESPONDING
	NTVAL COUNT.,COUNT
	NTVAL CURR.,CURRENCY
IFN DBMS,<NTVAL CURNT.,CURRENT>
	NTVAL DATA.,DATA
	NTVAL DBKEY.,DATABASE:KEY
	NTVAL DBKEY.,DBKEY
	NTVAL DATE..,DATE
	NTVAL DATEC.,DATE:COMPILED
	NTVAL DATEW.,DATE:WRITTEN
	NTVAL DAY..,DAY
	NTVAL DE.,DE
	NTVAL DEBUG.,DEBUGGING
	NTVAL DECPN.,DECIMAL:POINT
	NTVAL DECLA.,DECLARATIVES
	NTVAL DEFER.,DEFERRED
	NTVAL DELET.,DELETE
	NTVAL DLIMD.,DELIMITED
	NTVAL DLIMR.,DELIMITER
	NTVAL DENSIT,DENSITY
	NTVAL DEPEN.,DEPENDING
	NTVAL DESCN.,DESCENDING
	NTVAL DEST.,DESTINATION
	NTVAL DE.,DETAIL
	NTVAL DISAB.,DISABLE
	NTVAL DISPL.,DISPLAY
	NTVAL DSPL6.,DISPLAY:6
	NTVAL DSPL7.,DISPLAY:7
	NTVAL DSPL9.,DISPLAY:9
	NTVAL DIVID.,DIVIDE
	NTVAL DIVIS.,DIVISION
	NTVAL DOWN.,DOWN
IFN DBMS,<NTVAL DUPL.,DUP
	NTVAL DUPL.,DUPLICATE>
	NTVAL DUPL.,DUPLICATES
	NTVAL DYNAM.,DYNAMIC
	NTVAL EBCDC.,EBCDIC
	NTVAL EGI.,EGI
	NTVAL ELSE.,ELSE
	NTVAL EMI.,EMI
IFN DBMS,<NTVAL EMPTY.,EMPTY>
	NTVAL ENABL.,ENABLE
	NTVAL END.,END
	NTVAL EOP.,END:OF:PAGE
	NTVAL ENTER.,ENTER
	NTVAL ENTRY.,ENTRY
	NTVAL ENVIR.,ENVIRONMENT
	NTVAL EOP.,EOP
IFE TOPS20,<IFN MCS,<NTVAL EPI.,EPI>>
	NTVAL EQUAL.,EQUAL
	NTVAL EQUAL.,EQUALS
	NTVAL ERROR.,ERROR
	NTVAL ESI.,ESI
	NTVAL EVEN.,EVEN
	NTVAL EVERY.,EVERY
IFN DBMS,<NTVAL EXCL.,EXCLUSIVE
	NTVAL EXCL.,EXCL>
	NTVAL EXCEP.,EXCEPTION
	NTVAL EXIT.,EXIT
	NTVAL EXTEN.,EXTEND
	NTVAL FD.,FD
	NTVAL FILE.,FILE
	NTVAL FILEC.,FILE:CONTROL
	NTVAL FILST.,FILE:STATUS
	NTVAL FILLE.,FILLER
	NTVAL FINAL.,FINAL
	NTVAL FIND.,FIND
	NTVAL FIRST.,FIRST
	NTVAL FOOT.,FOOTING
	NTVAL FOR.,FOR
	NTVAL F10.,FORTRAN
	NTVAL FREE.,FREE
	NTVAL FREED.,FREED
	NTVAL FROM.,FROM
	NTVAL GEN.,GENERATE
	NTVAL GET.,GET
	NTVAL GIVIN.,GIVING
	NTVAL GO.,GO
	NTVAL GREAT.,GREATER
	NTVAL GROUP.,GROUP
	NTVAL HEADG.,HEADING
	NTVAL HIVAL.,HIGH:VALUE
	NTVAL HIVAL.,HIGH:VALUES
	NTVAL IO.,I:O
	NTVAL IOCON.,I:O:CONTROL
	NTVAL ID.,ID
	NTVAL ID.,IDENTIFICATION
	NTVAL IF.,IF
	NTVAL IN.,IN
	NTVAL INDEX.,INDEX
	NTVAL INDXD.,INDEXED
	NTVAL INDIC.,INDICATE
	NTVAL INITL.,INITIAL
	NTVAL INIT.,INITIATE
	NTVAL INPUT.,INPUT
	NTVAL IO.,INPUT:OUTPUT
	NTVAL INSRT.,INSERT
	NTVAL INSPC.,INSPECT
	NTVAL INSTA.,INSTALLATION
	NTVAL INTO.,INTO
	NTVAL INVAL.,INVALID
	NTVAL INVOK.,INVOKE
	NTVAL IS.,IS
IFN DBMS,<NTVAL JOURN.,JOURNAL>
	NTVAL JUST.,JUST
	NTVAL JUST.,JUSTIFIED
	NTVAL KEY,KEY
	NTVAL KEY,KEYS;;	;ALLOW PLURAL FORM FOR READABILITY
	NTVAL LABEL.,LABEL
	NTVAL LAST.,LAST
	NTVAL LEAD.,LEADING
	NTVAL LEFT.,LEFT
	NTVAL LNGTH.,LENGTH
	NTVAL LESS.,LESS
	NTVAL LIM.,LIMIT
	NTVAL LIM.,LIMITS
	NTVAL LINAG.,LINAGE
	NTVAL LNGCO.,LINAGE:COUNTER
	NTVAL LINE.,LINE
	NTVAL LINE.,LINES
	NTVAL LINKG.,LINKAGE
	NTVAL LOCK.,LOCK
	NTVAL LOVAL.,LOW:VALUE
	NTVAL LOVAL.,LOW:VALUES
	NTVAL MACRO.,MACRO
	NTVAL MEMOR.,MEMORY
IFN DBMS,<NTVAL MEMBR.,MEMBER>
IFN DBMS,<NTVAL MEMBR.,MEMBERS>
	NTVAL MERG.,MERGE
	NTVAL MSG.,MESSAGE
	NTVAL MODE.,MODE
	NTVAL MODIF.,MODIFY
	NTVAL MODUL.,MODULES
	NTVAL MOVE.,MOVE
	NTVAL MULTP.,MULTIPLE
	NTVAL MULTI.,MULTIPLY
	NTVAL NATIV.,NATIVE
	NTVAL NEGAT.,NEGATIVE
	NTVAL NEXT.,NEXT
	NTVAL NO.,NO
	NTVAL NONE.,NONE
	NTVAL NOT.,NOT
	NTVAL NUMBR.,NUMBER
	NTVAL NUMER.,NUMERIC
	NTVAL OBJEC.,OBJECT:COMPUTER
	NTVAL OCCUR.,OCCURS
	NTVAL ODD.,ODD
	NTVAL OF.,OF
	NTVAL OFF.,OFF
	NTVAL OMITT.,OMITTED
	NTVAL ON.,ON
IFN DBMS,<NTVAL ONLY.,ONLY>
	NTVAL OPEN.,OPEN
	NTVAL OPTIO.,OPT
	NTVAL OPTIO.,OPTIONAL
	NTVAL OR.,OR
	NTVAL ORGAN.,ORGANIZATION
	NTVAL OTHER.,OTHERS
	NTVAL OUTPU.,OUTPUT
	NTVAL OVRFL.,OVERFLOW
IFN DBMS,<NTVAL OWNER.,OWNER>
	NTVAL PAGE.,PAGE
	NTVAL PARIT.,PARITY
	NTVAL PERFO.,PERFORM
	NTVAL PF.,PF
	NTVAL PH.,PH
	NTVAL PIC.,PIC
	NTVAL PIC.,PICTURE
	NTVAL PLS.,PLUS
	NTVAL PNTR.,POINTER
	NTVAL PSTN.,POSITION
	NTVAL PSTNG.,POSITIONING
	NTVAL PSTV.,POSITIVE
	NTVAL PRINT.,PRINTING
IFN DBMS,<NTVAL PRIOR.,PRIOR>
IFN DBMS,<NTVAL PRVCY.,PRIVACY>
	NTVAL PROC.,PROCEDURE
	NTVAL PROC.,PROCEDURES
	NTVAL PROCE.,PROCEED
	NTVAL PGM.,PROGRAM
	NTVAL PGMID.,PROGRAM:ID
IFN DBMS,<NTVAL PROT.,PROT
	NTVAL PROT.,PROTECTED>
	NTVAL PROTC.,PROTECTION
	NTVAL QUEUE.,QUEUE
	NTVAL QUOTE.,QUOTE
	NTVAL QUOTE.,QUOTES
	NTVAL RAND.,RANDOM
	NTVAL RD.,RD
	NTVAL READ.,READ
	NTVAL READR.,READ:REWRITE
	NTVAL READW.,READ:WRITE
	NTVAL RECEV.,RECEIVE
	NTVAL REC.,RECORD
	NTVAL RECRDG,RECORDING
	NTVAL REC.,RECORDS
	NTVAL REDEF.,REDEFINES
	NTVAL REEL.,REEL
	NTVAL REFER.,REFERENCES
	NTVAL RELAT.,RELATIVE
	NTVAL RELEA.,RELEASE
	NTVAL REMAI.,REMAINDER
	NTVAL REMOV.,REMOVE
	NTVAL REMOV.,REMOVAL
	NTVAL RENAM.,RENAMES
	NTVAL REPLA.,REPLACING
	NTVAL REPOR.,REPORT
	NTVAL REPOR.,REPORTS
	NTVAL REPTG.,REPORTING
	NTVAL RERUN.,RERUN
	NTVAL RESER.,RESERVE
	NTVAL RESET.,RESET
	NTVAL RETAI.,RETAIN
	NTVAL RETAD.,RETAINED
IFN DBMS,<NTVAL RETR.,RETRIEVAL
	NTVAL RETR.,RETR>
	NTVAL RETUR.,RETURN
	NTVAL REVER.,REVERSED
	NTVAL REWIN.,REWIND
	NTVAL REWRT.,REWRITE
	NTVAL RF.,RF
	NTVAL RH.,RH
	NTVAL RIGHT.,RIGHT
	NTVAL RMS.,RMS
	NTVAL ROUND.,ROUNDED
	NTVAL RUN.,RUN
IFN DBMS,<NTVAL RNUNT.,RUN:UNIT>
	NTVAL SAME.,SAME
	NTVAL SCHEM.,SCHEMA
	NTVAL SD.,SD
	NTVAL SEARC.,SEARCH
	NTVAL SECT.,SECTION
	NTVAL SECUR.,SECURITY
	NTVAL SGMNT.,SEGMENT
	NTVAL SEGME.,SEGMENT:LIMIT
	NTVAL SELEC.,SELECT
	NTVAL SEND.,SEND
IFN DBMS,<NTVAL SELTV.,SELECTIVE>
	NTVAL SENT.,SENTENCE
	NTVAL SEPER.,SEPARATE
	NTVAL SEQCE.,SEQUENCE
	NTVAL SEQU.,SEQUENTIAL
	NTVAL SET.,SET
IFN DBMS,<NTVAL SET.,SETS>
	NTVAL SIGN.,SIGN
	NTVAL SIXBT.,SIXBIT
	NTVAL SIZE.,SIZE
	NTVAL SORT.,SORT
	NTVAL SRTMG.,SORT:MERGE
	NTVAL SOUR.,SOURCE
	NTVAL SOURC.,SOURCE:COMPUTER
	NTVAL SPACE.,SPACE
	NTVAL SPACE.,SPACES
	NTVAL SPECI.,SPECIAL:NAMES
	NTVAL STAND.,STANDARD
	NTVAL STND1.,STANDARD:1
	NTVAL STDAS.,STANDARD:ASCII
	NTVAL START.,START
	NTVAL STATU.,STATUS
	NTVAL STOP,STOP
	NTVAL STORE.,STORE
	NTVAL STRIN.,STRING
IFN DBMS,<NTVAL SBSCH.,SUB:SCHEMA>
	NTVAL SUBQ1.,SUB:QUEUE:1
	NTVAL SUBQ2.,SUB:QUEUE:2
	NTVAL SUBQ3.,SUB:QUEUE:3
	NTVAL SUBTR.,SUBTRACT
	NTVAL SUM.,SUM
	NTVAL SUPPR.,SUPPRESS
	NTVAL SWTCH.,SWITCH
	NTVAL SYMBL.,SYMBOLIC
	NTVAL SYNCH.,SYNC
	NTVAL SYNCH.,SYNCHRONIZED
	NTVAL TABLE.,TABLE
	NTVAL TLYNG.,TALLYING
	NTVAL TAPE.,TAPE
	NTVAL TERML.,TERMINAL
	NTVAL TERM.,TERMINATE
	NTVAL TEXT.,TEXT
	NTVAL THAN.,THAN
	NTVAL THRU.,THROUGH
	NTVAL THRU.,THRU
	NTVAL TIME..,TIME
	NTVAL TIMES.,TIMES
	NTVAL TO.,TO
	NTVAL TOP.,TOP
	NTVAL TRAC.,TRACE
	NTVAL TRAIL.,TRAILING
	NTVAL TRANS.,TRANSACTION
	NTVAL TYPE.,TYPE
	NTVAL UNAVA.,UNAVAILABLE
	NTVAL UNIT.,UNIT
	NTVAL UNLOC.,UNLOCK
	NTVAL UNSTR.,UNSTRING
	NTVAL UNTIL.,UNTIL
	NTVAL UP.,UP
IFN DBMS,<NTVAL UPDAT.,UPDATE
	NTVAL UPDAT.,UPDATES>
	NTVAL UPON.,UPON
	NTVAL USAGE.,USAGE
IFN DBMS,<NTVAL USGMD.,USAGE:MODE>
	NTVAL USE.,USE
	NTVAL PPN.,USER:NUMBER
	NTVAL USING.,USING
	NTVAL VALUE.,VALUE
	NTVAL VALUE.,VALUES
	NTVAL VARYI.,VARYING
	NTVAL VERB.,VERB
IFN DBMS,<NTVAL VIA.,VIA>
	NTVAL WHEN.,WHEN
	NTVAL WITH.,WITH
IFN DBMS,<NTVAL WITHN.,WITHIN>
	NTVAL WORDS.,WORDS
	NTVAL WORKI.,WORKING:STORAGE
	NTVAL WRITE.,WRITE
	NTVAL ZERO.,ZERO
	NTVAL ZERO.,ZEROES
	NTVAL ZERO.,ZEROS
;ANS-8x RESERVED words

NAMD82:	NTVAL ALPHA.,ALPHABET
	NTVAL ALPHL.,ALPHABETIC:LOWER
	NTVAL ALPHU.,ALPHABETIC:UPPER
	NTVAL ALPHN.,ALPHANUMERIC
	NTVAL ALPHE.,ALPHANUMERIC:EDITED
	NTVAL COMMN.,COMMON
	NTVAL CNTNT.,CONTENT
	NTVAL CONT.,CONTINUE
	NTVAL CONVS.,CONVERSION
	NTVAL CONVT.,CONVERTING
	NTVAL DOW.,DAY:OF:WEEK
	NTVAL ENDXX.,END:ADD
	NTVAL ENDXX.,END:CALL
	NTVAL ENDXX.,END:COMPUTE
	NTVAL ENDXX.,END:DELETE
	NTVAL ENDXX.,END:DIVIDE
	NTVAL ENDXX.,END:ENTER
	NTVAL ENDXX.,END:EVALUATE
	NTVAL ENDXX.,END:FREE
	NTVAL ENDXX.,END:IF
	NTVAL ENDXX.,END:MULTIPLY
	NTVAL ENDXX.,END:OPEN
	NTVAL ENDXX.,END:PERFORM
	NTVAL ENDXX.,END:READ
	NTVAL ENDXX.,END:RECEIVE
	NTVAL ENDXX.,END:RETAIN
	NTVAL ENDXX.,END:RETURN
	NTVAL ENDXX.,END:REWRITE
	NTVAL ENDXX.,END:SEARCH
	NTVAL ENDXX.,END:START
	NTVAL ENDXX.,END:STRING
	NTVAL ENDXX.,END:SUBTRACT
	NTVAL ENDXX.,END:UNSTRING
	NTVAL ENDXX.,END:WRITE
	NTVAL EVAL.,EVALUATE
	NTVAL EXTER.,EXTERNAL
	NTVAL FALSE.,FALSE
	NTVAL GLOBL.,GLOBAL
	NTVAL INITI.,INITIALIZE
	NTVAL NUMED.,NUMERIC:EDITED
	NTVAL ORDER.,ORDER
	NTVAL OTHER.,OTHER
	NTVAL PADD.,PADDING
	NTVAL PURG.,PURGE
	NTVAL REFER.,REFERENCE
	NTVAL RFMOD.,REFERENCE:MODIFIER
	NTVAL REPLC.,REPLACE
	NTVAL STND2.,STANDARD:2
	NTVAL TEST.,TEST
	NTVAL THEN.,THEN
	NTVAL TRUE.,TRUE
	0

IF2,<	I==0
REPEAT 1000,<PURGIT \I
	I==I+1>
	PURGE I,Z
>
	END	COBOLA