Google
 

Trailing-Edge - PDP-10 Archives - BB-GS97A-SM - exec-sources/execcs.mac
There are 47 other files named execcs.mac in the archive. Click here to see a list.
; UPD ID= 223, SNARK:<6.1.EXEC>EXECCS.MAC.7,  10-Jun-85 08:43:09 by DMCDANIEL
; UPD ID= 196, SNARK:<6.1.EXEC>EXECCS.MAC.6,  13-May-85 15:19:09 by PRATT
;TCO 6.1.1383 - Update CMPSIZ in CMPER. Fixes nested indirect files.
; UPD ID= 166, SNARK:<6.1.EXEC>EXECCS.MAC.5,   3-May-85 08:29:56 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 129, SNARK:<6.1.EXEC>EXECCS.MAC.4,   8-Feb-85 15:10:53 by PRATT
;TCO 6.1.1182 - Fix CREF problem when jsys trapping is on.
; UPD ID= 79, SNARK:<6.1.EXEC>EXECCS.MAC.2,  12-Nov-84 04:40:38 by MERRILL
; TCO 6.1.1042 - Change a CALL FIELD to CALL FIELDX
; UPD ID= 437, SNARK:<6.EXEC>EXECCS.MAC.50,  21-Aug-84 15:01:05 by SANTIAGO
;TCO 6.2188 - Make COMPILE command abort if illegal value is given to switch.
; UPD ID= 413, SNARK:<6.EXEC>EXECCS.MAC.49,  14-Jun-84 15:17:38 by MCCOLLUM
;TCO 6.2099 - Change HDDs to use directory number instead of PPNs.
; UPD ID= 402, SNARK:<6.EXEC>EXECCS.MAC.48,   1-May-84 15:10:02 by MCCOLLUM
; TCO 6.2054 - Add /NOSTAY switch to load class commands.
; UPD ID= 397, SNARK:<6.EXEC>EXECCS.MAC.47,  23-Mar-84 17:26:41 by MCCOLLUM
;More of TCO 6.1995 - Fix a couple of loose problems.
; UPD ID= 394, SNARK:<6.EXEC>EXECCS.MAC.46,  12-Mar-84 16:08:13 by MCCOLLUM
;TCO 6.1995 - Rewrite routine CMPER to properly replace '%' with ',%'
; UPD ID= 385, SNARK:<6.EXEC>EXECCS.MAC.45,   3-Feb-84 17:04:01 by MCCOLLUM
;TCO 6.1965 - .BLI and .B10 files are compiled by BLIS10. .B36 files are
;	compiled by BLISS (through XBLISS). Also, add /10-BLISS and
;	/36-BLISS switches.
; UPD ID= 365, SNARK:<6.EXEC>EXECCS.MAC.44,  27-Dec-83 10:45:47 by TSANG
;TCO 6.1914 - An unrecognized file type will be defaulted to FORTRAN
; UPD ID= 362, SNARK:<6.EXEC>EXECCS.MAC.42,  19-Dec-83 11:43:28 by TSANG
;TCO 6.1858 - Give a meaningful error message for @COMP FOO/L
; UPD ID= 308, SNARK:<6.EXEC>EXECCS.MAC.40,  26-Aug-83 13:28:22 by TSANG
;TCO 6.1778 - Pass the correct arguments to compilers for /NOBINARY,/NOCREF,/NODEBUG,/NOFLAG-NON-STANDARD,/NOLIST,/NOMACHINE-CODE,/NOOPTIMIZE and /NOWARNINGS.
;TCO 6.1653 - Make /RELOCATABLE switch work properly.
; UPD ID= 266, SNARK:<6.EXEC>EXECCS.MAC.37,   8-Apr-83 14:24:36 by TSANG
;TCO 6.1597 - Give a meanful error message for file generation number problem.
; UPD ID= 265, SNARK:<6.EXEC>EXECCS.MAC.36,   8-Apr-83 13:54:31 by TSANG
;TCO 6.1564 - Make /SWITCH:TEXT work.
; UPD ID= 260, SNARK:<6.EXEC>EXECCS.MAC.35,   4-Apr-83 10:10:30 by CHALL
;TCO 6.1456 - Set up AC C for $GET0 and $GET2
; UPD ID= 258, SNARK:<6.EXEC>EXECCS.MAC.34,  11-Feb-83 14:17:07 by TSANG
; UPD ID= 252, SNARK:<6.EXEC>EXECCS.MAC.33,  18-Jan-83 16:00:55 by WEETON
;TCO 6.1349 - Make @LOAD/NOSYMBOL Work
; UPD ID= 251, SNARK:<6.EXEC>EXECCS.MAC.32,  18-Jan-83 09:24:21 by TSANG
; UPD ID= 239, SNARK:<6.EXEC>EXECCS.MAC.31,  15-Jan-83 19:24:20 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 211, SNARK:<6.EXEC>EXECCS.MAC.34,  21-Dec-82 10:27:26 by TSANG
;TCO 6.1424 - MAKE /NOBINARY SWITCH WORK.
; UPD ID= 209, SNARK:<6.EXEC>EXECCS.MAC.33,  15-Dec-82 10:37:53 by TSANG
;TCO 6.1400 - MAKE THE QUOTATION MARK IN A QUOTE STRING WORK PROPERLY.
; UPD ID= 208, SNARK:<6.EXEC>EXECCS.MAC.32,  13-Dec-82 12:06:54 by TSANG
;TCO 6.1388 - MAKE /NOWARNINGS WORK PROPERLY FOR FORTRAN LANGUAGE.
; UPD ID= 207, SNARK:<6.EXEC>EXECCS.MAC.31,  13-Dec-82 11:31:15 by TSANG
;TCO 6.1389 - MAKE THE "%" OPERATOR WORK PROPERLY.
; UPD ID= 200, SNARK:<6.EXEC>EXECCS.MAC.30,  24-Nov-82 16:28:37 by TSANG
;TCO 6.1187 - STRIP THE LINE-CONTINUATION CHARACTER "-" IF SEE IN SOURCE.
;TCO 6.1158 - USE DDT SW INSTEAD OF BLISS SW WHEN USE DEBUG COMMAND ON A
; BLISS FILE.
; UPD ID= 197, SNARK:<6.EXEC>EXECCS.MAC.29,  22-Nov-82 13:56:55 by TSANG
;TCO 6.1382 - LET THE /NOCOMP LOCAL SWITCH TO OVERRIDE /COMP GLOBAL SW
; UPD ID= 187, SNARK:<6.EXEC>EXECCS.MAC.27,  25-Oct-82 11:38:18 by TSANG
;TCO 6.1319 - RECOMPILE THE SOURCE FILE IF .REL FILE IS OFFLINE.
; UPD ID= 180, SNARK:<6.EXEC>EXECCS.MAC.26,   8-Oct-82 18:42:53 by MURPHY
;TCO 5.1.1088 - Force compile if source in connected dir but REL not.
; UPD ID= 161, SNARK:<6.EXEC>EXECCS.MAC.25,  21-Sep-82 16:29:47 by TSANG
;TCO 6.1269 - SET CORRECT FORMAT FOR PASCAL FILE IN TMPCOR FILE.
; UPD ID= 155, SNARK:<6.EXEC>EXECCS.MAC.24,  30-Aug-82 11:20:15 by TSANG
;TCO 6.1234 - MAKE GLOBAL LANGUAGE SWITCHES OVERRIDE THE DEFAULT ONE
; UPD ID= 144, SNARK:<6.EXEC>EXECCS.MAC.23,   5-Aug-82 09:23:33 by CHALL
;TCO 6.1211 MOVE FORTRAN TO 2ND POSITION OF LANGUAGES MACRO
; UPD ID= 136, SNARK:<6.EXEC>EXECCS.MAC.22,   4-Aug-82 17:15:41 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 116, SNARK:<6.EXEC>EXECCS.MAC.20,  20-Apr-82 07:53:44 by CHALL
;MORE TCO 5.1717 - MAKE MINOR ALTERATIONS FOUND BY JOHN GROUT
;TCO 6.1063 ALLOW UP TO 32 LANGUAGES (ADJUST F%LANG AND F.LMSK)
; UPD ID= 107, SNARK:<6.EXEC>EXECCS.MAC.17,   7-Feb-82 14:31:10 by CHALL
;TCO 5.1719 ADD NATIVE FORTRAN (NFO) TO LANGUAGES MARCO
;TCO 5.1717 BILDIT- FOR NATIVE, PUT SWITCHES AFTER FILESPECS
; UPD ID= 90, SNARK:<6.EXEC>EXECCS.MAC.16,   8-Jan-82 15:48:57 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 76, SNARK:<6.EXEC>EXECCS.MAC.14,  22-Oct-81 15:04:33 by CHALL
;TCO 5.1582 .SNDCS- ALLOW "." TO BE A LEGAL EXTENSION NAME
;TCO 5.1577 Fix TPLUS and TCOMM to skip COMIN CRLF check
;TCO 5.1572 Fix INFO DEFAULT COMPILE-SWITCHES typeout
;TCO 5.1571 Fix /LANGUAGE-SWITCHES to work with SET DEFAULT COMPILE-SWITCHES
;TCO 5.1569 Fix SET DEFAULT COMPILE-SWITCHES
;TCO 5.1568 Make global language switches override file types for translator
;TCO 5.1567 Make /LANGUAGE-SWITCHES work as last thing on line
; UPD ID= 71, SNARK:<6.EXEC>EXECCS.MAC.13,  10-Oct-81 20:24:29 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= 61, SNARK:<6.EXEC>EXECCS.MAC.12,   2-Oct-81 10:41:06 by CHALL
;TCO 5.1539 P1SRC1- CHANGE "%" TO "?" IN "?SOURCE FILE MISSING"
;  ALSO,    PASS2-  CHANGE "%" TO "?" IN "?OBJECT FILE MISSING"
; UPD ID= 58, SNARK:<6.EXEC>EXECCS.MAC.11,  21-Sep-81 09:36:28 by CHALL
;TCO 5.1520 GTASC- 7-CHAR FILE NAMES WERE ALLOWED (TYPO), BUT NOT NO MO
; UPD ID= 51, SNARK:<6.EXEC>EXECCS.MAC.10,   9-Sep-81 10:09:36 by CHALL
;TCO 6.1025 SWTAB- ADD /NOCREF SWITCH (SAME AS /NOLIST)
; UPD ID= 17, SNARK:<6.EXEC>EXECCS.MAC.9,  17-Aug-81 10:09:32 by CHALL
;TCO 5.1454 CHANGE NAMES FROM CSCAN TO EXECCS AND XDEF TO EXECDE
; UPD ID= 2151, SNARK:<6.EXEC>EXECCS.MAC.8,   8-Jun-81 16:51:14 by OSMAN
; UPD ID= 2148, SNARK:<6.EXEC>EXECCS.MAC.7,   8-Jun-81 15:16:06 by OSMAN
; UPD ID= 2143, SNARK:<6.EXEC>EXECCS.MAC.6,   8-Jun-81 10:02:53 by OSMAN
; UPD ID= 2142, SNARK:<6.EXEC>EXECCS.MAC.5,   8-Jun-81 09:28:49 by OSMAN
; UPD ID= 2141, SNARK:<6.EXEC>EXECCS.MAC.4,   8-Jun-81 08:28:43 by OSMAN
; UPD ID= 2132, SNARK:<6.EXEC>EXECCS.MAC.3,   7-Jun-81 16:59:12 by OSMAN
;tco 6.1020 - Recognize .REQ files as bliss library files
;tco 6.1019 - Add /BLISS switch and don't say /obj: for native-mode compilers
;unless explicit .rel given
; UPD ID= 2119, SNARK:<6.EXEC>EXECCS.MAC.2,   3-Jun-81 16:10:25 by OSMAN
;tco 6.1017 - run XBLISS for bliss programs
;<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
SUBTTL T.HESS/TAH	1-SEP-75

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

	SEARCH EXECDE
	TTITLE EXECCS - COMMAND SCANNER FOR TOPS-20
	SALL

