; UPD ID= 3528 on 5/7/81 at 10:46 AM by NIXON                           
TITLE	COBOLA FOR COBOL V12B
SUBTTL	COBOL INITIALIZATION		AL BLACKINGTON/CAM



;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, 1981 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P,UUOSYM
	%%P==:%%P
	DBMS==:DBMS
	DEBUG==:DEBUG
	EBCMP.==:EBCMP.
	MPWCEX==:MPWCEX
	BIS==:BIS
	ONESEG==:ONESEG

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

TWOSEG
RELOC	400000
	SALL

DEFINE	TYPE(ADDR),<
	OUTSTR	ADDR
>

;FLAGS USED IN SWITCH SCANNING

FL.LIB==1		;FILE IS A LIBRARY
FL.REW==2		;DEVICE NEEDS REWINDING
IFE TOPS20,<
FL.ZRO==4		;DIRECTORY NEEDS CLEARING
>
;EDIT HISTORY

;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

COBOLA:	PORTAL	START		;COMMANDS FROM TTY
	PORTAL	COMDSK		;COMMANDS FROM DISK
	PORTAL	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:	MOVEI	SW,0		;CLEAR FLAGS

;START A NEW COMPILATION

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

	CALLI	$RESET		;YES

	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

COBLAS:
	SETZM	SUBPRG##	;ASSUME MAIN PROGRAM UNTIL FURTHER NOTICE
	SETZM	SLASHJ##	;CLR /J SWITCH
IFN TOPS20,<
	SWON	FREENT		;ASSUME 2 SEG CODE IF TOPS-20
>
	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)

IFE ONESEG,<
	MOVE	TA,RUNDEV	;IS RUN DEVICE REALLY A DISK?
	DEVCHR	TA,
	TXNN	TA,DV.DSK
	JRST	NOTDSK		;NO--ERROR
> ;END IFE ONESEG
;SET UP IMPURE AREA.
;GET RID OF LEADING CARRIAGE-RETURNS IN COMMAND STRING.

	SETFAZ	A;

	TSWF	FDSKC		;[266] DSK INPUT FOR COMMANDS
	JRST	COBAST		;[266] YES SKIP THIS
	PUSHJ	PP,TTYON##	;[266] TURN ON TTY IF USER TYPED CONT O

	TYPE	[ASCIZ/
*/]
COBAST:				;[266] NEW LABEL
	PUSHJ	PP,SETIMP	;SET UP IMPURE AREA
	PUSHJ	PP,GETDT	;SET UP DATE, TIME AND DEFAULT PATH
	PUSHJ	PP,GETVER	;SET UP VERSION NUMBER

	JRST	TESTCR

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?
IFN ANS68,<
	TYPE	[ASCIZ/COBOL:	/];NO
>
IFN ANS74,<
	TYPE	[ASCIZ/CBL74:	/]; 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
	TSWTZ	FHELP		;/H?
	JRST	SETSR1		;NO
HELP:
IFN ANS68,<
 IFE FT68274,<
	MOVE	1,[SIXBIT "COBOL"]	;YES, PRINT COBOL.HLP
 >
 IFN FT68274,<
	MOVE	1,[SIXBIT "68274"]
 >
>
IFN ANS74,<
	MOVE	1,[SIXBIT "CBL74"]	;YES, PRINT COBOL.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 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

IFE FT68274,<
	MOVSI	TA,'REL'
>
IFN FT68274,<
	MOVSI	TA,'CVT'	;USE DEFAULT CONVERTED EXTENSION
>
	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:
IFE FT68274,<
	MOVEI	I1,.IOBIN
>
IFN FT68274,<
	MOVEI	I1,.IOASC	;ITS THE CONVERTED SOURCE FILE
>
	MOVEI	DA,BINDEV
	MOVEI	DC,BIN
	SKIPN	BINDEV		;ANY BINARY FILE?
	JRST	INITL		;NO

	PUSHJ	PP,OPNOUT
IFN FT68274,<
	MOVE	TA,.JBFF
	MOVEM	TA,BINBUF##
	OUTBUF	BIN,2
