Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - mit/exec/execcs.mac
There are 47 other files named execcs.mac in the archive. Click here to see a list.
;713 add literals label
;712 DEC release version
; UPD ID= 140, SNARK:<5.EXEC>EXECCS.MAC.18,   7-Feb-82 14:00:09 by CHALL
;TCO 5.1719 ADD NATIVE FORTRAN (NFO) TO LANGUAGES MARCO
;TCO 5.1717 BILDIT- FOR NATIVE, PUT SWITCHES AFTER FILESPECS
; UPD ID= 116, SNARK:<5.EXEC>EXECCS.MAC.15,  28-Dec-81 11:12:13 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 103, SNARK:<5.EXEC>EXECCS.MAC.14,  22-Oct-81 14:39:14 by CHALL
;TCO 5.1582 .SNDCS- ALLOW "." TO BE A LEGAL EXTENSION NAME
; UPD ID= 95, SNARK:<5.EXEC>EXECCS.MAC.13,  21-Oct-81 11:27:34 by GROUT
;TCO 5.1577 Fix TPLUS and TCOMM to skip COMIN CRLF check
; UPD ID= 94, SNARK:<5.EXEC>EXECCS.MAC.12,  21-Oct-81 11:23:37 by GROUT
;TCO 5.1572 Fix INFO DEFAULT COMPILE-SWITCHES typeout
; UPD ID= 91, SNARK:<5.EXEC>EXECCS.MAC.11,  21-Oct-81 11:14:22 by GROUT
;TCO 5.1571 Fix /LANGUAGE-SWITCHES to work with SET DEFAULT COMPILE-SWITCHES
; UPD ID= 90, SNARK:<5.EXEC>EXECCS.MAC.10,  21-Oct-81 11:08:08 by GROUT
;TCO 5.1569 Fix SET DEFAULT COMPILE-SWITCHES
; UPD ID= 89, SNARK:<5.EXEC>EXECCS.MAC.9,  21-Oct-81 10:47:05 by GROUT
;TCO 5.1568 Make global language switches override file types for translator
; UPD ID= 88, SNARK:<5.EXEC>EXECCS.MAC.8,  21-Oct-81 10:43:17 by GROUT
;TCO 5.1567 Make /LANGUAGE-SWITCHES work as last thing on line
; UPD ID= 87, SNARK:<5.EXEC>EXECCS.MAC.7,  10-Oct-81 19:46:53 by CHALL
;TCO 5.1560 ADDED CBL68 (.C68) AND CBL74 (.C74) TO LANGUAGES TABLE
;  ALSO, ADDED CBL68 (.68C) TO BE PARALLEL TO THE EXISTING CBL74 (.74C)
; UPD ID= 77, SNARK:<5.EXEC>EXECCS.MAC.5,   2-Oct-81 10:34:35 by CHALL
;TCO 5.1539 P1SRC1- CHANGE "%" TO "?" IN "?SOURCE FILE MISSING"
;  ALSO,    PASS2-  CHANGE "%" TO "?" IN "?OBJECT FILE MISSING"
; UPD ID= 74, SNARK:<5.EXEC>EXECCS.MAC.4,  21-Sep-81 09:10:13 by CHALL
;TCO 5.1520 GTASC- 7-CHAR FILE NAMES WERE ALLOWED (TYPO), BUT NOT NO MO
; UPD ID= 24, SNARK:<5.EXEC>EXECCS.MAC.3,  14-Aug-81 18:33:42 by CHALL
;TCO 5.1454 CHANGE NAMES FROM CSCAN TO EXECCS AND XDEF TO EXECDE
; UPD ID= 1798, SNARK:<5.EXEC>EXECCS.MAC.2,   7-Apr-81 17:14:54 by TILLSON
;tco 5.1278 - Use "COBOL" as debugger name, not "74-COBOL"
;<4.EXEC>EXECCS.MAC.1, 26-Mar-80 18:55:00, Edit by DK32
;Programmable Command Language
; UPD ID= 1388, SNARK:<5.EXEC>EXECCS.MAC.13,  30-Dec-80 14:53:00 by DONAHUE
;tco 5.1221 - Make HANSWI check for S%QUO+S%VAL instead of S%DSP
; UPD ID= 1385, SNARK:<5.EXEC>EXECCS.MAC.12,  24-Dec-80 16:11:36 by OSMAN
;More 5.1220 - Allow compiler to have non-TOPS10 entry vector
; UPD ID= 1381, SNARK:<5.EXEC>EXECCS.MAC.11,  24-Dec-80 14:42:07 by OSMAN
;More 5.1220 - NTVCOM was superfluous
; UPD ID= 1380, SNARK:<5.EXEC>EXECCS.MAC.10,  24-Dec-80 14:38:55 by OSMAN
;tco 5.1220 - Talk to native-mode compilers
; UPD ID= 1238, SNARK:<5.EXEC>EXECCS.MAC.9,   6-Nov-80 15:20:36 by OSMAN
;tco 5.1189 - Use $GET0 instead of $GET2
; UPD ID= 1163, SNARK:<5.EXEC>EXECCS.MAC.8,  14-Oct-80 10:45:09 by DONAHUE
;TCO 5.1172 - MAKE TCR PUT A NULL AT END OF COMMAND STRING
; UPD ID= 985, SNARK:<5.EXEC>EXECCS.MAC.7,   3-Sep-80 14:57:49 by OSMAN
;tco 5.1140 - Make /LANGUAGE-SWITCHES: work!
; UPD ID= 869, SNARK:<5.EXEC>EXECCS.MAC.6,  11-Aug-80 11:21:29 by OSMAN
;tco 5.1129 - Make CFIELD global
; UPD ID= 850, SNARK:<5.EXEC>EXECCS.MAC.5,   7-Aug-80 16:48:30 by OSMAN
;More 5.1122 - Make sure CREF isn't run in "stay" mode
; UPD ID= 822, SNARK:<5.EXEC>EXECCS.MAC.4,   4-Aug-80 09:46:54 by OSMAN
;tco 5.1122 - Add /STAY
; UPD ID= 548, SNARK:<5.EXEC>EXECCS.MAC.3,  21-May-80 17:05:00 by MURPHY
;PREVENT FOLLOWING SEARCH LIST FOR REL FILE IN CERTAIN CASES
; UPD ID= 419, SNARK:<4.1.EXEC>EXECCS.MAC.4,   8-Apr-80 13:44:01 by OSMAN
;tco 4.1.1139 - Make "?Can't find process" a better message
; UPD ID= 395, SNARK:<4.1.EXEC>EXECCS.MAC.3,   1-Apr-80 16:40:43 by TOMCZAK
;TCO#4.1.1133 - Have EXEC look for CBL74, not 74-COBOL
;<4.1.EXEC>EXECCS.MAC.2, 26-Nov-79 09:59:06, EDIT BY OSMAN
;tco 4.2577 - Put in PASCAL and SIMULA support
;<4.EXEC>EXECCS.MAC.201, 19-Oct-79 15:29:02, EDIT BY OSMAN
;MORE 4.2436 - STRIP NULLS FROM INDIRECT FILE CONTENTS
;<4.EXEC>EXECCS.MAC.196,  3-Oct-79 19:59:21, EDIT BY OSMAN
;tco 4.2509 - Don't allow cr in LOAD-class command unless filespec seen
;<4.EXEC>EXECCS.MAC.190,  3-Oct-79 15:23:41, EDIT BY OSMAN
;USE PERMANENT FREE SPACE FOR REMEMBERED STRING
;<4.EXEC>EXECCS.MAC.181,  1-Oct-79 09:35:25, EDIT BY OSMAN
;PUT INDIRECT FILES IN-LINE!
;remove special guide-word scanner (not needed)
;MORE 4.2436 - Make CMPRES remember character from previous indirect level
;More 4.2436 - Make CMPRES ignores all spaces except those sandwiched
;between filespecs
;<4.EXEC>EXECCS.MAC.177, 14-Sep-79 15:51:52, EDIT BY OSMAN
;MORE 4.2436 - Make CMPRES delete spaces after quoted string
;<4.EXEC>EXECCS.MAC.176, 14-Sep-79 11:02:23, EDIT BY OSMAN
;MORE 4.2436 - ignore comma comma at RDCOMA
;<4.EXEC>EXECCS.MAC.175, 14-Sep-79 10:12:35, EDIT BY OSMAN
;MORE 4.2436 - Get rid of RDSKP; Make CMPRES flush spaces following comma
;Don't set F%LAHD after gobbling indirect file
;<4.EXEC>EXECCS.MAC.174, 10-Sep-79 16:13:07, EDIT BY OSMAN
;tco 4.2466 - Do better than "?File not found" when indirect file in
;indirect file is not found
;<4.EXEC>EXECCS.MAC.173, 13-Sep-79 15:21:44, EDIT BY OSMAN
;MORE 4.2436 - Store words for PARSE recursion
;<4.EXEC>EXECCS.MAC.171, 13-Sep-79 6:24:13, EDIT BY OSMAN
;MORE 4.2436 - HANDLE NON-7-BIT indirect files correctly
;<4.EXEC>EXECCS.MAC.170, 7-Sep-79 11:19:36, EDIT BY OSMAN
;DON'T CALL JFNSTK AT TAT, COM2, OR IDEN; IT'S ALREADY CALLED AT CFN2
;<4.EXEC>EXECCS.MAC.169, 11-Sep-79 14:56:13, EDIT BY OSMAN
;more 4.2436 - Leave room for null in indirect buffer
;<4.EXEC>EXECCS.MAC.168, 11-Sep-79 10:28:27, EDIT BY OSMAN
;MORE 4.2436 - CALL RETBUF with correct args
;<4.EXEC>EXECCS.MAC.166,  4-Sep-79 15:41:26, EDIT BY OSMAN
;tco 4.2436 - Allow comments in indirect files
;<EKLUND>EXECCS.MAC.5, 28-Aug-79 13:56:39, EDIT BY EKLUND
;TCO 4.2426 - Load LOWTSA.REL first if SAIL program is loaded
;<4.EXEC>EXECCS.MAC.161, 16-Aug-79 09:39:05, EDIT BY OSMAN
;tco 4.2403 - Give better error on SET NO DEFAULT COMPILE
;<4.EXEC>EXECCS.MAC.159, 27-Jul-79 16:33:56, EDIT BY EKLUND
;tco 4.2354 - Prohibit file specific switches after comma in commands
;<4.EXEC>EXECCS.MAC.158, 26-Jul-79 17:08:29, EDIT BY OSMAN
;tco 4.2351 - Prevent ?Invalid CMBFP pointer adnauseum
;<4.EXEC>EXECCS.MAC.156, 18-Jul-79 10:16:54, EDIT BY OSMAN
;tco 4.2334 - Don't recompile if .REL is current and trailing spaces
;<4.EXEC>EXECCS.MAC.151, 17-Jul-79 09:48:18, EDIT BY OSMAN
;tco 4.2331 - Allow comments in COMPIL-class commands.
;<4.EXEC>EXECCS.MAC.150, 21-Jun-79 11:32:23, EDIT BY OSMAN
;tco 4.2303 - Look for .REL in both connected and source directory
;<4.EXEC>EXECCS.MAC.149, 21-Jun-79 11:10:45, EDIT BY OSMAN
;tco 4.2302 - fix LOAD A:FOO1+A:FOO2 when .REL in A:
;DON'T CLEAR PPN AT MAKOBJ IN CASE REL FILE IS IN SOURCE AREA
;<HELLIWELL.EXEC.4>EXECCS.MAC.3,  6-Jun-79 11:50:35, EDIT BY HELLIWELL
;ADD TEMP VARS SRCPTR AND DSKPTR FOR USE IN GTLANG
;<HELLIWELL.EXEC.4>EXECCS.MAC.2,  5-Jun-79 12:28:46, EDIT BY HELLIWELL
;FIX ERRORS IN WHERE TO LOOK FOR .REL FILES AND WHEN
;CLEAR TEMP CORE FILE AREA BEFORE ENTERING FIRST FILE
;<4.EXEC>EXECCS.MAC.147,  2-May-79 10:22:31, EDIT BY OSMAN
;SET UP JFN IN A FOR $GET2
;<4.EXEC>EXECCS.MAC.146,  1-May-79 11:22:05, EDIT BY OSMAN
;GTJFN => CALL GTJFS (SO ^C CAN'T LEAVE JFN AROUND)
;<4.EXEC>EXECCS.MAC.142, 20-Apr-79 15:36:17, EDIT BY OSMAN
;tco 4.2238 - Fix "?SCNCDR COMA REQUIRED IN DIRECTORY 0" (tmpcor blocks too
;   long) 
;<4.EXEC>EXECCS.MAC.138, 30-Mar-79 10:57:11, EDIT BY OSMAN
;COPY COMMAND SO THAT WE DON'T CLOBBER ORIGINAL BUFFER (SO CTRL/H DOESN'T GET
;   CONFUSED) 
;<4.EXEC>EXECCS.MAC.137, 12-Mar-79 17:53:14, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECCS.MAC.132,  4-Jan-79 19:46:40, EDIT BY OSMAN
;tco 4.2149 - make link switches (%) work better
;<4.EXEC>EXECCS.MAC.122,  3-Jan-79 15:41:08, EDIT BY OSMAN
;GET RID OF STRP, STRC
;<4.EXEC>EXECCS.MAC.120, 21-Dec-78 14:09:56, EDIT BY OSMAN
;tco 4.2130 - Don't say "?Not confirmed" on "LOAD @FOO"
;<4.EXEC>EXECCS.MAC.119, 20-Dec-78 11:01:58, EDIT BY OSMAN
;tco 4.2125 - fix "comp foo + zot"
;<4.EXEC>EXECCS.MAC.116,  8-Oct-78 17:06:41, EDIT BY OSMAN
;REMOVE REFS TO CERET BY REMOVING GTASCE
;<4.EXEC>EXECCS.MAC.112, 14-Sep-78 14:11:33, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;TCO 4.1978 - FIX "COMP /L" AND "COMP A=B" TO MAKE THEM NOT LOOP
;AND THEN TYPE "?TOO MANY JFNS IN COMMAND".
;CHANGE COLON PARSING TO NOT BREAK ON COLON, EVEN IF COLON PART OF SWITCH
;<4.EXEC>EXECCS.MAC.79,  7-Aug-78 14:52:52, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.78,  7-Aug-78 11:32:02, EDIT BY OSMAN
;PUT IN /LANGUAGE-SWITCHES:
;<4.EXEC>EXECCS.MAC.77,  7-Aug-78 10:36:59, EDIT BY OSMAN
;FIX G COMMAND (FROM "EDIT" PROGRAM)
;<EKLUND>EXECCS.MAC.14, 27-Jul-78 15:17:56, Edit by EKLUND
;	TCO 1959
;MAKE /REL SWITCH WORK (AVOID %OBJECT FILE MISSING MESSAGE)
;<EKLUND>EXECCS.MAC.13, 27-Jul-78 15:16:24, Edit by EKLUND
;	TCO 1958
;DO NOT PASS /LOCALS TO LINK UNLESS EXPLICITLY REQUESTED BY USER
;<EKLUND>EXECCS.MAC.12, 27-Jul-78 15:11:59, Edit by EKLUND
;	TCO 1957
;MAKE THE /FOR AND /DDT SWITCHES SELECT THE RIGHT DEBUGGER (USED WITH @DEBUG)
;<4.EXEC>EXECCS.MAC.75, 27-Jul-78 16:38:20, EDIT BY OSMAN
;fix swmov
;<4.EXEC>EXECCS.MAC.74, 27-Jul-78 15:01:10, Edit by DBELL
;FIX TCO 1955
;<4.MONITOR>EXECCS.MAC.1, 27-Jul-78 13:35:42, EDIT BY OSMAN
;FIX A BUG
;<4.EXEC>EXECCS.MAC.72, 26-Jul-78 17:31:06, Edit by DBELL
;TCO 1955.  CLEAR PRARG AREA SO EXECUTE COMMANDS DON'T MAKE LINK FAIL
;<4.EXEC>EXECCS.MAC.71, 25-Jul-78 10:15:00, EDIT BY OSMAN
;UNSTACK LNGJFN WHEN DONE WITH IT
;<4.EXEC>EXECCS.MAC.70, 24-Jul-78 11:06:59, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.69, 21-Jul-78 08:26:11, EDIT BY OSMAN
;CHANGE BMSK TO NOT BREAK ON CR (BUT STILL BREAK ON LF)
;<4.EXEC>EXECCS.MAC.67, 14-Jul-78 13:11:15, EDIT BY OSMAN
;CHANGE LINK STRING FROM "/DEBUG:FORTRAN" TO "/DEBUG:(DDT,FORTRAN)"
;<4.EXEC>EXECCS.MAC.66, 13-Jul-78 15:41:15, EDIT BY OSMAN
;MAKE LHED, CRFHED, SAVPNT LOCAL
;<4.EXEC>EXECCS.MAC.65, 13-Jul-78 15:17:17, EDIT BY OSMAN
;MAKE CWBUF LOCAL
;<4.EXEC>EXECCS.MAC.61, 10-Jul-78 20:47:56, EDIT BY OSMAN
;MAKE TEXTIB BE LOCAL (AND RENAME IT TO CSTXTB)
;<4.EXEC>EXECCS.MAC.58, 27-Jun-78 15:13:27, EDIT BY OSMAN
;MAKE LOCAL VARIABLES BE DECLARED IN TRVAR (INSTEAD OF EXECPR AND EXECGL)
;<4.EXEC>EXECCS.MAC.57, 27-Jun-78 10:55:33, EDIT BY OSMAN
;STACK LNGJFN, SO IT NEEDN'T BE TREATED SPECIALLY IN RLJFNS
;<4.EXEC>EXECCS.MAC.56, 23-Jun-78 18:32:12, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: C.ILEG-IND-LPRN-PERC-PLUS-RPRN-SLSH,
;CMP3, D%IGN, P1LCOB, P1ST, PARD1, PPN1, PSWP, RDCMA4, RDFLD1, RDFLD2, S%PTYP,
;SPACE, SWSAV, SWSAV1, TCTAB
;<4.EXEC>EXECCS.MAC.52, 15-Jun-78 14:14:09, EDIT BY OSMAN
;ADD SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)
;ADD /68-COBOL /74-COBOL
;<4.EXEC>EXECCS.MAC.47, 14-Jun-78 14:45:05, EDIT BY OSMAN
;ADD "INFORMATION (ABOUT) DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;SET NO DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;<4.EXEC>EXECCS.MAC.37, 13-Jun-78 14:22:32, EDIT BY OSMAN
;CHANGE COMPILER-SWITCHES TO COMPILE-SWITCHES
;<4.EXEC>EXECCS.MAC.22, 11-Jun-78 21:15:47, EDIT BY OSMAN
;FREE UP USAGE OF P6, SO THAT TRVAR CAN BE USED FOR SRCEXT (AND ANY FUTURE
;   NEEDS!) 
;<4.EXEC>EXECCS.MAC.7,  8-Jun-78 16:34:16, EDIT BY OSMAN
;CAUSE DEFAULT SWITCHES TO COME AFTER EACH PROGRAM SPEC
;<3A.EXEC>EXECCS.MAC.2,  8-Jun-78 10:46:50, EDIT BY OSMAN
;ALLOW CRLF AS ALTERNATIVE TO LF AT END OF COMMAND LINE
;<4.EXEC>EXECCS.MAC.4,  3-May-78 11:01:15, Edit by DBELL
;MAKE /MAP AND /SAVE PRECEED /DEBUG IN LINK COMMAND
;<4.EXEC>EXECCS.MAC.3,  2-Mar-78 09:07:06, Edit by PORCHER
;<4.EXEC>EXECCS.MAC.2,  2-Mar-78 08:41:04, Edit by PORCHER
;Make CCL start use SFRKV rather than touching .JBSA
;<4.EXEC>EXECCS.MAC.1, 31-Jan-78 17:03:20, Edit by PORCHER
;Add stuff for execute-only
;TOPS20 'EXECUTIVE' COMMAND LANGUGAE

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;   OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH EXECDE
	TTITLE EXECCS 
	SUBTTL T.HESS/TAH	1-SEP-75