ESC==ALTM		;BETTER SYMBOL
QUOTE==""""		;QUOTING CHARACTER
B.BP==70000,,0		;CONSTANT TO BACKUP BYTE POINTER

;INTERNAL AC USAGE

;P1 - FLAGS
;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)
;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%NLOB==1B14		;GTLANG MAY NOT LOOK FOR OBJECT FILE
F%XPXT==1B15		;GTLANG HAS SEEN AN EXPLICIT EXTENSION TYPED
F%FWKE==1B16		;GTLANG HAS FOUND A FILE WITH A KNOWN EXTENSION
F%STOJ==1B17		;GTLANG HAS A STACKED OUTPUT JFN

;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		;Don't load local symbols
F%ABT==1B26		;ABORT-ON-ERROR
F%MACH==1B27		;MACHINE-CODE
F%FLAG==1B28		;FLAG-NON-STANDARD
F%NWAR==1B29		;NO WARNINGS
;F%CHK==1B30		;CHECK
;F%ERR==1B31		;MAXIMUM ERRORS ALLOWED
F%LANG==1B30		;GLOBAL LANGUAGE SWITCH SEEN
			;BITS 31-35 ARE LANG TYPE
F.LMSK==37B35		;MASK FOR LANG TYPE
F.ALL==776000		;MASK FOR ALL FILE RELEVENT SWS
;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==3			;SOURCE VERSION D/T
OVER==4			;OBJECT VERSION D/T
HDD==5			;HACKED DEVICE DESIGNATOR (DD OR PROG #,,RH OF DISK DD)
HDDO==6			;HACKED DEVICE DESIGNATOR FOR OLD OBJECT FILE
HDDNO==7		;HACKED DEVICE DESIGNATOR FOR NEW OBJECT FILE
SWP==8			;POINTER TO LANGUAGE SWITCHES
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

;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 - DEBUG SWITCH NAME
;	B - EXTENSION
;	C - PROCESSOR NAME
;	D - TEMP FILE NAME
;	E - TEMP FILE NAME FOR NATIVE COMPILER

DEFINE LANGUAGE <
	L (BINARY,REL,LINK,LNK)
	L (FORTRAN,FOR,FORTRA,FOR,NFO)
	L (SAIL,SAI,SAIL,SAI)
	L (FAIL,FAI,FAIL,FAI)
	L (SNOBOL,SNO,SNOBOL,SNO)
	L (PASCAL,PAS,PASCAL,PAS,NPO)
	L (SIMULA,SIM,SIMULA,SIM)
	L (BLISS,REQ,XBLISS,,BLB) ;HANDLE BLISS LIBRARY FILES (REQUIRE /LIB TO
				;BLISS)
	L (BLISS,R36,XBLISS,,BLB)
	L (DDT,B36,XBLISS,,BLI)
			;Until someone teaches the BLISS compiler how to
			;read the temp file, we'll run XBLISS which force feeds
			;the command string to BLISS
	L (DDT,BLI,BLIS10,BLI)
	L (DDT,B10,BLIS10,BLI)
	L (ALGOL,ALG,ALGOL,ALG)
	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 (MACRO,MAC,MACRO,MAC)
	L (,L36)		;NEEDED TO RECOGNIZE .REQ FILES THAT DON'T NEED
				;NEW COMPILATION BECAUSE THEIR .L36 IS CURRENT
				;*** this entry must be last ***
>
;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,,<-1,,[ASCIZ /FROM/]>]
	CALL CFIELD		;TYPE NOISE BUT DON'T ALLOW "@"!
	MOVEI P1,0		;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
	SETZM NFILES		;CLEAR OUT OLD "BUF0" FOR DPRARG
	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 D,B		;SAVE DIRECTORY NUMBER
	MOVX A,RC%EMO		;MATCH EXACTLY
	SETZ C,			;CLEAR C
	RCDIR			;CONVERT TO DIRECTORY NUMBER
	HRLZM C,CHDD		;SAVE RH OF PPN INTO LH OF CHDD (LH ALWAYS 4)
	MOVE B,D		;PUT DIRECTORY NUMBER BACK INTO B
	HRROI A,FSPEC		;WRITE STRING TO FSPEC
	DIRST
	 ERCAL CJERRE		;IN CASE ERROR
	HRROI A,FSPEC		;TRANSLATE STRING TO DEVICE DESIGNATOR
	STDEV
	 ERCAL CJERRE		;IN CASE ERROR
	HRRM B,CHDD		;SAVE RH OF DD INTO RH OF CHDD
	SETZM LHED		;INITIALIZE VARIABLES
	SETZM CRFHED
	SETZM SAVPNT
	SETZM LSWPTR		;NO GLOBAL /LANG: YET
	SETZM MAPPNT		;NO /MAP YET
	MOVEI 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,440700		;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,LHED,CRFHED,SAVPNT,<FSPEC,FILWDS>,<CWBUF,LCWBUF>,<CSTXTB,10>,SRCSAV,CSJOB,CHDD,SAVBRK,EXTP,COMPBP,LPROC,DEBAID,TMPJFN,INDJFN,INDSIZ,CJEPTR,CMPBUF,ADDSIZ,CMPSIZ,LNGJFN,GJNSF,OUTJFN,LNGTYP,RELDAT,NXPROC,MAPPNT,BSTDAT,SAILF,FSPEXT,QQQFLG,DEFSW,RELOSW,BINYSW,WARNSW,NOCRSW,NODBSW,NOFGSW,NOLISW,NOMASW,NOOPSW>

	SETZM BINYSW
	SETZM WARNSW
	SETZM NOCRSW
	SETZM NODBSW
	SETZM NOFGSW
	SETZM NOLISW
	SETZM NOMASW
	SETZM NOOPSW
	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:	MOVEI A,7		;ALLOCATE ROOM IN TEXTI BLOCK
	MOVEM A,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
	SETZM DEFSW		;SET DEFAULT
	SETZM RELOSW		;RELOCATABLE SW
	MOVEI A,NATWDS		;NUMBER OF WORDS FOR NATIVE STRING
	CALL GETBUF		;GET BUFFER FOR NATIVE COMMAND STRING
	HRLI A,440700		;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
	MOVEI 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%NLOD	;ARE WE GOING TO LOAD?
	MOVEI	A,0		;NO - THEN NO FILESPEC
	MOVEM	A,NXPROC	;SAVE AS NEXT PROCESSOR
		;;;; FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE

	MOVEI	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
	SOS P4			;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
	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	;YES - COBOL SPECIAL HACK
	CAIN	P4,LT.BLI	;BLISS?
	JRST	P1LBLI		;YES - SPECIAL BLISS HACK
	CAIN 	P4,LT.PAS	;PASCAL?
	JRST	P1LFOR		;YES - SPECIAL PASCAL HACK
	CALL	TSOUT0		;DUMP FILESPEC
P1LPC:	MOVEI B,"!"
	CALL TBOUT
P1LPC1:	HRROI	B,[BYTE (7)15,12]
	CALL	TSOUT0		;TERMINATE
P1LPN:	MOVEI B,.CHNUL		;ASSUME LINK TO PROCESSOR IS END OF STRING
	IDPB B,A		;GUARANTEE NULL AT END OF STRING
	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,(<POINT 7,,>)
	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>
	MOVEI	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
	SETO C,			;FORCE OVERLAY
	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,<XWD 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 XWD 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:	MOVEI	B,","		;TERMINATE WITH A COMMA
	CALLRET	TBOUT		;...

;ROUTINE TO SETUP DEBUG AID IF ANY

SETDEB:	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
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;CALL:	CALL	LSCAN
;	<COROUTINE ADDRS>
;	RETURN 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	@0(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	@0(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
	MOVNI	Q2,1		;INIT TO -1
	CALL	SRCSCN		;SCAN SOURCES
	  JRST	P1SRC		;ROUTINE FOR SOURCE ON PASS1
	JUMPE	Q2,R		;RETURN IF NO SOURCE
	SKIPN	A,OVER(P2)	;IS THERE A VALID OBJECT FILE?
	 JRST	[TXO P1,F%SUPP	;LOSAGE NOTED
		 TYPE <?Invalid object file: >
		 MOVE B,NAM(P2)	;TELL HIM WHAT
		 CALL DSOUTR	;PRINT SPEC
		 RET]		;RETURN
	TXNN	P5,F%CMPL	;FORCED COMPILE?
	CAML	Q2,A		;COMPARE SOURCE & REL TIMES
	CALLRE	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:	MOVEI	Q2,0		;SAY WE LOST
	RET			;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE

PASS2:	TXNE	P5,D%LINK	;LINK SWITCH
	JRST	PASS2S		;YES - HANDLE SPECIAL
	LDB	Q2,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
	CAIN Q2,LT.REQ		;DOING BLISS LIBRARY FILE?
	RET			;YES, DON'T ATTEMPT TO LOAD IT
	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
	CALL	PUTDFO		;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	;SAY WE NEED A COMMA
	MOVE	B,HDDO(P2)	;MOVE IN HDDO
	CALL	PUTPPN		;DUMP PPN IF NECESSARY
	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:	MOVEI	B,"/"		;OUTPUT SLASH
	MOVE	Q1,NAM(P2)	;GET STRING POINTER
	ILDB	Q1,Q1		;PEEK AT FIRST CHAR
	CAIE	Q1,"/"		;IS IT A SLASH?
	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:	TXNE	P5,F%LSYM	;Test if /NOSYMBOL given as local switch
	JRST	P2SYM1		;yes, force /NOLOCAL switch
	TXNN	P1,F%LSYM	;local /NOSYMBOL not given, text if global
	RET			;no, return with no switches set
	TXNN	P5,F%LSYM	;was global /NOSYMBOL turned off with local
				; /SYMBOL switch?
	RET			;yes, return with no special switches set
P2SYM1:	HRROI	B,[ASCIZ "/NOLOCAL "] ;here when /NOSYMBOL switch given
	CALLRET	TSOUT0		;dump switch to link.
;BLDCOM - ROUTINE TO BUILD A COMMAND STRING
;CHECK FOR FILE OPEN FOR THIS LANGUAGE

BLDCOM:	SKIPE	A,HDDNO(P2)	;GET HDDNO WORD FROM BLOCK
	MOVEM	A,HDDO(P2)	;IF NON-ZERO, IT SHOULD REPLACE HDDO
;	MOVEM	P5,FLG(P2)	;UPDATE FLAG WORD
	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?
	 JRST	[CALL BILOBN	;YES - OUTPUT IT (AS A SWITCH)
		 JRST .+3]	;CHECK NEXT SW
	HRROI	B,[ASCIZ "/NOBINARY"]	;NO, SWITCH FOR NOBINARY
	CALL 	TSOUT0		;DUMP IT
	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
	TXNN	P5,F%MACH	;WANT IT?
	 JRST [SKIPN NOMASW	;NO, IS NOMACH SW EXPLICITLY TYPED?
	       JRST .+2		;NO, DON'T WRITE
	       HRROI B,[ASCIZ "/NOMACH"]	;YES, WRITE IT
	       JRST .+1]
	CALL	TSOUT0		;YES - DUMP IT
	HRROI	B,[ASCIZ "/FLAG"] ;SWITCH FOR FLAG-NON-STANDARD
	TXNN	P5,F%FLAG	;WANT IT?
	 JRST [SKIPN NOFGSW	;NO, IS NOFLAG SW EXPLICITLY TYPED?
     	       JRST .+2		;NO, DON'T WRITE
	       HRROI B,[ASCIZ "/NOFLAG"]	;YES, WRITE IT
	       JRST .+1]
	CALL	TSOUT0		;YES - DUMP IT
	HRROI	B,[ASCIZ "/NOWARN"] ;SWITCH FOR NO WARNINGS
 	TXNN	P5,F%NWAR	;YES, WANT IT?
	 JRST [SKIPN WARNSW	;NO, IS WARN SW EXPLICITLY TYPED?
	       JRST .+2		;NO, DON'T WRITE
	       HRROI B,[ASCIZ "/WARN"]	;YES, WRITE IT
	       JRST .+1]
	CALL	TSOUT0		;YES - DUMP IT
	TXNN	P5,F%LIST	;WANT LISTING?
	 JRST [CALL NOCRLI	;NO, SKIP OVER LIST STUFF
	       JRST BLDNC1]
	TXNN	P5,F%CREF	;YES - WANT CREF, TOO?
	JRST	[HRROI B,[ASCIZ "/LIST:LPT:"] ;YES - OUTPUT SWITCH
		 CAIN P4,LT.PAS	;IS PASCAL PROGRAM?
		 HRROI B,[ASCIZ "/LIST:"]	;YES,
		 CALL TSOUT0
		 CALL PUTDF1	;DUMP NAME
		  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

NOCRLI: HRROI B,[ASCIZ "/NOLIST"]
	SKIPE NOLISW		;IS NOLIST SW EXPLICITLY TYPED?
	CALL TSOUT0		;YES, WRITE IT
	HRROI B,[ASCIZ "/NOCREF"]	;NO, 
	SKIPE NOCRSW		;IS NOCREF SW EXPLICITLY TYPED?
	CALL TSOUT0		;YES, WRITE IT
	RET			;NO, SKIP OVER

;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN NATIVE FORMAT

BLDSRN:	MOVEI B,"+"		;FOR NATIVE MODE, PLUS BETWEEN SOURCE SPECS
	TXZE P1,F%NCMA		;NEED SEPARATOR?
	CALL TBOUT		;YES, PUT IT IN
	CALL PUTDF		;OUTPUT DEVICE AND FILE NAME
	 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
	MOVEI	B,","		;SEPARATE WITH A COMMA
	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)
		 CALL PUTDF1	;DUMP NAME
		  NOP		;IGNORE EXTENSION
		 JRST BLDIT1]	;CONTINUE
	MOVE	B,CHDD		;OUTPUT CREF FILE TO CONNECTED DIRECTORY
	CALL	PUTDEV
	CALL	PUTDF1		;OUTPUT FILENAME
	  NOP			;IGNORE
	MOVEI	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:	MOVEI	B,"="		;DELIMIT
	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
	MOVE	B,HDD(P2)	;GET HACKED DEVICE DESIGNATOR
	CALLRET	PUTPPN		;DUMP ONE AND 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

BILOBO:	CALL	PUTDFO		;OUTPUT DEVICE AND 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:	MOVE	B,HDDO(P2)
	SKIPE	NATIVF		;NATIVE COMPILER?
	JRST	BLDOB2		;YES - SKIP PPN, BUT DO SWITCHES
	CALL	PUTPPN		;NO - DUMP PPN
	CAIE	P4,LT.FOR	;FORTRAN?
	RET			;NO - DONE
BLDOB2:	HRROI	B,[ASCIZ "/OPTIM"] ;SWITCH FOR OPTIMIZE
	TXNN	P5,F%OPT	;WANT IT
	 JRST [SKIPN NOOPSW	;NO, IS NOOP SW EXPLICITLY TYPED?
	        JRST .+2	;NO, DON'T WRITE
	       HRROI B,[ASCIZ "/NOOPTIM"]	;YES,
	       JRST .+1]	
	CALL	TSOUT0		;YES - DUMP IT
	HRROI	B,[ASCIZ "/DEBUG"] ;SWITCH FOR DEBUG
	TXNN	P5,F%DEB	;WANT DEBUG CODE?
	 JRST [SKIPN NODBSW	;NO, IS NODEB SW EXPLICITLY TYPED?
	        JRST .+2	;NO, DON'T WRITE IT
	       HRROI B,[ASCIZ "/NODEBUG"]	;YES,
	       JRST .+1]
	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:	MOVEI	B,"-"
	CALLRET TBOUT		;YES - DUMP MINUS

;ROUTINE TO PUT PPN IN OUTPUT STREAM

PUTPPN:	TLNN B,600000		;IS THIS A NON-DIRECTORY DEVICE?
	TLNN B,777777		;OR IS THIS THE CONNECTED DIRECTORY?
	RET			;YES TO ONE, LEAVE
	PUSH	P,B		;SAVE ARG
	HRROI	B,[ASCIZ "[4,"]	;MOVE IN PROJECT NUMBER (ALWAYS 4)
	CALL	TSOUT0		;DUMP IT
	POP	P,B		;GET PPN BACK
	HLRZS	B		;PUT PROGRAMMER NUMBER IN RHS
	LDF	C,1B0+10	;...
	NOUT			;MAJIK
	  CALL	CJERR
	MOVEI	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	A,CSBUFP	;CURRENT POINTER
	MOVE	B,CHDD		;OUTPUT DEVICE FOR CONNECTED STRUCTURE
	CALL	PUTDEV		;OUTPUT CURRENT STRUCTURE
	MOVE	C,A		;MOVE UPDATED POINTER TO C
	MOVE	Q1,NAM(P2)	;POINTER TO NAME
	CALL	CPYDF		;COPY FILE NAME
	  NOP			;IGNORE THIS RETURN
	MOVEI	B,0		;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,0(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:	MOVEI	A,2		;ALLOCATE CELL
	CALL	BALLOC		;...
	HRRM	A,0(Q1)		;LINK TO OLD
	MOVE A,CSBUFP		;POINTER TO NEW STRING
	CALL BUFFS		;ISOLATE THE STRING
	HRRZ B,0(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,7B5+1B19	;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:	MOVEI	B,0		;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,0(P)		;GET JFN
	TLO	A,(1B0)		;RETAIN IT
	CLOSF			;CLOSE FILE
	  CALL	CJERR		;NEVER HAPPEN
	LDF	B,7B5+1B20	;OPEN FOR WRITE
	TLZ	A,(1B0)		;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,0(P)		;GET JFN
DNCRF2:	MOVEI	B,"="		;EQUAL SIGN
	CALL	TBOUT		;DUMP IT
	MOVE	B,1(Q1)		;POINTER TO FILESPEC
	CALL	TSOUT0		;DUMP IT NEXT
	CALL	EOLOUT		;  AND CRLF
	SKIPE	Q1,0(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.
;NON-SKIP IF FILESPEC TERMINATED (; OR NULL).
;SKIP IF PERIOD FIRST.
;PUTDF0 - IF Q1 ALREADY SET UP

PUTDFO:	SKIPA	B,HDDO(P2)	;GET HDD FROM HDDO
PUTDF:	MOVE	B,HDD(P2)	;GET HDD FROM HDD
	SKIPE	NATIVF		;IN COMPATIBILITY MODE?
	TLNE	B,600000	;OR NON-DIRECTORY DEVICE?
	JRST	[CALL PUTDEV	;YES TO ONE, JUST OUTPUT DEVICE
		 JRST PUTDF1]	;AND GO OUTPUT FILENAME
	TLNN B,-1		;GOT THE CONNECTED DIRECTORY?
	JRST PUTDF1		;YES - DON'T OUTPUT DEVICE AND DIRECTORY AT ALL
	PUSH P,A		;SAVE JFN
	PUSH P,B		;AND HDD
	HRLI B,600000		;CHANGE TO DEVICE DESIGNATOR
	MOVE A,CSBUFP		;PUT IN CSBUF
	DEVST			;GET STRUCTURE STRING
	 ERCAL CJERRE		;IN CASE ERROR
	POP P,B			;RESTORE PPN
	HLRZS B			;PUT PROGRAMMER NUM IN RH
	HRLI B,4		;PUT PROJECT 4 IN LH
	MOVE C,CSBUFP		;PUT POINTER TO STRUCTURE IN C
	POP P,A			;GET BACK JFN
	PPNST			;TRANSLATE TO STRING
	 ERCAL CJERRE		;IN CASE ERROR
PUTDF1:	MOVE	Q1,NAM(P2)	;USE FILENAME POINTER
PUTDF0:	PUSH	P,[TBOUT]	;ROUTINE TO USE
PUTDFC:	ILDB	B,Q1		;GET CHAR
	SKIPE	B		;LOOK FOR NULL
	CAIN	B,";"		; OR SEMICOLON
	JRST	PTDFR		;GIVE RETURN (END-OF-SPEC)
	CAIN	B,"."		;PERIOD?
	JRST	PTDFR1		;YES - RETURN NOW
	CALL	@0(P)		;NO - DUMP CHAR
	JRST	PUTDFC		;CONTINUE

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

;ROUTINE LIKE PUTDF0 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 OUTPUT DEVICE FROM HDD TO DEVICE DESIGNATOR IN A

PUTDEV:	TLC B,600000		;CHANGE PROJECT NUMBER LH TO 600000+.DVDSK
	TLCE B,600000
	HRLI B,600000		;NOTE: .DVDSK = 0
	DEVST			;COPY THE DEVICE NAME
	 ERCAL JERRE		;HORRIBLE ERROR
	MOVEI B,":"		;OUTPUT A COLON
	CALLRET TBOUT		;AND RETURN
;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
	AOJ B,			;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,440700		;FILE
	RET			;GIVE CALLER THE BYTE POINTER ("JFN")

OPNT2:	SETZM ADDTAB		;CLEAR BUFFER
	MOVE B,[ADDTAB,,ADDTAB+1]
	BLT B,BUF1-1
	MOVEI 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
	MOVEI D,0		;END WITH A NULL
CLSTM1:	IDPB D,A		;FILL REST OF WORD WITH NULLS
	TLNE 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,7B5+1B20	;BYTE SIZE + WRITE
	OPENF			;OPEN FILE
	  CALL	CJERR		;TEMP FILE LOSAGE
	RET			;RETURN

TJNUM:	MOVEI	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:
;
;	o	Carriage returns are ignored.  Linefeeds are changed to
;		commas.  This is so that multiple-line indirect files work.
;
;	o	All multiple spaces are compressed to at most one space
;
;	o	Any spaces following end of line are
;		deleted.  Neglecting to remove spaces at end of line causes
;		"COMP FOO.MAC " to force a compilation.
;
;	o	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!
;	o	Comments enclosed in exclams (!) are removed
;
;	o	Comments starting with semicolon (;) last through the next
;		linefeed or end of command
;
;	o	All spaces other than those sandwiched between filespecs
;		are removed.

;Accepts:	AC1/	Pointer to command string

C%PLUS==1B0			;LAST NON-SPACE WAS NOT A FILESPEC CONSTITUENT

CMPRES:	MOVEI 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,100700		;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,4*8		;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,"-"		;CHECK THE LINE-CONTINUATION "-"
	JRST [MOVE D,A          ;YES, MAY BE, SO SAVE THE CHARACTER
	      ILDB A,CSPTR      ;LOAD NEXT BYTE
	      CAIE A,.CHCRT     ;IS CR ?
	      JRST ADJBP1       ;NO, IT IS NOT A LINE-CONTINUATION "-"
	      ILDB A,CSPTR      ;YES, LOAD THE NEXT BYTE
	      CAIE A,.CHLFD     ;IS LF ?
	      JRST ADJBP2       ;NO, IT IS NOT A LINE-CONTINUATION "-"
	      JRST GCMC]        ;YES, STRIP THE LINE-CONTINUATION
	JRST CMIND		;NO, IT IS NOT A LINE-CONTINUATION
ADJBP1:	MOVEM D,A		;RESTORE THE BYTE "-"
	MOVNI C,1		;
	IBP  C,CSPTR		;ADJUST THE SOURCE POINTER BACKWARD BY 1
	MOVEM C,CSPTR		;
	JRST CMIND		;
ADJBP2:	MOVEM D,A		;RESTORE THE BYTE "-"
	MOVNI C,2		;
	IBP C,CSPTR		;ADJUST THE SOURCE POINTER BACKWARD BY 2
	MOVEM C,CSPTR		;
	JRST CMIND		;
CMIND:	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,""""		;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
	CAIN A,"!"		;INTERNAL COMMENT IN LINE?
	JRST CMP5		;YES,
	CAIN A,"%"		;NO, IS IT A % SIGN?
	JRST CMPER		;YES,
	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,[377777,,377777]
	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?>]
	MOVNI C,1
	ADJBP C,B		;KEEP CHARACTER AFTER FILESPEC
	MOVEM C,CJEPTR		;REMEMBER POINTER TO END OF FILESPEC
	LDF	B,7B5+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,[440000,,1]	;GET BYTE POINTER TO 0TH BYTE IF BYTE SIZE WAS 0
	DPB C,[300600,,A]	;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,[360600,,D]	;GET NUMBER OF UNUSED BITS IN LAST WORD
	SOJ C,			;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
	MOVNI A,1
	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
		 MOVEI C,0	;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,""""		;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
	MOVNI C,1		;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
	MOVEI C,0		;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
	 ERJMP .+2		;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
	MOVEI A,","		;TREAT END OF LINE AS COMMA
	DPB A,CSPTR		;STORE IN SOURCE STRING IN FOR LDB INSTRUCTION
	RET			;ACCOUNT FOR COMMA

;COME HERE IF "%" SIGN SEEN. WE HAVE TO OUTPUT A COMMA PRECEEDING THE "%" SIGN.
;BUT IF THERE IS AN INDIRECT FILE BEFORE THE "%" SIGN, DON'T WORY ABOUT IT.

CMPER:	LDB Q1,CDPTR		;LOAD THE LAST OUTPUT CHARACTER
	CAIN Q1,","		;IS IT A COMMA?
	RET			;YES, FORGET ABOUT IT
	SETO B,			;GET -1
	ADJBP B,CMPPT0		;ADJUST POINTER TO STRING BACK ONE CHAR
	MOVEM B,CMPPT0		;SAVE THIS AS ORIGINAL BYTE POINTER
	MOVE A,CDPTR		;GET POINTER TO DESTINATION BYTE
	CALL SUBBP		;GET NUMBER OF BYTES TO MOVE
	SOJ A,			;ADJUST BY ONE
	MOVN C,A		;TELL SOUT EXACT NUMBER OF BYTES TO MOVE
	MOVE A,CMPPT0		;WHERE TO MOVE STRING TO
	MOVE B,CMPPT0		;GET NEW START OF STRING
	IBP B			;MAKE OLD START OF STRING
	SKIPGE C		;DON'T DO SOUT IF ZERO!
	SOUT%			;MOVE THE STRING BACKWARDS
	MOVEI B,","		;GET A COMMA
	IDPB B,A		;STORE IT BEFORE "%"
	MOVEI A,"%"		;GET BACK '%'
	AOS CMPSIZ		;ACCOUNT FOR THE NEW COMMA
	RET			;DONE. CONTINUE PROCESSING

;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
	CAIE 	A,0		;SPECIAL CHARACTER?
	JRST	XTAB(A)		;YES, DISPATCH
	JRST	[TXO P1,F%LAHD	;NO, MAY BE A FILESPEC
		 JRST RDSPAC]

CAPND:	MOVEI	Q1,":"		;REPLACE DELIMITER
CAPND1:	DPB	Q1,3+CSTXTB	;IN BUFFER
	PUSH	P,P3		;SAVE COUNT
	CALL	RDFLDN		;SPECIAL READ
	ADDM	P3,0(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
	MOVEI	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:	SETZM	GJNSF		;CLEAR GJ%NS FLAG (ONLY HERE MUST ATOM BE DONE)
	TXZ	P1,F%CMOK	;CLEAR FLAG FOR NULL SPEC
	SKIPN	Q1,SRCSAV	;DID WE HAVE SEPARATE SOURCES
	JRST	[MOVE A,FLG(P2)	;NO, CHECK TO SEE IF LINK SWITCH
		 TXNN A,D%LINK	;IF LINK SWITCH, DON'T STORE
		 SKIPGE A,RELDAT;IF NOT LINK SWITCH, STORE IF GE 0
		 JRST RDCMA2	;DON'T STORE, GO SET UP LANG TYPE
		 MOVEM A,OVER(P2) ;STORE
		 JRST RDCMA2]	;GO 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
	MOVEI	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
	MOVEI	Q1,0		;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
	MOVEI	Q2,0		;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
	SKIPL	A,RELDAT	;DO WE WANT TO STORE?
	MOVEM	A,OVER(P2)	;YES, DO SO
	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 POINTER TO PREVIOUS BLOCK IN B, NEW BLOCK IN P2.

FILBLK:	TXZA	P1,F%NLOB	;SAY OK TO LOOK FOR OBJECT
FILBK1:	TXO	P1,F%NLOB	;SAY NOT TO LOOK FOR OBJCECT
	MOVE	B,[POINT 7,FSPEC] ;COPY STRING TO FSPEC
FILBK2:	ILDB	A,P4		;...
	IDPB	A,B
	JUMPN	A,FILBK2
	MOVEI	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
;CALL:	MOVEI	A,<SIZE-IN-WORDS>
;	CALL	BALLOC
;	<RETURN>	C(A) := ADDRS OF BLOCK, BLOCK 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	0(P)		;SKIP RETURN
GTLNGB:	MOVE	A,LNGJFN	;GET JFN USED
	JUMPE	A,R		;NONE - RETURN
	CALL RJFN		;RELEASE LNGJFN
	SETZM	LNGJFN		;SAY RELEASED
	RET			;GIVE DESIRED RETURN

GTLNGA: TXNN P1,F%OBJ		;IS IN OBJECT FILE?
	CALL CJERR		;NO, IT IS SOURCE FILE?
	HRROI A,FSPEC		;POINT TO SPEC
	CALL BUFFS		;ISOLATE IT
	MOVEM A,NAM(P2)		;REMEMBER POINTER
	JRST	GTLNGB		;JOIN COMMON CODE
GTLNGX:	DMOVE A,[POINT 7,[ASCII "*"]
		 GJ%OLD+GJ%IFG+GJ%FLG] ;LOAD DEFAULTS FOR NON-OBJECT FIELD
	TXNE	P1,F%OBJ	;IN OBJECT FIELD?
	 DMOVE	A,[POINT 7,[ASCII "REL"]
		   GJ%FOU+GJ%FLG] ;YES, THEN USE THESE DEFAULTS INSTEAD
	MOVEM	A,CJFNBK+.GJEXT	;SAVE DEFAULTS
	MOVEM	B,CJFNBK
	MOVE	A,[377777,,377777] ;DON'T USE ANY OTHER INPUT
	MOVEM	A,CJFNBK+.GJSRC
	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
	HRRZM	A,LNGJFN	;SAVE JFN
	LDB	B,B		;CHECK TERMINATOR
	JUMPN B,[HRROI A,FSPEC
		 ERROR <Illegal character in filespec: %1M>]
	TXNE	A,GJ%EXT	;WAS AN EXPLICIT EXTENSION TYPED?
	TXZA	P1,F%XPXT	;NO, CLEAR F%XPXT
	TXO	P1,F%XPXT	;YES, SET F%XPXT
	TXNN	P1,F%OBJ	;ARE WE IN OBJECT FIELD?
	JRST	GTLNX0		;NO, GO HANDLE
	MOVX A,GJ%OLD+GJ%FLG	;IN OBJECT FIELD, TRY TO DO INPUT GTJFN
	SKIPE GJNSF		;DO WE WANT TO SET GJ%NS?
	TXO A,GJ%NS		;YES, SET IT
	MOVEM A,CJFNBK		;STORE FLAGS
	MOVEI A,CJFNBK		;BLOCK ADDRS
	HRROI B,FSPEC		;POINT TO STRING
	CALL GTJFS		;LOOK UP .REL FILE
	 JRST GTLNX0		;FAILS, NO STACKED OUTPUT JFN
	TXO P1,F%STOJ		;THERE IS STACKED OUTPUT JFN
	HRRZS A			;TAKE THE FLAGS OFF THE JFN FOR DVCHR
	EXCH A,LNGJFN		;INPUT JFN BECOMES LNGJFN
	MOVEM A,OUTJFN		;OUTPUT JFN IS SAVED AS OUTJFN
	CALL GTHDD		;GET THE HDD
	MOVEM C,HDDNO(P2)	;STORE IT IN HDDNO
	JRST	GTLNX1		;PROCEED
GTLNX0:	TXZ P1,F%STOJ		;NO STACKED OUTPUT JFN
	SETZM HDDO(P2)		;INDICATE NOT DIFFERENT DIRECTORY FOR OBJECT
GTLNX1:	LDF	A,GJ%OFG!GJ%XTN
	MOVEM	A,CJFNBK	;STORE FLAGS
	LDF	A,G1%SLN	;SUPRESS LOGICAL NAME EXPANSION
	MOVEM	A,CJFNBK+.GJF2
	SETZM	CJFNBK+.GJEXT	;NO MORE DEFAULT EXTENSION
	MOVEI	A,CJFNBK	;POINT TO BLOCK
	HRROI	B,FSPEC		;POINT TO STRING
	CALL GTJFS		;LOOK UP FILE
	 CALL JERRE		;SHOULD NEVER FAIL
	MOVE	B,A		;WRITE DEVICE AND DIRECTORY FIELDS
	HRROI	A,FSPEC		;INTO FSPEC
	MOVX	C,1B2+1B5+JS%PAF
	JFNS
	MOVEM	A,NAM(P2)	;SAVE BYTE POINTER TO BEGINNING OF FILE NAME
	MOVE	B,LNGJFN	;WRITE FILENAME FIELD
	MOVX	C,1B8		;FROM OTHER JFN INTO FSPEC
	JFNS
	MOVEM	A,FSPEXT	;SAVE EXTENSION POINTER HERE
	CALL	RJFN		;RELEASE PARSE-ONLY JFN
	MOVE	A,LNGJFN	;JFN
	DVCHR			;GET DEVICE CHARACTERISTICS
	TXNN	B,DV%IN		;IS DEVICE OUTPUT ONLY
	TXNE	P1,F%NLOD	;AND ARE WE LOADING?
	TRNA			;NO, SKIP
	RET			;YES, LEAVE
	TXNE	B,DV%DIR	;DIRECTORY DEVICE?
	 TDZA	C,C		;YES, CLEAR
	HRLOI	C,377777	;NO, FUNNY LARGE DATE
	TXNE	P1,F%OBJ	;ARE WE IN OBJECT FIELD?
	TXNE	P1,F%STOJ	;IF SO, DO WE HAVE STACKED OUTPUT JFN
	TRNA			;NOT IN OBJECT FIELD OR THIS IS INPUT JFN, SKIP
	SETO	C,		;FORCE COMPILE (NO INPUT FILE TO CHECK)
	MOVEM	C,BSTDAT	;SAVE IN BSTDAT
	TXNN	B,DV%DIR	;IS IT A DIRECTORY DEVICE?
	SKIPA	C,A		;NO, SAVE REAL DEVICE DESIGNATOR
	SETZ	C,		;YES, SAVE ZERO (FILL IN LATER WITH GTHDDF)
	MOVEM	C,HDD(P2)
	JUMPE	C,GTLNX2	;DON'T SAVE IN HDDNO IF NOT FORCED COMP
	TXNE	P1,F%OBJ	;ARE WE IN OBJECT FIELD?
	MOVEM	C,HDDNO(P2)	;YES, SAVE FORCED COMP IN HDDNO
GTLNX2:	MOVEI	A,LT.REL	;DEFAULT SOURCE LANGUAGE TYPE SEEN IS REL
	MOVEM	A,LNGTYP
	TXZ	P1,F%FWKE	;CLEAR "FILE WITH KNOWN EXTENSION" BIT
	LDF	A,GJ%OLD	;FILES WE'RE LOOKING FOR ARE OLD
	MOVEM	A,CJFNBK	;SAVE FLAGS IN GTJFN BLOCK
	SKIPN	BSTDAT		;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT
	TXNE	P1,F%XPXT	;OR WAS AN EXPLICIT EXTENSION TYPED?
	 TRNA			;YES TO ONE, SKIP
	 JRST	GTLNG2		;NO, START LOOKING AT STANDARD EXTENSIONS
	TXNE P1,F%OBJ		;IN OBJECT SPEC?
	SKIPN BSTDAT		;NON-TWO-WAY SPEC (NON-DIR OR INPUT FAILED)?
	TRNA			;NO TO ONE, SKIP
	 JRST	[MOVX B,LT.REL	;YES TO BOTH, EXTENSION MIGHT NOT BE THERE,
		 JRST GTLNX3]	;SO IT'S ARBITRARILY TYPE .REL
	MOVE A,LNGJFN		;GET BACK LNGJFN
	CALL DJFNSE		;PUT EXTENSION IN CWBUF
	MOVE B,CWBUF		;PUT EXTENSION INTO B
	CALL LOOKE		;LOOK UP EXTENSION IN LTAB
	 SETZ B,		;FAILED, MAKE LANGUAGE TYPE ZERO
GTLNX3:	MOVEM B,LNGTYP		;STORE LNGTYP
	MOVE A,LNGJFN		;GET BACK LNGJFN AGAIN
	MOVEM A,TMPJFN		;PUT IT WHERE GTLN1S WILL FIND IT
	SKIPE BSTDAT		;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT?
	 JRST GTLNG4		;YES, SKIP CHECKING FOR BETTER THINGS
	MOVE Q1,B		;GET IN LANGUAGE TYPE FOR GTLN1S
	CALL GTLN1S		;MAKE SHORT CALL TO LOOK AT THIS FILE
	MOVE B,LNGTYP		;SEE IF WE JUST LOOKED AT .REL FILE
	CAIN B,LT.REL		;DID WE?
	JRST GTLNG4		;YES, SKIP CHECKING IT AGAIN
GTLNG2:	MOVE	Q1,[1-LTABL,,1]	;GET LANGUAGE TABLE INDEX (SKIP NULL EXTENSION)
	SETOM	RELDAT		;SET REL FILE DATE-TIME TO -1 (FORCE COMPILE)
	TXNN	P1,F%NLOB       ;CAN WE USE AN OBJECT FILE?
GTLNG3:	CALL	GTLNG1		;CHECK THIS FILE TYPE
				;WE CAN'T USE AN OBJECT FILE, SKIP .REL ENTRY
				;NOTE THAT .REL MUST ALWAYS BE
				;THE FIRST ENTRY IN THE LANGUAGE TABLE
	TXNN	P1,F%XPXT	;STOP HERE IF EXPLICIT EXTENSION WAS TYPED
	AOBJN	Q1,GTLNG3	;SEE IF ANY OTHERS
	TXZN	P1,F%FWKE	;DID WE SEE A FILE WITH A KNOWN EXT?
	RET			;NO, FAIL
GTLNG4:	LDF	A,D%EXTN	;EXPLICIT EXTENSION GIVEN
	IORM	A,FLG(P2)
	SKIPE RELOSW		;IS RELOCAT SW ON?
	 JRST [TXNN P1,F%XPXT	;YES, IS FILE TYPE EXPLICITLY EXISTING?
	       ANDCAM A,FLG(P2)	;NO,
	       JRST .+1]	;YES,
	MOVE	A,LNGJFN	;RESTORE LANGUAGE JFN
	CALL	DJFNSE		;GET EXTENSION
	CALL	COPEXT		;COPY EXTENSION
	SKIPE	B,LNGTYP	;DO WE HAVE LANGUAGE TYPE FROM BEFORE?
	CALL	SETLTP		;YES, SET IT
	PUSH	P,B		;SAVE LANG TYPE TEMPORARILY
	MOVE	A,LNGJFN	;GET BACK LNGJFN
	SKIPN	C,HDD(P2)	;IS IT A NON-DIRECTORY DEVICE?
	CALL	GTHDDF		;NO, GET HDD FOR FILE
	MOVEM	C,HDD(P2)	;STORE IT
	TLNE	C,-1		;CONNECTED DIRECTORY?
	JRST	GTLG4A		;NO - SKIP THIS
	SETOM	GJNSF		;YES, FOLLOWING OBJECT SPEC USES GJ%NS
	MOVE	B,HDDO(P2)	;CHECK OBJECT HDD
	TLNE	B,-1		;CONNECTED DIR TOO?
	SETOM	RELDAT		;NO, CAN'T USE IT

GTLG4A:	POP	P,B		;RESTORE LANG TYPE
	CAIN	B,LT.REL	;IS IT A .REL FILE?
	MOVEM	C,HDDO(P2)	;YES, STORE HDD IN HDDO ALSO
	MOVE	A,BSTDAT	;GET BEST D/T FOUND EARLIER
	CAIN	B,LT.REL	;IS IT A .REL FILE?
	MOVE	A,RELDAT	;YES, GET D/T FROM HERE INSTEAD
	CALL	STODT		;STORE D/T ACCORDING TO TYPE
	CAIE	B,LT.REL	;IS OBJECT TYPE ALREADY
	TXNE	P1,F%NLOB	;OR CAN'T WE LOOK FOR OBJECT?
	 CALLRET STEXNA		;YES, UPDATE FSPEC, STORE NAME, LEAVE
	TXNE	P1,F%STOJ	;IS THERE A STACKED OUTPUT JFN?
	 JRST	[MOVE A,OUTJFN	;YES, GET IT BACK
		 JRST GTLNG5]	;AND SKIP OVER GETTING A NEW JFN
	SETZM	CJFNBK+2	;CLEAR DEFAULTS
	MOVE	Q1,[CJFNBK+2,,CJFNBK+3]
	BLT	Q1,XTNCNT-1	;...
	HRROI	A,[ASCIZ /REL/]	;STORE DEFAULT FOR FILE EXTENSION
	MOVEM	A,CJFNBK+.GJEXT
	LDF	A,GJ%FOU	;FIND OUT WHERE .REL FILE WILL GO
	MOVEM	A,CJFNBK	;...
	MOVEI	A,CJFNBK	;GET GTJFN BLOCK ADDRESS
	MOVE	B,NAM(P2)	;ENTER .REL FILE ON CONNECTED DIR
	CALL GTJFS		;(OR ON DSK:)
	  CALLRET STEXNA	;FAILED, UPDATE FSPEC AND STORE NAME, AND LEAVE
GTLNG5:	SETOM	OVER(P2)	;SAY WE HAVE CREATED A NEW .REL FILE
	TXO	P1,F%STOJ	;WE HAVE A STACKED OUTPUT JFN
	MOVEM	A,OUTJFN	;SAVE FOR AFTER DVCHR
	CALL	GTHDD		;GET HDD FOR THE FILE
	MOVEM	C,HDDNO(P2)	;SAVE FOR LATER
	CALLRET	STEXNA		;UPDATE FSPEC, STORE FILE NAME, AND LEAVE

GTLNG1:	HRROI	B,LTAB(Q1)	;GET A LANGUAGE TYPE FOR DEFAULT
	MOVEI	A,CJFNBK	;GET ADDRESS OF GTJFN BLOCK
	MOVEM	B,.GJEXT(A)	;SAVE DEFAULT LANG EXT
	TRNN	Q1,777776	;IS THIS TYPE .REL?
	TXNN	P1,F%XPXT	;AND WAS THERE AN EXPLICIT EXTENSION TYPED?
	SKIPA	B,[POINT 7,FSPEC] ;NOT BOTH - USE DIRECTORY SPECIFIED
	MOVE	B,NAM(P2)	;YES, IMPLICIT OBJECT ONLY LOOKED FOR ON DSK:
	CALL	GTJFS		;SEE IF THIS LANGUAGE TYPE IS THERE
	 RET			;THIS TYPE IS NOT THERE, RETURN
	MOVE B,[1,,.FBCTL]
	MOVEI C,C
	GTFDB
	TXNE C,FB%OFF		;IS .REL FILE OFFLINE?
	JRST [SETOM RELDAT	;YES, FORCE TO RECOMPILE
	      ETYPE <%% %1S - is offline file %_> ;GIVE WARNING MESSAGE
	      RET]     		;AND RETURN
	MOVEM A,TMPJFN		;FOUND A JFN, SAVE IT FOR NOW
GTLN1S:	CALL GTDT		;GET THE D & T OF LAST WRITE TO FILE
	CAMG A,BSTDAT		;IS IT LATER THAN PREVIOUSLY FOUND TYPE
	 CALLRET RJFN		;NO, THROW IT AWAY AND RETURN
	HRRZ B,Q1		;GET LANGUAGE TYPE INTO B
	CAIE B,LT.REL		;IS THIS A .REL FILE?
	 JRST	[MOVEM A,BSTDAT	;NOT .REL FILE, PUT IN BSTDAT
		 JRST GTLN1F]	;REJOIN TO CHECK FLAGS
	MOVEM A,RELDAT		;YES, SAVE D&T FOR MAKOBJ
	TXNE P1,F%OBJ		;IS THIS OBJECT SPEC?
	 JRST GTLN1F		;YES, DON'T FIND HDD AGAIN
	MOVE A,TMPJFN		;JFN
	CALL GTHDDF		;GET HDD OF .REL FILE
	MOVEM C,HDDO(P2)	;SAVE IT FOR LATER
GTLN1F:	TXON P1,F%FWKE		;SAY WE'VE SEEN A FILE WITH KNOWN EXT
	TXNN P1,F%XPXT		;FIRST TIME, IS THIS SHORT CALL AT GTLN1S?
	TRNA			;NOT FIRST TIME OR ISN'T LNGJFN, SKIP
	RET			;THIS IS A SHORT CALL, DON'T SWAP TO SELF
	HRRZ B,Q1		;GET LANGUAGE TYPE INTO B
	CAIN B,LT.REL		;IS THIS A .REL FILE?
	TXNN P1,F%XPXT		;IF SO, IS THIS THE FIRST FILE WE'RE DOING?
	TRNA			;NOT .REL FILE OR IT'S THE FIRST FILE, SKIP
	 CALLRET RJFN		;DON'T SWAP WITH VALID SOURCE JFN, LEAVE NOW
	MOVE A,TMPJFN		;GET BACK THE JFN OF THIS FILE
	MOVE B,LNGJFN		;GET JFN OF CURRENT BEST FILE
	SWJFN			;SWAP THE TWO JFN'S
	HRRZ B,Q1		;GET LANGUAGE TYPE INTO B
	CAIN B,LT.REL		;IS THIS A .REL FILE?
	 CALLRET RJFN		;YES, LEAVE NOW
	TXNE P1,F%LANG		;IS THERE A GLOBAL LANGUAGE SWITCH?
	LDB B,[POINTR (P1,F.LMSK)] ;YES, SUBSTITUTE THAT LANGUAGE TYPE
	MOVEM B,LNGTYP		;SAVE THE LANGUAGE TYPE WE FOUND
	CALLRET	RJFN		;THROW AWAY JFN WE DON'T WANT, AND RETURN

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.
;POINTER TO THE COPY IS STORED IN EXTP

COPEXT:	HRROI A,CWBUF		;POINT TO EXTENSION
	CALL BUFFS		;MAKE A COPY
	MOVEM A,EXTP		;REMEMBER POINTER TO COPY
	RET
;CHK10 -  CHECK FILE NAME TO BE OUTPUT FOR TOPS10 COMPAT.
;TAKES JFN IN B

CHK10:	MOVE A,CSBUFP		;BEGINNING OF STRING SPACE
	MOVE D,A		;POINTER TO FILESPEC'S END SO FAR
	LDF C,1B2+1B35		;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>]
	MOVE	B,LNGJFN	;JFN
	LDF	C,1B8+1B35	;FILE NAME
	JFNS
	CALL	GTASIZ		;GET SIZE
	CAILE	C,6		;MAX LEGAL
 	JRST [	HRROI A,FSPEC
		ERROR <File name exceeds 6 characters: %1M>]
	MOVE	B,LNGJFN	;JFN
	LDF	C,1B11+1B35	;GET EXTENSION
	JFNS
	CALL	GTASIZ
	CAILE	C,4		;MAX LEGAL (INCLUDES ".")
 	JRST [	HRROI A,FSPEC
		ERROR <File type exceeds 3 characters: %1M>]
	RET

GTASIZ:	MOVEI	C,0		;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.  GIVE IT POINTER TO SWITCH IN A.
;GIVE IT POINTER TO END OF SWITCH IN B.

DOSWI0:	STKVAR <SUFFIX>
	MOVE B,A		;PUT POINTER IN B
	TLC B,-1
	TLCN B,-1
	HRLI B,440700		;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
	MOVEI C,0		;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
	HLR D,C
	CAIN D,[ASCIZ "BINARY"]	;IS IT /BINARY?
	SETOM BINYSW		;YES, SET THE FLAG
	CAIN D,[ASCIZ "WARNINGS"]	;IS IT /WARNINGS?
	SETOM WARNSW		;YES, SET THE FLAG
	CAIN D,[ASCIZ "NOCREF"]	;IS IT /NOCREF?
	SETOM NOCRSW		;YES, SET THE FLAG
	CAIN D,[ASCIZ "NODEBUG"]	;IS IT /NODEBUG?
	SETOM NODBSW		;YES, SET THE FLAG
	CAIN D,[ASCIZ "NOFLAG-NON-STANDARD"]
	SETOM NOFGSW		;YES, SET THE FLAG
	CAIN D,[ASCIZ "NOLIST"]	;IS IT /NOLIST?
	SETOM NOLISW		;YES, SET THE FLAG
	CAIN D,[ASCIZ "NOMACHINE-CODE"]
	SETOM NOMASW		;YES, SET THE FLAG
	CAIN D,[ASCIZ "NOOPTIMIZE"]
	SETOM NOOPSW		;YES, SET THE FLAG
	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	0(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

;/NOSTAY CAUSES THE EXEC TO SLEEP DURING COMPILATION/LOADING. USED TO
;OVERRIDE A DEFAULT OF /STAY.

NOSTAY:	SETZM STAYF		;REMEMBER NOT 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
	CAIN B,LT.REL		;IS RELOCATABLE SW?
	 JRST [SETOM RELOSW	;YES, SET THE FLAG
	       TXNE P1,F%XPXT	;IS FILE TYPE SEEN?
	        JRST .+1	;YES,
	       LDF Q3,D%EXTN	;NO, LET THE .REL FILE BEEN USED
	       ANDCAM Q3,FLG(P2)	;MAKE SURE AN EXPLICIT EXTEN ISN'T USED
	       JRST .+1]
	TXNN P1,F%SPEC		;SPEC SEEN YET?
	 JRST SWLTP2		;NO, GO HANDLE GLOBAL SWITCH
	MOVE C,LPROC		;MOVE IN LANGUAGE TYPE WE ARE REPLACING
	CAIN C,LT.REL		;IS IT .REL?
	 RET			;YES, DON'T CHANGE, LEAVE
	SKIPN DEFSW		;DEFAULT SW SEEN?
	 JRST .+3		;NO,
	SETZM DEFSW		;YES,SET FLAG ON
	TRNN P1,F%LANG		;DOES THE GLOBAL LANGUAGE SW EXIST?
	MOVEM B,LPROC		;SET PROCESSOR TYPE
	CAIE B,LT.REL		;IS THIS /REL WE'RE SETTING?
	 RET			;NO, WE ARE DONE
	JUMPE C,SWLTP1		;IF WAS NULL TYPE, MOVE SOURCE TO OBJECT
	SKIPN HDDO(P2)		;IF WAS NON-NULL, IS OBJECT FILE SET UP?
	 JRST SWLTP1		;NO, MOVE SOURCE TO OBJECT
	RET			; EXPLICIT EXTENSION ISN'T USED

SWLTP1:	MOVE B,SVER(P2)		;MOVE SOURCE TIME/DATE
	MOVEM B,OVER(P2)	;TO OBJECT TIME/DATE
	MOVE B,HDD(P2)		;ALSO SET UP HDD
	MOVEM B,HDDO(P2)	;FOR OBJECT FILE
	RET			;LEAVE

SWLTP2:	DPB	B,[POINTR (P1,F.LMSK)] ;SET LANGUAGE TYPE
	TRON	P1,F%LANG	;SET GLOBAL LANG SWITCH SEEN - HAS IT ALREADY?
	RET			;NO - RETURN;
				;YES - FALL INTO AMBIGUOUS ERROR ROUTINE

;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
;PASS IT POINTER TO THE FILE TYPE IN A.

PARDEF:	STKVAR <QUOF,PAREND,SWIPTR,<ABSAV,2>>
	CALL GETDL		;GET DEFAULT SWITCHES FOR FILE TYPE
	SKIPE A			;IS DEFAULT SW EXISTING?
	SETOM DEFSW		;YES, SET THE FLAG ON
	MOVEM A,SWIPTR		;INITIALIZE POINTER TO SWITCH LIST
PARD0:	MOVE A,[440700,,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
	SKIPN QUOF		;IS OPEN QUOTE?
	JRST PARD2		;YES,
	MOVE Q3,B		;NO, SAVE PTR
	SOSG C			;DECREASE COUNT
	JRST .+6		;NO MORE SPACES FOR SWITCH
	ILDB D,B		;READ CHARACTER OF SWITCH
	CAIE D,0		;END OF QUOTE STRING?
	JRST PARD5		;NO, KEEP ON
	MOVEM Q3,B		;YES, RESTORE PREVIOUS PTR
	SKIPE QUOF		;START OR END OF A QUOTED STRING?
	 JRST	[DMOVEM A,ABSAV	;END, SAVE A AND B
		 MOVEM C,PAREND	;AND C TOO
		 MOVEI B,0	;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
		 MOVEI D,QUOTE	;AND D
		 DPB D,A	;RESTORE QUOTE AT END OF STRING
		 JRST PARD6]	;GO DECREMENT COUNT
PARD2:	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
	MOVEI C,0		;PUT NULL AFTER NAME
	IDPB C,A
	MOVNI A,1
	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	@0(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,0(P)		;REVERSE ARGS
	POP	P,@P4		;AND SAVE VALUE
	RET			;RETURN
;GTHDD - ROUTINE TO GET HDD FOR JFN IN A AND OUTJFN

GTHDD:	PUSH	P,A
	DVCHR
	TXNE	B,DV%TYP	;IS IT DISK?
	 JRST	[MOVE C,A	;YES, SKIP GETTING HDD
		 POP P,(P)	;ADJUST STACK
		 RET]		;AND RETURN
	CALLRE	GTHDD1		;GET HDD TO STORE FILE IN, AND RETURN

;GTHDDF - ROUTINE TO GET HDD FOR FILE

GTHDDF:	PUSH P,A		;SAVE JFN FOR LATER
	DVCHR%			;GET BACK DEVICE DESIGNATOR
	 ERCAL CJERRE		;HORRIBLE ERROR
	TXNE B,DV%TYP		;IS IT A DISK?
	ERROR <Non-disk directory devices are not supported>
GTHDD1:	EXCH A,(P)		;SWITCH JFN AND DEVICE DESIGNATOR
	MOVE B,A		;GET JFN IN B
	MOVX A,RC%EMO		;MATCH EXACTLY
	SETZ C,			;ZERO C
	RCDIR%			;GET BACK PPN FOR DEVICE
	 ERCAL CJERRE		;HORRIBLE ERROR
	MOVE B,C		;GET DIRECTORY NUMBER IN B
	POP P,C			;CONSTRUCT HDD IN AC C
	HRL C,B
	CAMN C,CHDD		;IS FILE IN CONNECTED DIRECTORY?
	TLZ C,777777		;IF SO, CLEAR LH OF HDD (NO PPN NECESSARY)
	RET			;RETURN
;DJFNSE - OBTAIN EXTENSION OF FILE SPECIFIED BY JFN IN A
;RETURNS ASCIZ IN CWBUF

DJFNSE:	LDF	C,1B11		;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 IN A
;FORMAT DESIRED IN C
;RETURNS ASCIZ IN CSBUF

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 B AND RETURN
;LANG TYPE IN B

LOOKE:	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 WRITE EXTENSION OF LNGJFN AT FSPEXT, ISOLATE THE FILENAME AND
;EXTENSION, AND STORE POINTER IN NAM OF FDB

STEXNA:	MOVE A,FSPEXT		;PLACE TO WRITE FILE EXTENSION
	LDB B,A			;BUT CHECK TO SEE IF THERE'S A FILENAME FIRST
	CAIN B,":"
	JRST [	MOVEI A,1		;NO THERE ISN'T
		CALL GETBUF		;GET A WORD
		SETZM (A)		;ZERO IT
		HRLI A,440700		;POINT TO IT
		JRST STEXN1]		;AND SAVE THE POINTER
	MOVEI B,"."		;(BUT PUT IN DOT FIRST)
	IDPB B,A
	MOVE B,LNGJFN
	LDF C,1B11
	JFNS
	MOVE	A,NAM(P2)	;ONLY COPY OVER THE PORTION WE WANT
	CALL	BUFFS
STEXN1:	MOVEM	A,NAM(P2)	;SAVE NEW FILENAME BYTE POINTER
	MOVE	B,LNGJFN	;CHECK JFN TO BE OUTPUT
	CALL	CHK10		;FOR TOPS-10 LEGALITY
	TXZN	P1,F%STOJ	;IS THERE AN EXTRA JFN TO RELEASE?
	RETSKP			;NO, LEAVE, GIVING GOOD RETURN
	MOVE	B,OUTJFN	;CHECK THIS JFN TOO
	CALL	CHK10		;FOR TOPS-10 LEGALITY
	CALL	RJFN		;RELEASE EXTRA JFN
	RETSKP			;LEAVE, GIVING GOOD 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
	 ERJMP .+2		;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
	MOVEI P1,0		;NO HIGH ORDER BITS
	MOVE P2,CSJOB		;BINARY JOB NUMBER
	MOVEI P3,0		;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,440600		;MAKE BYTE POINTER
	MOVEI P1,3		;WE WANT TO CONVERT 3 CHARACTERS
	MOVEI 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
	MOVEI C,0
	SOUT
	MOVX A,GJ%FOU+GJ%SHT	;OUTPUT USE, SHORT FORM
	MOVE B,CSBUFP		;POINT TO FILESPEC
	CALL GTJFS		;GET HANDLE
	 CALL CJERRE		;FAILED
	MOVE B,[70000,,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
	MOVEI C,0		;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 JFN IN A
;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:	CAIE	B,LT.L36	;FOR BLISS LIBRARY, OBJECT TYPE IS "L36"
	CAIN	B,LT.REL	;RELOC TYPE?
	MOVEM	A,OVER(P2)	;YES - STORE IN OBJECT
	MOVEM	A,SVER(P2)	;STORE IN SOURCE ALWAYS, IN CASE OF /BINARY
	RET			;RETURN
;SUBROUTINE TO OUTPUT THE STRING POINTED TO BY AC B, PLUS A CRLF

DSOUTR:	MOVE	A,COJFN		;OUTPUT JFN
	SETZ	C,
	SOUT			;PRINT STRING
	ETYPE	<%_>		;AND CRLF
	RET			;RETURN

;PUNCTUATION ROUTINES

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

SWOUT:	MOVEI	B,"/"		;SLASHIFY IT
	CALL	TBOUT		;...
	MOVE	B,D		;SW VALUE
	CALLRET	TBOUT		;DUMP IT

EOLOUT:	MOVEI B,15
	CALL TBOUT
	SKIPA	B,[12]		;END-OF-LINEF
SPOUT:	MOVEI	B," "		;SPACE
	CALLRET	TBOUT		;DUMP AND RETURN
SUBTTL RDSKP AND RDFLD

;RDFLD - READS NEXT FIELD USING TEXTI
;RETURNS: P5 := BREAK CHAR
;	  A := BREAK TYPE
;	  P3 := CHAR COUNT
;	  P4 := POINTER TO STRING

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,3+CSTXTB	;OUTPUT STRING HERE
RDFLD0:	MOVEI P3,STRSIZ		;ENOUGH LENGTH FOR ANY REASNABLE FIELD
	MOVEM	P3,4+CSTXTB	; IN STRING SPACE
	LDF	Q1,RD%RIE	;RETURN ON EMPTY STRING
	MOVE A,BMSKA		;GET SPECIAL BREAK MASK ADDRESS
	MOVEM A,7+CSTXTB
	MOVEM	Q1,1+CSTXTB	;...
	MOVEI	A,CSTXTB	;POINT AT ARGS
	TEXTI			;SNARF FIELD
	 CALL EOFJER		;CHECK FOR END OF FILE
	MOVE	Q1,1+CSTXTB	;GET FLAGS
	TXNN	Q1,RD%BTM	;BREAK ON TERM?
	ERROR	<Command string space exhausted>
	LDB	P5,3+CSTXTB	;GET BREAK CHAR
	CALL	GTYP		;GET CHAR TYPE
	MOVEI	Q1,0		;NULL OUT DELIM
	DPB	Q1,3+CSTXTB	;...
	SUB	P3,4+CSTXTB	;SIZE = ORIG - NEW COUNT
	RET			;AND RETURN

;FOLLOW THE ":" IN A SWITCH

RDFLDN:	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
	MOVEI P3,STRSIZ		;ENOUGH LENGTH FOR ANY REASNABLE FIELD
	MOVEM	P3,4+CSTXTB	; IN STRING SPACE
	TXNN	P1,F%SLSH	;SLASH SEEN?
	JRST 	RDFLDX		;NO
	MOVE 	A,QQQFLG	;YES, IT IS A SWITCH
	TXNE	A,S%QUO+S%VAL	;IS IT A LANGUAGE-SW?
	JRST	RDFLDX		;YES
	MOVEI	A,BMSKSW	;NO, USE NEW SET OF BREAK MASK
	CAIA
RDFLDX:	MOVE A,BMSKA		;GET SPECIAL BREAK MASK ADDRESS
	MOVEM A,7+CSTXTB
	LDF	Q1,RD%RIE	;RETURN ON EMPTY STRING
	MOVEM	Q1,1+CSTXTB	;...
	MOVEI	A,CSTXTB	;POINT AT ARGS
	TEXTI			;SNARF FIELD
	 CALL EOFJER		;CHECK FOR END OF FILE
	MOVE	Q1,1+CSTXTB	;GET FLAGS
	TXNN	Q1,RD%BTM	;BREAK ON TERM?
	ERROR	<Command string space exhausted>
	LDB	P5,3+CSTXTB	;GET BREAK CHAR
	CALL	GTYP		;GET CHAR TYPE
	MOVEI	Q1,0		;NULL OUT DELIM
	DPB	Q1,3+CSTXTB	;...
	SUB	P3,4+CSTXTB	;SIZE = ORIG - NEW COUNT
	RET			;AND RETURN
;ROUTINE TO READ A QUOTED STRING.  RETURNS POINTER TO IT IN A.

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	[MOVE A,.RDIOJ+CSTXTB	;SAVE PTR
		 ILDB P5,.RDIOJ+CSTXTB	;LOAD & INCRE PTR
		 CAIN P5,QUOTE	;IS QUOTE?
		 JRST RDPRC1+5	;YES,
		 MOVEM A,.RDIOJ+CSTXTB	;NO, RESTORE PREVIOUS PTR
                 JRST RDPRC2]		;YES - SET UP BLOCK
	IDPB	P5,P4		;STUFF CHAR
	JRST RDPRC1

RDPRC2:	MOVEI	P5,0		;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: P5: = CHARACTER
;	  A := CHAR TYPE

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 IN A

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.  THE ROUTINE RETURNS WITH 0
;OR A POINTER IN A.
;PASS THE ROUTINE IN A A POINTER TO THE DESIRED EXTENSION

GETDL:	MOVE C,A		;POINTER IN C
	BIN			;READ FIRST CHARACTER
	CAIN B,0		;NULL EXTENSION?
	SKIPA B,[440700,,[ASCIZ /./]]	;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,440700		;MAKE BYTE POINTER
	RET			;GIVE IT TO CALLER

GETDL0:	MOVEI A,0		;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,<-1,,[ASCIZ /*/]>,<"*" for all>,,[
		 FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /./]>,,,[
		 FLDDB. .CMKEY,,DEXTBL,<File type,>,,[
		 FLDDB. .CMFLD,CM%SDH]]]] ;.CMFLD MERELY FOR NONX ENTRIES
	CALL FLDSKP		;GET SOME INPUT
	 CMERRX
	LDB C,[331100,,(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,[350700,,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,[350700,,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>
	 CAIA			;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
	MOVEI 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>
	LDB C,[331100,,(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
	MOVEI D,0		;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
	AOJ B,
	MOVE A,B
	CALL GTBUFX		;GET THE MEMORY
	HRROS 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
	MOVEI C,377777		;COPY A NULL TOO
	HRROI B,LST		;GET POINTER TO DEFAULT LIST GIVEN IN COMMAND
	MOVEI D,0		;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	CJFNBK+2	;CLEAR DEFAULTS
	MOVE	Q1,[CJFNBK+2,,CJFNBK+3]
	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 FIELDX		;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,,<File name>,,[	    ;FILESPEC
		FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[    ;INDIRECT FILE
		FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]] ;PERCENT SIGN
	CALL COMIN		;INPUT THE FIELD
	CAIA			;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,,,<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,,<440700,,[ASCIZ /@/]>,,,[     ;INDIRECT FILE
		FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[     ;PLUS SIGN
		FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]] ;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,,<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,,<File name>,,[	      ;FILESPEC
		FLDDB. .CMCMA,,,,,[			      ;COMMA
		FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[      ;INDIRECT FILE
		FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[      ;PLUS SIGN
		FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]]] ;PERCENT SIGN
	CALL COMIN		;INPUT THE FIELD
	 CAIA			;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.  TAKES NON-SKIP
;RETURN IF FIELD DOESN'T MATCH SOMETHING IN THE REQUESTED CHAIN (FED
;BY AC2 ON THE CALL).  SKIP RETURNS WITH ADDRESS OF SUPPORT ROUTINE
;IN D IF SUCCESSFUL PARSE.

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
	TXNN A,CM%NOP	
	  IFSKP.
	    CAIE B,NPXAMB
	      IFSKP.
		CMERRX
	      ENDIF.
	    CAIE B,NPXNOM
	      IFSKP.
		CMERRX
	      ENDIF.
	    CAIE B,NPXNUL
	      IFSKP.
		CMERRX
	      ENDIF.
	    CAIE B,NPXNC
	      IFSKP.
		CMERRX
	      ENDIF.
	    JRST COM1
	  ENDIF.		
	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
	TXNN A,CM%NOP		;FAIL?
	 JRST COM2		;NO,
	CAIE B,600060		;YES, BECAUSE OF GENERATION # OR ATTRI?
	 RET			;NO,
	MOVE D,[440700,,ATMBUF]	;YES, GET FILE NAME
	ERROR <No generation field or attributes allowed, or invalid character in file name - %4M>
COM2:	MOVE A,CSBUFP		;GET POINTER TO TEMPORARY STORAGE
	MOVSI C,(1B8)		;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
	MOVEI D,TFILE		;SAY THAT FILESPEC TYPED
	RETSKP

;ROUTINE TO CALL AFTER COMND TO FIGURE OUT WHAT GOT TYPED.  RETURNS ADDRESS
;IN D OF ROUTINE TO JUMP TO TO HANDLE THAT FIELD.

IDEN:	MOVE A,B		;IF FILE TYPED, JFN NOW IN A!
	LDB D,[331100,,.CMFNP(C)] ;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
;GIVE IT TABLE ADDRESS IN A.  IT SKIPS WITH ARG PARSED, IFF A SPECIAL
;ARG IS REQUIRED
;RETURNS VALID SETTING OF S%QUO IN A.

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
	MOVEM A,QQQFLG
	TXNE A,S%QUO+S%VAL	;QUOTED STRING OR VALUE TO FOLLOW?
	 IFSKP.			; NO, BUT CHECK IF ONE WAS TYPED ANYWAY
	  MOVE D,SBLOCK+.CMFLG	;SET UP COMND% FLAGS
	  TXNE D,CM%SWT		;WAS ILLEGAL COLON TYPED IN SWITCH?
	   ERROR <Invalid use of colon in switch> ; YES, COMPLAIN ABOUT IT.
	  RET			;NO PROBLEM FOUND
	 ENDIF.
	CALL @(B)		;GO GET VALUE TYPED IN TO SWITCH
	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,,<File name>,,[	  ;FILESPEC
		FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[  ;INDIRECT FILE
		FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]] ;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
;FORMAT FOR FSYM
;CALL:	MOVE A,<POINTER-TO-STRING>
;	CALL SWMOV
;	RETURN HERE (STRING IN FSPEC), POINTER TO LAST CHAR IN A

SWMOV:	MOVE B,A		;SOURCE POINTER IN B
	HRROI A,FSPEC		;COPY TO FSPEC
	MOVEI C,0		;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

;Note that LT.REL, which must be the first entry, for GTLNG1, must be 1,
;because language type 0 is reserved for the null extension

LTAB:	0		;NULL EXTENSION (ILLEGAL AS ACTUAL LANGUAGE TYPE)
	LANGUAGE	;EXPAND MACRO

LTABL==.-LTAB			;LENGTH OF TABLE

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

;TABLE OF SIXBIT TMP FILE NAMES

SIXTAB:	0		;TYPE 0 UNUSED
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
>
LANGUAGE

;TABLE OF SIXBIT TMP FILE NAMES FOR NATIVE-COMPILERS

NSXTAB:	0
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
>
LANGUAGE

;LANGUAGE TMP FILE NAME TABLE

DEFINE L(LANG,EXT,PROC,TNAME) <
	[GETSAVE (<SYS:'PROC'.>)],,[ASCIZ \TNAME'.TMP\]
>
PRTAB:				;PROCESS NAME TABLE(LH)
	0			;TEMP NAME (RH)
	LANGUAGE		;EXPAND

;DEBUG AID TABLE

DEFINE L(LANG,EXT,PROC,TNAME) <
	0,,[ASCIZ \:'LANG\]
>
DBTAB:	0			;LOSAGE ENTRY
	LANGUAGE		;EXPAND
DEFINE NAMES <
	NM (10-BLISS,S%LTYP,LT.B10)
	NM (36-BLISS,S%LTYP,LT.B36)
	NM (68-COBOL,S%LTYP,LT.C68)
	NM (74-COBOL,S%LTYP,LT.C74)
	NM (ABORT,S%FRH,F%ABT)
	NM (ALGOL,S%LTYP,LT.ALG)
	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 (MAC,S%LTYP,LT.MAC)
	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 (NOSTAY,S%DSP,NOSTAY,[RET])
	NM (NOSYMBOLS,S%FRH,F%LSYM)
	NM (NOWARNINGS,S%FRH,F%NWAR)
	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)
	NM (SNOBOL,S%LTYP,LT.SNO)
	NM (STAY,S%DSP,DOSTAY,[RET])
	NM (SYMBOLS,S%TOFF!S%FRH,F%LSYM)
	NM (WARNINGS,S%TOFF!S%FRH,F%NWAR)
>

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.



;NEW SET OF BREAK MASK FOR /SWITCH:TEXT

BRINI.				;START WITH ALL 0'S

BRKCH. (40,77)			;BREAK ON ALMOST EVERY THINGS
BRKCH. (100,137)
BRKCH. (140,176)

BMSKSW:	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
	MOVEI 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
	MOVEI 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]
>
	END