>
	MOVE	TA,BINSWS##	;REWIND?
	TRNE	TA,FL.REW
	MTREW.	BIN,
IFE TOPS20,<
	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,
IFE TOPS20,<
	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##
IFE FT68274,<
	MOVE	TA,GENBUF##	;BINFIL OVERLAYS GENFIL
	MOVEM	TA,BINBUF##
>
;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
	SKIPE	(LN)		;DONE?
	JRST	SETN1		;NO--LOOP

	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]
	MOVE	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##

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;
;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"
	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
;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:>
	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:	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]
IFE TOPS20,<
	SETOM	MYPATH##	;MY JOB,,GET PATH FUNCTION
	MOVE	TA,[11,,MYPATH]
	PATH.	TA,		;GET DEFAULT PATH
	  SETZM	MYPPN##		;FAILED
>
IFN TOPS20,<
	GETPPN	TA,		;GET LOGGED-IN PPN
	  JFCL			;JUST INCASE JACCT ON
	MOVEM	TA,MYPPN##	;STORE IT
>
	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 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,
;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
IFE TOPS20,<
	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"
IFN ANS74,<
	SETOM	DEBSW##		;B - GENERATE DEBUG CODE
>
IFN ANS68,<
	JRST	BADCSW
>
	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
>
	JRST	BADCSW		;G -
	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	BADCSW		;V -
	JRST	SWICHW		;W -
	JRST	SWICHX		;X - DEFAULT THINGS TO EBCDIC INSTEAD OF SIXBIT.
IFN ANS68,<
	JRST	BADCSW		;Y -
>
IFN ANS74,<
	JRST	SWICHY		;Y - SET FIPS FLAGGER LEVEL
>
IFN TOPS20,<
	JRST	BADCSW		;Z -
>
IFE TOPS20,<
	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
IFE TOPS20,<
	SWON	FREENT		;R - TURN ON "/R"
>
IFN TOPS20,<
	SETOM	RENSW##		;R - SET FLAG FOR COBOLG, LEAVE FREENT ON
>
	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,

IFE TOPS20,<
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:
IFN EBCMP.,<
	HRROI	TA,%US.EB	;DISPLAY-9
	MOVEM	TA,DEFDSP##	;SET DEFAULT MODE
	POPJ	PP,
>
IFE EBCMP.,<
	MOVEI	TB,[ASCIZ -?/X is not allowed, for an EBCDIC/COMP-3 compiler
reassemble the compiler and OTS with EBCMP.==1-]
	JRST	BADCOM
>

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,
>
IFN ANS74,<
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 > 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/
/
;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 /]
	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

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
	AND	SW,[EXP FDSKC]	;NO--CLEAR ALL SWITCHES EXCEPT FDSKC
	JRST	COBLAS