;THIS FILE CONTAINS THE COMMAND SCANNER FOR TOPS-20

	SALL

	ESC==ALTM		;BETTER SYMBOL
	QUOTE==""""		;QUOTING CHARACTER
	B.BP==7B5		;CONSTANT TO BACKUP BYTE POINTER

;   ACS:	P1/	FLAGS
;			    FLAGS IN LH OF P1 (PARSE AND GLOBAL):
	F%LAHD==1B0		;LOOK AHEAD FLAG
	F%SLSH==1B1		;SLASH SEEN
	F%FILE==1B2		;POSSIBLE FILESPEC
	F%OBJ==1B3		;OBJECT SPEC IS NEXT
	F%DDT==1B4		;LOAD DDT
	F%TOPN==1B5		;TEMP FILE OPEN
	F%GO==1B6		;START EXECUTION
	F%SDDT==1B7		;GO TO DDT
	F%NLOD==1B8		;DON'T LOAD
	F%NCMA==1B9		;NEED COMMA FLAG
	F%CMOK==1B9		;(PARSE) COMMA OK FOR NULL SPEC
	F%SPEC==1B10		;FIRST FILESPEC SEEN (SWITCH HACK)
	F%SUPP==1B11		;LOADING SUPPRESSED
	F%DSYM==1B12		;DOING LOCAL SYMBOLS
	F%AGN==1B13		;DO OLD COMMAND AGAIN
	F%LOBJ==1B14		;GTLANG MAY LOOK FOR OBJECT FILE
	F%SLI==1B15		;7 use SLINK to load
;			    FLAGS IN RH OF P1 (LOCAL FOR FILESPEC BLOCKS):
	F%LIST==1B18		;MAKE LISTING
	F%CREF==1B19		;CREF
	F%CMPL==1B20		;FORCE COMPILATION
	F%NBIN==1B21		;NOBINARY FOR THIS FILE
	F%OPT==1B22		;PRODUCE OPTIMIZED OUTPUT
	F%DEB==1B23		;DEBUG CODE FOR THIS FILE
	F%LIB==1B24		;LIBRARY SEARCH OF THIS FILE
	F%LSYM==1B25		;LOAD LOCAL SYMBOLS
	F%ABT==1B26		;ABORT-ON-ERROR
	F%MACH==1B27		;MACHINE-CODE
	F%FLAG==1B28		;FLAG-NON-STANDARD
	F%WARN==1B29		;WARNINGS
	F%CHK==1B30		;CHECK
;	F%ERR==1B31		;ERROR LIMIT
	F%LANG==1B31		;GLOBAL LANGUAGE SWITCH SEEN
				;BITS 32-35 ARE LANG TYPE
	F.LMSK==17B35		;MASK FOR LANG TYPE

	F.ALL==776000		;MASK FOR ALL FILE RELEVENT SWS
;		P2/	DESC BLOCK POINTER
;		P3/	COUNT OF CHARS IN STRING
;		P4/	POINTER TO STRING (PARSE), LANGUAGE TYPE (LSCAN)
;		P5/	FLAGS DURING LSCAN
;		P6/	INTENTIONALLY NOT TOUCHED, SINCE TRVAR USES IT
;CHARACTER TYPE DEFINITIONS
	C.SPAC==1		;SPACE
	C.COMA==6		;COMMA
	C.EOL==7		;END-OF-LINE
	C.COLN==12		;COLON (SWITCH DELIM)

;OFFSETS IN FILE DESCRIPTOR BLOCK
	LNK==0			;LINK TO NEXT BLOCK
	SRC==0			;POINTER TO SOURCE DESC OR 0
	NAM==1			;BYTE POINTER TO FILESPEC
	FLG==2			;FLAG WORD
	SVER==4			;SOURCE VERSION D/T
	OVER==5			;OBJECT VERSION D/T
	PPN==6			;DIRECTORY NUMBER (RH)
	SWP==7			;POINTER TO LANGUAGE SWITCHES
	DYRNO==10		;DIRECTORY NUMBER
	B.SIZE==9		;SIZE OF BLOCK
	L.SIZE==3		;SIZE OF LINK-20 SWITCH BLOCK
	CMPWDS==FRESIZ/3	;MAX WORDS TO ALLOW IN COMMAND. BE CAREFUL
				;   RAISING THIS, SINCE A "LOAD" AFTER "LOAD
				;   FOO" CAUSES TWO PASSES, AND FREE SPACE IS
				;   FRAGMENTED DURING THE SECOND PASS
	CMPMSZ==CMPWDS*5	;MAXIMUM CHARACTERS IN COMMAND INCLUDING ALL
				;   INDIRECT FILES 

;FLAGS IN LH OF FILE DESC BLOCK FLAG WORD
	D%LINK==1B1		;LINK-20 SWITCH SPEC
	D%EXTN==1B2		;EXPLICIT EXTENSION TYPED
	D%FNF==1B3		;FILE DOES NOT EXIST
	D%OSRC==1B4		;OBJECT IN SOURCE DIRECTORY

;SWITCH TABLE DEFINITIONS (BITS IN LHS OF VALUE)
	S%DSP==1B0		;DISPATCH ADDRS
	S%TOFF==1B1		;TURN OFF BITS
	S%FRH==1B2		;FLAGS IN RHS OF P1
	S%FLH==1B3		;FLAGS IN LHS OF P1
	S%LTYP==1B4		;LANGUAGE TYPE
	S%LINK==1B6		;LINK-20 SWITCH TEXT
	S%VAL==1B7		;VALUE ALLOWED
	S%QUO==1B8		;SWITCH TAKES QUOTED STRING AFTER IT

;ARGUMENT BLOCK DEFINITIONS FOR SENDING DATA TO COMPATABILITY PACKAGE
	TMPCOR==BUF0		;TMPCOR AREA BEGINS AT BUF0
	NFILES==TMPCOR		;WORD 0, HOLDS NUMBER OF FILES BEING SENT 
	ADDTAB==TMPCOR+1	;WORD 1, BEGINNING OF TABLE OF FILE S/A'S
	ADDTLN==%LT+1		;ONE FILE FOR EACH SOURCE TRANSLATOR + ONE FOR
				;   LINK 
	TMPBUF==ADDTAB+ADDTLN	;ADDRESSES FOLLOWED BY FILES THEMSELVES
;LANGUAGE PROCESSOR DEFINITIONS
;
;   ARGS:	A - LANGUAGE NAME
;		B - EXTENSION
;		C - PROCESSOR NAME
;		D - TEMP FILE NAME
;		E - TEMP FILE NAME FOR NATIVE COMPILER

DEFINE LANGUAGE 
    <	L (ALGOL,ALG,ALGOL,ALG)
MIT,<	L (BCPL,BCP,BCPL,BCP)>	;7 BCPL language
	L (BINARY,REL,LINK,LNK)
	L (BLISS,BLI,BLIS10,BLI)
	L (COBOL,68C,CBL68,COB,NCO)
	L (COBOL,74C,CBL74,COB,NCO)
	L (COBOL,C68,CBL68,COB,NCO)
	L (COBOL,C74,CBL74,COB,NCO)
	L (COBOL,CBL,COBOL,COB,NCO)
	L (FAIL,FAI,FAIL,FAI)
	L (FORTRAN,FOR,FORTRA,FOR,NFO)
	L (MACRO,MAC,MACRO,MAC)
	L (PASCAL,PAS,PASCAL,PAS,NPO)
	L (SAIL,SAI,SAIL,SAI)
	L (SIMULA,SIM,SIMULA,SIM)
MIT,<	L (SLINK,SLI,SLINK,LNK)> ;7 special loader
	L (SNOBOL,SNO,SNOBOL,SNO)>
;CSCAN - ENTRY FROM COMMAND DECODER
;   PRIMARY COMMAND ALREADY IN CBUF, READ REMAINDER OF COMMAND
.COMPI::CALL CNSE		;NOISE STUFF
	TXO P1,F%NLOD		;SET NO LOAD
	JRST CSCAN		;CALL SCANNER

.DEBUG::CALL CNSE		;GUIDE WORD
	TXOA P1,F%SDDT		;SET DEBUG
.EXECU:: CALL CNSE		;NOISE STUFF
	TXOA P1,F%GO		;GO FLAG
.LOAD::	 CALL CNSE		;NOISE HACK
	JRST CSCAN

CNSE:	MOVEI B,[FLDDB. .CMNOI,,TXTPTR <from>]
	CALL CFIELD		;TYPE NOISE BUT DON'T ALLOW "@"!
	SETZ P1,		;CLEAR FLAGS
	RET

;ENTRY FROM CREF COMMAND
.CREF::	LINEX <Data line for CREF program>
	 CMERRX <Invalid data line for CREF program>
	CALL CRSCAN		;MAKE RESCAN BUFFER
	HRROI B,[GETSAVE <SYS:CREF.>]
	SETZM STAYF		;WAIT FOR CREF TO FINISH
	JRST RUNGO		;INVOKE CREF FOR NOW

CMAGN::	MOVX P1,F%AGN		;SAY WE'RE DOING OLD COMMAND AGAIN
	JRST CSCAN		;GO ALLOCATE LOCAL VARIABLES

CMAGN1:	CALL CSCANR		;RESET PARSER
	CALL TIRST		;RESET TEXTI/GTJFN BLOCKS
	MOVE P1,CSVCC		;GET COMMAND INFO
	JRST CSCAN2		;PARSE OLD ARGS IF ANY
;ROUTINE TO INIT SCANNER POINTERS, VALUES, ETC...
CSCANR:	GJINF			;GET JOB RELATED INFO
	MOVEM C,CSJOB		;JOB #
	MOVE A,B		;CONNECTED DIRECTORY NUMBER
	STPPN			;CONVERT TO PPN
	MOVEM B,CSPPN		;FOR THOSE WHO NEED
	SETZM LHED		;INITIALIZE VARIABLES
	SETZM CRFHED
	SETZM SAVPNT
	SETZM LSWPTR		;NO GLOBAL /LANG: YET
	SETZM MAPPNT		;NO /MAP YET
	MOVX Q1,LT.FOR		;INITIAL LANGUAGE TYPE
	DPB Q1,[POINTR P1,F.LMSK]
	MOVEI P2,LHED		;BEGINNING OF FILE LIST
	MOVEI A,STRSIZ*5
	CALL GETBUF		;ALLOCATE FREE SPACE FOR TEXTI DESTINATION
				;   BUFFER 
	HRLI A,(ASCPTR)		;MAKE A BYTE POINTER
	MOVEM A,TXTPR		;REMEMBER POINTER
	RET			;RETURN

	NATWDS==1000		;NUMBER OF WORDS FOR NATIVE COMMAND STRING

CSCAN:	TRVAR <NEWPT0,NEWJFN,OLDJFN,NATIVF,SAVQS,CSPTR,CDPTR,CMPPT0,BAKPTR,
TXTPR,NFIAR,NFILS,<SWIBUF,SWISIZ>,BMSKA,LSWPTR,SAVLNG,LHED,CRFHED,SAVPNT,
<FSPEC,FILWDS>,<CWBUF,LCWBUF>,<CSTXTB,10>,SRCSAV,CSJOB,CSPPN,SAVBRK,EXTP,
COMPBP,LPROC,DEBAID,TMPJFN,INDJFN,INDSIZ,CJEPTR,CMPBUF,ADDSIZ,CMPSIZ,LNGJFN,
NXPROC,MAPPNT,SRCPTR,DSKPTR,SAILF>
	SETZM STAYF		;DON'T STAY AT COMMAND LEVEL UNLESS /STAY
	MOVE A,CMPTR		;GET POINTER TO FOLLOWING "COMPILE (FROM)"
	MOVEM A,.RDIOJ+CSTXTB	;POINT TEXTI BLOCK AT ORIGINAL COMMAND STRING
	MOVEM A,COMPBP		;REMEMBER POINTER FOR CREATING DEFAULT STRING
				;   LATER 
	TXNE P1,F%AGN		;DOING OLD COMMAND AGAIN?
	 JRST CMAGN1		;YES, GO DO IT
	CALL TI			;READ A LINE
	CALL CSCANR		;SCAN RESET
	MOVEM P1,CSVCC		;SAVE COMMAND INFO FOR EDIT
CSCAN1:	MOVX A,7		;ALLOCATE ROOM IN TEXTI BLOCK
	MOVEM A,.RDCWB+CSTXTB
	SETZM .RDRTY+CSTXTB	;SAY NO ^R POINTER
	SETZM .RDBFP+CSTXTB	;NO SPECIAL BACKUP POINTER
	MOVE A,[TMPCOR,,TMPCOR+1] ;GET READY
	SETZM TMPCOR		;TO CLEAR THE TEMPORARY FILE AREA
	BLT A,TMPCOR+777	;DO IT
	MOVEI A,BMSK		;SET UP STANDARD BREAK MASK
	MOVEM A,BMSKA
	SETZM LNGJFN		;SAY NO LANGUAGE JFN YET
	SETZM SAILF		;ASSUME NOT SAIL
	SETZM INDJFN		;NO INDIRECT YET
	SETZM SRCSAV		;NO PARTIAL SOURCE LIST
	SETZM DEBAID		;NO DEBUGGING AID
	SETOM LPROC		;UNKNOWN LANG PROCESSOR
	MOVEI A,NATWDS		;NUMBER OF WORDS FOR NATIVE STRING
	CALL GETBUF		;GET BUFFER FOR NATIVE COMMAND STRING
	HRLI A,(ASCPTR)		;MAKE BYTE POINTER TO AREA
	MOVEM A,NEWPT0		;REMEMBER POINTER TO AREA FOR NATIVE STRING
	CALL CMPRES		;GET RID OF UNEEDED SPACES
	CALL PARSE		;CALL PARSER
	CALL RLJFNS		;RELEASE JFNS
	TXNN P1,F%SPEC		;SEEN FILE SPEC?
CSCAN2:	 JRST  [SKIPN A,CSVC	;NO, USE SAVED COPY
		 ERROR <No saved arguments>
		MOVEM A,.RDIOJ+CSTXTB ;REMEMBER POINTER TO COPY
		MOVEM A,COMPBP	;REMEMBER THAT WE'RE USING SAVED ONE
		JRST CSCAN1]	;AND REPARSE
	MOVE A,COMPBP		;BUFFER THE NEW ONE
	CAMN A,CSVC		;IF STRING ALREADY SAVED,
	 JRST CSCANO		;DON'T DO IT AGAIN
	CALL XBUFFS		;IN PERMANENT SPACE
	EXCH A,CSVC		;REMEMBER POINTER TO SAVED STRING
	CAIE A,0		;MAKE SURE THERE WAS A PREVIOUS STRING
	 CALL STREM		;RELEASE SPACE IT TOOK UP
	MOVX A,.CHLFD		;PCL Fix buffer
	DPB A,CMPTR		;PCL So .CMINI works again
CSCANO:	HLRO A,PRTAB+LT.REL	;GET NAME OF LINK-20
	TXNE P1,F%SLI		;7 use SLINK?
	 HLRO A,PRTAB+LT.SLI	;7 yes, get name of SLINK-20
	TXNE P1,F%NLOD		;ARE WE GOING TO LOAD?
	 SETZ A,		;NO - THEN NO FILESPEC
	MOVEM A,NXPROC		;SAVE AS NEXT PROCESSOR
				;FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE
	MOVX P4,%LT		;GET HIGHEST LANG TYPE
P1LUP:	MOVE A,NEWPT0		;GET POINTER TO AREA FOR CREATING NATIVE STRING
	MOVEM A,NEWJFN		;INITIALIZE POINTER TO END OF NATIVE STRING
	CALL LSCAN		;SCAN LIST
	 JRST PASS1		;CO-ROUTINE ADDRS
	TXNN P1,F%TOPN		;FILE OPEN?
	 JRST P1LPA		;NO - SKIP CLOSE STUFF
	SETZM NATIVF		;SAY WE'RE DOING OLD-STYLE LINE
	MOVE A,OLDJFN		;GET JFN
	CALL PUTLNK		;GO PUT LINK TO NEXT PROCESSOR IN TEXT
	CALL CLSTMP		;CLOSE TMP FILE FOR OLD-STYLE LINE
P1LPA:	MOVE A,NEWJFN		;GET POINTER TO NATIVE STRING
	CAMN A,NEWPT0		;IS THERE ANY NATIVE STRING?
	 JRST P1LPB		;NO
	SETOM NATIVF		;YES, SAY WE'RE DOING NATIVE-STYLE LINE
	CALL PUTLNK		;PUT IN LINK INFORMATION FOR NATIVE LINE
	CALL OPNTMP		;CREATE TMP FILE FOR NATIVE COMMAND STRING
	MOVE B,NEWPT0		;GET POINTER TO BEGINNING OF NATIVE STRING
	CALL TSOUT0		;WRITE COMMAND STRING INTO TEMP FILE
	CALL CLSTMP		;CLOSE TEMP FILE FOR NEW STYLE COMMAND STRING
P1LPB:	MOVE A,NEWJFN
	HLRO B,PRTAB(P4)	;LINK TO OURSELVES
	TXZN P1,F%TOPN
	 CAME A,NEWPT0
	  MOVEM B,NXPROC	;SAVE NEXT PROCESSOR ONLY IF THIS COMPILER WILL
				;   BE RUN 
	SUBI P4,1		;DECREMENT LANG
	CAIE P4,LT.REL		;DONE IF LANG TYPE = RELOC
	 JRST P1LUP		;CONTINUE
	JRST P2ST		;START PASS2

PUTLNK:	SKIPN B,NXPROC		;WHERE TO GO WHEN DONE
	 JRST P1LPN		;NONE
	SKIPE NATIVF		;NATIVE STYLE LINE?
	 JRST  [HRROI B,[ASCIZ"/RUN:"]
		CALL TSOUT0	;YES, PUT /RUN:PROG/OFFSET:1
		MOVE B,NXPROC
		CALL TSOUT0	;PUT PROGRAM NAME
		HRROI B,[ASCIZ"/OFFSET:1"]
		CALL TSOUT0
		JRST P1LPC1]	;JOIN COMMON CODE
	CAIE P4,LT.PAS		;7 SPR #:20-17931 PASCAL?
	 CAIN P4,LT.FOR		;FORTRAN?
	  JRST P1LFOR		;SPECIAL FORTRAN HACK
	CAIE P4,LT.C68		;68 COBOL,
	 CAIN P4,LT.C74		; OR 74 COBOL?
	  JRST P1LBLI		;YES
	CAIE P4,LT.CBL		;COBOL SPECIAL HACK
	 CAIN P4,LT.BLI		;BLISS?
	  JRST P1LBLI		;SPECIAL BLISS HACK
	CALL TSOUT0		;DUMP FILESPEC
P1LPC:	MOVX B,"!"
	BOUT			;7 that's all TBOUT does!
;7	CALL TBOUT
P1LPC1:	HRROI B,[BYTE (7).CHCRT,.CHLFD]
	CALLRET	TSOUT0		;TERMINATE

P1LPN:	RET

;SPECIAL LANGUAGE HACKS
P1LFOR:	HRROI B,[ASCIZ"/RUN:"] ;FORTRAN USES SCAN
	CALL TSOUT0		;PUT IN FILE
	MOVE B,NXPROC		;GET NEXT PROCESSOR NAME
	CALL TSOUT0		;DUMP IT
	CALL EOLOUT		;TERMINATE
	JRST P1LPN		;JOIN COMMON CODE

P1LBLI:	MOVE Q1,NXPROC		;POINT TO STRING
	HRLI Q1,(ASCPTR)
	CALL PUTDF0		;OUTPUT DEVICE AND FILENAME
	  NOP			;IGNORE EXTENSION
	JRST P1LPC		;CONTINUE
P2ST:	SETZM NATIVF		;LINK ISN'T NATIVE
	TXNE P1,F%NLOD		;WANT TO LOAD?
	 JRST P2XIT		;NO - EXIT THIS SECTION
	TXNE P1,F%SUPP		;LOSAGE?
	 ERROR <Loading suppressed>
	MOVX P4,LT.REL		;USE RELOC TYPE
	CALL OPNTMP		;OPEN TMP FILE
	MOVEM A,TMPJFN		;SAVE JFN
	TXZ P1,F%NCMA		;NO COMMA NEEDED YET
	SKIPN MAPPNT		;SEE IF WE NEED /MAP
	 SKIPE SAVPNT		;   OR /SAVE SWITCH PROCESSING
	  CALL MAPSAV		;YES - OUTPUT MAP/SAVE INFO
	SKIPE SAILF		;IF SAIL INVOLVED
	 CALL  [HRROI B,[ASCIZ/SYS:LOWTSA/]
		CALL TSOUT0	;PUT OUT REQUEST FOR LOWTSA
		CALLRET EOLOUT]
	TXNE P1,F%SDDT		;WANT TO DEBUG?
	 CALL SETDEB		;YES - SET DEBUGGER
	CALL LSCAN		;LOOP THROUGH LIST
	 JRST PASS2		;INSERT SPEC IN FILE
	HRROI B,[ASCIZ"/EXE"]	;ASSUME EXECUTE
	TXNE P1,F%GO		;IS IT?
	 CALL TSOUT0		;YES - DUMP SWITCH
	HRROI B,[ASCIZ"/GO"]	;NO - JUST LOAD
	CALL TSOUT0		;DUMP SWITCH
	CALL EOLOUT		;AND EOL
	CALL CLSTMP		;CLOSE TEMPORARY FILE
	TXNE P1,F%SUPP		;AOK?
	 ERROR <Loading suppressed>
P2XIT:	CALL FINCRF		;FINISH UP CREF FILE
	SKIPE B,NXPROC		;SEE IF SOMEWHERE TO GO
	 JRST RUNGO		;YES, GO START COMPILER OR LINK
	CALL UNMAP		;UNMAP FREE SPACE USED
	CALLRET	RLJFNS		;RELEASE JFNS & RETURN IF DONE

;PERFORM RUN AND CCL START ON THE PROCESS
RUNGO:	STKVAR <BPTR,CCLJFN,ENT0>
	MOVEM B,BPTR		;REMEMBER POINTER TO STRING
	CALL TRYGTJ		;TRY TO GET JFN
	 JRST  [MOVE A,BPTR	;FAILED, GET POINTER TO STRING
		ERROR <Can't find %1M - %?>]
	MOVEM A,CCLJFN		;REMEMBER JFN OF PROGRAM
	CALL ERESET		;RESET
	MOVE A,CCLJFN		;SAY WHICH PROGRAM TO LOAD
	CALL $GET0		;DO GET ETC...
	CALL DPRARG		;SEND TMP FILES
	CALL UNMAP		;UNMAP FREE SPACE USED
	CALL SETGO		;SET UP FOR PROGRAM RUNNING
	MOVX B,<1,,0>		;INCREMENT 1 INTO VECTOR LOCATION 0
	SFRKV			;   IS CCL START ADDRESS, START PROCESS
	 ERJMP RUNGO1		;FAILED-- TRY TO DO OLD STYLE
	JRST WAITF		;WAIT FOR PROCESS TO TERMINATE

;**** OLD STYLE CCL START ***** REMOVE THIS CODE SOMETIME ****
;   (SUCH AS WHEN SFRKV ALLOWS 1,,0 IN AC2 REGARDLESS OF WHETHER PROGRAM IS
;   TOPS10-STYLE) 
;
;THE FOLLOWING CODE HANDLES BOTH THE CASE WHERE THE "ENTRY VECTOR ADDRESS" AS
;   RETURNED BY GEVEC IS THE LOCATION OF THE FIRST INSTRUCTION OF THE PROGRAM,
;   AND THE CASE WHERE THE ADDRESS IS ACTUALLY THAT CONTAINING A JRST TO THE 
;   FIRST INSTRUCTION.
RUNGO1:	CALL GETENT		;GET ENTRY VECTOR
	MOVE A,C		;NO, GET ADDRESS OF ENTRY VECTOR
	MOVEM A,ENT0		;REMEMER WHERE ENTRY VECTOR IS
	CALL LOADF		;READ WHAT MIGHT BE FIRST INSTRUCTION
	 CALL CJERRE		;IF CAN'T, SAY WHY AND DIE
	HLRZ B,A		;GET LEFT HALF OF WHAT MIGHT BE FIRST REAL
				;   INSTRUCTION 
	CAIE B,(JRST)		;IS IT REALLY FIRST INSTRUCTION?
	 HRRZ A,ENT0		;NO, FIRST INSTRUCTION IS THE ENTRY VECTOR!
	MOVEI B,1(A)		;INCREMENT TO CREATE CCL ENTRY POINT
	CALLRET GOTO2		;GO START COMPILER
;ROUTINE TO DUMP /MAP AND/OR /SAVE INFO AND SWITCHES
MAPSAV:	SKIPN B,MAPPNT		;NEED MAP?
	 JRST MAPSV1		;NO - MUST BE SAVE
	TLNE B,-1		;CHECK FOR ARG
	 CALL TSOUT0		;OUTPUT ARG
	HRROI B,[ASCIZ"/MAP"]
	CALL TSOUT0		;DUMP SWITCH NAME
	SKIPN SAVPNT		;/SAVE ALSO?
	 JRST MAPSVX		;NO - JUST EXIT
	CALL CMOUT		;YES - NEED COMMA
MAPSV1:	MOVE B,SAVPNT		;NO - MUST BE SAVE FILE
	TLNE B,-1		;NO ARG IF LHS := 0
	 CALL TSOUT0		;DUMP IF NECESSARY
	HRROI B,[ASCIZ"/SAVE"]
	CALL TSOUT0		;DUMP SWITCH NAME
MAPSVX:	MOVX B,","		;TERMINATE WITH A COMMA
	CALLRET	TBOUT		;...

;ROUTINE TO SETUP DEBUG AID IF ANY
SETDEB:	MOVX B,LT.PAS		;7 RUTGER's PASCAL support
	CAMN B,DEBAID		;7
	 JRST PASDEB		;7
	HRROI B,[ASCIZ"/DEBUG"]
	CALL TSOUT0		;DUMP LINK SWITCH
	TXNN P1,F%LANG		;WAS A LANGUAGE SWITCH SEEN?
	 JRST TRYDDT		;NO, HOW ABOUT /DDT ?
	LDB B,[POINTR(P1,F.LMSK)] ;GET DEFAULT LANG COMPILER NAME
	CAIE B,0		;IF NONE, MOVE ON...
	 MOVEM B,DEBAID		;OTHERWISE, USE IT TO SELECT DEBUGGER
TRYDDT:	MOVEI B,LT.MAC		;BUT FIRST,
	TXNE P1,F%DDT		;CHECK FOR /DDT IN COMMAND
	 MOVEM B,DEBAID		;YES, SO USE REAL DDT INSTEAD!
	SKIPN B,DEBAID		;ANYTHING ELSE?
	 CALLRET SPOUT		;NO
	HRRO B,DBTAB(B)		;YES - GET AID NAME
	CALL TSOUT0		;DUMP IT
	CALLRET	SPOUT		;AND SPACE

PASDEB:	HRROI B,[ASCIZ/SYS:PASDDT/] ;7 just load PASDDT
	CALL TSOUT0		;7
	TXZ P1,F%SDDT		;7 and run program normally
	CALLRET EOLOUT		;7
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;
;   RETURNS:		ON EMPTY LIST
LSCAN:	MOVEI P2,LHED		;GET LIST HEAD
LSCAN0:	HRRZ P2,LNK(P2)		;LOOK AT NEXT ENTRY
	JUMPE P2,RSKP		;SKIP RETURN WHEN DONE
	SKIPGE P5,FLG(P2)	;LOAD FLAGS
	 JRST LSCAN0		;YES - SKIP IT
	HLL P2,SRC(P2)		;LOAD SOURCE POINTER IF ANY
	CALL @(P)		;INVOKE COROUTINE
	JRST LSCAN0		;TRY NEXT

;SRCSCN - ROUTINE TO SCAN ALL SOURCES AND CALL SOURCE COROUTINE
SRCSCN:	TLNN P2,-1		;SINGLE SOURCE?
	 JRST SRCSC2		;YES - INVOKE ROUTINE AND RETURN
	PUSH P,P2		;SAVE POINTER
	PUSH P,P5		;AND FLAGS
	HLRZ P2,P2		;GET STARTING POINT
SRCSC1:	MOVE P5,FLG(P2)		;LOAD FLAGS
	CALL @-2(P)		;CALL COROUTINE
	HRRZ P2,LNK(P2)		;LINK TO NEXT
	JUMPN P2,SRCSC1		;PROCEED IF EXISTS
	POP P,P5		;RESTORE FLAGS
	POP P,P2		;AND POINTER
	RETSKP			;RETURN, SKIPPING COROUTINE ADDRESS

SRCSC2:	CALL @(P)		;INVOKE COROUTINE
	RETSKP			;RETURN, SKIPPING COROUTINE ADDRESS
;PASS1 - DETERMINE WHAT TO COMPILE AND CONSTRUCT COMMAND
PASS1:	TXNE P5,D%LINK		;LINK-20 SWITCH?
	 RET			;YES - IGNORE
	SETO Q2,		;INIT TO -1
	CALL SRCSCN		;SCAN SOURCES
	 JRST P1SRC		;ROUTINE FOR SOURCE ON PASS1
	JUMPE Q2,R		;RETURN IF NO SOURCE
	TXNN P5,F%CMPL		;FORCED COMPILE?
	 CAML Q2,OVER(P2)	;COMPARE SOURCE & REL TIMES
	  CALL BLDCOM		;BUILD COMMAND STRING
	RET			;DON'T COMPILE

P1SRC:	LDB A,[POINTR P5,F.LMSK] ;GET LANG TYPE
	CAIE A,(P4)		;MATCH?
	 JRST P1SRCX		;NO - SKIP OVER
	JUMPE Q2,P1SRC1		;IF Q2 IS ZERO WE HAVE ALREADY LOST
	CAMG Q2,SVER(P2)	;SAVE LARGEST TO DATE
	 MOVE Q2,SVER(P2)	;LOAD D/T OR 0
P1SRC1:	TXNN P5,D%FNF		;FILE PRESENT?
	 RET			;YES - RETURN
	TXO P1,F%SUPP		;SET SUPPRESSED
	TYPE <?Source file missing: >
	MOVE B,NAM(P2)
	CALL DSOUTR		;FILE NAME & CRLF
P1SRCX:	SETZ Q2,		;SAY WE LOST
	RET			;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE
PASS2:	TXNE P5,D%LINK		;LINK SWITCH
	 JRST PASS2S		;YES - HANDLE SPECIAL
	SKIPN OVER(P2)		;HAVE REL SOMEWHERE?
	 JRST  [TXO P1,F%SUPP	;LOSAGE NOTED
		PUSH P,A	;SAVE JFN
		TYPE <?Object file missing: >
		MOVE B,NAM(P2)	;TELL HIM WHAT
		CALL DSOUTR	;PRINT SPEC
		POP P,A		;RESTORE JFN
		RET]		;RETURN
	TXZE P1,F%NCMA		;NEED COMMA?
	 CALL CMOUT		;YES - PUT ONE IN
	CALL P2SYMS		;DO SYMBOL CODE
	MOVE Q1,NAM(P2)		;GET POINTER TO FILE NAME STRING
	SKIPE PPN(P2)		;STRANGE DIRECTORY INVOLVED? (SKIP IF NO)
	 TXNN P5,D%OSRC		;OBJECT IN SOURCE DIRECTORY?
	  CALL SKPDEV		;WITHOUT THIS CHECK, "LOAD SNARK:FOO" TRIES TO
				;   LOAD SNARK:FOO.REL EVEN THOUGH MACRO
				;   GENERATED PS:SNARK.REL 
	CALL PUTDF0		;OUTPUT DEVICE AND FILENAME
	 JRST PASS2A		;END-OF-SPEC USE REL EXTENSION
	LDB Q2,[POINTR P5,F.LMSK] ;GET LANG TYPE
	CAIN Q2,LT.REL		;LANG TYPE = REL?
	 TXNN P5,D%EXTN		;EXPLICIT EXTENSION TYPED?
	  JRST PASS2A		;NO - USE DEFAULT
	CALL PROUT		;YES - DUMP PERIOD
	CALL PUTDF0		;REMAINDER OF TYPED EXTENSION
	  NOP			;IGNORE END-OF-SPEC
	JRST PASS2B		;DONE WITH SPEC

PASS2A:	HRROI B,[ASCIZ/.REL/]	;DEFAULT EXTENSION
	CALL TSOUT0		;DUMP INTO FILE
PASS2B:	TXO P1,F%NCMA		;LSAY WE NEED A COMMA
	SKIPE B,PPN(P2)		;ANY PPN?
	 TXNN P5,D%OSRC		;YES - USE IT?
	  ABSKP			;NO
	   CALL PUTPPN		;YES - DUMP IT
	TXNN P5,F%LIB		;WANT LIB FOR THIS?
	 JRST PASOUT		;DONE
	HRROI B,[ASCIZ"/SEARCH"]
	CALL TSOUT0		;YES - DUMP SWITCH
	JRST PASOUT		;DONE, SAVE JFN AND RETURN

;PASS2S CALLED TO DUMP LINK SWITCH
PASS2S:	MOVX B,"/"		;OUTPUT SLASH
	MOVE Q1,NAM(P2)		;GET STRING POINTER
	ILDB Q1,Q1		;PEEK AT FIRST CHAR
	CAIE Q1,"/"		;IS IT A SLASH?
	 BOUT			;7 that's all TBOUT does!
;7	 CALL TBOUT		;NO - DUMP ONE
	MOVE B,NAM(P2)		;GET STRING
	CALL TSOUT0		;DUMP IT
	TXO P1,F%NCMA		;NO COMMA YET
PASOUT:	MOVEM A,TMPJFN		;SAVE UPDATED JFN
	RET

;ROUTINE TO OUTPUT /LOCAL OR /NOLOCAL ETC...
P2SYMS:	TXNN P5,F%LSYM		;LOAD LOCALS?
	 JRST P2SYM1		;NO - CHECK IF OFF
	TXOE P1,F%DSYM		;YES - ALREADY?
	 RET			;YES - RETURN
	HRROI B,[ASCIZ"/LOCALS "]
	CALLRET	TSOUT0		;DUMP SWITCH

P2SYM1:	TXZN P1,F%DSYM		;GRNTEE SW OFF
	 RET			;RETURN IF NO FURTHER ACTION
	HRROI B,[ASCIZ"/NOLOCA "]
	CALLRET	TSOUT0		;ELSE DUMP SWITCH
;BLDCOM - ROUTINE TO BUILD A COMMAND STRING
;   CHECK FOR FILE OPEN FOR THIS LANGUAGE
BLDCOM:	TXZ P5,D%OSRC		;CLEAR THIS IF COMPILING
	MOVEM P5,FLG(P2)
	SETOM OVER(P2)		;MARK REL EXISTANCE
	SKIPN SIXTAB(P4)	;DOES OLD-STYLE COMPILER EXIST FOR THIS
				;   LANGUAGE? 
	 JRST BLDCMN		;NO, SKIP OLD-STYLE
	SETZM NATIVF		;SAY WE'RE DOING OLD-STYLE LINE
	MOVE A,OLDJFN		;OLDJFN => TMPJFN IN CASE OPNTMP ISN'T CALLED
	MOVEM A,TMPJFN
	TXNE P1,F%TOPN		;TEMP FILE OPEN?
	 JRST BLDCM1		;YES - GO ON
	CALL OPNTMP		;OPEN TEMP FILE
	MOVEM A,TMPJFN		;SAVE JFN
	TXO P1,F%TOPN		;FLAG FILE OPEN
BLDCM1:	CALL BILDIT		;DO OLD-STYLE COMMAND LINE
	MOVEM A,OLDJFN		;REMEMBER LATEST OLD POINTER
BLDCMN:	SKIPN NSXTAB(P4)	;IS THERE A NATIVE VERSION FOR THIS COMPILER?
	 RET			;NO - DONE
	SETOM NATIVF		;MARK THAT WE'RE DOING NEW STYLE
	MOVE A,NEWJFN		;SET UP WHICH BYTE POINTER TO USE
	MOVEM A,TMPJFN
	CALL BILDNC		;BUILD NEW-STYLE COMMAND STRING
	MOVEM A,NEWJFN		;REMEMBER POINTER TO NATIVE-STYLE STRING
	RET

;SUBROUTINE TO BUILD THE COMMAND LINE FOR A NATIVE COMPILER
BILDNC:	MOVE A,TMPJFN		;GET JFN TO OUTPUT TO
	TXZ P1,F%NCMA		;SAY NO COMMA HAS BEEN SEEN YET
	CALL SRCSCN		;LOOP THROUGH SOURCES
	 JRST BLDSRN		;(ADDRESS OF COROUTINE FOR SOURCE FILES)
	TXNN P5,F%NBIN		;WANT AN OBJECT FILE?
	 CALL BILOBN		;YES - OUTPUT IT (AS A SWITCH)
	  ABSKP			;7 SPR #:20-18623
	   JRST [HRROI B,[ASCIZ"/NOBINARY"] ;7 make /NOBINARY work
		CALL TSOUT0	;7
		JRST .+1]	;7
	HRROI B,[ASCIZ"/ABORT"] ;SWITCH FOR ABORT
	TXNE P5,F%ABT		;WANT IT?
	 CALL TSOUT0		;YES - DUMP IT
	HRROI B,[ASCIZ"/MACH"]	;SWITCH FOR MACHINE-CODE
	TXNE P5,F%MACH		;WANT IT?
	 CALL TSOUT0		;YES - DUMP IT
	HRROI B,[ASCIZ"/FLAG"]	;SWITCH FOR FLAG-NON-STANDARD
	TXNE P5,F%FLAG		;WANT IT?
	 CALL TSOUT0		;YES - DUMP IT
	HRROI B,[ASCIZ"/WARN"]	;SWITCH FOR WARNINGS
	TXNE P5,F%WARN		;WANT IT?
	 CALL TSOUT0		;YES - DUMP IT
	HRROI B,[ASCIZ"/CHECK"] ;SWITCH FOR CHECK
	TXNE P5,F%CHK		;WANT IT?
	 CALL TSOUT0		;YES - DUMP IT
	TXNN P5,F%LIST		;WANT LISTING?
 	 JRST BLDNC1		;NO - SKIP OVER LIST STUFF
	TXNN P5,F%CREF		;YES - WANT CREF, TOO?
	 JRST  [HRROI B,[ASCIZ"/LIST:LPT:"] ;YES - OUTPUT SWITCH
		CALL TSOUT0
		MOVE Q1,NAM(P2)	;POINTER TO FILESPEC
		CALL SKPDEV	;SKIP OVER DEVICE FIELD
		CALL PUTDF0	;DUMP NAME (Q1 RETURNED BY SKPDEV)
		 NOP		;IGNORE EXTENSION
		JRST BLDNC1]	;CONTINUE
	HRROI B,[ASCIZ"/CREF"]
	CALL TSOUT0		;ELSE JUST PUT IN CREF SWITCH WITH NO FILENAME
BLDNC1:	SKIPE B,LSWPTR		;GOT GLOBAL LANGUAGE SWITCHES?
	 CALL TSOUT0		;YES - DUMP THEM
	SKIPE B,SWP(P2)		;GOT LANGUAGE SWITCHES?
	 CALL TSOUT0		;YES - DUMP THEM
	CALL EOLOUT		;END THE SPECS
	MOVEM A,TMPJFN		;SAVE UPDATED JFN
	RET			;RETURN

;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN NATIVE FORMAT
BLDSRN:	MOVX B,"+"		;FOR NATIVE MODE, PLUS BETWEEN SOURCE SPECS
	TXZE P1,F%NCMA		;NEED SEPARATOR?
	 BOUT			;7 that's all TBOUT does!
;7	 CALL TBOUT		;YES, PUT IT IN
	SKIPE B,PPN(P2)		;SPECIAL DIRECTORY?
	 CALL PUTPPN		;YES, PUT IT IN
	MOVE Q1,NAM(P2)		;GET POINTER TO NAME
	CALL SKPDEV		;SKIP DEVICE SINCE IT'S INCLUDED IN DIRECTORY
	CALL PUTDF0		;PUT REST OF SPEC
	 JRST BLDN1		;SPEC OVER, NO PERIOD
	CALL PROUT		;PUT IN PERIOD
	CALL PUTDF0		;CONTINUE SPEC
	 NOP			;SHOULD BE OVER BY NOW
BLDN1:	TXO P1,F%NCMA		;MAKE SURE SEPARATOR PUT IN IF MORE SPECS
	RET			;DONE WITH THIS SPEC

;SUBROUTINE TO BUILD THE COMMAND LINE FOR AN OLD-STYLE COMPILER
BILDIT:	MOVE A,TMPJFN		;GET JFN TO OUTPUT TO
	TXNE P5,F%NBIN		;WANT OBJECT?
	 CALL CKCOB		;NO - OUTPUT A HYPHEN IF COBOL
	TXNN P5,F%NBIN		;WANT OBJECT?
	 CALL BILOBO		;YES - OUTPUT OBJECT SPECS
	MOVX B,","		;SEPARATE WITH A COMMA
	BOUT			;7 that's all TBOUT does!
;7	CALL TBOUT
	TXNN P5,F%LIST		;WANT LISTING?
	 JRST  [CALL CKCOB	;NO - CHECK COBOL
		JRST BLDIT1]	;SKIP OVER LIST STUFF
	TXNN P5,F%CREF		;YES - WAS A CREF REQUESTED TOO?
	 JRST  [HRROI B,[ASCIZ/LPT:/]
		CALL TSOUT0	;NO - DUMP DEVICE (FOR LIST FILE)
		MOVE Q1,NAM(P2)	;GET POINTER TO FILESPEC
		CALL SKPDEV	;SKIP OVER DEVICE FIELD
		CALL PUTDF0	;DUMP NAME (Q1 RETURNED BY SKPDEV)
		 NOP		;IGNORE EXTENSION
		JRST BLDIT1]	;CONTINUE
	MOVE Q1,NAM(P2)		;GET POINTER TO FILENAME AGAIN
	CALL SKPDEV		;ONLY OUTPUT LISTING TO CONNECTED DIRECTORY
				;WARNING: IF YOU MERELY TRY TO OMIT THE "CALL
				;   SKPDEV", THE COMMAND "COMP FOO:[A]ZOT/CREF"
				;   WILL TRY TO WRITE THE .CRF FILE TO
				;   "FOO:[B]" WHERE "BAR:[B]" IS YOUR CURRENTLY
				;   CONNECTED DIRECTORY. THE "CALL SKPDEV"
				;   PREVENTS THAT, ALTHOUGH IT MAKES
				;   RESTRICTION THAT .CRF FILES ONLY GO TO
				;   CONNECTED DIRECTORY. 
	CALL PUTDF0		;OUTPUT FILENAME
	 NOP			;IGNORE
	SKIPE B,PPN(P2)		;WANT PPN
	 CALL PUTPPX		;YES - DUMP IT
	MOVX D,"C"		;OUTPUT SW
	CALL SWOUT		;...
	CAIE P4,LT.C68		;68 COBOL,
	 CAIN P4,LT.C74		; OR 74 COBOL?
	  JRST BLDIT1		;YES, SO DON'T CREF
	CAIE P4,LT.CBL		;IF COBOL
	 CAIN P4,LT.BLI		; OR BLISS
	  JRST BLDIT1		; THEN DON'T CREF
	CALL ENTCRF		;ENTER NAME IN CREF FILE
BLDIT1:	MOVX B,"="		;DELIMIT
	BOUT			;7 that's all TBOUT does!
;7	CALL TBOUT
	TXZ P1,F%NCMA		;SAY NO COMMA SEEN YET
	CALL SRCSCN		;LOOP THROUGH SOURCES
	 JRST BLDSRC		;(ADDRESS OF COROUTINE FOR SOURCE FILES)
	SKIPE B,LSWPTR		;GOT GLOBAL LANGUAGE SWITCHES?
	 CALL TSOUT0		;YES - DUMP THEM
	SKIPE B,SWP(P2)		;GOT LANGUAGE SWITCHES?
	 CALL TSOUT0		;YES - DUMP THEM
	CALL EOLOUT		;END OF SPECS
	MOVEM A,TMPJFN		;SAVE UPDATED JFN
	RET			;RETURN

;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN OLD FORMAT
BLDSRC:	TXZE P1,F%NCMA		;NEED COMMA?
	 CALL CMOUT		;YES - DUMP ONE
	CALL PUTDF		;OUTPUT DEVICE & FILE
	 JRST BSRC1		;END OF SPEC
	CALL PROUT		;DUMP PERIOD
	CALL PUTDF0		;CONTINE SPEC
	 NOP			;IGNORE
BSRC1:	TXO P1,F%NCMA		;SET NEED-COMMA FLAG
	SKIPE B,PPN(P2)		;CHECK FOR PPN
	 CALLRET PUTPPN		;DUMP ONE AND RETURN
	RET			;RETURN

;SUBROUTINE TO OUTPUT THE OBJECT FILE
;   BILOBO: ENTRY FOR OLD-STYLE
;   BILOBN: ENTRY FOR NATIVE MODE
BILOBN:	HRROI B,[ASCIZ"/OBJECT:"]
	CALL TSOUT0		;NATIVE MODE: OUTPUT OBJECT FILE AS A SWITCH
	SKIPE B,PPN(P2)		;SPECIAL DIRECTORY?
	 CALL PUTPPX		;YES - PUT IT IN STRING
BILOBO:	MOVE Q1,NAM(P2)		;GET POINTER TO NAME STRING
	CALL SKPDEV		;PREVENT DEVICE FROM GOING INTO COMMAND FILE
				;   THIS MAY LOOK WRONG. WELL IT IS. HOWEVER,
				;   WITHOUT IT, THE FOLLOWING CASE CAUSES MACRO
				;   TO CREATE SNARK:[OSMAN]FOO.REL:
				;	@DEFINE DSK: DSK:,SNARK:[3-EXEC]
				;	@CONNECT PS:[OSMAN]
				;	@COMP FOO FOO
				;   THIS SHOULD CREATE PS:[OSMAN]FOO.REL, BUT
				;   IN FACT TRIES TO CREATE
				;   SNARK:[OSMAN]FOO.REL, IF IT WEREN'T FOR THE
				;   "CALL SKPDEV" HERE. 
				;NOTE: THAT WITH THE "CALL SKPDEV", THERE IS
				;   NOW A RESTRICTION THAT ONLY ONE'S CONNECTED
				;   DIRECTORY MAY BE USED FOR THE .REL
				;   CREATION, BUT THAT'S PRETTY MUCH O.K., AS
				;   THAT'S WHAT PEOPLE TEND TO DO. ASSUME THAT
				;   BEFORE THE COMP COMMAND, THE ONLY FOO'S IN
				;   THE WORLD WERE PS:[OSMAN]FOO.MAC AND
				;   SNARK:[3-EXEC]FOO.REL, WHERE THE .REL IS
				;   OLDER THAN THE .MAC. NOTE THAT THIS BUG
				;   WILL DO ANYONE IN THAT TRIES TO USE LOGICAL
				;   NAMES FOR THE PURPOSE OF FOOLING THE SYSTEM
				;   INTO USING A FEW PRIVATE MODULES FROM A
				;   PRIVATE DIRECTORY TOGETHER WITH MOST OF THE
				;   STANDARD  MODULES IN A STANDARD DIRECTORY.
	CALL PUTDF0		;OUTPUT FILENAME
	 JRST BLDOB1		;END OF SPEC
	LDB Q2,[POINTR P5,F.LMSK] ;GET LANGUAGE TYPE
	CAIN Q2,LT.REL		;IS IT "RELOC"?
	 TXNN P5,D%EXTN		;YES - EXPLICIT EXTENSION?
	  JRST BLDOB1		;NO - PROCEED
	CALL PROUT		;DUMP PERIOD
	CALL PUTDF0		;Q1 STILL HAS POINTER
	 NOP			;IGNORE END-OF-SPEC RETURN
BLDOB1:	SKIPE NATIVF		;NATIVE COMPILER?
	 JRST BLDOB2		;YES - ALREADY HAVE DIRECTORY
	SKIPE B,PPN(P2)		;NEED PPN?
	 CALL PUTPPX		;YES - DUMP IT
	CAIE P4,LT.FOR		;FORTRAN?
	 RET			;YES - DONE
BLDOB2:	HRROI B,[ASCIZ"/OPT"]	;SWITCH FOR OPTIMIZE
	TXNE P5,F%OPT		;WANT IT
	 CALL TSOUT0		;YES - DUMP IT
	HRROI B,[ASCIZ"/DEBUG"] ;SWITCH FOR DEBUG
	TXNE P5,F%DEB		;WANT DEBUG CODE?
	 CALLRET TSOUT0		;YES - DUMP IT AND RETURN
	RET			;NO - JUST RETURN
;ROUTINE TO CHECK FOR COBOL AND OUTPUT A "-" TO THE COMMAND FILE
CKCOB:	CAIE P4,LT.C68		;COBOL 68,
	 CAIN P4,LT.C74		;   OR COBOL 74?
	  JRST CKCOB1		;YES
	CAIE P4,LT.CBL		;IS IT COBOL?
	 RET			;NO - RETURN
CKCOB1:	MOVX B,"-"
	CALLRET TBOUT		;YES - DUMP MINUS

;ROUTINE TO PUT PPN IN OUTPUT STREAM
PUTPPX:	TLNE P2,-1		;HAVE SOURCE LIST?
	 TXNN P5,D%OSRC		;YES - WANT OBJ IN SOURCE DIR?
	  RET			;NO - IGNORE PPN
PUTPPN:	SKIPE NATIVF		;DOING NATIVE-STYLE LINE?
	 JRST  [MOVE B,DYRNO(P2) ;YES, USE DIRECTORY STRING
		DIRST
		 ERCAL CJERRE	;IF CAN'T, DIE.
		RET]
	PUSH P,B		;SAVE ARG
	MOVX B,"["		;OPEN BRACKET
	BOUT			;7 that's all TBOUT does
;7	CALL TBOUT		;DUMP IT
	HLRZ B,(P)		;LHS
	LDF C,NO%MAG!FLD(10,NO%RDX) ;MAG & RADIX
	NOUT			;CONVENIENT
	 CALL CJERR		;WHOOPS
	CALL CMOUT		;COMMA
	POP P,B			;GET PPN BACK
	ANDI B,-1		;RHS ONLY
	LDF C,NO%MAG!FLD(10,NO%RDX) ;...
	NOUT			;MAJIK
	 CALL CJERR
	MOVX B,"]"		;CLOSE BRACKET
	CALLRET	TBOUT		;DUMP AND RETURN
;ROUTINE TO ADD NEW FILESPEC TO THINGS THAT NEED CREFING
ENTCRF:	PUSH P,A		;SAVE POSIBLE JFN
	MOVE C,CSBUFP		;CURRENT POINTER
	MOVE Q1,NAM(P2)		;POINTER TO NAME
	CALL SKPDEV		;DON'T PUT ERRONEOUS DEVICE NAME IN STRING
	CALL CPYDF		;COPY FILE NAME
	 NOP			;IGNORE THIS RETURN
	SETZ B,			;TERMINATE STRING
	IDPB B,C		;...
	CALL CHKCRF		;CHECK AND ENTER IF UNIQUE
	POP P,A			;RESTORE ACCUM
	RET			;RETURN

;CHECK FOR ALREADY EXISTING FILESPEC
CHKCRF:	MOVEI Q1,CRFHED		;POINTER TO HEAD OF LIST
CKCRF1:	SKIPN Q2,(Q1)		;CHECK FOR END OF LIST
	 JRST CKCRF2		;END - ENTER NEW STRING
	MOVE A,CSBUFP		;POINTER TO STRING TO BE CONSIDERED
	MOVE B,1(Q2)		;POINTER TO OLD STRING
	STCMP			;COMPARE STRINGS
	JUMPE A,R		;MATCH IF ZERO CODE (RETURN)
	MOVE Q1,Q2		;ADVANCE POINTER
	JRST CKCRF1		;TRY NEXT

CKCRF2:	MOVX A,2		;ALLOCATE CELL
	CALL BALLOC		;...
	HRRM A,(Q1)		;LINK TO OLD
	MOVE A,CSBUFP		;POINTER TO NEW STRING
	CALL BUFFS		;ISOLATE THE STRING
	HRRZ B,(Q1)		;GET ADDRESS OF NEW BLOCK
	MOVEM A,1(B)		;STORE POINTER TO STRING IN SECOND WORD OF
				;   BLOCK 
	RET			;RETURN

;ROUTINE TO MERGE EXISTING CREF FILE WITH CORE INFO
FINCRF:	SKIPN CRFHED		;ANYTHING NEW?
	 RET			;NO - THEN DONE
	CALL TJNUM		;GO MAKE A FILENAME
	MOVEI A,"CR"
	DPB A,[POINT 14,FSPEC,34]
	MOVE A,[ASCII/E.TMP/]
	MOVEM A,1+FSPEC		;COMPLETE NAME
	SETZM 2+FSPEC		;MAKE ASCIZ
	LDF A,GJ%SHT!GJ%PHY!GJ%OLD
	HRROI B,FSPEC		;ARGS FOR GTJFN
	CALL GTJFS		;SEE IF FILE EXISTS
	 JRST DONCRF		;NO - JUST DUMP CORE
	LDF B,FLD(7,OF%BSZ)!OF%RD ;BITS FOR READ
	OPENF			;OPEN FILE
	 CALL CJERR		;LOSAGE
	PUSH P,A		;SAVE JFN ON STACK
	PUSH P,EOFDSP		;SAVE EOF TRAP
	MOVEI A,CRFEOF		;NEW ADDRS FOR TRAP
	MOVEM A,EOFDSP		;...
				;FALL INTO FNCRFN
;HERE TO SCAN FILE FOR SPEC
FNCRFN:	MOVE A,-1(P)		;FETCH JFN
FNCRF1:	BIN			;READ A CHAR
	CAIE B,"="		;SEARCH FOR BEGINNING OF SPEC
	 JRST FNCRF1		;LOOP TILL FOUND
	MOVE C,CSBUFP		;   "  POINTER
FNCRF2:	BIN			;GOBBLE CHAR
	CAIN B,LF		;LOOK FOR EOL
	 JRST FNCRF3		;FOUND - CHECK FOR MERGE
	IDPB B,C		;COPY TO STRING SPACE
	JRST FNCRF2

FNCRF3:	SETZ B,			;REPLACE CR WITH NULL
	DPB B,C			;...
	CALL CHKCRF		;CALL COMMON CODE
	JRST FNCRFN		;LOOK FOR MORE

;HERE ON EOF INTERUPT FROM READING CREF FILE
CRFEOF:	POP P,EOFDSP		;RESTORE THIS
	MOVE A,(P)		;GET JFN
	TXO A,CO%NRJ		;RETAIN IT
	CLOSF			;CLOSE FILE
	 CALL CJERR		;NEVER HAPPEN
	LDF B,FLD(7,OF%BSZ)!OF%WR ;OPEN FOR WRITE
	TXZ A,CO%NRJ		;CLEAR FLAG
	OPENF			;...
	 CALL CJERR		;SOMETHING WENT WRONG
	JRST DNCRF1		;JOIN WRITE
;ROUTINE TO WRITE OUT NEW CREF FILE
DONCRF:	CALL TOPNF		;OPEN TMP FILE IN FSPEC
	PUSH P,A		;STACK JFN
DNCRF1:	MOVE Q1,CRFHED		;GET LIST HEAD
	MOVE A,(P)		;GET JFN
DNCRF2:	MOVEI B,"="		;EQUAL SIGN
	BOUT			;7 that's all TBOUT does!
;7	CALL TBOUT		;DUMP IT
	MOVE B,1(Q1)		;POINTER TO FILESPEC
	CALL TSOUT0		;DUMP IT NEXT
	CALL EOLOUT		;  AND CRLF
	SKIPE Q1,(Q1)		;SEE IF MORE
	 JRST DNCRF2		;YES - LOOP BACK
	POP P,A			;NO - CLOSE OUT FILE
	CLOSF			;...
	 CALL CJERR		;WHOOPS
	RET			;ALL DONE - RETURN
;PUTDF - ROUTINE TO OUTPUT FILESPEC AS FOLLOWS:
;   OUTPUT DEVICE IF ANY, DUMP FILENAME TERMINATE ON FIRST PERIOD OR ; OR NULL.
;PUTDF0 - IF Q1 ALREADY SET UP
;
;   RETURNS: +1		FILESPEC TERMINATED (; OR NULL)
;	     +2		IF PERIOD FIRST
PUTDF:	MOVE Q1,NAM(P2)		;USE FILESPEC POINTER
PUTDF0:	PUSH P,[TBOUT]		;ROUTINE TO USE
PUTDFC:	ILDB B,Q1		;GET CHAR
	CAIE B,0		;LOOK FOR NULL
	 CAIN B,";"		; OR SEMICOLON
	  JRST PTDFR		;GIVE RETURN (END-OF-SPEC)
	CAIN B,"."		;PERIOD?
	 JRST PTDFR1		;YES - RETURN NOW
	CALL @(P)		;NO - DUMP CHAR
	JRST PUTDFC		;CONTINUE

PTDFR1:	AOS -1(P)		;SET FOR SKIP RETURN
PTDFR:	POP P,(P)		;PRUNE PDL
	RET			;AND RETURN

;ROUTINE LIKE PUTDF ONLY COPIES TO CORE
CPYDF:	PUSH P,[CPYDF1]		;ROUTINE TO USE
	JRST PUTDFC		;JOIN COMMON CODE

CPYDF1:	IDPB B,C		;POINTER IN C
	RET

;ROUTINE TO SKIP OVER DEVICE FIELD (Q1 HAS TEXT POINTER)
SKPDEV:	PUSH P,Q1		;SAVE ORIG POINTER IF NO DEVICE
SKPDV1:	ILDB B,Q1		;GET A CHAR
	CAIE B,0		;SEARCH FOR NULL
	 CAIN B,";"		;  OR ; AS END OF SPEC
	  JRST SKPDV2		;NO DEVICE - EXIT
	CAIE B,":"		;DEVICE DELIM?
	 JRST SKPDV1		;NO - TRY NEXT CHAR
	MOVEM Q1,(P)		;USE THIS POINTER
SKPDV2:	POP P,Q1		;RETURN UPDATED POINTER
	RET			;...
;OPEN TMP CORE FILE
OPNTMP:	AOS A,NFILES		;INCREASE NUMBER OF TMP FILES BY ONE
	CAIN A,1		;FIRST ONE?
	 JRST OPNT2		;YES
	MOVE B,ADDTAB-2(A)	;NO, IT STARTS RIGHT AFTER LAST ONE
	ADD B,TMPCOR(B)		;GET ADDRESS OF NEXT FILE
	ADDI B,1		;LENGTH DOESN'T INCLUDE HEADER
OPNT1:	HRRZM B,ADDTAB-1(A)	;REMEMBER STARTING ADDRESS OF TMP FILE
	HLLZ C,SIXTAB(P4)	;GET NAME OF TMP FILE, MAC, FOR, LNK ETC.
	SKIPE NATIVF		;DOING NATIVE-STYLE?
	 HLLZ C,NSXTAB(P4)	;YES, GET CORRECT NAME FOR NATIVE COMPILER
	MOVEM C,TMPCOR(B)	;STORE NAME IN LEFT HALF OF FIRST WORD
	MOVEI A,TMPCOR+1(B)	;MAKE BYTE POINTER TO SECOND WORD OF
	HRLI A,(ASCPTR)		;FILE
	RET			;GIVE CALLER THE BYTE POINTER ("JFN")

OPNT2:	SETZM ADDTAB		;CLEAR BUFFER
	MOVE B,[ADDTAB,,ADDTAB+1]
	BLT B,BUF1-1
	MOVX B,TMPBUF-TMPCOR	;ASSUME FIRST ONE
	JRST OPNT1

;CLOSE TEMP FILE
CLSTMP:	MOVE B,NFILES
	MOVE C,ADDTAB-1(B)	;GET BEGINNING OF FILE ADDRESS
	SETZ D,			;END WITH A NULL
CLSTM1:	IDPB D,A		;FILL REST OF WORD WITH NULLS
	TXNE A,76B5		;AT END OF WORD?
	 JRST CLSTM1		;NO, LOOP BACK TIL DONE
	SUBI A,TMPCOR(C)	;CALCULATE LENGTH OF FILE
	HRRM A,TMPCOR(C)	;REMEMBER LENGTH
	RET

;ROUTINE TO ATTEMPT TO OPEN FILE IN FSPEC
TOPNF:	LDF A,GJ%SHT!GJ%FOU!GJ%PHY!GJ%TMP
	HRROI B,FSPEC		;POINT TO FILESPEC
	CALL GTJFS		;GET A JFN
	 CALL CJERR		;TEMP FILE LOSAGE
	LDF B,FLD(7,OF%BSZ)!OF%WR ;BYTE SIZE + WRITE
	OPENF			;OPEN FILE
	 CALL CJERR		;TEMP FILE LOSAGE
	RET			;RETURN

TJNUM:	MOVX Q1,3		;NEED TO MAKE TMP FILE
	MOVE A,CSJOB		;GET JOB #
TJNM1:	IDIVI A,^D10		;DIVIDE INTO DIGITS
	ADDI B,"0"		;CONVERT TO ASCII
	LSHC B,-7		;SHIFT OVER
	SOJG Q1,TJNM1		;LOOP
	MOVEM C,FSPEC		;PUT IN BLOCK
	RET			;RETURN
	SUBTTL PARSE

;THE CMPRES ROUTINE TIDIES UP COMMAND STRINGS FOR THE COMPILE-CLASS COMMANDS.
;   LOTS OF THESE PETTY CHORES ARE NORMALLY HANDLED BY THE MONITOR VIA THE
;   COMND JSYS. HOWEVER, SINCE THE PARSE ROUTINE DOESN'T USE COMND, THIS CMPRES
;   ROUTINE IS NEEDED. CMPRES DOES THE FOLLOWING:
;
;   1) CARRIAGE RETURNS ARE IGNORED. LINEFEEDS ARE CHANGED TO COMMAS. THIS IS
;	SO THAT MULTIPLE-LINE INDIRECT FILES WORK. 
;   2) ALL MULTIPLE SPACES ARE COMPRESSED TO AT MOST ONE SPACE
;   3) ANY SPACES FOLLOWING END OF LINE ARE DELETED. NEGLECTING TO REMOVE
;	SPACES AT END OF LINE CAUSES "COMP FOO.MAC " TO FORCE A COMPILATION.
;   4) SPACES PRECEDING PERCENT SIGNS ARE DELETED. IF SPACES AREN'T REMOVED IN
;	FRONT OF PERCENT, THE COMMAND LOAD FOO %"TEXT" FAILS TO CALL THE
;	COMPILER! 
;   5) COMMENTS ENCLOSED IN EXCLAMS (!) ARE REMOVED
;   6) COMMENTS STARTING WITH SEMICOLON (;) LAST THROUGH THE NEXT LINEFEED OR
;	END OF COMMAND 
;   7) ALL SPACES OTHER THAN THOSE SANDWICHED BETWEEN FILESPECS ARE REMOVED.
;
;   ACCEPTS:	A/	POINTER TO COMMAND STRING
	C%PLUS==1B0		;LAST NON-SPACE WAS NOT A FILESPEC CONSTITUENT

CMPRES:	MOVX A,CMPWDS		;INITIALLY ALLOCATE ENTIRE BUFFER FOR COMMAND
	CALL GETBUF
	MOVEM A,CMPBUF		;REMEMBER ADDRESS OF BLOCK
	ADDI A,CMPWDS-1		;GET LAST ADDRESS IN BLOCK
	SETZM (A)		;GUARANTEE NULL AT END OF STRING
	HRLI A,(<POINT 7,0,27>)	;GET STARTING POINTER IF STRING WERE 0 BYTES
	MOVEM A,CMPPT0		;REMEMBER POINTER TO NULL COMMAND
	MOVE A,.RDIOJ+CSTXTB	;GET POINTER TO COMMAND STRING
	CALL BCOUNT		;SEE HOW MANY CHARACTERS ARE IN IT
	MOVEI C,1(B)		;LEAVE ROOM FOR NULL
	CAILE C,CMPMSZ		;MAKE SURE THERE'S ROOM FOR COMMAND STRING
	 ERROR <COMPIL-class command string is too long>
	MOVEM C,CMPSIZ		;REMEMBER INITIAL SIZE OF STRING
	MOVN A,B		;GET NEGATIVE NUMBER OF CHARACTERS
	MOVE C,A		;REMEMBER NEGATIVE COUNT FOR SOUT JSYS
	ADJBP A,CMPPT0		;GET ACTUAL STARTING BYTE POINTER FOR COMMAND
	MOVEM A,CMPPT0		;REMEMBER STARTING POINTER
	MOVEM A,CSPTR		;INITIALIZE SOURCE POINTER
	MOVEM A,CDPTR		;INITIALIZE DESTINATION POINTER
	MOVE B,.RDIOJ+CSTXTB	;GET POINTER TO COMMAND STRING
	SOUT			;CREATE INITIAL COMMAND (BEFORE EXPANDING
				;   INDIRECT FILES!) 
	MOVX Z,C%PLUS		;FORCE LEADING SPACES TO BE FILTERED OUT
	CALL REMNUL		;REMOVE NULLS FROM COMMAND
CMP2:	CALL GCMC		;GET CHARACTER, STRIP COMMENT IF SEEN
	CAIE A,.CHTAB		;TABS ARE THE SAME AS SPACES
	 CAIN A," "		;A SPACE?
	  JRST CMP1		;YES, GO HACK IT
CMP4:	IDPB A,CDPTR		;NOT A SPACE, STORE IT IN NEW STRING
	JUMPE A,CMPDON		;DONE IF NULL
	TXZ Z,C%PLUS		;FIRST ASSUME FILEPSEC CHARACTER
	CALL SKPFCH		;IS CHARACTER A FILESPEC CHARACTER?
	 TXO Z,C%PLUS		;NO, REMEMBER
	JRST CMP2		;GO BACK FOR REST OF CHARACTERS

CMPDON:	MOVE A,CMPPT0		;GET RESULTANT STARTING POINTER
	MOVEM A,.RDIOJ+CSTXTB	;PLACE IN TEXTI BLOCK
	HRRZ A,A		;KEEP FIRST ADDRESS USED
	SUB A,CMPBUF		;CALCULATE NUMBER OF WORDS UNUSED
	MOVE B,CMPBUF		;TELL RETBUF WHERE THE BLOCK IS
	CALLRET RETBUF		;RETURN THE UNUSED WORDS AND EXIT

CMP1:	CALL GCMC		;GET CHARACTER AFTER SPACE
	CAIE A,.CHTAB		;TABS ARE THE SAME AS SPACES
	 CAIN A," "		;MULTIPLE SPACES?
	  JRST CMP1		;YES, SEARCH FOR FIRST NON-SPACE
	TXNE Z,C%PLUS		;WAS CHARACTER BEFORE SPACES A NON-FILE
				;   CHARACTER? 
	 JRST CMP4		;YES, SO LEAVE OUT THE SPACES
	JUMPE A,CMP4		;THROW AWAY TRAILING SPACES
	CALL SKPFCH		;SKIP IF CHARACTER IS A FILE CHARACTER
	 JRST CMP7		;NOT A FILE CHARACTER, SO THROW AWAY SPACES
	MOVEI A," "		;SPACE SANDWICHED BETWEEN FILESPECS, LEAVE IT
				;   IN 
	IDPB A,CDPTR
CMP7:	LDB A,CSPTR		;GET THE FILE CHARACTER BACK
	JRST CMP4

;SKPFCH - SKIPS IF CHARACTER IS A FILE CONSTITUENT FOR COMPIL-CLASS COMMANDS.
;
;   ACCEPTS:	A/	CHARACTER
;   RETURNS: +1		CHARACTER IS NOT PART OF A FILESPEC
;	     +2		CHARACTER IS PART OF A FILESPEC
SKPFCH:	IDIVI A,^D32		;GET INDEX AND OFFSET
	MOVE B,BITS(B)		;GET BIT POSITION
	TDNE B,NFLBTS(A)	;SKIP IF BIT NOT ON
	 RET			;BIT ON, CHARACTER IS NOT PART OF FILESPEC
	RETSKP			;CHARACTER IS PART OF FILESPEC, SKIP.

;TABLE OF CHARACTERS NOT INCLUDED IN COMPIL-CLASS FILESPECS. THERE ARE FOUR
;   WORDS, EACH OF WHICH CONTAINING 32 LEFT-JUSTIFIED BITS, YIELDING A TOTAL OF
;   128 BITS, ONE FOR EACH POSSIBLE CHARACTER. THE BIT IS ON IF THE CHARACTER
;   IS NOT PART OF A FILESPEC 
NFLBTS:	BRMSK. FILB0.,FILB1.,FILB2.,FILB3.,,<%>	;PERCENT IS PART OF A LINK
				;   SWITCH 

;GET CHARACTER, STRIP COMMENT OR CARRIAGE RETURN IF SEEN
GCMC:	ILDB A,CSPTR		;LOOK AT CHARACTER FROM OLD STRING
	CAIN A,"@"		;INDIRECT FILE?
	 JRST GCMIND		;YES, GO STUFF IT INTO THE STRING
	CAIN A,.CHCRT		;CARRIAGE RETURN
	 JRST GCMC		;YES, IGNORE IT
	CAIN A,QUOTE		;QUOTED STRING?
	 JRST GCMQT		;YES, FIND THE END OF IT
	CAIE A,","		;COMMA IS SAME AS LINEFEED!
	 CAIN A,.CHLFD		;END OF LINE?
	  JRST GCMLF		;YES
	CAIN A,";"		;IS REST OF LINE A COMMENT?
	 JRST CMP6		;YES, GO FIND END OF LINE
	CAIE A,"!"		;INTERNAL COMMENT IN LINE?
	 RET			;NO
CMP5:	ILDB A,CSPTR		;YES, FIND END OF IT
	JUMPE A,R		;IF COMMAND ENDS BEFORE COMMENT, CATCH IT.
	CAIN A,.CHLFD		;END OF LINE SEEN?
	 JRST GCMLF		;YES, ENDS COMMENT AND ACTS AS END OF LINE
	CAIE A,"!"		;END OF COMMENT YET?
	 JRST CMP5		;NO, KEEP LOOKING
	JRST GCMC		;COMMENT OVER, READ NEXT CHARACTER

CMP6:	ILDB A,CSPTR		;REST OF LINE IS COMMENT, FIND END OF LINE
	JUMPE A,R		;NULL MEANS END OF LINE
	CAIN A,.CHLFD		;END OF LINE SEEN?
	 JRST GCMLF		;YES, ENDS COMMENT AND ACTS AS END OF LINE
	JRST CMP6		;KEEP LOOKING FOR END OF LINE

;GET HERE WHEN ATSIGN (@) SEEN IN COMMAND STRING. SHOVE EVERYTHING TO THE LEFT
;   OF IT MORE TO THE LEFT, SO THE INDIRECT FILE'S CONTENTS MAY BE STUFFED IN
;   INSTEAD OF THE ATSIGN AND THE FILESPEC 
GCMIND:	HRROI A,[ASCIZ/CMD/]	;DEFAULT EXTENSION
	MOVEM A,CJFNBK+.GJEXT	;GOOD PLACE
	MOVE A,[.NULIO,,.NULIO]
	MOVEM A,CJFNBK+.GJSRC	;NO EXTRA INPUT
	LDF A,GJ%OLD		;PREPARE FOR GTJFN
	MOVEM A,CJFNBK		;STORE
	MOVEI A,CJFNBK		;POINT TO BLOCK
	MOVE B,CSPTR		;POINTER TO STRING
	CALL GTJFS		;GET A JFN
	 CALL  [MOVE B,CSPTR	;FAILED, TRY TO GET PARSE-ONLY JFN
		MOVE Q1,A	;REMEMBER ERROR CODE
		MOVX A,GJ%OFG	;SAY WE WANT NAME ONLY
		MOVEM A,.GJGEN+CJFNBK
		MOVEI A,CJFNBK
		CALL GTJFS	;ATTEMPT PARSE-ONLY
		 CALL  [MOVE A,Q1 ;FAILED, GET ORIGINAL ERROR
			ERROR <Can't access indirect file - %1?>]
		MOVE B,Q1	;GOT A JFN, GET THE ERROR CODE
		ERROR <Can't access indirect file %1S - %2?>]
	SETO C,
	ADJBP C,B		;KEEP CHARACTER AFTER FILESPEC
	MOVEM C,CJEPTR		;REMEMBER POINTER TO END OF FILESPEC
	LDF B,FLD(7,OF%BSZ)!OF%RD ;BITS FOR OPENF
	MOVEM A,INDJFN		;REMEMBER INDIRECT JFN
	OPENF			;OPEN FILE
	 CALL CJERR		;WHOOPS
	MOVE B,[2,,.FBBYV]	;WE WANT BYTE SIZE AND NUMBER OF BYTES
	MOVEI C,C		;READ INFO INTO C AND D
	GTFDB
	 ERCAL [ERROR <Can't determine size of indirect file %1S>]
	LOAD C,FB%BSZ,C		;ISOLATE THE BYTE SIZE
	MOVE A,[POINT 0,A]	;GET BYTE POINTER TO 0TH BYTE IF BYTE SIZE WAS
				;   0 
	DPB C,[POINT 6,A,11]	;NOW A HAS BYTE POINTER TO 0TH BYTE
	ADJBP D,A		;GET POINTER TO LAST BYTE IN D
	HRRZ A,D		;REMEMBER NUMBER OF WORDS
	LDB C,[POINT 6,D,5]	;GET NUMBER OF UNUSED BITS IN LAST WORD
	SUBI C,1		;BIT 35 IS UNUSED FOR ASCII
	IDIVI C,7		;SEE HOW MANY ASCII BYTES ARE UNUSED IN LAST
				;   WORD 
	IMULI A,5		;GET MAXIMUM NUMBER OF ASCII CHARACTERS
	SUB A,C			;GET RID OF UNUSED CHARACTERS
	MOVEM A,INDSIZ		;REMEMBER TOTAL NUMBER OF ASCII CHARACTERS
	SETO A,
	ADJBP A,CSPTR		;BACKUP ONE FROM CURRENT TO FLUSH THE ATSIGN
	MOVEM A,CSPTR		;STORE SO THAT FIRST CHARACTER OF INDIRECT FILE
				;   GETS SEEN 
	MOVE B,CJEPTR		;GET POINTER TO END OF FILESPEC
	CALL SUBBP		;GET NEGATIVE CHARACTERS FILESPEC AND ATSIGN
				;   TAKES 
	ADD A,INDSIZ		;ADD TO SPACE NEEDED BY INDIRECT FILE TO GET
				;   DISTANCE STUFF HAS TO BE SHUFFLED 
	MOVEM A,ADDSIZ		;REMEMBER ADDITIONAL SIZE OF COMMAND
	MOVE B,CMPPT0		;GET POINTER TO BEGINNING OF STRING
	MOVE A,CSPTR		;GET POINTER TO BEFORE ATSIGN
	CALL SUBBP		;CALCULATE LENGTH OF STRING TO MOVE
	MOVN C,A		;TELL SOUT TO MOVE EXACTLY THAT NUMBER OF
				;   CHARACTERS 
	MOVE A,ADDSIZ		;GET ADDITIONAL SIZE (MIGHT BE NEGATIVE!)
	ADDB A,CMPSIZ		;GET TOTAL NEW SIZE OF COMMAND STRING
	SKIPGE ADDSIZ		;IS COMMAND STRING SHRINKING?
	 JRST GSHRNK		;YES, CONTENTS IS SHORTER THAN FILEPSEC!
	CAILE A,CMPMSZ		;STILL LESS THAN MAXIMUM ALLOWED?
	 ERROR <Indirect file too large or too many indirect files>
	MOVN A,ADDSIZ		;GET NEGATIVE AMOUNT WE HAVE TO MOVE THE
				;   COMMAND 
	ADJBP A,CMPPT0		;BACKUP POINTER TO GET NEW BEGINNING
	MOVE B,CMPPT0		;MOVE FROM OLD BEGINNING
	MOVEM A,CMPPT0		;REMEMBER NEW BEGINNING
	CAIE C,0		;DON'T GIVE SOUT 0, SINCE IT DOESN'T MEAN 0
				;   BYTES 
	 SOUT			;SHOVE FIRST PORTION TO THE LEFT
	MOVE B,A		;B NOW HAS PLACE WHERE INDIRECT FILE GOES
	MOVE A,INDJFN		;SAY WHAT CHANNEL INDIRECT FILE IS ON
	MOVN C,INDSIZ		;PREPARE TO READ EXACT NUMBER OF CHARACTERS
	CALL GEOFQ		;DO SIN AND CHECK FOR EOF
	JUMPN C,[MOVE A,CJEPTR	;SIN STOPPED SHORT. GET POINTER TO COMMAND
				;   BEYOND THE INDIRECT SPEC 
		SETZ C,		;STOP ON NULL
		SIN		;SLIDE STUFF LEFT TO FILL GAP AFTER INDIRECT
				;   FILE CONTENTS 
		JRST .+1]
	MOVN A,ADDSIZ		;GET NEGATIVE AMOUNT WE MOVED STRING
	ADJBP A,CDPTR		;FIX DESTINATION POINTER TO ACCOUNT FOR MOVED
				;   STRING 
	MOVEM A,CDPTR		;REMEMBER FIXED POINTER
	MOVN A,ADDSIZ		;FIX SOURCE POINTER
	ADJBP A,CSPTR
	MOVEM A,CSPTR		;STORE FIXED SOURCE POINTER
GCOMMN:	CALL RJFN		;CLOSE INDIRECT FILE SO THAT HAVING MANY LEVELS
				;   DOESN'T RUN OUT OF JFNS 
	CALL REMNUL		;REMOVE ANY NULLS THAT WERE IN INDIRECT FILE
	JRST GCMC		;CONTINUE PARSING WITH CONTENTS OF INDIRECT
				;   FILE 

GCMQT:	IDPB A,CDPTR		;SAVE QUOTED STRING
GCQ1:	ILDB A,CSPTR		;QUOTED STRING, FIND ITS END
	CAIE A,QUOTE		;FIND THE END YET?
	 JRST GCMQT		;NO, KEEP LOOKING
	RET

;REMNUL - USES CSPTR AS POINTER TO "REST" OF UNCOMPRESSED STRING AND REMOVES
;   ANY NULLS EXCEPT THE ONE TERMINATING THE STRING. THE REASON WE DON'T MERELY
;   STRIP NULLS AS WE SCAN THE STRING, IS THAT WHEN ATSIGN IS SEEN, GTJFN IS
;   SCANNING, SO WE MUST MAKE SURE WE STRIP AT LEAST THOSE NULLS THAT MAY FALL
;   WITHIN A FILESPEC. 
REMNUL:	MOVE A,CSPTR		;START SCANNING HERE
	MOVE B,CSPTR		;STORE NON-NULLS WITH B POINTER
REMN1:	ILDB C,A		;PICK UP NEXT CHARACTER FROM COMMAND STRING
	IDPB C,B		;STORE IT, NULL OR NOT.
	JUMPN C,REMN1		;JUST CONTINUE IF NON-NULL
	MOVE C,CMPSIZ		;NULL FOUND, CALCULATE POINTER TO END OF STRING
	ADJBP C,CMPPT0
	CAMN B,C		;IS THIS NULL AT END OF STRING?
	 RET			;YES, WE'RE DONE
	SETO C,			;STRING DIDN'T END, BACK UP DESTINATION POINTER
	ADJBP C,B
	MOVE B,C		;CAUSE INTERNAL NULL TO BE OVERWRITTEN
	SOS CMPSIZ		;REMEMBER REDUCED SIZE TOO
	JRST REMN1		;LOOP FOR CHARACTERS AFTER INTERNAL NULL

;HERE DURING INDIRECT PROCESSING IF INDIRECT FILE CONTENTS IS SHORTER THAN ITS
;   NAME. HANDLE THIS BY COPYING THE INDIRECT FILE CONTENTS OVER THE FILESPEC
;   AND THEN SLIDING THE REMAINDER OF THE COMMAND STRING TO THE LEFT 
GSHRNK:	MOVE A,INDJFN		;GET HANDLE OF INDIRECT FILE
	MOVE B,CSPTR		;COPY OVER THE ATSIGN AND FILESPEC
	MOVN C,INDSIZ		;INPUT EXACT NUMBER OF CHARACTERS
	CALL GEOFQ		;DO SIN AND CHECK FOR EOF
	MOVE A,CJEPTR		;NOW INPUT CHARACTERS STARTING AFTER FILESPEC
	SETZ C,			;READ UNTIL NULL FOUND
	SIN			;SLIDE STUFF LEFT THAT WAS AFTER INDIRECT SPEC
	JRST GCOMMN		;JOIN COMMON CODE

;GEOFQ DOES SIN AND VERIFIES THAT THE FAILING SIN JSYS READING THE INDIRECT
;   FILE WAS DUE TO EOF. THIS IS EXPECTED IF THE INDIRECT FILE HAS LINE
;   NUMBERS. 
;
;   RETURNS: +1		EOF WAS THE CAUSE OF THE ERROR.  ALL AC'S PRESERVED.
;	     NEVER	IF SOME STRANGE ERROR OCCURRED
GEOFQ:	SIN			;READ ENTIRE FILE
	 ERSKP			;FAILED, GO INVESTIAGE
	  RET			;SUCCEEDED, RETURN
	ADDM C,CMPSIZ		;FIX COMMAND SIZE. C WILL BE NEGATIVE IF LINE
				;   NUMBERS IN INDIRECT FILE 
	SAVEAC <A,B,C,D>	;SAVE WHAT THE SIN JSYS RETURNED
	CALL DGETER		;GET THE ERROR CODE
	CAIE A,IOX4		;END OF FILE REACHED?
	 CALL CJERRE		;NO, SO BOMB OUT
	RET			;YES, SO RETURN GOOD

;COME HERE IF COMMA OR LF. WE MUST FILTER OUT MULTIPLE COMMAS, SINCE CRLF AT
;   THE END OF INDIRECT FILES GENERATES ONE COMMA, AND THEN THE COMMA IN THE
;   COMMAND FOLLOWING THE INDIRECT SPEC WOULD CAUSE A MULTIPLE ONE.
GCMLF:	MOVE B,CDPTR
	CAMN B,CMPPT0		;IS LINEFEED AT BEGINNING OF COMMAND?
	 JRST GCMC		;YES, SO IGNORE IT
	LDB A,CDPTR		;LINEFEED IS USUALLY COMMA, BUT SEE IF COMMA
				;   ALREADY 
	CAIN A,","		;DO WE ALREADY HAVE A COMMA?
	 JRST GCMC		;YES, IGNORE THIS LINEFEED
	MOVX A,","		;TREAT END OF LINE AS COMMA
	DPB A,CSPTR		;STORE IN SOURCE STRING IN FOR LDB INSTRUCTION
	RET			;ACCOUNT FOR COMMA

;MAIN PARSER
PARSE:	CALL RDFLD		;HERE TO READ A FIELD
PARSE2:	JRST XTAB(A)		;TRANSFER ON BREAK TYPE

;TRANSFER TABLE FOR CHARACTER TYPE DISPATCH
XTAB:	ERROR <Illegal character in command>	;0 - ILLEGAL
	JRST RDSPAC				;1 - SPACE SEEN
	JRST RDPLUS				;2 - PLUS SEEN
	JRST RDSLSH				;3 - SLASH SEEN
	ERROR <Illegal character in command>	;4 - ILLEGAL
	ERROR <Illegal character in command>	;5 - ILLEGAL
	JRST RDCOMA				;6 - COMMA SEEN
	RET					;NULL IS END OF COMMAND
	ERROR <Illegal character in command>	;10 - ILLEGAL
	JRST RDPERC				;11 - PERCENT SEEN
	JRST RDCOLN				;12 - COLON SEEN
	JRST RDQS				;13 - QUOTED STRING STARTING
	ERROR <Illegal character in command>	;14 - ILLEGAL
	ERROR <Illegal character in command>	;15 - ILLEGAL
	ERROR <Illegal character in command>	;16 - ILLEGAL
;HERE TO HANDLE QUOTED STRING
RDQS:	MOVE A,P4		;GET POINTER TO SWITCH
	CALL SWMOV		;SAVE SWITCH STRING IN FSPEC
	CALL RDQOT1		;READ QUOTED STRING (OPEN QUOTE ALREADY SEEN)
	MOVEM A,SAVQS		;REMEMBER POINTER TO QUOTED STRING
	HRROI A,FSPEC		;POINT TO THE SAVED SWITCH
	CALL DOSWI0		;HANDLE THE PARTICULAR SWITCH
	TXZ P1,F%SLSH		;SAY WE ARE DONE PROCESSING THE SWITCH
	TXO P1,F%CMOK		;SAY NULL SPEC IS OK
	JRST PARSE		;GO READ THE NEXT ITEM IN THE COMMAND

;HERE TO PROCESS COLON (MAY BE SWITCH DELIM OR DEVICE)
RDCOLN:	CAIG P3,1		;ANYTHING?
	 ERROR <Null spec before colon>
	CALL CAPND		;APPEND COLON TO BUFFER
	JRST XTAB(A)		;DISPATCH

CAPND:	MOVX Q1,":"		;REPLACE DELIMITER
CAPND1:	DPB Q1,.RDDBP+CSTXTB	;IN BUFFER
	PUSH P,P3		;SAVE COUNT
	CALL RDFLD0		;SPECIAL READ
	ADDM P3,(P)		;UPDATE COUNT
	POP P,P3		;PRUNE PDL
	RET			;RETURN

;HERE TO PROCESS LINK SWITCH SPEC
RDPERC:	CAILE P3,1		;BETTER STAND ALONE
	 JRST RDSLH1		;ELSE MAY BE LOCAL SW
	MOVX A,L.SIZE		;SIZE FOR L20 SWITCH
	CALL BALLOC		;ALLOCATE BLOCK
	HRRM A,LNK(P2)		;LINK TO NEW BLOCK
	MOVE P2,A		;UPDATE AC P2
	CALL RDQUOT		;READ QUOTED STRING
	MOVEM A,NAM(P2)		;STORE STRING POINTER
	LDF Q2,D%LINK		;SAY LINK SWITCH
	IORM Q2,FLG(P2)		;...
	TXO P1,F%CMOK		;SAY NULL SPEC OK
	JRST PARSE		;CONTINUE
;HERE TO PROCESS COMMA (MUST HAVE COMPLETE FILESPEC NOW)
RDCOMA:	TXZE P1,F%SLSH		;SWITCH FIELD?
	 JRST RDCMA3		;YES - PROCESS
	CAILE P3,1		;DO WE HAVE AN ATOM?
	 JRST  [CALL FILBLK	;YES - GEN BLOCK
		TXZ P1,F%FILE	;DONE WITH THIS SPEC
		JRST RDCMA1]	;PROCEDE
	TXNN P1,F%CMOK		;NULL ATOM - IS IT OK?
	 JRST PARSE		;NO, MUST BE END OF INDIRECT FILE
RDCMA1:	TXZ P1,F%CMOK		;CLEAR FLAG FOR NULL SPEC
	SKIPN Q1,SRCSAV		;DID WE HAVE SEPARATE SOURCES
	 JRST RDCMA2		;DONE - SET UP LANG TYPE
	MOVE B,BAKPTR		;GET PREVIOUS BLOCK POINTER
	TXNE P1,F%OBJ		;HAVE OBJECT?
	 SETZM LNK(B)		;YES - CLEAR OLD SRC LINK
	TXZN P1,F%OBJ		;CHECK FOR OBJ GIVEN
	 CALL MAKOBJ		;MAKE OBJECT BLOCK
	HRLM Q1,SRC(P2)		;POINTER TO SOURCE LIST
	HLRZ Q1,SRCSAV		;POINTER TO LAST OBJ BLOCK
	HRRM P2,LNK(Q1)		;POINT TO NEW ONE
	MOVX Q2,LT.REL		;MARK AS RELOC
	DPB Q2,[POINTR FLG(P2),F.LMSK]
	SETZM SRCSAV		;CLEAR POINTER
RDCMA2:	SKIPGE B,LPROC		;HAVE A PROCESSOR?
	 LDB B,[POINTR P1,F.LMSK] ;USE DEFAULT
	SETOM LPROC		;CLEAR THIS NOW
	MOVE Q1,B		;COPY TYPE
	CAIE Q1,LT.REL		;NO DEBUG AID FOR REL FILES
	 CAIN Q1,LT.MAC		;  OR MACRO
	  SETZ Q1,		;YES - NO AID FOR YOU
	CAIN B,LT.SAI		;IF SAIL
	 SETOM SAILF		;SAY WE HAVE SEEN SAIL
	CAMLE Q1,DEBAID		;CHECK BEST SEEN SO FAR
	 MOVEM Q1,DEBAID	;SAVE BETTER
	PUSH P,P2		;SAVE THIS POINTER
	HLL P2,SRC(P2)		;POINTER TO SOURCE LIST
	MOVE P5,FLG(P2)		;GET FLAGS
	SETZ Q2,		;INIT REG
	CALL SRCSCN		;LOOP THROUGH SOURCES
	 JRST  [DPB B,[POINTR FLG(P2),F.LMSK] ;STORE TYPE
		ANDI P5,F.ALL	;MASK FLAGS WE WANT
		IOR Q2,P5	;ACCUMULATE RESULT
		RET]		; AND EXIT
	POP P,P2		;RESTORE ORIG POINTER
	IORM Q2,FLG(P2)		;SET AGGREGATE FLAGS
	JRST PARSE		;CONTINUE SCAN
;HERE TO PROCESS SWITCH
RDCMA3:	TXZE P1,F%FILE		;FILE SPEC SEEN?
	 JRST [CALL DOSWIT	;PROCESS SWITCH
		JRST RDCMA1]	;CHECK FOR 2ND PART
	CALL DOSWIT		;DO SWITCH
	TXNE P1,F%SPEC		;ANYTHING YET?
	 SKIPGE LPROC		;YES - LANG SWITCH?
	  JRST PARSE		;NO - CONTINUE
	JRST RDCMA2		;YES - HANDLE SOURCE UPDATE

;ROUTINE TO MAKE OBJ BLOCK FROM LAST SRC BLOCK (P2)
MAKOBJ:	MOVEI A,B.SIZE		;GET SOME SPACE
	CALL BALLOC		;...
	EXCH A,P2		;P2 POINTS TO NEW BLK
	MOVEI Q2,NAM(P2)	;SET UP BLT POINTER
	HRLI Q2,NAM(A)		;...
	BLT Q2,B.SIZE-1(P2)	;MOVE VALUES
	LDF A,D%EXTN		;CLEAR EXPLICIT EXTENSION
	ANDCAM A,FLG(P2)	;  FLAG IN IMPLICIT NAME
	RET			;RETURN
;HERE TO PROCESS SLASH
RDSLSH:	CAILE P3,1		;ANYTHING BEFORE SLASH?
	 JRST RDSLH1		;HANDLE FILESPEC
	TXOE P1,F%SLSH		;SET SLASH SEEN
	 ERROR <Illegal slash>
	JRST PARSE		;CONTINUE SCAN

;HERE TO HANDLE SPEC BEFORE SLASH IS PROCESSED
RDSLH1:	TXO P1,F%LAHD		;WANT TO SEE IT AGAIN
	TXZE P1,F%SLSH		;PREVIOUS SWITCH?
	 JRST RDSPC2		;YES - PROCESS
	CALL FILBLK		;STORE FILE SPEC
	TXNE P1,F%OBJ		;IN OBJECT SPEC?
	 JRST  [TXZ P1,F%FILE	;YES - SAY DONE WITH SPEC
		JRST RDCMA1]	; AND STORE
	HRL P2,B		;SAVE BACK POINTER
	JRST PARSE		;AND CONTINUE SCAN

;HERE TO PROCESS SPACE (DELIMITS OBJECT MODULE)
RDSPAC:	TXZ P1,F%CMOK		;CLR THIS HERE
	TXZN P1,F%FILE		;ANY SPEC SEEN YET?
	 JRST RDSPC1		;NO - CHECK SWITCH
	TXZE P1,F%SLSH		;SW SEEN?
	 JRST  [SKIPN SRCSAV	;SAVED SOURCE POINTER YET?
		 MOVEM P2,SRCSAV ;NO - SAVE ONE
		TXO P1,F%OBJ	;AND MOVE TO OBJECT FIELD
		JRST RDSPC2]	;PROCESS SWITCH
RDSPC0:	CAIG P3,1		;DO WE HAVE A SPEC?
	 CALL SCREWUP		;NEVER COME HERE
	CALL RDFILB		;SAVE FILE
	TXO P1,F%OBJ		; AND SET FLAG FOR OBJECT
	JRST PARSE		;PROCEDE

RDSPC1:	TXZN P1,F%SLSH		;SWITCH?
	 JRST RDSPC0		;NO - FILE ALONE
RDSPC2:	CALL DOSWIT		;PROCESS SWITCH
	JRST PARSE		;PROCEED

;HERE TO PROCESS PLUS SIGN (MULTIPLE SOURCES)
RDPLUS:	CAILE P3,1		;BETTER HAVE SPEC
	 TXNE P1,F%OBJ		;AND BE IN SOURCE FIELD
	  ERROR <Illegal plus sign>
	CALL RDFILB		;STASH SPEC AND CHECK SRCSAV
	JRST PARSE		;GET NEXT SPEC

RDFILB:	CALL FILBK1		;STASH SPEC ETC.
	HRL P2,B		;BACK POINTER TO BE SAVED
	SKIPN SRCSAV		;FIRST TIME?
	 MOVEM P2,SRCSAV	;YES - SAVE POINTER TO THIS BLK
	RET			;RETURN
	SUBTTL PARSE SUBROUTINES

;ROUTINE TO ALLOCATE AND FILL A FILE DESCR BLOCK
;
;   RETURNS:	B/	POINTER TO PREVIOUS BLOCK
;		P2/	POINTER TO NEW BLOCK
FILBLK:	TXOA P1,F%LOBJ		;SAY OK TO LOOK FOR OBJECT
FILBK1:	 TXZ P1,F%LOBJ		;SAY NOT TO LOOK FOR OBJCECT
	MOVE B,[ASCPTR FSPEC]	;COPY STRING TO FSPEC
FILBK2:	ILDB A,P4		;...
	IDPB A,B
	JUMPN A,FILBK2
	MOVX A,B.SIZE		;SIZE OF BLOCK
	CALL BALLOC		;ALLOCATE IT
	HRRM A,LNK(P2)		;STORE POINTER TO NEW BLOCK
	PUSH P,P2		;SAVE OLD POINTER
	MOVE P2,A		;SET UP NEW POINTER
	HRRM P1,FLG(P2)		;SET DEFAULTS
	SETZM NAM(P2)		;NONE YET
	TXO P1,F%FILE!F%SPEC	;SAY FILE SEEN
	CALL GTLANG		;FILL IN LANG TYPE INFO
	 JRST  [LDF A,D%FNF	;SET FILE NOT FOUND
		IORM A,FLG(P2)	;IN FLAGS OF SPEC
		JRST NODEF]	;KEEP GOING
	MOVE A,EXTP		;GET POINTER TO EXTENSION
	TXNN P1,F%OBJ		;ON OBJECT OR FILE NOT FOUND?
	 CALL PARDEF		;NO, GOBBLE THE DEFAULT SWITCHES
NODEF:	POP P,B			;RETURN BACK POINTER
	MOVEM B,BAKPTR		;STORE IN BAKPTR TOO
	RET			;...
;ROUTINE TO ALLOCATE SOME SPACE IN STRING SPACE
;
;   ACCEPTS:	A/	SIZE OF REQUIRED SPACE
;   RETURNS:	A/	ADDR OF BLOCK (BLOCK IS ZEROED)
BALLOC:	STKVAR <BSZ>
	MOVEM A,BSZ		;REMEMBER HOW MUCH IS WANTED
	CALL GETBUF		;GET THE MEMORY
	SETZM (A)		;CLEAR OUT THE BLOCK
	SOSGE B,BSZ		;GET ONE LESS THAN SIZE
	 RET			;NO MORE TO CLEAR, BLOCK IS ONE ONE WORD
	ADD B,A			;GET LAS WORD TO CLEAR
	HRRI C,1(A)		;MAKE BLT POINTER FOR 0ING BLOCK
	HRL C,A
	BLT C,(B)		;0 THE BLOCK
	RET
;GTLANG - ROUTINE TO DETERMINE LANGUAGE TYPE AND CHECK FOR EXISTING OBJECT
;   FILE. 
GTLANG:	CALL GTLNGX		;CALL SUBROUTINE
	 JRST GTLNGA		;NO SUCH FILE RETURN
	AOS (P)			;SKIP RETURN
GTLNGB:	HRRZ A,LNGJFN		;GET JFN USED
	JUMPE A,R		;NONE - RETURN
	CALL RJFN		;RELEASE LNGJFN
	SETZM LNGJFN		;SAY RELEASED
	RET			;GIVE DESIRED RETURN

GTLNGA:	HRROI A,FSPEC		;POINT TO SPEC
	CALL BUFFS		;ISOLATE IT
	MOVEM A,NAM(P2)		;REMEMBER POINTER
	JRST GTLNGB		;JOIN COMMON CODE
GTLNGX:	HRROI A,[ASCII/*/]	;DEFAULT EXTENSION
;	TXNE P1,F%OBJ		;IN OBJECT FIELD?
;	HRROI A,[ASCII/REL/]	;YES - USE THIS DEFAULT
	MOVEM A,CJFNBK+.GJEXT
	MOVE A,[.NULIO,,.NULIO] ;DON'T USE ANY OTHER INPUT
	MOVEM A,CJFNBK+.GJSRC
	LDF A,GJ%OLD!GJ%IFG!GJ%FLG
	MOVEM A,CJFNBK		;STORE FLAGS
	MOVEI A,CJFNBK		;BLOCK ADDRS
	HRROI B,FSPEC		;POINT TO STRING
	CALL GTJFS		;LOOK UP FILE
	 JRST  [CAIN A,GJFX24	;FILE NOT FOUND RETURN
		 RET		;RETURN ERROR
		CAIL A,GJFX16	;VARIOUS OTHER FNF RETURNS
		 CAILE A,GJFX21	;...
		  CALL CJERR	;SYNTAX ERROR
		RET]		;ERROR RETURN
	MOVEM A,LNGJFN		;SAVE JFN
	LDB B,B			;CHECK TERMINATOR
	JUMPN B,[HRROI A,FSPEC
		ERROR <Illegal character in filespec: %1m>]
	TXNE A,GJ%EXT		;* FOR EXTENSION
	 JRST  [TXNN P1,F%OBJ	;YES, IN OBJ FIELD?
		 JRST GTLNG1	;NO, LOOK FOR STANDARD EXT
		JRST GTOBF1]	;YES, LOOK FOR REL
GTOBF2:	MOVE A,LNGJFN		;GET JFN
	CALL DJFNSE		;GET EXTENSION
	CALL COPEXT		;COPY EXTENSION
	CALL GTASC		;GET ACTUAL ASCII STRING
	HRRZ A,LNGJFN		;JFN
	DVCHR			;GET DEVICE CHARACTERISTICS
	TXNN B,DV%DIR		;DIRECTORY DEVICE?
	 JRST  [HRLOI A,377777	;FUNNY LARGE DATE
		MOVEM A,SVER(P2)
		RETSKP]		;GIVE GOOD RETURN
	LDF A,D%EXTN		;EXPLICIT EXT GIVEN
	IORM A,FLG(P2)
	MOVE A,LNGJFN		;JFN
	CALL GTPPN		;GET PPN
	HRRZ A,LNGJFN		;RESTORE JFN
	CALL GTDT		;GET SOURCE DATE/TIME
	PUSH P,A		;SAVE D/T
	CALL LOOKE		;LOOK UP EXTENSION IN CSBUF
	 ABSKP			;IGNORE IF NOT FOUND
	  CALL SETLTP		;SET LANG TYPE
	POP P,A			;RESTORE D/T
	CALL STODT		;STORE D/T ACCORDING TO TYPE
				;FALL INTO NEXT PAGE
	CAIN B,LT.REL		;OBJECT TYPE ALREADY
	 JRST  [LDF A,D%OSRC	;YES - SET FLG WHERE OBJ IS
		IORM A,FLG(P2)
		RETSKP]		;   AND EXIT
	TXNN P1,F%LOBJ		;CAN WE LOOK FOR OBJECT?
	 RETSKP			;NO
	MOVE A,CSBUFP		;GET POINTER TO STRING SPACE
	MOVEM A,SRCPTR		;THIS WILL BE POINTER TO SOURCE SPEC
	MOVE B,LNGJFN		;GET JFN
	LDF C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF
	JFNS			;GET DEV:<DIR>
GTLNGZ:	MOVEM A,DSKPTR		;THIS BEGINS CONNECTED FILESPEC
	MOVE B,LNGJFN		;GET JFN
	LDF C,FLD(.JSAOF,JS%NAM)!JS%PAF
	JFNS			;GET NAME
	HRROI B,[ASCIZ/REL/]
	LDF C,FLD(.JSAOF,JS%TYP)!JS%PTR!JS%PAF
	JFNS			;TACK ON .REL
	CALL GTLNGB		;RELEASE JFN
	SETZM .GJDEV+CJFNBK	;CLEAR DEFAULTS
	MOVE Q1,[.GJDEV+CJFNBK,,.GJDIR+CJFNBK]
	BLT Q1,XTNCNT-1		;...
	LDF A,GJ%OLD		;OLD FILE ONLY
	LDF B,D%OSRC
	TDNN B,FLG(P2)		;HAVE SEEN REL IN SAME DIR AS SOURCE?
	 TXO A,GJ%NS		;NO, PREVENT FOLLOWING SEARCH LIST
	MOVEM A,CJFNBK		;...
GTLNGY:	MOVEI A,CJFNBK		;POINT TO BLOCK
	SKIPN B,SRCPTR		;TRY SOURCE AREA?
	MOVE B,DSKPTR		;NO, DSK:
	CALL GTJFS		;LOOK UP
	 JRST  [SKIPN SRCPTR	;TRIED DSK: YET?
		 RETSKP		;YES, ALL DONE
		SETZM SRCPTR	;NO, TRY IT NOW
		JRST GTLNGY]
	MOVEM A,LNGJFN		;STORE JFN
	CALL GTDT		;GET DATE/TIME
	MOVEM A,OVER(P2)	;REMEMBER IT.
	LDF A,D%OSRC		;FOUND IN SOURCE AREA FLAG
	SKIPN SRCPTR		;WAS THIS SOURCE AREA?
	 JRST  [ANDCAM A,FLG(P2) ;SAY .REL FOUND IN DSK:
		RETSKP]
	IORM A,FLG(P2)		;SET FLAG
	SETZM SRCPTR		;NOW TRY DSK:
	JRST GTLNGY
;GTLANG...

;HERE IF IN OBJ FIELD. HAVE LOOKED UP FILNAM.*, SEE IF REL IS ONE OF THE VALUES
;   OF * 
GTOBF1:	MOVE A,LNGJFN
	CALL DJFNSE		;GET EXT STRING
	MOVE B,CWBUF
	CAMN B,[ASCIZ/REL/]	;A REL?
 	 JRST GTOBF2		;YES, PROCESS IT
	MOVE A,LNGJFN
	GNJFN			;STEP
	 RET			;NORMAL NOT FOUND RETURN
	JRST GTOBF1		;TRY AGAIN

;HERE IF NO EXT SPECIFIED - FIND A STANDARD ONE TO USE
GTLNG1:	SETO Q3,		;INITIAL VALUE
GTLNG2:	MOVE A,LNGJFN		;GTJFN FLAGS ETC...
	CALL DJFNSE		;GET EXTENSION
	CALL LOOKE		;SEE IF STANDARD
	 SETO B,		;DON'T CHANGE CURRENT VALUE
	CAMGE Q3,B		;CHECK BEST SO FAR
	 JRST  [MOVE Q3,B	;SAVE LARGEST VALUE
		PUSH P,B	;SAVE IT
		CALL GTLNGS	;GET STRING FOR SPEC
		CALL COPEXT	;COPY EXTENSION
		POP P,B
		JRST .+1]
	JUMPL B,GTLNG3		;LOSAGE IF NO FILE
	MOVE A,LNGJFN		;JFN
	CALL GTPPN		;GET PPN
	HRRZ A,LNGJFN		;GET JFN
	CALL GTDT		;GET DATE/TIME INFO
	CALL STODT		;STORE ACCORDING TO TYPE
GTLNG3:	MOVE A,LNGJFN		;RESTORE GTJFN INFO
	GNJFN			;GET NEXT
	 ABSKP			;NO MORE FILES
	  JRST GTLNG2		;CHECK EXTENSION
	SKIPGE B,Q3		;FIND ANYTHING INTERESTING?
	 RET			;NO - FNF RETURN
	LDB A,[POINTR P1,F.LMSK] ;GET CURRENT LANG TYPE
	CAIN A,LT.REL		;IS IT RELOC?
	 MOVX B,LT.REL		;YES - THEN ASSUME THATS WHAT WE WANT
	AOS (P)			;SET FOR SKIP RETURN
	LDF A,D%OSRC		;YES - SAY OBJ IN SOURCE DIR
	SKIPE OVER(P2)		;SAW A REL?
	 IORM A,FLG(P2)		;SAW .REL IN SOURCE AREA
	TXNN P1,F%LOBJ		;OK TO LOOK FOR OBJECT
	 JRST SETLTP		;NO
	MOVEM B,SAVLNG		;DON'T LOSE EXTENSION
	CALL GTLNGB		;WE MUST DO THIS THE HARD WAY (RLS JFN)
	LDF A,GJ%OLD		;OLD FILE ONLY (ALREADY SEEN)
	MOVEM A,CJFNBK
	MOVE B,SAVLNG		;RESTORE LANGUAGE
	HRROI A,LTAB(B)		;GET EXTENSION FROM TABLE
	MOVEM A,CJFNBK+.GJEXT
	MOVEI A,CJFNBK		;POINT TO BLOCK
	PUSH P,B		;SAVE THIS
	HRROI B,FSPEC		;WHAT HE TYPED
	CALL GTJFS		;GET JFN
	 CALL CJERR
	MOVEM A,LNGJFN		;SAVE IN CASE LOSAGE
	SETZM SRCPTR		;DON'T TRY SOURCE AREA (ALREADY LOOKED)
	MOVE A,CSBUFP		;GET STRING SPACE POINTER
	CALL GTLNGZ		;LOOK FOR OBJECT
	 NOP			;CAN'T HAPPEN
	POP P,B			;RESTORE B
SETLTP:	SKIPGE LPROC		;HAVE PROCESSOR SET YET?
	 JRST  [MOVEM B,LPROC	;NO -SET IT
		RET]		; AND RETURN
	TXNE P1,F%OBJ		;OK IF OBJECT FIELD
	 CAIE B,LT.REL		;OK IF RELOC
	  CAMN B,LPROC		;OR SAME AS BEFORE
	   RET			;...
	ERROR <Language processor conflict>

;ROUTINE TO COPY EXTENSION FROM CWBUF. THE COPY IS USED AS THE FILE-TYPE USED
;   FOR LOOKING UP DEFAULTS IF IT ISN'T IN THE OBJECT FIELD.
;
;   RETURNS:	EXTP/	POINTER TO THE COPY 
COPEXT:	HRROI A,CWBUF		;POINT TO EXTENSION
	CALL BUFFS		;MAKE A COPY
	MOVEM A,EXTP		;REMEMBER POINTER TO COPY
	RET
;ROUTINE TO DETERMINE CORRECT FILE NAME WHEN NO EXT WAS TYPED
GTLNGS:	CAIE B,LT.REL		;THIS OBJECT TYPE?
	 JRST GTASC		;NO, GO GET ONE
	SKIPE NAM(P2)		;HAVE A NAME YET?
	 RET			;YES - RETURN
;	CALLRET	GTASC		;NO - GET ONE AND RETURN

;GTASC - GET REAL ASCII FILESPEC FROM JFN AND CHECK LEGAL SIZES FOR TOPS10
;   COMPAT. 
GTASC:	HRRZ B,LNGJFN		;JFN
	MOVE A,CSBUFP		;BEGINNING OF STRING SPACE
	MOVEM A,NAM(P2)		;REMEMBER BEGINNING OF NAME
	MOVE D,A		;POINTER TO FILESPEC'S END SO FAR
	LDF C,FLD(.JSAOF,JS%DEV)!JS%PAF ;GET DEVICE
	JFNS
	CALL GTASIZ		;GET STRING SIZE
	CAILE C,7		;MAX LEGAL (INCLUDES ":")
	 JRST  [HRROI A,FSPEC
		ERROR <Device name exceeds 6 characters: %1M>]
	HRRZ B,LNGJFN		;JFN
	LDF C,FLD(.JSAOF,JS%NAM)!JS%PAF ;FILE NAME
	JFNS
	CALL GTASIZ		;GET SIZE
	CAILE C,6		;MAX LEGAL
 	 JRST  [HRROI A,FSPEC
		ERROR <File name exceeds 6 characters: %1M>]
	HRRZ B,LNGJFN	;JFN
	LDF C,FLD(.JSAOF,JS%TYP)!JS%PAF;GET EXTENSION
	JFNS
	CALL GTASIZ
	CAILE C,4		;MAX LEGAL (INCLUDES ".")
 	 JRST  [HRROI A,FSPEC
		ERROR <File type exceeds 3 characters: %1M>]
	SETZ B,			;TERMINATE SPEC
	IDPB B,D		;...
	MOVE A,NAM(P2)		;GET POINTER TO BEGINNING OF NAME
	CALL BUFFS		;ISOLATE THE ENTIRE STRING
	MOVEM A,NAM(P2)		;REMEMBER POINTER TO NAME
	RET

GTASIZ:	SETZ C,			;INIT COUNT
GTASZ1:	CAMN A,D		;COMPARE
	 RET			;MATCH RETURN
	ILDB B,D		;PROCEED - GET CHAR
	CAIE B,"-"		;CHECK LEGAL
	 CAIN B,"_"
	  JRST ILCHR		;INFORM LOSER
	CAIN B,"$"
	 JRST ILCHR
	AOJA C,GTASZ1		;LOOP TILL MATCH

ILCHR:	HRROI A,FSPEC		;GET FILESPEC THAT'S WRONG
	ERROR <Illegal character %2\ in file: %1M">
;DOSWIT - DECODE SWITCH AND TAKE ACTION
DOSWIT:	MOVE A,P4		;STR POINTER TO A
	CALL SWMOV		;MOVE STR TO FSPEC
	MOVE B,A		;REMEMBER POINTER TO LAST CHARACTER
	HRROI A,FSPEC		;POINTER TO SW NAME
;	CALLRET DOSWI0		;DO THE SWITCH

;ROUTINE TO PARSE A SWITCH. 
;
;   ACCEPTS:	A/	POINTER TO SWITCH
;		B/	POINTER TO END OF SWITCH
DOSWI0:	STKVAR <SUFFIX>
	MOVE B,A		;PUT POINTER IN B
	TLC B,-1
	TLCN B,-1
	 HRLI B,(ASCPTR)	;MAKE REAL BYTE POINTER
	SETZM SUFFIX		;NO SUFFIX YET
DOSWI1:	ILDB D,B		;SCAN SWITCH STRING
	JUMPE D,DOSWI2		;IF NULL CHARACTER, NO SUFFIX TO WORRY ABOUT
	CAIE D,":"		;FIND A COLON?
	 JRST DOSWI1		;NO, KEEP LOOKING
	MOVEM B,SUFFIX		;REMEMBER POINTER TO SUFFIX
	SETZ C,			;MAKE STRING END IN NULL
	DPB C,B
DOSWI2:	MOVE B,A		;GET POINTER TO SWITCH AGAIN
	MOVEI A,SWTAB		;THE SWITCH TABLE
	TBLUK			;LOOK UP THE SWITCH
	TXNE B,TL%NOM		;NO MATCH AT ALL?
	 JRST NOMAT		;CORRECT
	TXNE B,TL%AMB		;AMBIGUOUS?
	 JRST AMBIG		;YUP
	MOVE C,(A)		;PUT VALUE INTO C
	HRRZ B,(C)		;GET RHS OF TABLE
	HLL C,(C)		;GET FLAGS FROM LHS
	MOVE A,SUFFIX		;GIVE SUPPORT ROUTINES POINTER TO SWITCH ARG
	TXNE C,S%DSP		;CHECK FOR ROUTINE ADDRS
	 JRST (B)		;EXIT THROUGH ROUTINE
	TXNE C,S%VAL!S%LINK	;VALUE ALLOWED OR L20 SWITCH?
	 JRST SWVAL		;YES - FURTHER WORK REQ'D
	CAIN P5,":"		;CHECK FOR COLON
	 JRST  [HRROI A,FSPEC
		ERROR <Value illegal for switch: %1M>]
	TXNE C,S%LTYP		;LANGUAGE TYPE DESIGNATOR?
	 JRST SWLTYP		;YES - CHECK PERM/TEMP
	MOVE D,[IORM B,FLG(P2)] ;INTSTR TO SET FLAGS
 	TXNE C,S%TOFF		;CLEAR FLAGS?
	 TLC D,(<IORM>-<ANDCAM>) ;YES - CHANGE INSTR
	TXNE C,S%FLH		;FLAGS IN LH?
	 MOVSS B		;YES - SWAP HALVES
	TXNN C,S%FLH		;PERM FLAGS?
	 TXNN P1,F%SPEC		;OR FILE SPEC SEEN YET
	  JRST [TLZ D,17	;CLEAR INDEX REG
		HRRI D,P1	;SET FLAG ADDRS
		JRST DOSWIX]	;DO FLAGS & RETURN
	TXNE C,S%FRH		;TEMP FLAGS?
DOSWIX:	 XCT D			;YES - SET/CLR IN DESC BLOCK
	RET			;RETURN

;HERE TO HANDLE ADDITIONAL VALUES AND LINK-20 SWITCHES
SWVAL:	RET			;RETURN FOR NOW

;/STAY CAUSES EXEC TO STAY AT COMMAND LEVEL DURING COMPILATION/LOADING.
DOSTAY:	SETOM STAYF		;REMEMBER TO STAY
	RET

;HANDLE /LANGUAGE-SWITCHES:
DOLSW:	TXNE P1,F%SPEC		;GLOBAL?
	 JRST DOL1		;NO, ON PARTICULAR PROGRAM
	SKIPE LSWPTR		;YES, ALREADY GIVEN?
	 ERROR <Only one global /LANGUAGE-SWITCHES: allowed>
	MOVE A,SAVQS		;GET POINTER TO SAVED QUOTED STRING
	MOVEM A,LSWPTR		;REMEMBER POINTER TO STRING
	RET

DOL1:	SKIPE SWP(P2)		;SWITCH GIVEN FOR THIS FILE YET?
	 ERROR <Only one /LANGUAGE-SWITCHES: switch allowed per source module>
	MOVE A,SAVQS		;GET POINTER TO SAVED QUOTED STRING
	MOVEM A,SWP(P2)		;REMEMBER POINTER TO STRING
	RET

;HERE TO HANDLE LANGUAGE TYPE SWITCHES
SWLTYP:	CAIN B,LT.SAI		;IF SAIL
	 SETOM SAILF		;SAY WE HAVE SEEN SAIL
	TXNE P1,F%SPEC		;SPEC SEEN YET?
	 JRST  [MOVEM B,LPROC	;SET PROCESSOR TYPE
		CAIE B,LT.REL	;IS THIS /REL?
		 RET		;NO, WE ARE DONE
		MOVE B,SVER(P2) ;YES, THEN SET UP
		MOVEM B,OVER(P2) ;TIME/DATE FOR OBJECT FILE
		RET]
	DPB B,[POINTR P1,F.LMSK] ;SET PERM TYPE
	TRON P1,F%LANG		;SET GLOBAL LANG SWITCH SEEN
	 RET			;RETURN

;ERROR RETURNS
AMBIG:	HRROI A,FSPEC
	ERROR <Switch name ambiguous: %1m>
NOMAT:	HRROI A,FSPEC
	ERROR <No such switch: %1M>

;ROUTINE TO PARSE THE DEFAULT SWITCHES FOR A FILE TYPE
;
;   ACCEPTS:	A/	POINTER TO FILE TYPE
PARDEF:	STKVAR <QUOF,PAREND,SWIPTR,<ABSAV,2>>
	CALL GETDL		;GET DEFAULT SWITCHES FOR FILE TYPE
	MOVEM A,SWIPTR		;INITIALIZE POINTER TO SWITCH LIST
PARD0:	MOVE A,[ASCPTR SWIBUF]	;POINTER TO SWITCH BUFFER
	MOVE B,SWIPTR		;POINTER TO NEXT SWITCH
	MOVEI C,SWISIZ*5	;MAXIMUM CHARACTERS TO READ
	ILDB D,B		;READ THE SLASH
	JUMPE D,R		;IF NULL, LAST ONE WAS LAST SWITCH
	SETZM QUOF		;NOT IN QUOTED STRING YET
PARD3:	ILDB D,B		;READ CHARACTER OF SWITCH
	JUMPE D,PARD4		;IF NULL, SWITCH OVER
	SKIPE QUOF		;IN QUOTED STRING?
	 JRST PARD5		;YES, SO "/" DOESN'T START NEXT SWITCH
	CAIN D,"/"		;OR IF SLASH OF NEXT SWITCH, SWITCH OVER
	 JRST PARD4		;YES, SWITCH OVER
PARD5:	IDPB D,A		;SWITCH NOT OVER, ACCUMULATE NAME
	CAIE D,QUOTE		;A QUOTE?
	 JRST PARD6		;NO, GO DECREMENT COUNT
	SKIPE QUOF		;START OR END OF A QUOTED STRING?
	 JRST  [DMOVEM A,ABSAV	;END, SAVE A AND B
		MOVEM C,PAREND	;AND C TOO
		SETZ B,		;PUT ZERO BYTE AT END OF STRING
		DPB B,A
		MOVE A,QUOF	;GET QUOTED STRING POINTER
		CALL BUFFS	;BUFFER THE QUOTED STRING
		MOVEM A,SAVQS	;AND SAVE THE POINTER
		SETZM QUOF	;NOT IN QUOTED STRING ANY MORE
		DMOVE A,ABSAV	;RESTORE A AND B
		MOVE C,PAREND	;AND C
		MOVX D,QUOTE	;AND D
		DPB D,A		;RESTORE QUOTE AT END OF STRING
		JRST PARD6]	;GO DECREMENT COUNT
	MOVEM A,QUOF		;BEGINNING OF QUOTED STRING, SAVE PTR
PARD6:	SOJG C,PARD3		;READ REST OF NAME
	ERROR <Default switch too long>
PARD4:	MOVEM A,PAREND		;REMEMBER POINTER TO END OF SWITCH
	SETZ C,			;PUT NULL AFTER NAME
	IDPB C,A
	SETO A,
	ADJBP A,B		;BACK SOURCE POINTER BACK TO BEGINNING OF NEXT
				;   SWITCH 
	MOVEM A,SWIPTR		;REMEMBER POINTER FOR NEXT SWITCH
	HRROI A,SWIBUF		;POINT AT THE DEFAULT SWITCH
	MOVE B,PAREND		;PASS POINTER TO END OF SWITCH
	CALL DOSWI0		;PARSE THE SWITCH
	JRST PARD0		;LOOP FOR REST OF SWITCHES
;ROUTINES TO PROCESS /MAP AND /SAVE SWITCHES
SWMAP:	PUSH P,[MAPPNT]		;SAVE ADDRS ON STACK
	SKIPE @(P)		;ALREADY SEE THIS SWITCH?
	 ERROR <MAP or SAVE switch seen twice>
	CAIE P5,":"		;MORE COMING?
	 JRST  [MOVEI P4,-1	;NO - SET FLAG
		JRST SWSAV2]	;AND EXIT
	CALL RDFLD		;YES - READ NEXT FIELD
	CAIN P5,":"		;CHECK FOR DEVICE
	 CALL CAPND		;AND APPEND TO COLON
SWSAV2:	EXCH P4,(P)		;REVERSE ARGS
	POP P,@P4		;AND SAVE VALUE
	RET			;RETURN
;GTPPN - ROUTINE TO GET TOPS10 STYLE PPN AND STORE IN DESC BLOCK IF DIFFERENT
;   THAT CONNECTED PPN 
GTPPN:	PUSH P,B		;SAVE B
	PUSH P,A		;SAVE JFN
	HRRZ B,A		;PUT JFN IN B
	MOVX A,RC%EMO		;WE WANT EXACT MATCH
	RCDIR			;GET DIRECTORY ON WHICH THIS FILE RESIDES
	 ERCAL CJERRE		;SHOULD NEVER FAIL
	PUSH P,C		;SAVE DIRECTORY NUMBER
	GJINF			;GET CONNECTED DIRECTORY NUMBER INTO B
	POP P,C			;NOW CONN DIR IN B, FILE DIR IN C
	POP P,A			;RESTORE THE JFN (ONLY B LEFT TO "POP")
	CAMN B,C		;FILE DIR SAME AS CONN DIR?
	 JRST STPPN0		;YES, SO DON'T BOTHER TRYING TO GET PPN
	MOVEM C,DYRNO(P2)	;REMEMBER DIRECTORY NUMBER
	LDF C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF ;SPECIFY STR:<DIR>
	CALL DOJFNS		;GET STRING
	MOVE A,CSBUFP		;GET POINTER TO DIRECTORY NAME
	STPPN			;CHANGE TO PPN
	 ERCAL CJERRE		;SHOULDN'T FAIL
	MOVEM B,PPN(P2)		;   SAVE IT
STPPN0:	POP P,B			;RESTORE
	RET			;RETURN
;DJFNSE - OBTAIN EXTENSION OF FILE SPECIFIED 
;
;   ACCEPTS:	A/	JFN
;   RETURNS:	CWBUF/	ASCIZ FILE EXTENSION
DJFNSE:	LDF C,FLD(.JSAOF,JS%TYP) ;EXTENSION ONLY ENTRY
	SETZM CWBUF		;CLEAR DESTINATION
	HRRZ B,A		;JFN TO B
	HRROI A,CWBUF		;POINTER TO DEST
	JFNS			;GET EXTENSION
	RET			;RETURN

;DOJFNS - OBTAIN DESIRED TEXT FOR JFN 
;
;   ACCEPTS:	A/	JFN
;		C/	FORMAT DESIRED
;   RETURNS:	CSBUF/	ASCIZ OF FORMAT DESIRED
DOJFNS:	HRRZ B,A		;JFN TO B
	MOVE A,CSBUFP		;POINTER TO DEST
	JFNS			;GET IT
	RET			;RETURN

;ROUTINE TO LOOK UP EXTENSION FOUND IN CWBUF 
;
;   RETURNS:	B/	LANGUAGE TYPE
LOOKE:	MOVE B,CWBUF		;GET EXTENSION IN B
	MOVSI C,-LTABL		;LTAB LENGTH
	CAME B,LTAB(C)		;MATCH?
	 AOBJN C,.-1		;NO - TRY NEXT
	JUMPGE C,R		;FAIL RETURN
	HRRZ B,C		;TABLE INDEX IS TYPE
	TXNE P1,F%LANG		;IS THERE A GLOBAL LANGUAGE SWITCH?
	 CAIN B,LT.REL		;IF SO, IS FILE REL?
	  JUMPN B,RSKP		;NO, SKIP, ELSE IF NOT GLOBAL, IS NULL?
	LDB B,[POINTR P1,F.LMSK] ;GLOBAL AND NOT REL OR NULL, REPLACE
	RETSKP			;RETURN

;ROUTINE TO SEND TMP FILE TO COMPATABILITY PACKAGE
DPRARG:	MOVE A,NFILES		;POINT TO WORD CONTAINING LAST FILE ADDRESS
	MOVE C,ADDTAB-1(A)	;GET STARTING ADDRESS OF LAST FILE
	ADD C,TMPCOR(C)		;GET FINAL ADDRESS
	HRRZI C,1(C)		;KEEP ONLY THE LENGTH
	MOVEI B,NFILES		;SPECIFY S/A OF ARG BLOCK
	MOVE A,FORK		;SEND BLOCK TO CURRENT FORK
	HRLI A,.PRAST		;FUNCTION IS "ARG BLOCK BEING SPECIFIED"
	PRARG			;SEND THE BLOCK
	 ERSKP			;FAILED, SEE WHY
	  RET

;THE PRARG FAILED, PROBABLY BECAUSE WE TRIED TO SEND TOO MUCH. WRITE FILES TO
;   DISK. 
	MOVE Q1,NFILES		;GET NUMBER OF FILES
TMP1:	SOJL Q1,TMP2		;JUMP TO TMP2 IF NO MORE TMP FILES
	SETZ P1,		;NO HIGH ORDER BITS
	MOVE P2,CSJOB		;BINARY JOB NUMBER
	SETZ P3,		;UNUSED WORD
	MOVE P4,[400000,,3]	;WE WANT FILLING, THREE DIGITS
	MOVE P5,CSBUFP		;POINTER TO AREA INTO WHICH TO WRITE NUMBER
	EXTEND P1,[CVTBDO "0"
		"0"]		;THREE DIGITS TO ASCII(FILL WITH "0" AT
				;   BEGINNING) 
	 ERCAL CJERRE		;FAILED, SAY WHY
	MOVE D,ADDTAB(Q1)	;GET ADDRESS OF FILE
	MOVEI P2,TMPCOR(D)	;GET SIXBIT NAME OF FILE(ADDRESS THEREOF)
	HRLI P2,(<POINT 6,0>)	;MAKE BYTE POINTER
	MOVX P1,3		;WE WANT TO CONVERT 3 CHARACTERS
	MOVX P4,3
	EXTEND P1,[MOVSO "A"-'A'];SIXBIT TO ASCII CONVERSION
	 ERCAL CJERRE
	MOVE A,P5		;RETAIN UPDATED BYTE POINTER
	HRROI B,[ASCIZ/.TMP;T/] ;REST OF FILESPEC
	SETZ C,
	SOUT
	MOVX A,GJ%FOU!GJ%SHT	;OUTPUT USE, SHORT FORM
	MOVE B,CSBUFP		;POINT TO FILESPEC
	CALL GTJFS		;GET HANDLE
	 CALL CJERRE		;FAILED
	MOVX B,FLD(7,OF%BSZ)!OF%WR ;OPEN FOR WRITING
	OPENF
	 ERCAL CJERRE		;FAILED
	MOVE D,ADDTAB(Q1)	;GET ADDRESS OF FILE
	HRROI B,TMPCOR+1(D)	;GET POINTER TO DATA
	SETZ C,			;END ON NULL
	SOUT			;WRITE THE DATA TO FILE
	CLOSF			;CLOSE FILE
	 ERCAL CJERRE		;COULDN'T
	JRST TMP1		;DO NEXT FILE

TMP2:	RET			;ALL DONE
;GTDT - GET DATE/TIME OF FILE
;
;   ACCEPTS:	A/	JFN
;   RETURNS:		VERSION D/T IN A
GTDT:	PUSH P,[0]		;PLACE TO READ D/T
	PUSH P,B		;SAVE ACS
	PUSH P,C
	MOVEI C,-2(P)		;POINT TO SPECIAL CELL
	MOVE B,[1,,.FBWRT]	;GET TIME LAST WRITTEN
	GTFDB
	POP P,C			;RESTORE STUFF
	POP P,B
	POP P,A			;SHOULD HAVE D/T
	RET			;RETURN

;ROUTINE TO STORE DATE/TIME IN SPEC BLOCK ACCORDING TO LANGUAGE TYPE (I.E. REL
;   OR NOT) 
STODT:	CAIN B,LT.REL		;RELOC TYPE?
	 CALLRET STOREL		;YES - STORE DATE
	MOVEM A,SVER(P2)	;YES - MUST BE SOURCE
	RET			;RETURN

STOREL:	MOVEM A,OVER(P2)	;USE IT
	RET			;RETURN
;OUTPUT SUBROUTINES DSOUT & DSOUTR
DSOUTR:	CALL DSOUT		;DUMP STRING IN B
	ETYPE<%_>		;AND CRLF
	RET

DSOUT:	MOVE A,COJFN		;OUTPUT JFN
	SETZ C,
	SOUT			;PRINT STRING
	RET			;RETURN

;PUNCTUATION ROUTINES
PROUT:	SKIPA B,["."]		;PERIOD
CMOUT:	 MOVX B,","		;COMMA
	CALLRET	TBOUT		;DUMP IT

SWOUT:	MOVX B,"/"		;SLASHIFY IT
	BOUT			;7 that's all TBOUT does
;7	CALL TBOUT		;...
	MOVE B,D		;SW VALUE
	CALLRET	TBOUT		;DUMP IT

EOLOUT:	MOVEI B,.CHCRT
	BOUT			;7 that's all TBOUT does
;7	CALL TBOUT
	SKIPA B,[.CHLFD]	;END-OF-LINEF
SPOUT:	 MOVEI B," "		;SPACE
	CALLRET	TBOUT		;DUMP AND RETURN
	SUBTTL RDSKP AND RDFLD

;RDFLD - READS NEXT FIELD USING TEXTI
;
;   RETURNS: 	A/	BREAK TYPE
;		P3/	CHAR COUNT
;		P4/	POINTER TO STRING
;		P5/	BREAK CHAR
RDFLD:	MOVE Q1,.RDIOJ+CSTXTB	;CURRENT POINTER
	TXZE P1,F%LAHD		;CHECK IF NEED BACKUP
	 ADD Q1,[B.BP]		;YES - ADD CONST
	MOVEM Q1,.RDIOJ+CSTXTB	;NOW HAVE CORRECT POSITION
	MOVE P4,TXTPR		;POINTER TO STRING SPACE
	MOVEM P4,.RDDBP+CSTXTB	;OUTPUT STRING HERE
RDFLD0:	MOVX P3,STRSIZ		;ENOUGH LENGTH FOR ANY REASNABLE FIELD
	MOVEM P3,.RDDBC+CSTXTB	; IN STRING SPACE
	LDF Q1,RD%RIE		;RETURN ON EMPTY STRING
	MOVE A,BMSKA		;GET SPECIAL BREAK MASK ADDRESS
	MOVEM A,.RDBRK+CSTXTB
	MOVEM Q1,.RDFLG+CSTXTB	;...
	MOVEI A,CSTXTB		;POINT AT ARGS
	TEXTI			;SNARF FIELD
	 CALL EOFJER		;CHECK FOR END OF FILE
	MOVE Q1,.RDFLG+CSTXTB	;GET FLAGS
	TXNN Q1,RD%BTM		;BREAK ON TERM?
	 ERROR <Command string space exhausted>
	LDB P5,.RDDBP+CSTXTB	;GET BREAK CHAR
	CALL GTYP		;GET CHAR TYPE
	SETZ Q1,		;NULL OUT DELIM
	DPB Q1,.RDDBP+CSTXTB	;...
	SUB P3,.RDDBC+CSTXTB	;SIZE = ORIG - NEW COUNT
	RET			;AND RETURN
;ROUTINE TO READ A QUOTED STRING.  
;
;   RETURNS:	A/	POINTER TO STRING
RDQUOT:	CALL LDCHR		;GET A CHAR
	CAIE P5,QUOTE		;GRNTEE QUOTED
	 ERROR <String must be quoted>
RDQOT1:	MOVE P4,CSBUFP		;PICK UP STRING POINTER
RDPRC1:	CALL LDCHR		;GET CHAR
	CAIN A,C.EOL		;CHECK END
	 ERROR <Unterminated quoted string>
	CAIN P5,QUOTE		;END OF SWITCH?
	 JRST RDPRC2		;YES - SET UP BLOCK
	IDPB P5,P4		;STUFF CHAR
	JRST RDPRC1

RDPRC2:	SETZ P5,		;TERMINATE WITH NULL
	IDPB P5,P4		;...
	MOVE A,CSBUFP
	CALLRET BUFFS		;BUFFER THE STRING AND RETURN POINTER TO CALLER

;LDCHR - ROUTINE TO GET NEXT CHARACTER
;
;   RETURNS:	A/	CHARACTER TYPE
;	  	P5/	CHARACTER
LDCHR:	TXZN P1,F%LAHD		;CHECK FLAG
	 IBP .RDIOJ+CSTXTB	;INCR BYTE POINTER
	LDB P5,.RDIOJ+CSTXTB	;GET CHAR
;	CALLRET	GTYP		;GET TYPE INFO AND EXIT

;GTYP - GET CHAR TYPE 
;
;   ACCEPTS:	A/	CHARACTER
GTYP:	MOVE Q1,P5		;COPY IT
	IDIVI Q1,^D9		;LOOK IT UP IN TABLE
	LDB A,PTAB(Q2)		;...
	RET			;RETURN

;THE FOLLOWING ROUTINE GETS A POINTER TO THE STRING OF DEFAULT SWITCHES FOR A
;   PARTICULAR EXTENSION.
;
;   ACCEPTS:	A/	POINTER TO EXTENSION
;   RETURNS:	A/	POINTER OR 0
GETDL:	MOVE C,A		;POINTER IN C
	BIN			;READ FIRST CHARACTER
	CAIN B,0		;NULL EXTENSION?
	 SKIPA B,[TXTPTR <.>]	;YES, SO LOOK UP DOT
	  MOVE B,C		;RETRIEVE POINTER
	MOVEI A,DEXTBL		;ADDRESS OF DEFAULT TABLE
	TBLUK			;LOOK FOR THE EXTENSION
	TXNN B,TL%EXM		;EXACT MATCH?
	 JRST GETDL0		;NO
	HRR A,(A)		;YES, GET POINTER TO STRING
	HRLI A,(ASCPTR)		;MAKE BYTE POINTER
	RET			;GIVE IT TO CALLER

GETDL0:	SETZ A,			;NO DEFAULTS SET, RETURN 0
	RET

;INFO DEFAULT COMPILE-SWITCHES

.IDCS::	STKVAR <NWHICH,NS>
	HLRZ A,DEXTBL		;GET NUMBER OF FILE TYPES
	MOVEM A,NS		;REMEMBER HOW MANY TO DO
	SETZM NWHICH		;INITIALIZE WHICH ONE WE'RE ON
IDC0:	AOS C,NWHICH		;STEP TO NEXT FILE TYPE
	CAMLE C,NS		;DONE THEM ALL YET?
	 RET			;YES
	HLRO A,DEXTBL(C)	;GET POINTER TO FILE TYPE
	HRRO B,DEXTBL(C)	;GET POINTER TO LIST OF SWITCHES
	ETYPE < set default compile-switches %1M %2M%%_>
	JRST IDC0		;LOOP FOR REST

;SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)

.SNDCS::STKVAR <<WHAT,2>,TBDLSA>
	NOISE <file type>
	MOVEI B,[FLDDB. .CMTOK,CM%SDH,TXTPTR <*>,<"*" for all>,,[
		FLDDB. .CMTOK,CM%SDH,TXTPTR <.>,,,[
		FLDDB. .CMKEY,,DEXTBL,<a file type,>,,[
		FLDDB. .CMFLD,CM%SDH]]]] ;.CMFLD MERELY FOR NONX ENTRIES
	CALL FLDSKP		;GET SOME INPUT
	 CMERRX
	GTFLDT C		;SEE WHICH WAS TYPED
	DMOVEM B,WHAT		;REMEMBER COMND DATA
	CONFIRM			;CONFIRM THE COMMAND
	DMOVE B,WHAT		;GET WHAT WAS TYPED
	CAIN C,.CMFLD		;NONEXISTENT ENTRY?
	 JRST SNDERR		;YES - GIVE ERROR
	CAIN C,.CMTOK		;STAR OR DOT?
	 JRST SNDALL		;YES, DELETE ALL DEFAULTS OR "."
	MOVE A,(B)		;SAVE TABLE ENTRY FOR LATER
SNDCS1:	MOVEM A,TBDLSA
	MOVEI A,DEXTBL		;POINT AT TABLE
	TBDEL			;REMOVE REQUESTED ENTRY
	HLRO A,TBDLSA		;DEALLOCATE STRINGS IN EACH HALF
	CALL STREM
	HRRO A,TBDLSA
	CALLRET STREM		;AND RETURN

;HERE IF A TOKEN WAS TYPED. IF "*" DELETE ALL DEFAULTS. IF "." DELETE "."
SNDALL:	LDB A,[FIRCHR ATMBUF]	;GET THE TOKEN THAT WAS TYPED
	CAIE A,"*"		;STAR?
	 JRST SNDALD		;NO - MUST BE A DOT
	HLLZ D,DEXTBL		;YES - FIGURE OUT HOW MANY DEXTBL ENTRIES
	HRRZS DEXTBL		;CLEAR ALL ENTRIES
	JUMPE D,R		;IF NO ENTRIES, DONE
	MOVNS D			;CONSTRUCT AOBJN POINTER
	HRRI D,DEXTBL+1
SNDAL1:	HLRO A,(D)		;DEALLOCATE STRINGS IN EACH HALF
	CALL STREM
	HRRO A,(D)
	CALL STREM
	AOBJN D,SNDAL1		;GO BACK IF MORE
	RET

SNDALD:	HRROI B,ATMBUF		;FIND THE "." ENTRY
	MOVEI A,DEXTBL		; IN THE DEFAULT EXTENSION TABLE
	TBLUK
	TXNN B,TL%EXM		;FOUND IT?
	 JRST SNDERR		;NO - ERROR
	MOVE B,A		;YES - SET UP ADDRESS TO DELETE
	MOVE A,(A)		;GET ADDRESS OF EXTENSION ENTRY
	JRST SNDCS1		;GO FINISH OFF

SNDERR:	HRROI A,ATMBUF		;POINTER TO NONEXISTENT FILE TYPE
	LDB B,[FIRCHR ATMBUF]	;SEE IF ANYTHING TYPED
	CAIN B,.CHNUL		;ANYTHING TYPED?
	 ERROR <File type or "*" expected>
	ETYPE <%%No defaults were set for file type %1M%%_>
	RET

;SET DEFAULT COMPILE-SWITCHES (FILE TYPE) TYP (SWITCHES) /SW/SW/SW...

.SDCS::	STKVAR <STE,SAVOP,SAVSCT,SAVFGS,EXTPTR,ENTPTR,ANYYET,<LST,DCSSIZ>,
SWPT,LSTPT,LSTRM>
	NOISE <file type>
	DOTX <File type (without the dot), or just dot (.) for null type>
	 ABSKP			;NOT DOT, MUST BE REAL FILE TYPE
	  JRST SDC0		;USER TYPED DOT
	WORDX <File type (without the dot)>
	 CMERRX <File type or dot (.) required>
SDC0:	CALL BUFFF		;ISOLATE THE EXTENSION
	MOVEM A,EXTPTR		;REMEMBER IT
	MOVX A,DCSSIZ*5		;INITIALIZE AMOUNT OF ROOM LEFT
	MOVEM A,LSTRM
	HRROI A,LST		;INITIALIZE POINTER TO LIST OF SWITCHES
	MOVEM A,LSTPT		;REMEMBER POINTER
	SETZM ANYYET		;NOTE THAT NO SWITCHES INPUT YET
SDC1:	MOVEI B,[FLDDB. .CMCFM,,,,,[
		FLDDB. .CMSWI,,SWTAB]]
	SKIPN ANYYET		;GOT ANY SWITCHES YET?
	 MOVE B,(B)		;NO, SO NO CR ALLOWED
	CALL FLDSKP		;READ FIELD, SKIP IF SUCCESSFUL
	 CMERRX <Invalid switch>
	GTFLDT C		;SEE WHAT WAS TYPED
	SETOM ANYYET		;MARK THAT WE'VE GOT AT LEAST ONE SWITCH
	CAIN C,.CMCFM		;END OF LINE?
	 JRST SDC3		;YES, GO STORE SWITCHES
	MOVEM B,STE		;REMEMBER TABLE ENTRY
	MOVE B,(B)		;GET TABLE ENTRY
	HLRO B,B		;MAKE POINTER TO SWITCH STRING
	MOVEM B,SWPT		;REMEMBER POINTER TO SWITCH
	SETZB C,D		;STOP ON NULL (D USED FOR SECOND SOUT)
	HRROI B,[ASCIZ"/"]	;PUT SLASH IN FOR SWITCH
	MOVE A,LSTPT		;GET POINTER TO LIST
	SOUT			;WRITE THE SLASH
	SOS C,LSTRM		;GET ROOM LEFT, ACCOUNT FOR SLASH
	MOVE B,SWPT		;GET POINTER TO SWITCH
	CALL SOUTN		;SOUT BUT DON'T KEEP NULL
	MOVEM A,SAVOP		;SAVE OUTPUT POINTER
	MOVEM C,SAVSCT		;SAVE SWITCH CHARACTER COUNT
	MOVE A,STE		;GET SWITCH TABLE ENTRY
	CALL HANSWI		;DO SPECIAL PARSING
	 JRST  [MOVE A,SAVOP
		MOVE C,SAVSCT	;NO, RESTORE SOUT STUFF
		JRST SDC4]
	MOVEM A,SAVFGS		;SAVE SPECIAL FLAGS
	MOVE A,SAVOP		;GET BACK DATA TO CONTINUE SOUT
	MOVE C,SAVSCT
	MOVX D,S%QUO
	TDNE D,SAVFGS		;IS SWITCH QUOTED?
	 CALL SDCQ		;YES - OUTPUT A QUOTE
	SETZ D,			;END ON NULL
	HRROI B,ATMBUF		;GET SPECIAL DATA
	CALL SOUTN		;SOUT BUT DON'T KEEP NULL
	MOVX D,S%QUO
	TDNE D,SAVFGS		;QUOTED?
	 CALL SDCQ		;YES - OUTPUT A QUOTE
SDC4:	CAIG C,1		;MAKE SURE ROOM FOR AT LEAST ONE MORE CHAR
				;   (NEXT "/" !) 
	 ERROR <Too many switches in command>
	MOVEM C,LSTRM		;REMEMBER HOW MUCH ROOM IS LEFT NOW
	MOVEM A,LSTPT		;REMEMBER UPDATED POINTER
	JRST SDC1		;KEEP READING

SDC3:	MOVEI A,DEXTBL		;GET ADDRESS OF TABLE
	MOVE B,EXTPTR		;GET POINTER TO EXTENSION
	TBLUK			;FIND EXTENSION IN TABLE
	TXNE B,TL%EXM		;ALREADY IN TABLE?
	 JRST SDC2		;YES
	MOVE A,EXTPTR		;NO, SET IT UP IN PERMANENT FREE SPACE
	CALL XBUFFS
	HRRZM A,EXTPTR		;REMEMBER WHERE WE PUT IT
	HRLZ B,A		;GET TABLE ENTRY TO BE ADDED
	MOVEI A,DEXTBL		;ADDRESS OF TABLE
	TBADD			;ADD NEW ENTRY
	 ERJMP [HRRO A,EXTPTR	;REMOVE EXTENSION STRING
		CALL STREM	;FROM PERMANENT FREE SPACE
		ERROR <No room for another file type>]
SDC2:	HRRZM A,ENTPTR		;SAVE ENTRY POINTER FOR LATER
	HRRO A,(A)		;MAKE BYTE POINTER TO DEFAULT STRING SO FAR
	TRNN A,777777		;IS THERE ANY STRING TO APPEND TO?
	 JRST  [HRROI A,LST	;NO, PUT IN PERMANENT FREE SPACE
		CALL XBUFFS
		HRRM A,@ENTPTR	;PUT STRING POINTER INTO TABLE ENTRY
		RET]
	CALL BCOUNT		;YES, FIND HOW BIG IT IS
	ADDI B,DCSSIZ*5+1	;COMPUTE SIZE OF JOINED STRINGS
	SUB B,LSTRM		;(PLUS 1 FOR NULL)
	IDIVI B,5
	CAIE C,0
	 ADDI B,1
	MOVE A,B
	CALL GTBUFX		;GET THE MEMORY
	HRRO A,A		;FIX UP OUTPUT ADDRESS AS BYTE POINTER
	MOVE C,ENTPTR
	HRRO B,(C)		;COPY FROM PRESENT DEFAULT STRING FIRST
	HRRZM B,SAVOP		;SAVE TO DELETE LATER
	HRRM A,(C)		;UPDATE STRING POINTED TO
	SETZ C,
	SOUT
	MOVX C,377777		;COPY A NULL TOO
	HRROI B,LST		;GET POINTER TO DEFAULT LIST GIVEN IN COMMAND
	SETZ D,			;STOP COPYING ON NULL
	SOUT			;ADD IT TO REST
	HRRO A,SAVOP		;RETURN OLD STRING TO PERMANENT FREE SPACE
	CALLRET STREM

SDCQ:	SETZ D,			;SUBROUTINE TO OUTPUT A QUOTE
	HRROI B,[ASCIZ/"/]
;	CALLRET	SOUTN		;SOUT BUT DON'T KEEP NULL; FALL INTO SOUTN

;ROUTINE USED ABOVE TO DO SOUT ASSUMING POSITIVE COUNT IN C. BACKS UP COUNT AND
;   DESTINATION POINTER SO AS NOT TO KEEP NULL CHARACTER IN STRING
SOUTN:	SOUT			;WRITE THE DATA
	BKJFN			;BACK UP THE POINTER
	 CALL JERR		;SHOULDN'T FAIL
	AOJA C,R		;UNCOUNT THE FINAL NULL AND RETURN
	SUBTTL TI - TEXT INPUT ROUTINE

;TEXTI/GTJFN BLOCK INIT ROUTINE
TIRST:	LDF Q1,GJ%XTN!GJ%OLD	;EXTENDED GTJFN
	MOVEM Q1,CJFNBK
	SETZM .GJDEV+CJFNBK	;CLEAR DEFAULTS
	MOVE Q1,[.GJDEV+CJFNBK,,.GJDIR+CJFNBK]
	BLT Q1,XTNCNT-1		;...
	LDF Q1,G1%RBF!G1%RND!G1%NLN!3 ;RETURN ON NULL NAME
	MOVEM Q1,XTNCNT
	RET			;RETURN

;ROUTINE FOR DOING COMND JSYS FOR COMPILE-CLASS COMMANDS. PREVENTS "@" FROM
;   HAVING STANDARD EFFECT, AS COMPILE-CLASS COMMANDS WANT TO PROCESS "@"
;   THEMSELVES. 
CFIELD::MOVX A,CM%XIF		;WE WANT TO DO INDIRECT FILESPEC OURSELF
	IORM A,CMFLG
	CALLRET FIELD		;READ INPUT AND RETURN

;MAIN ROUTINE
;   INPUT ROUTINE, MERELY INPUTS ENTIRE LINE, DOING RECOGNITION ON FILESPECS
;   AND SWITCHES 
TI:	SETZM NFIAR		;NO FILES IN A ROW YET
	SETZM NFILS		;NO FILES AT ALL
	MOVEI B,[FLDDB. .CMCFM,,,,,[			;CR IS LEGAL
		FLDDB. .CMSWI,,SWTAB,,,[		;SWITCH
		FLDDB. .CMFIL,CM%SDH,,<a file name>,,[	;FILESPEC
		FLDDB. .CMTOK,,TXTPTR <@>,,,[		;INDIRECT FILE
		FLDDB. .CMTOK,,TXTPTR <%>]]]]]		;PERCENT SIGN
	CALL COMIN		;INPUT THE FIELD
	 ABSKP			;FAILED
	  JRST @D		;DISPATCH ON FIELD FLAVOR
	CALL SKCROK		;DIFFERENT ERROR DEPENDING ON WHETHER CR
				;   ALLOWED 
	 CMERRX <Switch, filespec, "@", or "%" required>
	CMERRX <Carriage return, switch, filespec, "@", or "%" required>

;CR GOT TYPED
TCR:	MOVE A,CMPTR		;GET POINTER TO END OF STRING
	SETZM B
	IDPB B,A		;PUT NULL AT END OF STRING
	RET			;RETURN TO CALLER

;AT SIGN TYPED
TAT:	DEXTX <CMD>		;DEFAULT COMMAND FILE EXTENSION IS "CMD"
	MOVX A,GJ%OLD		;COMMAND FILE MUST EXIST
	MOVEM A,CJFNBK+.GJGEN
	MOVEI B,[FLDDB. .CMFIL,,,<a name of indirect file>,,]
	CALL CFIELD		;READ INDIRECT FILESPEC
	TXNE A,CM%NOP
	 CMERRX <Invalid indirect file specification>
	AOS NFILS		;WE MUST ASSUME THERE IS A FILESPEC IN THE
				;   INDIRECT FILE 
	JRST TALL		;AFTER INDIRECT FILE, ANYTHING CAN BE INPUT

;FILE SPEC SEEN.  MAY BE FOLLOWED BY ANYTHING.
TFILE:	AOS NFILS		;REMEMBER HOW MANY FILES
	AOS A,NFIAR		;COUNT HOW MANY FILESPECS IN A ROW
	CAIGE A,2		;DON'T ALLOW MORE THAN TWO FILESPECS IN A ROW
				;   (WITHOUT THIS CHECK, "COMP /L" CAUSES "?TOO
				;   MANY JFNS IN COMMAND")  
	 JRST TALL
	MOVEI B,[FLDDB. .CMCFM,,,,,[		;CR IS LEGAL
		FLDDB. .CMSWI,,SWTAB,,,[	;SWITCH
		FLDDB. .CMCMA,,,,,[		;COMMA
		FLDDB. .CMTOK,,TXTPTR <@>,,,[	;INDIRECT FILE
		FLDDB. .CMTOK,,TXTPTR <+>,,,[	;PLUS SIGN
		FLDDB. .CMTOK,,TXTPTR <%>]]]]]] ;PERCENT SIGN
	CALL COMIN		;TRY TO PARSE A FIELD
	 CMERRX			;FAILED, USE SYSTEM'S REASON
	JRST @D			;SUCCEEDED, DISPATCH ON FLAVOR

;PLUS SIGN SEEN
TPLUS:	MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<a source file specification>] ;FILESPEC
	CALL COMIN1		;INPUT FILESPEC
	 CMERRX <Invalid source file specification>
	JRST TALL		;ANYTHING CAN BE TYPED AFTER A SOURCE

;GET HERE WHEN ANYTHING MAY BE TYPED
TALL:	MOVEI B,[FLDDB. .CMCFM,,,,,[			;CR IS LEGAL
		FLDDB. .CMSWI,,SWTAB,,,[		;SWITCH
		FLDDB. .CMFIL,CM%SDH,,<a file name>,,[	;FILESPEC
		FLDDB. .CMCMA,,,,,[			;COMMA
		FLDDB. .CMTOK,,TXTPTR <@>,,,[ 		;INDIRECT FILE
		FLDDB. .CMTOK,,TXTPTR <+>,,,[		;PLUS SIGN
		FLDDB. .CMTOK,,TXTPTR <%>]]]]]]]	;PERCENT SIGN
	CALL COMIN		;INPUT THE FIELD
	 ABSKP			;FAILED
	  JRST @D		;DISPATCH ON FIELD FLAVOR
	CALL SKCROK		;SEE IF CARRIAGE RETURN ALLOWED
	 CMERRX <Switch, filespec, comma, "@", "+", or "%" required>
	CMERRX <Carriage return, switch, filespec, comma, "@", "+", or "%" 
required>

;SKCROK SKIPS IF CARRIAGE RETURN VALID NOW. CLOBBERS NOTHING.
SKCROK:	SKIPN CSVC		;IF DEFAULT STRING, THEN CR IS O.K.
	 SKIPE NFILS		;IF NO DEFAULT STRING BUT FILE SEEN, THEN CR
				;   O.K. 
	  RETSKP		;SKIP, CR O.K.
	RET			;DON'T SKIP, CR NOT O.K.

;ROUTINE TO DO INPUT FOR COMPILE-CLASS COMMAND. 
;
;   ACCEPTS:	B/	FUNCTION CHAIN
;   RETURNS: +1		FIELD NOT PARSED
;	     +2	D/	SUCESSFUL PARSE, ADDRESS OF SUPPORT ROUTINE
COMIN:	CALL SKCROK		;SEE IF CARRIAGE RETURN LEGAL
	MOVE B,(B)		;NO, SO CR INVALID ON EMPTY LINE
COMIN1:	PUSH P,B		;SAVE FUNCTION CHAIN
	DEXTX			;NO DEFAULT EXTENSION ON FILESPEC
	MOVX A,GJ%XTN		;WE HAVE AN EXTENDED FLAG, SO WE NEED THIS BIT
	MOVEM A,CJFNBK+.GJGEN
	MOVX A,G1%NLN		;EXTENDED FLAG SAYS ONLY ALLOW TOPS-10 STYLE
				;   NAMES (SHORT NAMES AND NO GENERATION FIELDS
				;   AND ATTRIBUTES ALLOWED)  
	MOVEM A,CJFNBK+.GJF2	;STORE EXTENDED FLAGS
	POP P,B			;RESTORE FUNCTION CHAIN
	CALL CFIELD		;DO COMND JSYS
	TXNE A,CM%NOP		;MAKE SURE A LEGAL POSSIBILITY WAS TYPED
	 JRST COM1		;GO TRY PARSE ONLY
	CALL IDEN		;FIND OUT WHAT GOT TYPED
	RETSKP			;SKIP ON SUCCESS

;REGULAR GTJFN FAILED, SO TRY OLD-FILE ONLY. NOTE THAT IT ISN'T GOOD TO TRY
;   OLD-FILE-ONLY FIRST, BECAUSE SIMPLE COMMON CASE OF "COMPILE FOO" WOULD
;   FAIL, AS FILE ISN'T CALLED "FOO", BUT "FOO.FOR" OR SOMETHING LIKE THAT.
;   HOWEVER, THE ORIGINAL GTJFN WE DID WITH NO BITS ON WILL FAIL ON "COMP
;   X:FOO" WHERE X: IS DEFINED WITH "DEFINE X: (AS) <A>,<B>", AND DIRECTORY <A>
;   IS NOT WRITABLE BY THE USER. OLD-FILE-ONLY WILL CAUSE THE LOGICAL NAME TO
;   BE STEPPED WHEN LOOKING FOR "FOO" IF NOT FOUND IN <A>. ACTUALLY,
;   OLD-FILE-ONLY WILL ALSO FAIL FOR "COMP X:FOO"!  HOWEVER, IF FOO.MAC IS
;   UNIQUE IN X:, "COMP X:FOO$" WILL RECOGNIZE IT WITH OLD-FILE-ONLY. BUT IF NO
;   RECOGNITION IS ATTEMPTED, "COMP X:FOO" WILL FAIL, SINCE THERE'S NO OLD FILE
;   CALLED "FOO" IN X:. HENCE, IF OLD-FILE-ONLY FAILS, WE HAVE TO TRY
;   PARSE-ONLY GTJFN!! NOTE THAT PARSE-ONLY MUST BE TRIED LAST TO ALLOW
;   RECOGNITION TO WORK. 
COM1:	MOVE A,NFIAR		;SEE HOW MANY FILES IN A ROW SO FAR
	CAIL A,2		;TWO?
	 RET			;YES, DON'T ALLOW ANY MORE
	MOVX A,GJ%OLD		;TRY OLD-FILE-ONLY
	IORM A,CJFNBK+.GJGEN
	MOVEI B,[FLDDB. .CMFIL]
	CALL CFIELD
	TXNN A,CM%NOP		;SKIP IF FAILED
	 JRST COM2		;SUCCEEDED
	MOVE A,CJFNBK+.GJGEN	;GET FLAGS
	TXZ A,GJ%OLD		;TURN OFF OLD-FILE-ONLY
	TXO A,GJ%OFG		;TRY PARSE-ONLY
	IORM A,CJFNBK+.GJGEN
	MOVEI B,[FLDDB. .CMFIL]
	CALL CFIELD
	TXNE A,CM%NOP
	 RET			;SINGLE RETURN ON FAILURE
COM2:	MOVE A,CSBUFP		;GET POINTER TO TEMPORARY STORAGE
	MOVX C,FLD(.JSAOF,JS%NAM) ;ALWAYS OUTPUT THE FILE NAME ONLY
	JFNS			;GET THE FILE NAME THAT WAS ENTERED
	ILDB A,CSBUFP		;TAKE A LOOK AT THE FIRST CHARACTER
	JUMPE A,R		;ERROR IF FILE NAME IS NULL
	TLNE B,(GJ%NAM!GJ%EXT)	;7 SPR #:20-17432 begin
	 ERROR <No wildcards allowed in this file specification> ;7
				;7 SPR #:20-17432 end
	MOVEI D,TFILE		;SAY THAT FILESPEC TYPED
	RETSKP

;ROUTINE TO CALL AFTER COMND TO FIGURE OUT WHAT GOT TYPED.
;
;   RETURNS:	D/	ADDR OF ROUTINE TO HANDLE PARSED FIELD
IDEN:	MOVE A,B		;IF FILE TYPED, JFN NOW IN A!
	GTFLDT D		;FIND OUT WHAT WAS TYPED
	CAIE D,.CMFIL		;FILESPEC?
	 SETZM NFIAR		;NO, SO TALLY ZERO FILESPECS IN A ROW
	EXCH C,D		;FUNCTION CODE IN C, POINTER IN D
	CAIN C,.CMTOK		;TOKEN?
	 JRST IDTOK		;YES, GO INVESTIGATE FURTHER
	CAIN C,.CMCMA		;COMMA?
	 MOVEI D,TCOMM		;YES
	CAIN C,.CMCFM		;CARRIAGE RETURN?
	 MOVEI D,TCR		;YES
	CAIN C,.CMFIL		;FILESPEC?
	 MOVEI D,TFILE		;YES
	CAIN C,.CMSWI		;SWITCH?
	 MOVEI D,TSWI		;YES
	RET

IDTOK:	MOVE A,.CMDAT(D)	;TOKEN TYPED, GET POINTER TO WHICH KIND
	BIN			;GET THE TOKEN
	CAIN B,"%"		;LINK SWITCH DELIMITER?
	 MOVEI D,TPER		;YES
	CAIN B,"@"		;INDIRECT FILE DELIMITER?
	 MOVEI D,TAT		;YES
	CAIN B,"+"		;PLUS SIGN?
	 MOVEI D,TPLUS		;YES
	RET

;% TYPED.  READ THE LINK SWITCH
TPER:	QUOTEX <LINK switch, in quotes>
	 CMERRX <Invalid LINK switch>
	JRST TALL		;AFTER LINK SWITCH, ANYTHING MAY BE TYPED

;SWITCH TYPED. ANYTHING MAY FOLLOW
TSWI:	MOVE A,B		;PUT TABLE ADDRESS IN A
	CALL HANSWI		;HANDLE DETAILS ABOUT PARSING THE SWITCH
	 JRST TALL		;WE DON'T CARE IF SPECIAL VALUE WAS REQUIRED
	JRST TALL

;ROUTINE TO DO SWITCH-SPECIFIC PARSING
;
;   ACCEPTS:	A/	TABLE ADDRESS
;   RETURNS: +1		NO QUOTED STRING OR VALUE TO FOLLOW
;	     +2	A/	SPECIAL ARG REQUIRED AND PARSED, VALID S%QUO SETTING
HANSWI:	STKVAR <QQQ>
	HRRZ A,(A)		;GET ADDRESS OF SWITCH DATA
	MOVEI B,1(A)		;GET ADDRESS CONTAINING SPECIAL DISPATCH
				;   ADDRESS 
	MOVE A,(A)		;GET SWITCH DATA
	MOVEM A,QQQ		;REMEMBER FLAGS
	TXNN A,S%QUO+S%VAL	;QUOTED STRING OR VALUE TO FOLLOW?
	 RET			;NO
	CALL @(B)		;YES, DO IT
	MOVE A,QQQ		;RETURN FLAGS IN A
	RETSKP			;SKIP TO SAY SOMETHING MORE WAS READ

;READ VALUE FOR /LANGUAGE-SWITCHES
RDLSW:	QUOTEX <Switch(es) for compiler, in quotes>
	 CMERRX <Invalid value for /LANGUAGE-SWITCHES:>
	RET

;COMMA TYPED. DON'T ALLOW END OF LINE AFTER COMMA, OR ANOTHER COMMA, OR A PLUS
;   SIGN. 
TCOMM:	MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<a file name>,,[	;FILESPEC
		FLDDB. .CMTOK,,TXTPTR <@>,,,[		;INDIRECT FILE
		FLDDB. .CMTOK,,TXTPTR <%>]]]		;PERCENT SIGN
	CALL COMIN1		;INPUT FIELD
	 CMERRX <Filespec, "@", or "%" required after comma>
	JRST @D			;DISPATCH

;SWMOV - ROUTINE TO PLACE SWITCH NAME IN BUFFER IN PROPER
;
;   ACCEPTS:	A/	POINTER TO STRING
;   RETURNS:	A/	POINTER TO LAST CHAR
;		FSPEC/	STRING
SWMOV:	MOVE B,A		;SOURCE POINTER IN B
	HRROI A,FSPEC		;COPY TO FSPEC
	SETZ C,			;STOP ON NULL
	SOUT
	RET

;LANGUAGE EXTENSION TABLE
DEFINE L(LANG,EXT,PROC,TNAME) 
    <	LT.'EXT==<%LT==%LT+1>
	ASCII"EXT">

	%LT==0			;INITIAL VALUE

LTAB:	0			;ILLEGAL ENTRY (NULL EXTENSION)
	LANGUAGE		;EXPAND MACRO

LTABL==.-LTAB			;LENGTH OF TABLE

	LT.68C==LT.C68
	LT.74C==LT.C74

;TABLE OF SIXBIT TMP FILE NAMES
DEFINE L(A,B,C,D)
    <IFNB <D>,SIXBIT/D/		;;SIXBIT IF OLD-STYLE LINE EXISTS
     IFB <D>,0>			;0 IF NO OLD-STYLE LINE EXISTS

SIXTAB:	0			;TYPE 0 UNUSED
	LANGUAGE

;TABLE OF SIXBIT TMP FILE NAMES FOR NATIVE-COMPILERS
DEFINE L(A,B,C,D,E)
    <IFB <E>,0			;;0 IF NO NATIVE COMPILER FOR THIS LANGUAGE
     IFNB <E>,SIXBIT/E/>	;SIXBIT FOR NATIVE COMPILER TEMP FILE NAME

NSXTAB:	0
	LANGUAGE

;LANGUAGE TMP FILE NAME TABLE
DEFINE L(LANG,EXT,PROC,TNAME) 
    <	[GETSAVE (<SYS:'PROC'.>)],,[ASCIZ\TNAME'.TMP\]>

PRTAB:	0			;PROCESS NAME TABLE,,TEMP NAME 
	LANGUAGE		;EXPAND

;DEBUG AID TABLE
DEFINE L(LANG,EXT,PROC,TNAME) 
    <	0,,[ASCIZ\:'LANG\]>

DBTAB:	0			;LOSAGE ENTRY
	LANGUAGE		;EXPAND
DEFINE NAMES 
   <	NM (68-cobol,S%LTYP,LT.C68)
	NM (74-cobol,S%LTYP,LT.C74)
	NM (abort,S%FRH,F%ABT)	;7 SPR #:20-18717 wrong alphabetical order
	NM (algol,S%LTYP,LT.ALG)
;7	NM (abort,S%FRH,F%ABT)
MIT,<	NM (bcpl,S%LTYP,LT.BCP)> ;7
	NM (binary,S%TOFF!S%FRH,F%NBIN)
	NM (check,S%FRH,F%CHK)
	NM (cobol,S%LTYP,LT.CBL)
	NM (compile,S%FRH,F%CMPL)
	NM (cref,S%FRH,F%CREF!F%LIST)
	NM (cross-reference,S%FRH,F%CREF!F%LIST)
	NM (ddt,S%FLH,F%DDT)
	NM (debug,S%FRH,F%DEB)
;	NM (error-limit,S%FRH,F%ERR)
	NM (fail,S%LTYP,LT.FAI)
	NM (flag-non-standard,S%FRH,F%FLAG)
	NM (fortran,S%LTYP,LT.FOR)
	NM (language-switches:,S%QUO!S%DSP,DOLSW,RDLSW)
	NM (library,S%FRH,F%LIB)
	NM (list,S%FRH,F%LIST)
	NM (machine-code,S%FRH,F%MACH)
	NM (macro,S%LTYP,LT.MAC)
	NM (map,S%DSP,SWMAP,[RET])
	NM (nobinary,S%FRH,F%NBIN)
	NM (nocheck,S%TOFF!S%FRH,F%CHK)
	NM (nocompile,S%TOFF!S%FRH,F%CMPL)
	NM (nocref,S%TOFF!S%FRH,F%CREF!F%LIST)
	NM (nocross-reference,S%TOFF!S%FRH,F%CREF!F%LIST)
	NM (nodebug,S%TOFF!S%FRH,F%DEB)
;	NM (noerror-limit,S%TOFF!S%FRH,F%ERR)
	NM (noflag-non-standard,S%TOFF!S%FRH,F%FLAG)
	NM (nolibrary,S%TOFF!S%FRH,F%LIB)
	NM (nolist,S%TOFF!S%FRH,F%CREF!F%LIST)
	NM (nomachine-code,S%TOFF!S%FRH,F%MACH)
	NM (nooptimize,S%TOFF!S%FRH,F%OPT)
	NM (nosearch,S%TOFF!S%FRH,F%LIB)
	NM (nosymbols,S%TOFF!S%FRH,F%LSYM)
	NM (nowarnings,S%TOFF!S%FRH,F%WARN)
	NM (optimize,S%FRH,F%OPT)
	NM (pascal,S%LTYP,LT.PAS)
	NM (relocatable,S%LTYP,LT.REL)
	NM (sail,S%LTYP,LT.SAI)
	NM (search,S%FRH,F%LIB)
	NM (simula,S%LTYP,LT.SIM)
MIT,<	NM (slink,S%FLH,F%SLI)>	;7
	NM (snobol,S%LTYP,LT.SNO)
	NM (stay,S%DSP,DOSTAY,[RET])
	NM (symbols,S%FRH,F%LSYM)
	NM (warnings,S%FRH,F%WARN)>

DEFINE NM (NAME,FLAGS<0>,VALUE<0>,VAL2) 
    <	%V==VALUE		;;TEMP EQUATE
	IF2,<IFN <%V&^O777777B17>,<%V==<Z (%V)>>>
	IFB <VAL2>,<[ASCIZ"NAME"],,[<Z (FLAGS)>,,%V]>
	IFNB <VAL2>,<[ASCIZ"NAME"],,[<Z (FLAGS)>,,%V
					VAL2]>>

SWTAB:	SWLEN,,SWLEN
	NAMES

SWLEN==.-SWTAB-1
	BRINI.			;START WITH ALL 0'S
	BRKCH. " "		;BREAK ON THESE CHARACTERS
	BRKCH. "/"
	BRKCH. ":"
	BRKCH. "+"
	BRKCH. "%"
	BRKCH. ","
	BRKCH. (QUOTE)		;QUOTE MARK
	BRKCH. (0)		;NULL (END OF COMMAND)

BMSK:	EXP W0.,W1.,W2.,W3.
;CTAB - CHARACTER TYPE TABLE
;   EACH 4-BIT ENTRY CONTAINS THE CHARACTER TYPE FOR CHARACTER N
CTAB:	BYTE (4) 7,0,0,0,0,0,0,0,0	; NULL THRU ^H (NULL MARKS END OF
					;   COMMAND) 
	BYTE (4) 0,0,0,0,0,0,0,0,0	; ^I THRU ^Q
	BYTE (4) 0,0,0,0,0,0,0,0,0	; ^R THRU ^Z
	BYTE (4) 0,0,0,0,0,1,0,13,0	; ESC,PS,CS,RS,^_,SP,!,",#
	BYTE (4) 0,11,0,0,0,0,0,2,6	; $,%,&,',(,),*,+,,
	BYTE (4) 0,0,3,0,0,0,0,0,0	; -,.,/,0,1,2,3,4,5
	BYTE (4) 0,0,0,0,12,0,0,0,0	; 6,7,8,9,:,;,<,=,>
	BYTE (4) 0,0,0,0,0,0,0,0,0	; ?,@,A,B,C,D,E,F,G
	BYTE (4) 0,0,0,0,0,0,0,0,0	; H,I,J,K,L,M,N,O,P
	BYTE (4) 0,0,0,0,0,0,0,0,0	; Q,R,S,T,U,V,W,X,Y
	BYTE (4) 0,0,0,0,0,0,0,0,0	; Z,[,\,],^,_,@,a,b
	BYTE (4) 0,0,0,0,0,0,0,0,0	; c,d,e,f,g,h,i,j,k
	BYTE (4) 0,0,0,0,0,0,0,0,0	; l,m,n,o,p,q,r,s,t
	BYTE (4) 0,0,0,0,0,0,0,0,0	; u,v,w,x,y,z,[,\,]
	BYTE (4) 0,0			; 176,177

;PTAB - BYTE POINTER TABLE FOR CTAB
PTAB:	POINT 4,CTAB(Q1),3
	POINT 4,CTAB(Q1),7
	POINT 4,CTAB(Q1),11
	POINT 4,CTAB(Q1),15
	POINT 4,CTAB(Q1),19
	POINT 4,CTAB(Q1),23
	POINT 4,CTAB(Q1),27
	POINT 4,CTAB(Q1),31
	POINT 4,CTAB(Q1),35
;TRANSLATE (DIRECTORY) COMMAND
;   ALLOWS EITHER PPN OR DIRECTORY NAME TO BE INPUT AND TRANSLATES TO THE OTHER

.TRANS::NOISE <directory>
	DIRX <Directory name or project-programmer-number>
	 JRST PPNQ		;USER DIDN'T TYPE DIRECTORY NAME.
	CONFIRM			;GET CONFIRMATION OF COMMAND
	MOVE C,B		;REMEMBER DIRECTORY NUMBER IN C
	MOVE A,CSBUFP
	DIRST			;GET DIRECTORY STRING
	 ERCAL CJERRE
	MOVE A,CSBUFP
	STDEV			;GET DEVICE ASSOCIATED WITH DIRECTORY
	 ERCAL CJERRE
	MOVE A,CSBUFP
	PUSH P,A		;REMEMBER POINTER TO DEVICE NAME
	DEVST			;GET NAME OF DEVICE
	 ERCAL CJERRE
	MOVE A,C		;PUT DIRECTORY NUMBER IN A
	STPPN			;GET IT'S PPN
	HLRZ C,B		;LEFT HALF IN C
	HRRZ B,B		;LEAVE RIGHT HALF IN B
	POP P,D			;GET POINTER TO DEVICE NAME
	ETYPE <%1R (is) %4M:[%3O,%2O]%_>
	RET

;USER TYPED NON-DIRECTORY.  MAYBE IT'S A PPN.
PPNQ:	CALL CONST		;GET DEVICE DESIGNATOR FOR CONNECTED STRUCTURE
	MOVEM A,FBLOCK+.CMDEF	;FILL IN DEFAULT INFO
	MOVE D,A		;REMEMBER POINTER IN CASE USER DOESN'T TYPE
				;   STRUCTURE NAME 
	DEVX <Structure name or/and "[" to start PPN>
	 SKIPA A,D		;NO DEVICE TYPED, USE CONNECTED STRUCTURE
	  CALL BUFFF		;ISOLATE THE DEVICE NAME
	PUSH P,A		;REMEMBER POINTER TO DEVICE NAME
	MOVX A,"["
	CHARX <"[" to start PPN>
	 JRST BADPPN		;BAD SYNTAX FOR PPN
	OCTX <Octal programmer number>
	 JRST BADPPN
	PUSH P,B		;SAVE PROJECT NUMBER
	COMMAX <Comma to separate programmer number from project number>
	 JRST BADPPN
	OCTX <Octal project number>
	 JRST BADPPN
	PUSH P,B		;PROGRAMMER NUMBER
	MOVX A,"]"
	CHARX <"]" to end PPN>
	 JRST BADPPN
	CONFIRM
	POP P,B			;GET PROGRAMMER NUMBER
	POP P,D			;AND PROJECT NUMBER
	HRL B,D			;PUT THEM TOGETHER
	MOVE C,(P)		;GET POINTER TO STRUCTURE NAME
	MOVE A,CSBUFP		;GET SOME SPACE FOR WRITING DIRECTORY NAME INTO
	PPNST			;GET THE DIRECTORY NAME
	 ERCAL CJERRE		;ASSUME FAILURE WILL HAVE REASONABLE MESSAGE
	HRRZ B,B		;KEEP ONLY THE PROGRAMMER NUMBER IN B
	MOVE A,CSBUFP		;GET POINTER TO STRUCTURE NAME
	POP P,C			;GET POINTER TO STRUCTURE NAME
	ETYPE <%3M:[%4O,%2O] (is) %1M%%_>
	RET

;THE FOLLOWING VERBOSE ERROR MESSAGE WAS PUT IN BECAUSE AT TIME OF THIS
;   COMMAND, DOCUMENTATION DEPARTMENT DIDN'T HAVE TIME TO UPDATE ALL THE
;   DOCUMENTATION TO DESCRIBE IT, AS MANY PLACES HAD TO BE EDITED. 
BADPPN:	ERROR <To translate between PPN's and directories, type one of:
	TRANSLATE str:<directory>
	TRANSLATE str:[n,m]%_>

LITSCS:				;713 debugging aid: literals label
	END