;ERROR ROUTINES  (CONT'D).
;LIBRARY DEVICE IMPROPER
BADLIB:	MOVEI	TB,[ASCIZ/?CBLMBD Library device must be DSK/]
	JRST	BADCOM


;DOUBLE NAMTAB ENTRY

DBLNAM:	TYPE	[ASCIZ/?COBOLA: NAMTAB entry duplicated
/]
	JRST	KILL##

;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##
;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
;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
SUBTTL TABLE OF RESERVED WORDS

;VERBS

;001 ACCEPT				020 MOVE
;002 ADD				021 MULTIPLY
;003 ALTER				022 NOTE
;004 CLOSE				023 OPEN
;005 COMPUTE				024 PERFORM
;006 COPY 				025 READ
;007 DISPLAY				026 RELEASE
;010 DIVIDE				027 RETURN
;011 ELSE 				030 SEARCH
;012					031 SEEK
;013 ENTER				032 SET,SETS
;014 EXAMINE				033 SORT
;015 EXIT 				034 STOP
;016 GO					035 SUBTRACT
;017 IF					036 USE
;					037 WRITE

;040 INITIATE
;041 GENERATE
;042 TERMINATE
;043 DELETE
;044 REWRITE
;045 STORE
;046 INSERT
;047 MODIFY
;050 GET
;051 REMOVE
;052 FIND
;053 RECEIVE
;054 SEND
;055 DISABLE
;056 ENABLE

;060 STRING
;061 UNSTRING

;062 RETAIN
;063 FREE

;064 METER--JSYS
;WORDS USED ONLY BY ID & ED SCANS

;100 [%316]ACCESS TO 267		126 PROGRAM-ID
;101 ACTUAL				127 RANDOM
;102 ALTERNATE				130 REMARKS
;103 <EMPTY>				131 RERUN
;104 ASSIGN				132 RESERVE
;105 AUTHOR				133 SAME
;106 CONFIGURATION			134 SECURITY
;107 <EMPTY>				135 SEGMENT-LIMIT
;110 DATE-COMPILED			136 SELECT
;111 ENVIRONMENT			137 SEQUENTIAL
;					140 SIGN
;112 FILE-CONTROL 			141 SOURCE-COMPUTER
;113 FILE-LIMIT,FILE-LIMITS		142 SPECIAL-NAMES
;114 I-O-CONTROL			143 FILE-STATUS 
;115 INSTALLATION 			144 TAPE
;116 MEMORY				145 WORDS
;117 MODULES				146 <EMPTY>
;120 MULTIPLE				147 COMMA
;121 OBJECT-COMPUTER			150 DECIMAL-POINT
;122					151 MODE
;123 OPTIONAL				152 RELATIVE
;124 POSITION				153 DEFERRED
;125 PROCESSING				154 CHANNEL
;					155 STANDARD-ASCII
;					156 PDP-6
;					157 PDP-10, DECSYSTEM-10
;					160 RECORDING
;					161 DENSITY
;					162 PARITY
;					163 ASCII
;					164 SIXBIT
;					165 BINARY
;					166 DECSYSTEM-20 
;					167 ODD
;					170 EVEN
;					171 BYTE
;					172 METER--ING
;WORDS WHICH CAN GO AWAY AFTER DD SCAN

;201 ALPHANUMERIC 			222 LIMIT[S] 
;202 BLANK				223 LEFT
;203 BLOCK				224 OCCURS
;204 COMP,COMPUTATIONAL			225 OMITTED
;205 COMP-1,COMPUTATIONAL-1		226 PIC,PICTURE
;206 CONTAINS				227 RD 
;207 COMP-3,COMPUTATIONAL-3		230 REDEFINES
;210 DATE-WRITTEN 			231 RENAMES
;211 DATABASE-KEY
;212 DISPLAY-6				232 RIGHT
;213 DISPLAY-7				233 SD
;214 FD					234 COMP-2,COMPUTATIONAL-2 
;215 DISPLAY-9				235 SYNC,SYNCHRONIZED
;216 IDENTIFICATION,ID			236 USAGE
;217 INDEX				237 VALUE,VALUES
;220 INDEXED
;221 JUST,JUSTIFIED

;240 WORKING-STORAGE			260 CONTROL[S]
;241 CHARACTERS [74] TO 642		261 COMPILE
;242 USER-AREA				262 FINAL
;243 LINKAGE				263 FOOTING
;244 SUB-SCHEMA				264 GROUP
;245 SCHEMA				265 HEADING
;246 INVOKE				266 INDICATE
;247 TYPE				267 ACCESS 

;250 RH					270 NUMBER
;251 PH					271 <EMPTY>
;252 CH					272 PLUS
;253 DE,DETAIL				273 REPORT[S]
;254 CF					274 RESET
;255 PF					275 SOURCE
;256 RF					276 SUM
;257 COLUMN				277 CODE
;WORDS USED BY ALL PHASES

;300 ADVANCING				341 LEADING
;301 AFTER				342 LESS,"<"
;302 CONSOLE
;303 ALPHABETIC				343 LINE,LINES
;304 AND				344 LOCK
;305 ARE (SEE IS) 			345 NEGATIVE
;305 IS (SEE ARE) 			346 NEXT
;306 ASCENDING				347 NO
;307 AT					350 NOT
;310 BEFORE				351 NUMERIC
;311 BEGINNING				352 ON
;312 BY					353 OR
;313 COBOL				354 OUTPUT
;314 CORR,CORRESPONDING			355 POSITIVE
;315 DECLARATIVES 			356 PROCEED
;316 DEPENDING				357 RECORD,RECORDS
;317 DESCENDING				360 REEL (SEE UNIT)
;320 DOWN 				360 UNIT (SEE REEL)
;321 ENDING				361 REPLACING
;322 EQUAL,EQUALS,"="			362 REVERSED
;323 ERROR				363 REWIND
;324 EVERY				364 ROUNDED
;325 FILE 				365 RUN
;326 FIRST				366 SECTION
;327 FOR				367 SENTENCE
;330 FROM 				370 TALLYING
;331 GIVING				371 THAN
;332 GREATER,">"			372 THRU,THROUGH
;333 INPUT-OUTPUT,I-O			373 TIMES
;334 IN (SEE OF)			374 TO
;334 OF (SEE IN)			375 UNTIL
;335 INPUT				376 UP
;336 INTO 				377 UPON
;337 INVALID
;340 KEY,KEYS


;400 USING				405 DIVISION
;401 VARYING				406 END
;402 WHEN				407 STANDARD
;403 WITH				410 LABEL
;404 SIZE				411 PROCEDURE, PROCEDURES
;					412 OFF
;					413 REMAINDER
;					414 MACRO
;					415 FORTRAN-IV
;					416 SWITCH
;					417 REPORTING
;					420 TRACE
;					421 FILLER
;422 CALL				;502 SEGMENT
;423 FORTRAN				;503 ESI
;424 CANCEL				;504 EMI
;425 ENTRY				;505 EGI
;426 GOBACK				;506 EPI
;427 PROGRAM				;507 TERMINAL
;430 OVERFLOW				;510 PAGE

;431 ANY				;511 DATA
;432 EMPTY				;512 DELIMITED
;433 MEMBER,MEMBERS			;513 DELIMITER
;434 OWNER				;514 VERB
;435 AREA				;515 OTHERS
;436 CURRENCY				;516 ALLOWING
;437 SUPPRESS				;517 NONE
;440 UPDATE				;520 UNAVAILABLE
;441 ONLY				;521 READ-REWRITE
;442 SELECTIVE				;522 READ-WRITE
;443 RUN-UNIT				;523 FREED
;444 STATUS				;524 RETAINED
;445 CURRENT				;525 POSITIONING
;446 PRIOR				;526 JOURNAL
;447 LAST				;527 CHECK
;450 DUPLICATE, DUPLICATES		;530 SEQUENCE
;451 WITHIN				;531 TRANSACTION
;452 PRIVACY				;532 VIA
;453 USAGE-MODE
;454 RETRIEVAL
;455 PROTECTED
;456 EXCLUSIVE
;457 COMMUNICATION
;460 CD
;461 INITIAL
;462 SYMBOLIC, NOMINAL
;463 QUEUE
;464 SUB-QUEUE-1
;465 SUB-QUEUE-2
;466 SUB-QUEUE-3
;467 MESSAGE
;470 DATE
;471 TIME
;472 TEXT
;473 LENGTH
;474 COUNT
;475 DEPTH
;476 DESTINATION
;477 TABLE
;500 CLASS
;501 POINTER
;502 COMPILER-BREAK-IN-PHASE
;ANS-74 RESERVED WORDS

;600 ALSO
;601 BOTTOM
;602 CLOCK-UNITS
;603 CODE-SET
;604 COLLATING
;605 DAY
;615 DEBUGGING
;616 DYNAMIC
;617 EOP, END-OF-PAGE
;620 EXCEPTION
;621 EXTEND
;622 INSPECT
;623 LINAGE
;624 LINAGE-COUNTER
;625 RMS
;626 MERGE
;627 NATIVE
;630 ORGANIZATION
;631 CHECKPOINT
;632 PRINTING
;633 REFERENCES
;634 SEPARATE
;635
;636 SORT-MERGE
;637 STANDARD-1
;640 START
;641 TRAILING
;642 CHARACTER, CHARACTERS
;643 EBCDIC
;700 HIGH-VALUE,HIGH-VALUES		704 TALLY
;701 LOW-VALUE,LOW-VALUES		705 ZERO,ZEROS,ZEROES
;702 QUOTE,QUOTES			706 ALL
;703 SPACE,SPACES			707 TODAY

;765 ,					772 +
;766 ;					773 -
;767 (					774 /
;770 )					775 *
;771 .					776 **

;777 END OF SOURCE
	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
IFN ANS68,<NTVAL ACTUA.,ACTUAL>
	NTVAL ADD.,ADD
	NTVAL ADVAN.,ADVANCING
	NTVAL AFTER.,AFTER
	NTVAL ALL.,ALL
	NTVAL ALLOW.,ALLOWING
	NTVAL ALPHB.,ALPHABETIC
IFN ANS74,<NTVAL ALSO.,ALSO>
	NTVAL ALTER.,ALTER
	NTVAL ALTRN.,ALTERNATE
	NTVAL AND.,AND
	NTVAL ANY.,ANY
	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 BEFOR.,BEFORE
IFN ANS68,<NTVAL BEGIN.,BEGINNING>
	NTVAL BINRY.,BINARY
	NTVAL BLANK.,BLANK
	NTVAL BLOCK.,BLOCK
IFN ANS74,<NTVAL BOTTO.,BOTTOM>
	NTVAL BY.,BY
	NTVAL BYTE.,BYTE
	NTVAL CALL.,CALL
	NTVAL CAN.,CANCEL
IFN MCS!TCS!ANS74,<NTVAL CD.,CD>
	NTVAL CF.,CF
	NTVAL CH.,CH
	NTVAL CHANN.,CHANNEL
IFN ANS74,<NTVAL CHARA.,CHARACTER>
	NTVAL CHARA.,CHARACTERS
	NTVAL CHECK.,CHECK
	NTVAL CHKPT.,CHECKPOINT
IFN MCS!TCS,<NTVAL CLASS.,CLASS>
;IFN ANS74,<NTVAL CLCKU.,CLOCK:UNITS>
	NTVAL CLOSE.,CLOSE
	NTVAL COBOL.,COBOL
	NTVAL CODE.,CODE
IFN ANS74,<NTVAL CDSET.,CODE:SET>
IFN ANS74,<NTVAL COLLA.,COLLATING>
	NTVAL COL.,COLUMN
	NTVAL COMMA,COMMA
	NTVAL COMM.,COMMUNICATION
	NTVAL COMP.,COMP
	NTVAL COMP1.,COMP:1
;IFN ANS74,<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
;IFN ANS74,<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
IFN MCS!TCS!ANS74,<NTVAL DATE..,DATE>
	NTVAL DATEC.,DATE:COMPILED
	NTVAL DATEW.,DATE:WRITTEN
IFN ANS74,<NTVAL DAY..,DAY>
	NTVAL DE.,DE
IFN ANS74,<NTVAL DEBUG.,DEBUGGING>
	NTVAL DECPN.,DECIMAL:POINT
	NTVAL DECLA.,DECLARATIVES
	NTVAL PDP10.,DECSYSTEM10
	NTVAL PDP10.,DECSYSTEM:10
	NTVAL DEC20.,DECSYSTEM:20
	NTVAL DEFER.,DEFERRED
	NTVAL DELET.,DELETE
	NTVAL DLIMD.,DELIMITED
	NTVAL DLIMR.,DELIMITER
	NTVAL DENSIT,DENSITY
	NTVAL DEPEN.,DEPENDING
IFN ANS68,<IFN MCS!TCS,<NTVAL DEPTH.,DEPTH>>	;OBSOLETE
	NTVAL DESCN.,DESCENDING
IFN MCS!TCS,<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>
IFN ANS74,<NTVAL DUPL.,DUPLICATES>
IFN ANS74,<NTVAL DYNAM.,DYNAMIC>
IFN ANS74,<NTVAL EBCDC.,EBCDIC>
IFN MCS!TCS,<NTVAL EGI.,EGI>
	NTVAL ELSE.,ELSE
IFN MCS!TCS,<NTVAL EMI.,EMI>
IFN DBMS,<NTVAL EMPTY.,EMPTY>
	NTVAL ENABL.,ENABLE
	NTVAL END.,END
IFN ANS74,<NTVAL EOP.,END:OF:PAGE>
IFN ANS68,<NTVAL ENDIN.,ENDING>
	NTVAL ENTER.,ENTER
	NTVAL ENTRY.,ENTRY
	NTVAL ENVIR.,ENVIRONMENT
IFN ANS74,<NTVAL EOP.,EOP>
IFN MCS!TCS,<IFE TOPS20,<NTVAL EPI.,EPI>>
	NTVAL EQUAL.,EQUAL
	NTVAL EQUAL.,EQUALS
	NTVAL ERROR.,ERROR
IFN MCS!TCS,<NTVAL ESI.,ESI>
	NTVAL EVEN.,EVEN
	NTVAL EVERY.,EVERY
IFN ANS68,<NTVAL EXAMI.,EXAMINE>
IFN DBMS,<NTVAL EXCL.,EXCLUSIVE
	NTVAL EXCL.,EXCL>
IFN ANS74,<NTVAL EXCEP.,EXCEPTION>
	NTVAL EXIT.,EXIT
	NTVAL EXTEN.,EXTEND
	NTVAL FD.,FD
	NTVAL FILE.,FILE
	NTVAL FILEC.,FILE:CONTROL
IFN ANS68,<NTVAL FILEL.,FILE:LIMIT>
IFN ANS68,<NTVAL FILEL.,FILE:LIMITS>
	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
IFN ANS68,<NTVAL FORTR.,FORTRAN:IV>
	NTVAL FREE.,FREE
	NTVAL FREED.,FREED
	NTVAL FROM.,FROM
	NTVAL GEN.,GENERATE
	NTVAL GET.,GET
	NTVAL GIVIN.,GIVING
	NTVAL GO.,GO
IFN ANS68,<NTVAL GOBAK.,GOBACK>
	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
IFN MCS!TCS!ANS74,<NTVAL INITL.,INITIAL>
	NTVAL INIT.,INITIATE
	NTVAL INPUT.,INPUT
	NTVAL IO.,INPUT:OUTPUT
	NTVAL INSRT.,INSERT
IFN ANS74,<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
IFN MCS!TCS!ANS74,<NTVAL LNGTH.,LENGTH>
	NTVAL LESS.,LESS
	NTVAL LIM.,LIMIT
	NTVAL LIM.,LIMITS
IFN ANS74,<NTVAL LINAG.,LINAGE>
IFN ANS74,<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>
IFN CSTATS,<NTVAL METNG.,METER::ING>
IFN CSTATS,<NTVAL METJS.,METER::JSYS>
	NTVAL MERG.,MERGE
IFN MCS!TCS!ANS74,<NTVAL MSG.,MESSAGE>
	NTVAL MODE.,MODE
	NTVAL MODIF.,MODIFY
	NTVAL MODUL.,MODULES
	NTVAL MOVE.,MOVE
	NTVAL MULTP.,MULTIPLE
	NTVAL MULTI.,MULTIPLY
IFN ANS74,<NTVAL NATIV.,NATIVE>
	NTVAL NEGAT.,NEGATIVE
	NTVAL NEXT.,NEXT
	NTVAL NO.,NO
IFN ANS68,<NTVAL SYMBL.,NOMINAL>
	NTVAL NONE.,NONE
	NTVAL NOT.,NOT
IFN ANS68,<NTVAL NOTE.,NOTE>
	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
IFN ANS74,<NTVAL ORGAN.,ORGANIZATION>
	NTVAL OTHER.,OTHERS
	NTVAL OUTPU.,OUTPUT
	NTVAL OVRFL.,OVERFLOW
IFN DBMS,<NTVAL OWNER.,OWNER>
	NTVAL PAGE.,PAGE
	NTVAL PARIT.,PARITY
	NTVAL PDP10.,PDP:10
	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
IFN ANS74,<NTVAL PRINT.,PRINTING>
IFN DBMS,<NTVAL PRIOR.,PRIOR>
IFN DBMS,<NTVAL PRVCY.,PRIVACY>
	NTVAL PROC.,PROCEDURE
IFN ANS74,<NTVAL PROC.,PROCEDURES>
	NTVAL PROCE.,PROCEED
IFN ANS68,<NTVAL PRCSS.,PROCESSING>
	NTVAL PGM.,PROGRAM
	NTVAL PGMID.,PROGRAM:ID
IFN DBMS,<NTVAL PROT.,PROTECTED
	NTVAL PROT.,PROT>
IFN MCS!TCS,<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
IFN ANS74,<NTVAL REFER.,REFERENCES>
	NTVAL RELAT.,RELATIVE
	NTVAL RELEA.,RELEASE
	NTVAL REMAI.,REMAINDER
IFN ANS68,<NTVAL REMAR.,REMARKS>
	NTVAL REMOV.,REMOVE
IFN ANS74,<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
IFN ANS74,<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
IFN ANS68,<NTVAL SEEK.,SEEK>
IFN MCS!TCS,<NTVAL SGMNT.,SEGMENT>
	NTVAL SEGME.,SEGMENT:LIMIT
	NTVAL SELEC.,SELECT
	NTVAL SEND.,SEND
IFN DBMS,<NTVAL SELTV.,SELECTIVE>
	NTVAL SENT.,SENTENCE
IFN ANS74,<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
IFN ANS74,<NTVAL SRTMG.,SORT:MERGE>
	NTVAL SOUR.,SOURCE
	NTVAL SOURC.,SOURCE:COMPUTER
	NTVAL SPACE.,SPACE
	NTVAL SPACE.,SPACES
	NTVAL SPECI.,SPECIAL:NAMES
	NTVAL STAND.,STANDARD
IFN ANS74,<NTVAL STND1.,STANDARD:1>
	NTVAL STDAS.,STANDARD:ASCII
IFN ANS74,<NTVAL START.,START>
	NTVAL STATU.,STATUS
	NTVAL STOP,STOP
	NTVAL STORE.,STORE
	NTVAL STRIN.,STRING
IFN DBMS,<NTVAL SBSCH.,SUB:SCHEMA>
IFN MCS!TCS,<NTVAL SUBQ1.,SUB:QUEUE:1
	NTVAL SUBQ2.,SUB:QUEUE:2
	NTVAL SUBQ3.,SUB:QUEUE:3>
	NTVAL SUBTR.,SUBTRACT
	NTVAL SUM.,SUM
IFN DBMS!<ANS74&RPW>,<NTVAL SUPPR.,SUPPRESS>
	NTVAL SWTCH.,SWITCH
	NTVAL SYMBL.,SYMBOLIC
	NTVAL SYNCH.,SYNC
	NTVAL SYNCH.,SYNCHRONIZED
IFN MCS!TCS,<NTVAL TABLE.,TABLE>
IFN ANS68,<NTVAL TALLY,TALLY>
	NTVAL TLYNG.,TALLYING
	NTVAL TAPE.,TAPE
IFN MCS!TCS,<NTVAL TERML.,TERMINAL>
	NTVAL TERM.,TERMINATE
IFN MCS!TCS,<NTVAL TEXT.,TEXT>
	NTVAL THAN.,THAN
	NTVAL THRU.,THROUGH
	NTVAL THRU.,THRU
IFN MCS!TCS!ANS74,<NTVAL TIME..,TIME>
	NTVAL TIMES.,TIMES
	NTVAL TO.,TO
IFN ANS68,<NTVAL TODAY,TODAY>
IFN ANS74,<NTVAL TOP.,TOP>
	NTVAL TRAC.,TRACE
IFN ANS74,<NTVAL TRAIL.,TRAILING>
	NTVAL TRANS.,TRANSACTION
	NTVAL TYPE.,TYPE
	NTVAL UNAVA.,UNAVAILABLE
	NTVAL UNIT.,UNIT
	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
	0

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