IFNDEF FTIPC, <FTIPC==-1>	;LOCAL MODS
IFNDEF FTFIX, <FTFIX==-1>	;PATCHES, FIXES, ETC.
	TITLE	COMPIL	22B(236)	CCL CONTROL CUSP
SUBTTL	WEIHER/CLEMENTS/RCC/PMH/NGP/DMN/HPW	29-AUG-74
	SUBTTL	PROGRAM TO COMPILE LOAD EXECUTE AND DEBUG USER PROGRAMS

FQZSIM==-1			;QZ-MODIFICATIONS FOR SIMULA *******
VCOMPIL==22
VUPDATE==2			;DEC UPDATE LEVEL
VEDIT==236			;EDIT LEVEL
VCUSTOM==0			;NON-DEC UPDATE LEVEL

;THE ORIGINAL VERSION OF
;THIS PROGRAM WAS WRITTEN AT THE STANFORD UNIVERSITY
;ARTIFICIAL INTELLIGENCE LABORATORY BY WILLIAM F. WEIHER.
;MR. WEIHER'S COOPERATION, AND THAT OF THE A-I LABORATORY,
;ARE GRATEFULLY ACKNOWLEDGED.
;
;CONVERTED TO MACRO SOURCE LANGUAGE FROM FAIL ON
;1 NOVEMBER 68 BY R CLEMENTS

INTERN VCOMPILE,.JBVER	;FOR LOADER MAP AND LIBRARY

IFN FTIPC, <	;LOCAL VERSION AND HISTORY INFORMATION
VCUSTOM==6	;LOCALLY GENERATED MODS

VIPCED==01	;FIRST MOD TO V22B - 4-DEC-74   /MSL
	;USE EDITS INSTEAD OF LINED (MODIFIED VIPCED 05)
	;CAUSE MAKE TO FUNCTION LIKE CREATE (REMOVED VIPCED 04)
	;DEFAULT TO LOADER INSTEAD OF LINK (REMOVED VIPCED 02)
	;DEFAULT TO F40 INSTEAD OF F10 (REMOVED VIPCED 02)
	;ALWAYS DEFAULT LIST TO DSK:, EVEN FOR CREFS
   ;[241] - SPR 10-14082 (CORRECTED VIPCED 04)
	;FIX CONFUSION DEPENDING ON EXISTENCE OF .REL FILES
   ;[243] - SPR 10-14732
	;ALLOW COMP @DEV:...
VIPCED==02	;SECOND MOD TO 22B - 1-APR-75	/EEP
	;GO BACK TO USING LINK AND F10
VIPCED==03	;ADDED SOME PUBLISHED PATCHES	13-MAY-75	/MSL
   ;[240] - SPR 10-14125
	;MAKE .REL,/.SRC TIME COMPARISONS ACCURATE TO 1/3 SEC
   ;[244] - SPR 10-14663 (MORE FIXES VIPCED 05)
	;DON'T IGNORE USERS OUTPUT DEVICE SPEC
   ;[253] - SPR 10-15228
	;FIX UP FILE-FINDING WITH LOGICAL TMP:
   ;[254] - SPR 10-15270 (MODIFIED) (MORE FIXES VIPCED 05)
	;MAKE DEVICES STICKY (WITH LOCAL CORRECTION TO DO IT RIGHT)
VIPCED==04	;23-JUL-74	/MSL
	;FIX TO EDIT 241 (CORE-GRABBER BUG) (SEE [262] VIPCED 05)
	;RESTORE "MAKE" TO ORIGINAL MEANING (WITH MESSAGE)
		;(MESSAGE REMOVED VIPCED 05)
VIPCED==05	;4-AUG-76	/MSL
	;ELIMINATE "MAKE" MESSAGE FROM VIPCED 04
	;CHECK %CNVER FOR EDIT TO EDITS/SOS
	;FIX TO STICKY DEVS LOSING STICKY PPNS TO PIP
   ;[260] - SPR 10-16201
	;FIX FOR [254] - DON'T LOSE DEV IF NULL FILENAME
   ;[262] - SPR 10-16412
	;FIX FOR [241] - PREVENT CORE GROWTH
   ;[266] - SPR 10-16808
	;BETTER LOOKUP ERROR MESSAGES
   ;[267] - SPR 10-16937
	;FIX FOR [244,ETC.] - UNSTICK DEVICE AT =
   ;[271] - SPR 10-17329
	;PASS TRAILING *'S TO PIP
   ;[302] - SPR 10-20202 (ORIG. PUBL. AS [272] SPR 10-17024)
	;FIX TO [254,ETC] - SWITCH ARGS SHOULD NOT STICK
VIPCED==06	;10-SEP-76 /PWP
	;INSTALLED .COR FILE WITH SIMULA PATCHES SO SIMULA IS
	;ACCEPTED AS A REGULAR COMPILER
VIPCED==07	;19-MAY-77 /PWP
	;INSTALLED .COR FILE WITH PASCAL PATCHES SO PASCAL IS
	;ACCEPTED AS A REGULAR COMPILER

VEDIT==BYTE (18)0 (6)VIPCED (12)VEDIT
>
LOC	<.JBVER==137>
	<VCUSTOM>B2+<VCOMPIL>B11+<VUPDATE>B17+VEDIT
RELOC	0

IFNDEF TEMP,<TEMP==1>		;TEMP=1 ALLOWS THE TMPCOR UUO TO BE USED

IFNDEF RUNSW,<RUNSW==1>		;NON-ZERO TO USE THE RUN UUO
IFNDEF PURESW,<PURESW==1>	;NON-ZERO FOR A SHARED VERSION OF COMPIL

IFNDEF STANSW,<STANSW=0>	;NON-ZERO TO INCLUDE STANFORD FEATURES
IFN STANSW,<FAIL==1>
IFNDEF LSTRSW,<LSTRSW=0>	;NON-ZERO TO USE "LISTER" INSTEAD OF PIP
				;FOR TYPE AND LIST COMMANDS
IFNDEF SAVEXT,<SAVEXT=='SAV'>	;USE DMP FOR PDP6'S
IFNDEF FASTFS,<FASTFS=0>	;FASTEST FILE STRUCTURE
				;IF ZERO COMPIL WILL FIND IT AT RUN TIME
IFNDEF DIRSW,<DIRSW==1>		;USE DIRECT CUSP IF NON-ZERO
IFNDEF TENEX,<TENEX==0>		;CHANGES FOR TENEX OPERATION
IFN TENEX,<
FAIL==1
SFDSW==0
DEBSW==1
>

IFNDEF SNOBOL,<SNOBOL==1>	;ACCEPT SNOBOL AS A COMPILER
IFNDEF MACY11,<MACY11==1>	;[203] ACCEPT MACY11 (PDP-11) ASSEMBLER
IFNDEF BLISS,<BLISS==1>		;ACCEPT BLISS COMPILER
IFNDEF FAIL,<FAIL==1>		;[202] FAIL ASSEMBLER
IFNDEF SAIL,<SAIL==1>		;SAIL COMPILER
IFNDEF PAL10,<PAL10==0>		;PAL10 ASSEMBLER (NO CCL INTERFACE YET)
IFN FQZSIM,<
IFNDEF SIMULA,<SIMULA==1>>	;ACCEPT SIMULA COMPILER
IFNDEF PASCAL,<PASCAL==1>
IFNDEF DEBSW,<DEBSW==0>		;DEBUGGING AIDS IF NON-ZERO
IFNDEF SFDSW,<SFDSW==1>		;ENABLED FOR SUB-FILE DIRECTORY
IFN SFDSW,<IFNDEF SFDLEN,<SFDLEN==5>>	;LENGTH ALLOWED
IFDEF SFDLEN,<IFLE SFDLEN,<SFDSW==0>>	;NO SFD'S IF LENGTH.LE.0
IFNDEF MANTIS,<MANTIS==0>	;SPECIAL F4 DEBUGGER
IFNDEF FORTRAN,<FORTRAN==1>	;NON-ZERO IF BOTH F40 AND FORTRAN-10 ALLOWED
IFNDEF DFORTRAN,<DFORTRAN==1>	;DEFAULT VALUE 0=F40, 1=FORTRAN-10
IFNDEF LINK10,<LINK10==1>	;0 FOR LOADER, 1 FOR LINK-10
IFN FTIPC, <EDITOR=='EDITS '>	;DDC EDITOR [VIPCED 01, 05]
IFNDEF EDITOR,<EDITOR=='LINED '>;EITHER LINED OR EDITS
SUBTTL	REVISION HISTORY

;START OF VERSION 22A
;144	PASS FORTRAN-10 SWITCHES IN () CORRECTLY
;145	(10405) CLEAR .JBSA & JOB NAME SO START, RUN, GET FAIL
;146	MAKE ERROR MESSAGES CONFORM TO STANDARD CMLxxx
;147	(9096) MAKE TECO COMMAND ACCEPT SWITCHES IN ()
;150	TEST FOR LINK/LOADER CONFLICT AND WARN USER
;151	(9949) FIX TO RECOMPILE LIBRARY FILE WITH NULL EXT
;152	FIX TO RECOMPILE FILE IF TEMP /COM BUT PERMANENT /REL
;153	MAKE LINK-10 & FORTRAN-10 THE DEFAULT
;154	(11535) FIX COPY WITH TAPEID AND SWITCH BEFORE =
;155	(10817) FIX TYPO IN SFDPPN ROUTINE
;156	ADD DATE75 HACK
;157	READ SVC FILE IF ONLY SWITCHES HAVE BEEN SEEN (NO FILE NAME)
;160	FIX ILL MEM REF FROM ZERO COMMAND WITH NO ARGS
;161	(11209) ?COMMAND ERROR: .Y WITH DEL X.,*.Y; DON'T SCAN OFF COMMA AT GETN1+5
;162	FIX PC OUT OF BOUNDS
;163	REVERSE ORDER OF LOOKUPS SO FORTRAN IS FIRST
;164	LOAD CORRECT REL FILE IN LOAD FOO.BIN=FOO[PPN] WHERE BOTH FILES ON [PPN]
;165	GET STACK CORRECT ON DEBUG /LINK A+<B,C>
;166	(11466) CORRECT TECO COMMAND STRING IF [PPN] PRESENT
;167	(11643) ACCEPT "_" FOR "=" IN RENAME AND COPY
;170	TYPE RUN UUO ERROR CODES IN OCTAL
;171	MAKE CODE MORE READABLE
;172	FIX TYPO AT NOCOM3 + 3
;173	(11377) PASS ()'D SWITCHES TO COMPILERS IN ()'S (EXCEPT F10)
;174	(10945) LOADER NEEDS /N OR /L ON EACH FILE
;175	(11831) DO NOT TEST FOR .REL ON /COMP
;176	(11620) FIX ADDRESS CHECK ON EX DSKC:A,B (A.F4)
;177	FIX EDIT 173
;200	EXTEND EDIT 153
;201	EDIT 161 KILLED <progname> . / <switch>
;	REDO EDIT 161 AND ALLOW [P,PN] IN <progname>.[P,PN]
;	AS A SIDE EFFECT
;202	TURN FAIL ON
;203	CHANGE MACX11 TO MACY11 AND TURN MACY11 ON

;START OF VERSION 22B
;204	(12705) IMPLEMENT NEW ERROR MESSAGE IF NO PREVIOUS COMMAND
;205	(12994) GIVE ERROR MESSAGE IF NO COMMAND TO RESCAN
;206	(12705) EXTEND EDIT #145 TO ALL POSSIBLE "EXIT"S
;207	(13072) ALLOW COMPILATION OF FILE WITH NULL EXTENSION
;210	(12259) FIX SO THAT TECO COMMAND CAN BE TERMINATED WITH ALTMODE
;211	(13801) FIX BUG IN #205 WHICH MAKES DEBUGGING HARD
;212	(13036) PUT OUTPUT EXTENSION IN A TABLE
;213	GIVE EDR ERROR ON MTA OPERATION WITH NO DEVICE SPECIFIED
;214	(12998) OUTPUT /C RATHER THAN /T ON TYPE COMMAND
;215	(12993) DELETE CODE TO RUN RANDOM CUSPS, ITS NEVER USED
;216	(13000) ALLOW MAKE AND TECO WITH NO PREVIOUS COMMAND RUN TECO
;217	TURN SAIL ON AND ADD SDDT FOR FAIL AND SAIL
;220	fix /debug switch for link-10 to contain the process name
;221	ADD SUPPORT FOR FORDDT, /DEBUG, /FORDDT
;222	(11911) ADD ERROR MESSAGE IF USER TRIES TO USE F40 AND F10 IN SAME COMMAND
;223	(12374) REMOVE UNNECESSARY CORE UUO
;224	(12162) FIX BUG IN MAKE [1,3] WHICH CAUSES COMPIL TO GROW WITHOUT LIMIT
;225	(12992) TRY NULL EXTENSION AFTER CMD EXTENSION
;226	(11977) GIVE BETTER MESSAGE IF @DEV DOES NOT EXIST
;227	(12051) FIX VARIOUS COPY BUGS
;230	(13351) FIX ILL MEM REF IF /MAP SPECIFIED AND NOT LOADING
;231	(13881) GIVE ERROR IF PROTECTION CODE GREATER THAN 3 CHARACTERS
;232	(12269) BACKUP CHAR COUNT AS WELL AS BYTE PTR IN SCANS
;233	(12273) USE "=" RATHER THAN "-" WHERE EVER POSSIBLE FOR .TMP FILES
;234	(11937) IMPLEMENT /SAVE SWITCH TO PASS COMMAND TO LINK-10
;235	MAKE /FOR AND /MAC UNIQUE
;236	(13963) FIX EDIT #174 TO PUT OUT /L OR /N ONLY IF NEEDED

SUBTTL	ASSIGNMENTS

;ACS
P=17		;PUSHDOWN POINTER
C=16		;CHARACTERS RETURNED HERE
CS=15		;CHARACTER STATUS BITS HERE
SVPT=14		;POINTER TO CURRENT FILE IN LIST OF FILES (AOBJN)
SWPT=13		;BYTE POINTER INTO SWITCH STORAGE AREA
SWCNT=12	;NUMBER OF BYTES LEFT FOR SWITCH STORAGE
FL3=11		;FLAG REGISTER (LEFT HALF IS GLOBAL SWITCHES)
FL2=10		;FLAG REGISTER (LEFT HALF INDICATES PROCESSOR)
		;RIGHT HALF IS DEFAULT LOCAL PROCESSOR (SET BY /F ETC)
IOP=7		;PDL FOR INPUT NESTING
IOPNT=6	;POINTER TO CURRENT INPUT FILE

T5=5		;USED IN OUTPUT ROUTINES ONLY (DMN)
T4=4		;TEMPORARY ACCUMS
T3=3
T2=2
T1=1
FL=0		;FLAG REGISTER (LEFT HALF LOCAL SWITCHES)
		;(RIGHT HALF MISC BITS)

IFN PURESW,<IFE RUNSW,<
PRINTX ;ASSEMBLY SWITCHES CONFLICT>>

	SALL	;SUPPRESS ALL MACROS AND REPEATS

	MLON

IFN TENEX,<
SEARCH STENEX		;GET THE TENEX OPERATION CODES
OPDEF	RESET	[CALLI	0]		;THE ONLY CONFLICTING JSYS/CALLI
>
IFE DEBSW,<OPDEF GOTO [JRST]>
IFN DEBSW,<OPDEF GOTO [PUSHJ P,]	;LEAVE TRACES IN STACK>

IFE SFDSW,<PDL==100	;LENGTH OF PDL>
IFN SFDSW,<PDL==200	;NESTING TAKES UP MORE SPACE>
IFE PASCAL <
SWBK==5>		;NUMBER OF WORDS FOR SWITCHES TO PROCESSOR
IFN PASCAL <SWBK==5+17>
LODSCT==^D40+^D40*LINK10	;NUMBER OF LOADER SWITCHES PER FILE ALLOWED
DEBSIZ==5		;[221] NO. OF WORDS OF FORDDT SWITCHES
.TYSPL==(1B13)		;DEVTYP BIT FOR SPOOLING

IFN FTFIX, <	;[VIPCED 03] ADDITIONAL VALUES NEEDED FOR EDIT 240
.RBSIZ==5	;LAST WORD IN 4-WORD LOOKUP
.RBTIM==35	;INTERNAL CREATION DATE OF DSK FILE
DV.DSK==(1B1)	;DEVICE IS A DSK
>
;FLAGS (RH OF FL)

PROCS==1	;PROCESSOR SWITCHES SEEN
DOLOD==2	;WE WANT TO DO LOADING
PCM1==4		;FIRST COMMA SEEN IN PROCESSOR SWITCHES
PCM2==10	;SECOND COMMA SEEN
IDF==20		;SCAN SAW AN IDENTIFIER
LODOUT==40	;SOME OUTPUT HAS BEEN DONE TO LOADER
SOSF==100	;SOS FOR AN EDITOR?
PERF==200	;PERMANENT TYPE FLAGS
LINKFL==400	;LINK-10 REQUIRED (RATHER THAN LOADER)
CMDSN==1000	;THE COMMAND SHOULD BE WRITTEN AS SVC OR EDS
INCRF==2000	;WE ARE FINISHING CREF OUTPUT
INPRNT==4000	;WE ARE PRINTING A CHARACTER STRING IN ERROR MSG
PIPF==10000	;DOING SOMETHING FOR PIP
EDITF==20000	;IN EDIT OR CREATE
CREATF==40000	;CREATE
FFLG==PCM1	;/F FLAG IN DIRECTORY COMMAND
LPTFG==PCM2	;/L FLAG IN DIRECTORY COMMAND
NODAT==PCM1	;FILE FROM OTHER THAN DSK
NOLOOK==PCM2	;LOOKUP FAILED
TECOF==100000	;WE WANT TECO
RECALF==200000	;WE ARE READING A COMMAND SAVE FILE
IFN FTFIX, <	;[VIPCED 05] NEW FLAG FOR ED 302
F.STKY==400000	;DEVICES AND PPNS SHOULD NOT STICK
>

;TABLE OF NEW DEVICES
DEFINE DEVICE<
X NEW,NEW
X OLD,OLD
X SYS,SYS
X SELF,DSK
>
;FLAGS (SWITCH TYPE)
LISTSW==1		;DO LISTING
CRSW==2			;DO A CREF
LIBSW==4		;DO A LIBRARY SEARCH OF THIS FILE
DEBUGSW==10		;[221] COMPIL SPECIAL CODE FOR FORDDT
COMPLS==20		;COMPILE REGARDLESS OF DATES
NOBINSW==40		;DON'T DO A REL FILE
MANTSW==100		;COMPIL SPECIAL MANTIS CODE IF F4
NOMANTSW==200			;DON'T
F40SW==400		;COMPILE FORTRAN WITH F40
F10SW==1000		;COMPILE FORTRAN WITH FORTRAN-10
KA10SW==2000		;COMPIL CODE FOR KA-10
KI10SW==4000		;COMPIL CODE FOR KI-10
CPUSW==KA10SW!KI10SW	;SPECIFIC CPU REQUIRED
OPTSW==10000		;OPTIMIZED CODE
NOPTSW==20000		;NON-OPTIMIZED CODE
;NEWSW==(1B0)		;USE DEVICE NEW:
;OLDSW==(1B1)		;USE DEVICE OLD:
;SYSSW==(1B2)		;USE DEVICE SYS:
;SELFSW==(1B3)		;USE DEVICE DSK:
DEVSW==(1B0)		;INITIAL VALUE
DEVSWS==0		;SUM OF DEVSW
DEFINE X(A,B)<
A'SW==DEVSW
DEVSWS==DEVSWS!DEVSW
DEVSW==DEVSW_-1>
DEVICE

REPEAT 0,< THE MACRO PROCESS DEFINES DETAILS ABOUT THE VARIOUS
	PROCESSORS WHICH COMPILE IS EXPECTED TO HANDLE BY CALLING
	THE MACRO X WHICH IS REDEFINED TO PRODUCE THE INFORMATION REQUIRED.
	THE ARGUMENTS ARE :-
	A	SWITCH NAME
	B	EXTENSION
	C	PROCESSOR NAME
	D	<OPTIONAL>EXTENSION OF NEXT PROCESSOR IF MUST BE PROCESSED MORE THAN ONCE
	E	EXTENSION PRODUCED
	F	DEBUGGING AID USED ON DEBUG COMMAND (DDT IF NULL)
	G	SEPARATOR, EITHER "=" OR "_"
>

DEFINE PROCESS<
IFN DFORTRAN,<
IFN MANTIS,<X FORTRAN,FOR,FORTRAN,,,MANTIS,=>
IFE MANTIS,<X FORTRAN,FOR,FORTRAN,,,,=>>
IFE DFORTRAN,<
IFN MANTIS,<X FORTRAN,FOR,F40,,,MANTIS,=>
IFE MANTIS,<X FORTRAN,FOR,F40,,,,=>>
X MACRO,MAC,MACRO,,,,=
X COBOL,CBL,COBOL,,,COBDDT,=
X ALGOL,ALG,ALGOL,,,,=
IFN PASCAL,<X PASCAL,PAS,PASCAL,,,,=>
IFN SNOBOL,<X SNOBOL,SNO,SNOBOL,,,,_>
IFN MACY11,<X MACY11,P11,MACY11,,OBJ,,_>
IFN BLISS,<X BLISS,BLI,BLIS10,,,,=>
IFN FAIL,<X FAIL,FAI,FAIL,,,SDDT,_>
IFN SAIL,<X SAIL,SAI,SAIL,,,SDDT,_>
IFN PAL10,<X PAL10,PAL,PAL10,,,,=>
IFN FQZSIM,<
IFN SIMULA,<X SIMULA,SIM,SIMULA,,,,=>>
>

DEFINE XPROCESS<
X LOADER,LOD,LOADER
X LINK,LNK,LINK
X CREF,CRF,CREF
X PIP,PIP,PIP
X EDT,EDT
IFN LSTRSW,<X LIST,LST,LISTER>
>

;PROCESSOR FLAGS IN FL2
RELSW==1	;DO A LOAD ONLY ON THIS FILE (PROCESSOR IS LOADER)
ALPROC==RELSW	;OR OF BITS FOR ALL THE PROCESSORS
NPROCS==0	;NUMBER OF PROCESSORS
PROCBIT==400000	;USE TO ASSIGN PROCESSOR FLAGS
MXPROC==^D17		;MAXIMUM PROCESSORS ALLOWED (REAL COMPILERS)
XTPROC==0		;EXTRA "PROCESSORS (PIP,LOADER, ETC)
SPRC==0		;BITS FOR THOSE PROCESSORS WHICH OUTPUT TO ANOTHER

DEFINE X (A,B,C,D,E,F,G)<
CHN'B==NPROCS	;INDEX TO OUTPUT ROUTINE
B'SW==PROCBIT	;PROCESSOR BIT
IFDIF <D><>,<SPRC==SPRC!PROCBIT>
ALPROC==ALPROC!PROCBIT
NPROCS==NPROCS+1
PROCBIT==PROCBIT_-1>

PROCESS
IFG NPROCS-MXPROC,<PRINTX TOO MANY PROCESSORS DEFINED>


DEFINE X (A,B,C,D,E,F,G)<
CHN'B==MXPROC+XTPROC
XTPROC==XTPROC+1>
XPROCESS

IFE BLISS,<BLISW==0>	;MAKES TESTS EASIER AND NEATER
IFN FQZSIM,<
IFE SIMULA,<SIMSW==0>>
LOOK==0		;CHANNEL FOR DOING LOOKUPS FOR INFORMATION
NFILE==^D40	;NUMBER OF FILES PERMITTED IN A + CONSTRUCTION
IFNDEF NESTDP,<NESTDP==17>	;MAXIMUM NESTING DEPTH TO PERMIT
IFLE NESTDP,<NESTDP==17>
IFG NESTDP-17,<NESTDP==17>

SUBTTL	MACROS

EXTERN	.JBFF,.JBREL,.JBERR,.JBSA

%LOREL:!			;RELOCATABLE BEGINNING OF LOW SEGMENT

IFN PURESW,<	TWOSEGMENTS
.ZZ:
	RELOC	400000>

OPDEF	STRING	[TTCALL	3,]
OPDEF	PJRST	[JRST]		;POPJ RETURN

DEFINE SKIP (J)<JRST .+1+'J>

;MACROS FOR THE DATA STORAGE IN PURE AND IMPURE VERSIONS

DEFINE WORDS(A)<
IRP A,<
U(A,1)>>

IFE PURESW,<
DEFINE U(A,B)<
A:	BLOCK B>>

IFN PURESW,<
DEFINE U(A,B)<
	RELOC
A:	BLOCK B
	RELOC>>
SUBTTL	COMMAND AND SWITCH TABLES

DEFINE CTABLE<
COMAND	COMPILE,<TRZ	FL,DOLOD>
COMAND	LOAD,JFCL
COMAND	DEBUG,<PUSHJ	P,DEBUG>
COMAND	EXECUTE,<PUSHJ	P,XCTR>
COMAND	EDIT,<TRO	FL,EDITF>
COMAND	CREATE,<TRO	FL,EDITF!CREATF>
COMAND	LIST,<JRST	LISTR>
COMAND	CREF,<JRST	CREFIT>
COMAND	DELETE,<JRST	DODEL>
COMAND	TECO,<TRO	FL,EDITF!TECOF>
COMAND	MAKE,<TRO	FL,EDITF!TECOF!CREATF>
COMAND	RENAME,<JRST	DOREN>
COMAND	TYPE,<JRST	TYPR>
COMAND	COPY,<JRST	DOCOPY>
COMAND	PRESERVE,<JRST	DOPRES>
COMAND	PROTECT,<JRST	DOPROT>
COMAND	REWIND,<JRST	DOREW>
COMAND	UNLOAD,<JRST	DOUNLD>
COMAND	ZERO,<JRST	DOZERO>
COMAND	ZER,<JRST	DOZERO>
COMAND	SKIP,<JRST	DOSKIP>
COMAND	BACKSPACE,<JRST	DOBKSP>
COMAND	EOF,<JRST	DOEOF>
COMAND	FUDGE,<JRST	FUDGIT>
COMAND	CTEST,<JRST	TESTIT>
COMAND	SOS,<TRO	FL,EDITF!SOSF>
COMAND	LABEL,<JRST	IDENT>
IFE DIRSW,<
COMAND	DIRECTORY,<JRST	DODIR>
>>
	DEFINE STABLE<
SWITCH LIST,<XWD LISTSW,CRSW>
SWITCH CREF,<XWD CRSW!LISTSW,0>
SWITCH C,<XWD CRSW!LISTSW,0>
SWITCH SEARCH,<LIBSW,,0>
SWITCH LIBRARY,<LIBSW,,0>
SWITCH NOLIST,LISTSW
SWITCH NOSEARCH,LIBSW
SWITCH L,<XWD LISTSW,CRSW>
SWITCH N,LISTSW
SWITCH COMPILE,<XWD COMPLS,0>
SWITCH NOCOMPILE,COMPLS
SWITCH	NOBINARY,<NOBINSW,,0>
SWITCH	BINARY,NOBINSW
SWITCH	NODEBUG,DEBUGSW
IFN MANTIS,<SWITCH MANTIS,<XWD MANTSW,NOMANTSW!RELSW>
SWITCH NOMANTIS,<XWD NOMANTSW,MANTSW!RELSW>>
SWITCH	F40,<F40SW,,F10SW>
SWITCH	F10,<F10SW,,F40SW>
SWITCH	KA10,<KA10SW,,KI10SW>
SWITCH	KI10,<KI10SW,,KA10SW>
SWITCH	OPTIMIZE,<OPTSW,,NOPTSW>
SWITCH	NOPTIMIZE,<NOPTSW,,OPTSW>
SWITCH	NEW,<NEWSW,,DEVSWS>
SWITCH	OLD,<OLDSW,,DEVSWS>
SWITCH	SYS,<SYSSW,,DEVSWS>
SWITCH	SELF,<SELFSW,,DEVSWS>
>

DEFINE PTABLE<
SWITCH REL,<XWD RELSW,ALPROC>
SWITCH M,<XWD MACSW,ALPROC>
SWITCH F,<XWD FORSW,ALPROC>
SWITCH MA,<XWD MACSW,ALPROC>
SWITCH FO,<XWD FORSW,ALPROC>
SWITCH MAC,<XWD MACSW,ALPROC>
SWITCH FOR,<XWD FORSW,ALPROC>
PROCESS
>

DEFINE	ATABLE<
SWITCH	MAP,<0,,SETMAP>
SWITCH	LMAP,<0,,SETMPL>
SWITCH	FUDGE,<0,,SETFUD>
SWITCH	DDT,<0,,SETDDT>
SWITCH	FOROTS,<0,,FOROTS>
SWITCH	FORSE,<0,,FORSE>
SWITCH	LOADER,<0,,LOADIT>
SWITCH	LINK,<0,,LINKIT>
SWITCH	DEBUG,<0,,SETDEB>
SWITCH	FORDDT,<0,,FORDDT>
SWITCH	SAVE,<0,,SAVE>
SWITCH	SSAVE,<0,,SSAVE>
>
SUBTTL	RUN UUO

IFE RUNSW,<
NUNPNT==6
NUNTOP==7
EXTERN	.JBDDT,.JBSA,.JBS41,.JBCOR

OFFSET==INHERE-74

NUNCOM:	IOWD	0,INHERE
	0
NUNGO2:	CALLI	15,11		;GET PROPER CORE SIZE
	JRST	NOCOR		;LOSE
	IN	1,NUNCOM	;GET IT
	JRST	NUNGO3		;OK
NUNERR:	CALLI	NUNPNT,3	;WE LOSE, PRINT ERROR
	CALLI	12
NUNERM:	ASCIZ	#?LINKAGE ERROR - I/O#
NUNGO3:	SKIPE	12,OFFSET+.JBCOR	;GET JOBCOR
	CAMG	12,.JBREL	;AND SEE IF WE SHOULD EXPAND
	JRST	NUNGO4		;NO, START THE BLT
	MOVEI	NUNPNT,NUNCER
	CALLI	12,11		;YES, DO IT
	JRST	NUNERR		;LOSE
	MOVE	12,OFFSET+.JBS41	;RESET 41
	MOVEM	12,41
	JRST	NUNGO4		;WIN
NUNCER:	ASCIZ	/?CORE NEEDED/
INHERE:

NUNAC:	PHASE	0		;THE CODE TO GO IN THE ACS
NUNGO4:	MOVE	12,OFFSET+.JBDDT;SET JOBDDT
	CALLI	12,2		;SET JOBDDT
NUNBLT:	BLT	NUNTOP,0
	CALLI			;RESET THE WORLD
	AOS	1,.JBSA		;GET STARTING ADDRESS
	JRST	(1)
	NUNERM
	XWD	INHERE+1,75	;THE BLT WORD
	DEPHASE
%RNBLK==NAME-1
>
CREFIT:	SKIPA	T1,[SIXBIT /CREF/]
FUDGIT:	MOVSI	T1,'PIP'
NUNDO:	MOVSI	T2,1		;START ADDR PLUS ONE
RUNIT:	MOVEM	T1,%RNBLK+1	;[216] SET FILE NAME SINCE WE HAVE IT IN T1
	RESET			;RESET THINGS
	SETZ	 %RNBLK+4	;USE DEFAULT PPN
	MOVE	T1,RUNCOR	;GET CORE ARG (USUALLY 0)
	MOVEM	T1,%RNBLK+5	;BUT NOT FOR COPY (^D10)
IFN RUNSW,<
	SKIPN	T1,PCDEV	;USE SPECIAL DEVICE IF SET
	MOVSI	T1,'SYS'	;GET SYS DEVICE
	MOVEM	T1,%RNBLK	;SET IT IN LOW SEG RUN BLOCK
	SETZM	%RNBLK+2	;CLEAR EXTENSION - LET MONITOR CHOOSE
	SETZM	%RNBLK+3	;THIS ALSO (DATE, TIME, ETC)
	HRRI	T2,%RNBLK	;GET LOWSEG ADDRESS OF RUN BLOCK
	MOVSI	T1,1		;SET TO REMOVE HIGH SEGMENT
	HRRI	T1,%LENTH-1	;REDUCE LOWSEG FOR SIMILAR REASON
	MOVE	T3,[%RUN1,,%LOREL]	;GET READY TO PHASE CODE INTO LOWSEG
	BLT	T3,%RNBLK-1	;PERFORM THE TRANSFER
	MOVEM	T2,%RUNT2	;INCASE OF FAILURE
	JRST	%LOREL		;DO UUO'S IN LOWSEG SINCE HIGH SEG GONE

%RUN1:
	PHASE	%LOREL
	CORE	T1,		;ALREADY SET UP IN HIGH SEG
	  JFCL			;DON'T CARE IF IT FAILS
%RUN:	RUN	T2,		;T2 ALREADY SET UP ABOVE
	HRRZ	T1,T2		;GET ERROR CODE
	CAIN	T1,10		;NOT ENOUGH CORE ERROR?
	SKIPN	%RNBLK+5	;ONLY IF TOO MUCH ASKED FOR
	JRST	%RUN2		;NO, U LOSE
	SETZM	%RNBLK+5	;USE WHAT WE GET
	SKIPA	T2,.+1		;RESET T2
%RUNT2:	Z			;SET FROM HIGH SEG
	JRST	%RUN		;TRY AGAIN

%RUN2:	OUTSTR	RUNER1		;WARN USER OF FAILURE
				;**;[170],%RUN2+1,HPW,10/22/73
	IDIVI	T1,10		;[170] MAY BE 2 DIGITS
	JUMPE	T1,.+3		;NO, ONLY ONE
	ADDI	T1,"0"		;MAKE ASCII
	OUTCHR	T1		;OUTPUT IT
	ADDI	T2,"0"
	OUTCHR	T2
	OUTSTR	RUNER2		;REST OF MESSAGE
	MOVE	T2,%RNBLK	;PICK UP DEVICE
	SETZ	T1,		;CLEAR OUT JUNK
	LSHC	T1,6		;MOVE LEADING CHARACTER INTO T1
	MOVEI	T1,40(T1)	;FORM ASCII
	OUTCHR	T1		;PRINT IT
	JUMPN	T2,.-4		;MORE TO GO
	MOVEI	T1,":"		;USUAL SEPARATOR
	OUTCHR	T1
	MOVE	T2,%RNBLK+1	;FILE NAME
	SETZ	T1,
	LSHC	T1,6
	MOVEI	T1,40(T1)
	OUTCHR	T1
	JUMPN	T2,.-4
	EXIT			;AND GIVE UP

RUNER1:! ASCIZ	/?CMLRUF RUN UUO failure (/
RUNER2:! ASCIZ	/) for /

%RNBLK:!			;SIZE OF PHASED CODE FOR BLT
%LENTH==%RNBLK+6		;FOR CORE UUO WHICH INCLUDES RUN BLOCK
	DEPHASE>

IFE RUNSW,<
NORUN:	INIT	1,16		;GET A DSK IN DUMP MODE
	EXP	SYSDEV		;SIXBIT SYS OR DSK
	0
	JRST	DSKNA
	MOVSI	T1,SAVEXT	;SIXBIT FOR SAVE OR DMP.
	MOVEM	T1,NAME+1
	LOOKUP	1,NAME
	JRST	NOFIL
	MOVE	T1,NAME		;SET NAME OF NEW PROCESSOR
	CALL	T1,[SIXBIT /SETNAM/]
	HLRO	15,NAME+3	;GET COUNT
	HRLM	15,NUNCOM
	MOVNS	15		;MAKE POSITIVE
	MOVEI	16,73(15)	;GET END
	ADDI	15,INHERE	;CHECK CORE SIZE
	IORI	15,1777
	MOVSI	NUNTOP,NUNAC
	BLT	NUNTOP,NUNTOP	;GET ACS LOADER
	HRR	NUNBLT,16	;AND SET END OF BLT
	JRST	NUNGO2
>
SUBTTL	SCANNER

TERMF==200000
NUMF==100000
SPCF==400000
SPACT==40000	;SPECIAL ACTION TO BE TAKEN ON CHAR

SCANAM:	PUSHJ	P,SCAN		;GET NEXT CHAR. FIRST
GETNAM:	SETZM	SVNAM(SVPT)	;ZERO OUT CELLS IN CASE NOTHING
	SETZM	SVEXT(SVPT)	;GETS PUT THERE
	SETZM	SVPPN(SVPT)
	SETZM	SWBKS(SVPT)
	SETZM	SVDEV(SVPT)
IFN SFDSW,<X==0			;INITIAL CONDITION
REPEAT SFDLEN,<
	SETZM	SVSFD+X(SVPT)
X==X+NFILE>
>	;END OF IFN SFDSW
				;**;[154],GETNAM+ ,HPW,10/24/73
GETNM0:	TRNE	FL,IDF		;[154] WAS THE THING SCANNED AN IDENT
	JRST	GETDEV		;YES, SEE WHAT WE'VE GOT
	CAIE	C,"["		;MIGHT BE A PPN
	JRST	SYNERP		;NO, LOSE UNLESS A PIP COMMAND
	PUSHJ	P,GETPP1	;READ THE PPN
	PUSHJ	P,SCAN		;AND GET RID OF "]"
	TRNE	FL,PIPF		;[227] IS THIS PIP?
	TRNE	FL,IDF		;[227] YES, IDENTIFIER ALREADY SEEN?
	JRST	GETDEV		;[227] NO
	POPJ	P,		;IT IS, SO RETURN
GETDEV:	PUSH	P,ACCUM
	PUSHJ	P,SCANS		;CHECK FOR EXT OR PPN
	CAIE	C,":"		;IS IT A DEVICE NAME
	JRST	NODEV		;NO
;GETDEV + 3 1/2
IFN FTFIX, <	;[254,260][VIPCED 03,05] MAKE DEVICES STICKY, BUT
		;DON'T LOSE DEVICE IF NULL FILENAME   ... ALSO
		;[302] SWITCH ARGS SHOULD NOT STICK  ...
		;ALSO LOCAL FIX TO NOT DO IT FOR PIP
	POP	P, T1		;WE WERE HIDING IT IN THE STACK
	TRNN	FL, F.STKY!PIPF	;LET PIP DO ITS OWN THING
	 MOVEM	T1, SVDEVV	;REMEMBER FOR 'STICKINESS'
	MOVEM	T1, SVDEV(SVPT)	;SAVE IT AS A DEVICE NOW
>
IFE FTFIX, <	;[VIPCED 03] CODE PRIOR TO EDIT 254
	POP	P,SVDEV(SVPT)	;WE WERE HIDING IT IN THE STACK
>
	PUSHJ	P,SCAN		;BYPASS
	PUSHJ	P,SCAN		;AND GET NEXT
	CAIN	C,"["		;CHECK FOR PROJ-PROG
	PUSHJ	P,[PUSHJ P,GETPP1
		   JRST	SCAN]	;POPJ RETURN
	TRNN	FL,IDF		;MUST BE AN IDENT
	POPJ	P,		;RETURN, ONLY DEVICE SEEN
	PUSH	P,ACCUM
	PUSHJ	P,SCANS
	SETZM	SVPPP	;CLEAR STICKY PPN ON NEW DEVICE
IFN SFDSW,<
	SETZM	SVSFP	;AND STICKY SFD
	MOVE	T1,[SVSFP,,SVSFP+1]
	BLT	T1,SVSFP+SFDLEN-1>
NODEV:	POP	P,SVNAM(SVPT)
;NODEV + 1/2
IFN FTFIX, <	;[254,302][VIPCED 03,05] MAKE DEVS STICK WHEN APPRO PO
	SKIPN	T1,SVDEVV	;IF DEVICE, SKIP
	 JRST	NODEV1		;OTHERWISE PROCEED
	TRNN	FL, F.STKY	;IF FROM SWITCH, DON'T SAVE
	 MOVEM	T1,SVDEV(SVPT)	;ELSE, MAKE DEVICE HAPPEN
NODEV1:	TRNE	FL, F.STKY	;SHOULD PPN STICK?
	 JRST	NOTSTK		;NO--PROCEED
>
IFE SFDSW,<SKIPE T1,SVPPN(SVPT)	;FOUND A NEW STICKY PPN?
	MOVEM	T1,SVPPP	;YES>
IFN SFDSW,<SKIPN T1,SVPPN(SVPT)	;STICKY PPN?
	JRST	NOTSTK		;NO
	MOVEM	T1,SVPPP	;YES
X==<Y==0>			;INITIAL CONDITION
REPEAT SFDLEN,<
	MOVE	T1,SVSFD+X(SVPT)
	MOVEM	T1,SVSFP+Y
X==X+NFILE
Y==Y+1>
	JRST	GOTSTK		;DON'T MOVE IT BACK AGAIN
NOTSTK:>
	MOVE	T1,SVPPP	;GET STICKY PPN
	MOVEM	T1,SVPPN(SVPT)	;SET PPN INCASE ONE NOT FOLLOWING
IFN SFDSW,<X==<Y==0>		;INITIAL CONDITION
REPEAT SFDLEN,<
	MOVE	T1,SVSFP+Y
	MOVEM	T1,SVSFD+X(SVPT)
X==X+NFILE
Y==Y+1>
GOTSTK:>
	CAIN	C,"["		;IS IT PPN
	JRST	GETPP
	CAIE	C,"."		;NO, EXT?
	POPJ	P,		;NEITHER, RETURN
	PUSHJ	P,SCAN		;NO. GO OVER DOT
	PUSHJ	P,SCANS		;PEEK AT NEXT CHAR
	SKIPG	SAVCHR		;ALPHANUMERIC?
	JRST	GETN1		;NO. IT MAY BE A STAR IN PIP MODE
GETN2:	PUSHJ	P,SCAN		;GET EXT
	TRNN	FL,IDF
	GOTO	SYNERR
	MOVE	T1,ACCUM
	HLLZM	T1,SVEXT(SVPT)
IFN PASCAL< CAMN	T1,[SIXBIT/PAS/]
	    TLO		FL3,LISTSW> ;FOR PASCAL AS DEFAULT
				;**;[201],GETN2+5,HPW,11/14/73
GETN3:	PUSHJ	P,SCANS		;[201] FIND DELIMITER
	CAIE	C,"["		;CHECK FOR PPN AGAIN
	POPJ	P,
	JRST	GETPP		;READ PROG-PROG PAIR

GETN1:	TRNE	FL,PIPF		;PIP MODE?
	CAIE	C,52		;YES. ASTERISK?
				;**;[201],GETN1+3,HPW,11/14/73
	TROA	FL,IDF		;[201] SIMULATE IDENTIFIER SEEN
	JRST	GETN2		;WILD EXTENSION. GO GET IT.
	HLLOS	SVEXT(SVPT)	;MARK NULL EXT WITH -1
	PJRST	GETN3		;[201] ALLOW PPN AFTER <progname>.
GETPP:	PUSHJ	P,SCAN
GETPP1:	PUSHJ	P,SCAN
	SETZM	SVPPN(SVPT)	;INCASE NOT FIRST TIME IN
IFN SFDSW,<X==0			;INITIAL CONDITION
REPEAT SFDLEN,<
	SETZM	SVSFD+X(SVPT)
X==X+NFILE>>
	TRNN	FL,IDF
	JRST	[SKIPN	T1,MYPPN	;ALLOW [,,]
		 PUSHJ	P,USRPPN	;NOT GOT IT YET
		 HLLZM	T1,SVPPN(SVPT)
		 JRST	GETPP2]
	MOVE	T1,ACCUM
	PUSHJ	P,RJUST		;THIS NEED TO BE RIGHT JUSTIFIED
	HRLM	T1,SVPPN(SVPT)	;STORE LEFT HALF
	PUSHJ	P,SCAN
GETPP2:	CAIE	C,","
	GOTO	SYNERR
	PUSHJ	P,SCAN
	TRNN	FL,IDF
	JRST	[SKIPN	T1,MYPPN
		 PUSHJ	P,USRPPN	;GET USERS PPN VIA UUO
		 HRRM	T1,SVPPN(SVPT)
		 JRST	GETPP3]
	MOVE	T1,ACCUM
	PUSHJ	P,RJUST
	HRRM	T1,SVPPN(SVPT)
	PUSHJ	P,SCAN
GETPP3:	SETZM	ACCUM		;[227] CLEAR JUNK
	CAIN	C,"]"
	POPJ	P,		;ALL DONE
IFN SFDSW,<CAIE	C,","		;COMMA MEANS SFD COMING
	JRST	ENDSFD		;NO, ALL OVER
	HRRZ	T2,SVPT		;STORAGE POINTER IN RIGHT
	HRLI	T2,-SFDLEN	;AOBJN WORD FOR ALL SFD'S
GETSFD:	PUSHJ	P,SCAN		;GET SOMETHING
	MOVE	T1,ACCUM	;GET WHAT WAS SEEN
	MOVEM	T1,SVSFD(T2)	;STORE IT
	PUSHJ	P,SCAN		;GET NEXT CHAR
	CAIN	C,"]"		;END OF PPN
	JRST	GETPP3		;[227] YES, BUT CLEAR ACCUM
	CAIE	C,","		;MORE TO COME
	JRST	ENDSFD		;NO
	ADDI	T2,NFILE-1	;ADD DIFFERENCE OVER FILE
	AOBJN	T2,GETSFD	;MORE TO COME
	GOTO	SFDERR		;YES, BUT YOU LOSE
ENDSFD:	>	;END OF IFN SFDSW
	TLNN	CS,TERMF	;END OF LINE?
	GOTO	SYNERR		;NO
	MOVEI	C,"]"		;FAKE CLOSING  BRACKET
	MOVEM	CS,SAVCHR	;SEE TRMF NEXT TIME
	POPJ	P,		;RETURN

USRPPN:	GETPPN	T1,		;GET USER'S LOGGED IN PPN
	  JFCL			;INCASE JACCT ON
	MOVEM	T1,MYPPN	;SAVE IT
	POPJ	P,

IFN STANSW,<
RJUST:	TRNE	T1,77
	POPJ	P,		;GET IT OVER THERE
	LSH	T1,-6
	JRST	RJUST>

IFE STANSW,<
RJUST:	PUSH	P,T3
	MOVE	T3,T1		;CONVERT SIXBIT TO OCTAL
	MOVEI	T1,0
CONVOC:	MOVEI	T2,0
	LSHC	T2,6
	CAIL	T2,20
	CAILE	T2,27
	GOTO	SYNERR
	LSH	T1,3
	IORI	T1,-20(T2)
	JUMPN	T3,CONVOC
	POP	P,T3
	POPJ	P,0
>
SCANS:	MOVNI	T1,1		;FLAG AS NOTHING SEEN YET
	SKIPN	CS,SAVCHR	;CHARACTER WAITING?
SCNS2:	PUSHJ	P,GETCH
	JUMPN	CS,SCNS1	;FOUND SOMETHING
	MOVEI	T1,0
	JRST	SCNS2
SCNS1:	JUMPL	CS,SCNS4	;SPECIAL CHARACTER
	MOVEM	CS,SAVCHR	;SAVE THAT CHARACTER
	JUMPL	T1,SCNS3	;DO NOTHING ELSE IF NO BLANKS SEEN
	MOVEM	T1,SAVCHR	;IF BLANKS SEEN, SAVE ONE
	MOVSI	T1,70000
	ADDM	T1,@GETB3(IOPNT)	;AND BACK UP POINTER
	AOS	@GETB1(IOPNT)	;[232] ALSO BACKUP COUNT
SCNS3:	TDZA	CS,CS		;IN EITHER CASE, RETURN 0
SCNS4:	MOVEM	CS,SAVCHR	;SAVE SPECIAL CHARACTER
	HRRZ	C,CS		;GET A CHARACTER TO RETURN
	POPJ	P,
SCAN:	TRZ	FL,IDF		;RESET IN CASE NOT
	SKIPN	CS,SAVCHR	;WAS THERE SOMETHING LEFT OVER
CONSN:	PUSHJ	P,GETCH		;NO, GET ANOTHER
	JUMPE	CS,.-1		;IGNORE BLANKS
	JUMPL	CS,SPCHR	;IS IT A SPECIAL CHARACTER
	SETZM	ACCUM		;PREPARE TO STORE IT
	MOVE	T1,[POINT 6,ACCUM]
SCAN1:	TLNE	T1,770000	;ALL SIX STORED?
	IDPB	CS,T1		;NO, STORE ANOTHER
	PUSHJ	P,GETCH		;GET NEXT
	JUMPG	CS,SCAN1	;ANOTHER ALPHA
;SCAN1 + 3 1/2
IFN FTFIX, <	;[271][VIPCED 05] PASS TRAILING * TO PIP
	CAIN	C, "*"		;DID WE STOP ON A "*"?
	 TRNN	FL, PIPF	;YES, IS THIS PIP MODE?
	  JRST	SCAN2		;NO, STOP THE SCAN
	MOVEI	CS, '*'		;YES, "*" IS JUST ANOTHER CHAR
	JRST	SCAN1		;SO GO STORE IT AWAY
SCAN2:
>
	TRO	FL,IDF		;IT SURE IS
	MOVEM	CS,SAVCHR
	SETZB	C,CS		;TO AVOID CONFUSION
	POPJ	P,
SPCHR:	HRRZ	C,CS		;RETURN HIM THE HALF OF IT
	SETZM	SAVCHR		;NOTHING SAVED BY NOW
	CAIN	C,"*"
	TRNN	FL,PIPF
	JRST	SPCHR1
	PUSH	P,[SIXBIT /*/]	;IN PIP MODE * IS AN IDENT
	POP	P,ACCUM
	TROA	FL,IDF
SPCHR1:	TLNN	CS,SPACT	;DO WE WANT SPECIAL ACTION?
	POPJ	P,		;NO
	JRST	(CS)		;YES, RH IS DISPATCH
;GETCH RETURNS 7-BIT ASCII CHAR IN C, TABLE ENTRY IN CS

GETCH:	SOSLE	@GETB1(IOPNT)	;USE CORRECT BUFFER HEADER
	JRST	OKPICK
IFN TEMP,<SKIPGE C,TMPFLG(IOPNT)	;IS TMPCOR BEING USED
				;SET TO -1 IF YES
	AOJE	C,POPFL1	;YES FINISHED WITH THIS READ>
	XCT	GETB2(IOPNT)	;AN IN UUO
	JRST	OKPICK
	XCT	GETB4(IOPNT)	;TO A STATZ
	JRST	READER		;AN INPUT ERROR
	JRST	POPFIL		;GO GET PREVIOUS FILE

OKPICK:	IBP	@GETB3(IOPNT)
	MOVE	C,@GETB3(IOPNT)	;PICK UP THE NEW BYTE POINTER
	MOVE	CS,(C)		;GET THE WORD IT CAME FROM
	TRNE	CS,1		;AND CHECK FOR SEQ NUM
	JRST 	[AOS @GETB3(IOPNT)	;ADVANCE POINTER
		 MOVNI CS,5	;AND ADJUST COUNT
		 ADDB CS,@GETB1(IOPNT)
		 SKIPG CS	;CHECK FOR BUFFER OVERRUN
		 PUSHJ P,GETCH	;GET RID OF TAB
		 JRST GETCH]
	LDB	C,@GETB3(IOPNT)
	JUMPE	C,GETCH		;IGNORE NULLS
	CAIN	C,";"		;IS IT A COMMENT?
	TRNE	FL,INPRNT	;IN PRINTING ERROR
	JRST	EOFRT		;YES, DONT PROCESS ";"
SEMIC:	TRO	FL,INPRNT	;HACK SO THAT "@" COME HERE
	PUSHJ	P,GETCH		;READ CHRS
	MOVE	CS,CTBL(C)	;GET STATUS
	TLNN	CS,TERMF	;END OF LINE?
	JRST	SEMIC		;NO, KEEP GOING
	TRZ	FL,INPRNT	;CLEAR FLAG AGAIN
EOFRT:	MOVE	CS,CTBL(C)	;GET STATUS BITS
EOFRT1:	TRNN	FL,INPRNT	;IF PRINTING ERROR, DO NOT NEST
	CAIE	C,100		;IS IT @
	POPJ	P,
	JRST	NEST		;SPECIAL
	XALL		;BACK TO NORMAL LISTING
CTBL:	0
REPEAT 10,<	XWD	SPCF,.-CTBL>
	0					;TAB
	XWD	SPCF!SPACT!TERMF+12,CHKTRM	;LF
	XWD	SPCF!SPACT!TERMF+13,CHKTRM	;VTAB
	XWD	SPCF!SPACT!TERMF+14,CHKTRM	;FORM
	0					;CARRET
REPEAT 15,<	XWD	SPCF,.-CTBL>
	XWD	SPCF!TERMF!SPACT+44,CHKTRM
REPEAT 4,<	XWD	SPCF,.-CTBL>
	0					;SPACE
REPEAT 17,<	XWD	SPCF,.-CTBL>
REPEAT 12,<	XWD	NUMF,.-CTBL-40			;DIGIT>
REPEAT 5,<	XWD	SPCF,.-CTBL>
	EXP	.-CTBL-40			;?
	XWD	SPCF,100
REPEAT 32,<	EXP	.-CTBL-40			;UPPER CASE LETTERS>
REPEAT 6,<	XWD	SPCF,.-CTBL>
REPEAT 32,<	EXP	.-CTBL-100			;LOWER CASE LETTERS>
	XWD	SPCF,.-CTBL
	XWD	SPCF,.-CTBL
	XWD	SPCF!TERMF!SPACT+44,CHKTRM
	XWD	SPCF!TERMF!SPACT+44,CHKTRM
	XWD	SPCF!SPACT,POPFIL

COMMA==CTBL+","

CHKTRM:	PUSH	P,CS		;SAVE MAGIC BITS
TERMC1:	PUSHJ	P,GETCH
	JUMPE	CS,TERMC1	;ALSO IGNORE TABS AND SPACES
	TLNE	CS,TERMF
	JRST	TERMC1		;BYPASS TERMINATORS
	CAMN	CS,COMMA	;CHECK FOR , AFTER CRET
	JRST	[POP P,(P)	;GET STACK IN SYNC
		 POPJ P,]	;RETURN THE COMMA
	MOVEM	CS,SAVCHR	;SAVE FOR LATER
	POP	P,CS
	MOVEI	C,0		;AS GOOD AS ANYTHING ELSE
	POPJ	P,

DEFINE QQ<
N==1
REPEAT NESTDP,<MAC(\N)
	N==N+1>>

GETB1:	DINCT
DEFINE MAC(X)<IBUF'X+2>
QQ
GETB2:	HALT
DEFINE  MAC(X)<IN	X,0>
QQ
GETB3:	DINPT
DEFINE MAC(X)<IBUF'X+1>
QQ
GETB4:	HALT
DEFINE MAC(X)<STATZ	X,740000>
QQ
	SUBTTL	COMMAND NESTING

NEST:	PUSH	P,ACCUM		;SAVE STATE OF SCANNER
	PUSH	P,FL		;SAVE THE FLAGS (AS IDF?)
	PUSH	P,T1
	SETZM	SAVCHR
	PUSH	P,NAME		;AND THIS OTHER STUFF
	PUSH	P,NAME+1
	PUSH	P,NAME+2
	PUSH	P,NAME+3
	AOBJP	SVPT,TMNER	;GET A CLEAR SPACE FOR NAME
;NEST + 10 1/2
IFN FTFIX, <	;[302][VIPCED 05] SWITCH ARGS SHOULD NOT STICK
	TRO	FL, F.STKY	;SET FLAG FOR NO STICKINESS
>
	PUSHJ	P,SCANAM	;GET ONE TO USE
IFN FTFIX, <	;[302]
	TRZ	FL, F.STKY	;CLEAR FLAG
>
	PUSH	IOP,SAVCHR
	PUSHJ	P,CHKRM		;GET BUFFER SPACE
	AOBJP	IOPNT,NESTTD	;TOO DEEP?
IFE TEMP,<
	SKIPE	C,SVDEV(SVPT)	;WAS A DEVICE SPECIFIED?
	JRST	NSTDEV		;YES, USE IT
>
IFN TEMP,<
	MOVS	C,SVDEV(SVPT)	;[226] GET DEVICE
	MOVSM	C,OPENB+1	;[226] STORE DEV OR 0
	CAIN	C,'TMP'		;[226] TEST FOR TMPCOR
	JRST	[
IFN FTFIX, <	;[253][VIPCED 03] FIX UP FILE-FINDING WITH LOGICAL TMP
		MOVSS	C,		;GET IN PLACE FOR DEVCHR
>
		DEVCHR	C,		;[226] BUT NOT IF A REAL DEVICE
		JUMPN	C,NSTDV1	;[226] IT REALLY EXISTS
		JRST	.+2]		;[226] TRY TMPCOR ONLY
;NEST+21
IFN FTFIX, <	;[243][VIPCED 01] ALLOW COMP @DEV:...
	JUMPN	C,NSTDV1
>
IFE FTFIX, <	;ORIGINAL CODE PRE-VIPCED 01
	JUMPN	C,NSTDEV	;[226] DEVICE SPECIFIED
>
	MOVE	C,.JBFF		;GET START OF BUFFER
	MOVEM	C,BUFTAB(IOPNT)	;SAVE IT FOR RELEASING INFO
	MOVEM	C,TMPFIL+1	;SAVE IOWD FOR TMPCOR UUO
	MOVEM	C,@GETB3(IOPNT)	;DUMMY UP BYTE POINTER
	SOS	TMPFIL+1	;MAKE TMPFIL INTO CORRECT IOWD FORMAT
	MOVNI	C,200		;GET BUFFER LENGTH
	HRLM	C,TMPFIL+1	;STORE NEGATIVE WORD COUNT
	MOVE	C,SVNAM(SVPT)	;PICK UP FILNAM
	SKIPE	OPENB+1		;[226] SPECIAL IF TMP:
	JRST	[HLLZM	C,TMPFIL	;[226] 3 CHARS ONLY
		JRST	ISTMP1]		;[226] TRY TMPUUO
	XOR	C,JOBNAM	;ONLY ALLOW TMPCOR IF CURRENT JOB NUMBER
	TLNE	C,-1		;OTHERWISE WE MIGHT READ XXXPIP ETC
	JRST	NOTMP		;NOT A VALID TMPCOR FILE NAME
	HRLZM	C,TMPFIL	;STORE RIGHT THREE LETTERS
ISTMP1:	MOVE	C,[XWD 1,TMPFIL]	;SET UP FOR TMPCOR READ
	TMPCOR	C,		;READ FILE AND DON'T DELETE
	  JRST	[SKIPN	OPENB+1		;[226] FAILED, TMP: ONLY?
		JRST	NOTMP		;[226] NO SUCH FILE, TRY THE DISK
		MOVE	C,SVNAM(SVPT)	;[226] GET FILE NAME
		HLLZM	C,LNAM		;[226] FOR ERROR MESSAGE
		SETZM	LEXT		;[226]
		JRST	NOFIL]		;[226] FILE NOT THERE
	SETOM	TMPFLG(IOPNT)	;FLAG THAT TMPCOR READ WAS DONE
	IMULI	C,5		;CALCULATE CHARACTER COUNT
	MOVEM	C,@GETB1(IOPNT)	;STORE IN BUFFER HEADER
	MOVEI	C,440700	;SET UP BYTE POINTER
	HRLM	C,@GETB3(IOPNT)	;BUFFER HEADER FINALLY SET UP
	JRST	NEXT2		;CONTINUE INTO MAIN STREAM
NOTMP:			>
	MOVSI	C,'DSK'
NSTDEV:	MOVEM	C,OPENB+1	;[226]
NSTDV1:	SETZM	OPENB		;[226]
	MOVE	C,NESTB(IOPNT)	;GET BUFFER POINTER
	MOVEM	C,OPENB+2
	MOVE	C,[OPEN .-.,OPENB]
	DPB	IOPNT,[POINT 4,C,12]
	XCT	C
	  JRST	[MOVE	C,OPENB+1	;[226] GET DEVICE
		MOVEM	C,LOKNAM	;[226] INCASE IT DOESN'T EXIST
		DEVCHR	C,		;[226] SEE IF IT DOES
		JUMPE	C,DEVNA		;[226] NO
		JRST	DSKNA]		;[226] MUST BE SOMETHING ELSE
	MOVE	C,.JBFF
	MOVEM	C,BUFTAB(IOPNT)	;SAVE THE PLACE PUT
	XCT	INTAB(IOPNT)	;DO AN INBUFF
	MOVE	C,SVNAM(SVPT)
	MOVEM	C,LNAM		;SET UP FOR LOOKUP
	SKIPN	C,SVEXT(SVPT)
	JUMPE	C,NEST1		;NOT EXT SUPPLIED
	TRZA	C,-1		;INCASE NULL SUPPLIED
NEST1:	MOVSI	C,'CMD'		;TRY .CMD
	MOVEM	C,LEXT
NEST1A:	MOVE	C,SVPPN(SVPT)
IFN SFDSW,<
	SKIPE	SVSFD(SVPT)	;ANY SFD'S SEEN?
	PUSHJ	P,SETSFD	;YES, SET PATH>
	MOVEM	C,LPPN
	XCT	LKTAB(IOPNT)
	  JRST	[TRNE FL,INCRF		;SPECIAL IF TRYING TO READ QQCREF
		 JRST DNCRF
		 HLLZ C,LEXT		;SEE IF BLANK USED
		 JUMPE C,NOFIL		;[225] NO, NOT THERE
		SETZM	LEXT		;[225] TRY NULL EXT
		 JRST NEST1A]	;[225]
NEXT2:	SUB	SVPT,[XWD 1,1]	;GET HIM POINTED BACK RIGHT
	POP	P,NAME+3	;RESTORE THINGS
	POP	P,NAME+2
	POP	P,NAME+1
	POP	P,NAME
	POP	P,T1
	POP	P,FL
	POP	P,ACCUM
	TRZ	FL,RECALF	;WE HAVE DONE THE FIND
;	JRST	GETCH		;AND CONTINUE TO GET THAT CHR
	MOVEI	C," "		;SUPPLY A FREE BLANK IF "@" SO COM@FOO WORKS
	SETZ	CS,		;STATUS OF A BLANK
	POPJ	P,		;BYPASS GETCH AND RETURN BLANK TO CALLER

IFN SFDSW,<
SETSFD:	MOVEM	C,LSFDPP	;STORE PPN
X==<Y==0>
REPEAT SFDLEN,<MOVE	C,SVSFD+X(SVPT)
	MOVEM	C,LSFD+Y
X==X+NFILE
Y==Y+1>
	MOVEI	C,LSFDAD	;TO STORE SFD BLOCK IN LPPN
	POPJ	P,		;RETURN
>

POPFIL:
;TEMP FIX FOR PIP FUNCTION PROBLEM WITH SCANNER
;SCANNING TO FAR AND ENDING UP AT POPFIL
;THIS CURES SYMPTOMS NOT THE DESEASE
	TRNN	IOPNT,-1	;ALREADY AT TOP LEVEL?
	TRNN	FL,PIPF		;YES, BUT IS IT PIP?
	CAIA			;NO
	JRST	[MOVEI	C,12	;YES, FAKE A LF
		 MOVE	CS,CTBL(C)
		 POPJ	P,]	;AND RETURN IT
;END OF "FIX"
	XCT	RELTAB(IOPNT)	;RELEASE HIM
IFN TEMP,<
POPFL1:	SETZM	TMPFLG(IOPNT)	;CLEAR TMPCOR FLAG
>
	MOVE	C,BUFTAB(IOPNT)
	MOVEM	C,FREBUF(IOPNT)	;MARK BUFFER FREE
	POP	IOP,CS
	HRRZ	C,CS
	SUB	IOPNT,[XWD 1,1]	;POINT IT BACK
	JRST	EOFRT1		;AND GIVE BACK THE CHARACTER

	SALL
NESTB:	0
DEFINE MAC(X)<IBUF'X>
QQ
DEFINE MAC(X)<U (IBUF'X,3)>
QQ
IFN TEMP,<U(TMPFLG,NESTDP+2)>
INTAB:	HALT			;INBUFS
DEFINE MAC(X)<INBUF X,2>
QQ

LKTAB:	HALT
DEFINE MAC(X)<LOOKUP	X,NAME>
QQ
RELTAB:	JRST	ALLDON
DEFINE MAC(X)<RELEAS	X,0>
QQ
	SUBTTL	ERROR ROUTINES

IFDEF SALL,<SALL>	;MAKE LISTING NEATER
ETMS:	STRING	[ASCIZ /?CMLTMS Too many switches: /]
ERRCOM:	MOVEI	T1,20		;SET TO TYPE SOME CHRS TO TELL WHERE ERROR
	MOVE	T2,[POINT 7,ERRBUF]	;IS FROM
	TRO	FL,INPRNT	;IN CASE EOF WHILE READING CHRS TO TYPE
	SKIPN	C,SAVCHR	;FIND THE ONE LEFT
	JRST	PUTER
	TLNE	C,SPACT		;IS IT SPECIAL
	JRST	NOFIL0		;YES, GIVE UP AT END OF LINE
	SKIP	1
PUTER:	PUSHJ	P,GETCH
	CAIN	C,177		;THIS IS EOF
	JRST	NOFIL0
	IDPB	C,T2
	SOJGE	T1,PUTER
NOFIL0:	MOVE	T1,T2
	JRST	NOFIL1		;PRINT WITH CR/LF
TMNER:	STRING	[ASCIZ /?CMLTMN Too many names: /]
	JRST	ERRCOM
DSKNA:	STRING	[ASCIZ /?CMLDNA Disk not available: /]
	JRST	ERRCOM
OUTER:	STRING	[ASCIZ /?CMLOPE Output error: /]
	JRST	ERRCOM
PROCON:	STRING	[ASCIZ /?CMLLPC Language processor conflict: /]
	JRST	ERRCOM
NOCOR:	STRING	[ASCIZ /?CMLNEC Not enough core: /]
	JRST	ERRCOM
READER:	STRING	[ASCIZ /?CMLIPE Input error: /]
	JRST	ERRCOM
SYNRR1:	SUB	IOPNT,[XWD 1,1]	;GET HIM BACK TO RIGHT PLACE
SYNRR2:	STRING	[ASCIZ	/?CMLNPC No previous command/]	;[204]
	JRST	ABORT			;[204] EXIT
SYNERR:	STRING	[ASCIZ /?CMLCME Command error: /]
	JRST	ERRCOM
NESTTD:	STRING	[ASCIZ /?CMLNTD Nesting too deep: /]
	JRST	ERRCOM
AMBIGU:	STRING	[ASCIZ /?CMLAMB Ambiguous abbreviation: /]
	SKIP	1
UNRECS:	STRING	[ASCIZ /?CMLURS Unrecognizable switch: /]
	MOVE	T3,ACCUM	;BAD SWITCH IN HERE
	JRST	ERRBF1
XPDERR:	STRING	[ASCIZ	/?CMLEDR Explicit device required /]
	JRST	ABORT		;"22A-160"
LLCERR:	STRING	[ASCIZ	\?CMLLLC LINK-10/LOADER conflict: \]
	JRST	ERRCOM
IPCERR:	STRING	[ASCIZ	/?CMLIPC Illegal protection code: /]	;[231]
	MOVE	T3,ACCUM	;[231] BAD CODE
	JRST	ERRBF1		;[231] LIST IT
NOFIL:	TRNN	FL,RECALF	;WE WERE LOOKING UP A SVC FILE
;NOFIL + 1
IFN FTFIX, <	;[266][VIPCED 05] BETTER LOOKUP ERROR REPORTING
	JRST	FIU		;YES, TELL OF ERROR
>
IFE FTFIX, <	;CODE BEFORE VIPCED 05
	JRST	NOFIL3		;YES, USE STANDARD MESSAGE
>
	TRNN	FL,SOSF!TECOF	;[216] NO, TEST FOR LOOKING FOR SOS OR TECO FILE
	JRST	SYNRR1		;NO, SO GIVE SPECIAL MESSAGE
	TRNN	FL,SOSF		;[216] SKIP IF GOING TO RUN SOS
	SKIPA	T1,[SIXBIT /TECO/]	;[216] ELSE LOAD TECO
	SKIPA	T1,[SIXBIT /SOS/]	;[216] LOAD NAME OF SOS
	JFFO	T1,RUNIT	;[216] RUN TECO WITH OFFSET OF ZERO
	JRST	NUNDO		;[216] RUN SOS WITH OFFSET OF ONE
IFE FTFIX, <	;[VIPCED 05] CODE DELETED WITH ED 266
NOFIL3:	STRING	[ASCIZ	/?CMLLRE /]
	STRING	@ERRTAB		;USE STANDARD MESSAGE
>
NAMCOM:	MOVE 	1,[POINT 7,ERRBUF]
	MOVE	T3,NAME
	PUSHJ	P,SIXOUT
	HLLZ	T3,NAME+1
	JUMPE	T3,NOFIL1
	MOVEI	T2,"."
	IDPB	T2,T1
NOFIL2:	PUSHJ	P,SIXOUT
NOFIL1:	MOVEI	T2,0
	IDPB	T2,T1
	STRING	ERRBUF
ABORT:	CLRBFI			;CLEAR INPUT BUFFER SO GARBAGE IS NOT READ;"22A-160"
	RESET
DOEND:	SETZB	0,.JBSA		;SO START FAILS
	SETNAM	0,		;SO RUN FAILS
	EXIT	1,
	EXIT			;IN CASE SOME IDIOT TYPES CONTINUE

SIXOUT:	MOVEI	T2,0
	LSHC	T2,6
	ADDI	T2,40
	IDPB	T2,T1
	JUMPN	T3,SIXOUT
	POPJ	P,

DEVNA:	STRING	[ASCIZ /?CMLDVA Device not available - /]
	MOVE	T3,LOKNAM
ERRBF1:	MOVE	T1,[POINT 7,ERRBUF]
	JRST	NOFIL2


SYNERP:	TRNN	FL,PIPF		;A PIP COMMAND?
	GOTO	SYNERR		;NO, YOU LOSE
	CAIN	C,"["		;START OF PPN?
	JRST	GETPP1		;YES, AND PROBABLY NO DEVICE
	POPJ	P,		;RETURN AND HOPE IT MAKES SENSE

UNKERR:	STRING	[ASCIZ /?CMLUNC Unknown command: /]
	MOVE	T3,ACCUM	;GET IT
	JRST	ERRBF1		;OUTPUT IT

IFN SFDSW,<
SFDERR:	STRING	[ASCIZ	/?CMLLRE /]
	STRING	@ERRTAB+25	;SFD PATH TOO LONG
	JRST	ERRCOM
>
FIU:	STRING	[ASCIZ	/?CMLLRE /]
	HRRZ	T1,LEXT		;GET ERROR CODE
	CAIL	T1,TABLND-ERRTAB	;SEE IF LEGAL
	SKIPA	T1,TABLND	;NO USE CATCHALL MESSAGE
	MOVE	T1,ERRTAB(T1)	;GET ADDRESS OF MESSAGE
	STRING	(T1)		;OUTPUT IT
	JRST	NAMCOM

ERRTAB:	[ASCIZ /(0) file was not found - /]
	[ASCIZ /(1) no directory for project-programmer number - /]
	[ASCIZ /(2) protection failure - /]
	[ASCIZ /(3) file was being modified - /]
	[ASCIZ /(4) rename file name already exists - /]
	[ASCIZ /(5) illegal sequence of UUOs - /]
	[ASCIZ /(6) bad UFD or bad RIB - /]
	[ASCIZ /(7) not a SAV file - /]
	[ASCIZ /(10) not enough core - /]
	[ASCIZ /(11) device not available - /]
	[ASCIZ /(12) no such device - /]
	[ASCIZ /(13) not two reloc reg. capability - /]
	[ASCIZ /(14) no room or quota exceeded - /]
	[ASCIZ /(15) write lock error - /]
	[ASCIZ /(16) not enough monitor table space - /]
	[ASCIZ /(17) partial allocation only - /]
	[ASCIZ /(20) block not free on allocation - /]
	[ASCIZ /(21) can't supersede (enter) an existing directory - /]
	[ASCIZ /(22) can't delete (rename) a non-empty directory - /]
	[ASCIZ /(23) SFD not found - /]
	[ASCIZ /(24) search list empty - /]
	[ASCIZ /(25) SFD nested too deeply - /]
	[ASCIZ /(26) no-create on for specified SFD path - /]

TABLND:	[ASCIZ /(?) lookup,enter,or rename error - /]
	SUBTTL	ALL DONE

ALLDON:	TRNE	FL,INCRF	;JUST FOUND END OF QQCREF FILE
	JRST	DNCRF
	SKIPE	FDGFLG		;WRITING A FUDGE FILE?
	PUSHJ	P,DNFUDG	;YES, CLOSE IT
	TRNE	FL,INPRNT
	JRST	NOFIL0		;IF PRINTENG AND EOF THEN FIINSH UP
	HRRZ	T1,(P)		;GET THE ADDRESS WE WANT TO RETURN TO
	CAIE	T1,NXFIL1	;THIS SHOULD BE HERE
	GOTO	SYNERR		;ELSE ERROR
	SETZM	PCNAM		;NO LINK NAME TO START WITH
	SETZM	PCDEV		;AND DEVICE
	MOVEI	T3,CHNLOD	;START WITH LOADER
	TRNN	FL,DOLOD	;ARE WE LOADING?
	JRST	ALDN1		;NO
	SKIPN	T2,EXECFL	;WANT EXECUTION?
IFE FQZSIM,<
	JRST	.+4		;NO
	>
IFN FQZSIM,<
	JRST	.+6
	CAMN	T2,[',SYS: ']	;SIMULA DEBUG?
	JRST	[PUSHJ	P,OUTSIX	;YES OUTPUT ',SYS:SIMLIB/S
		 MOVE	T2,['SIMLIB']	; /STA:.OCRE0/E'
		 PUSHJ	P,OUTSIX	; SIMLIB MUST BE SEARCHED FIRST
		 MOVE	T2,['/S/STA']	; TO DEFINE THE START ADDRESS
		 PUSHJ	P,OUTSIX	; .OCRE0 WHERE THE FIRST 
		 MOVE	T2,[':.OCRE']	; ACTION IS TO LOAD AND
		 PUSHJ	P,OUTSIX	; START SIMDDT
		 MOVSI	T2,'0/E'
		 JRST	.+1]
	>
	PUSHJ	P,OUTSIX	;YES, /E
	TRNE	FL,LINKFL	;LINK-10?
	PUSHJ	P,OUTSPC	;NEEDS SEPARATOR
	SKIPN	T2,MAPSW	;SKIP IF MAP REQUIRED
	MOVSI	T2,'/G '	;SET UP FOR TERMINATE LOADING
	PUSHJ	P,OUTSIX	;YES, PUT IT OUT
	TRNE	FL,LINKFL	;LINK-10?
	PUSHJ	P,OUCRLF	;YES, BUG IN SCAN REQUIRES EOL MARKER
	HLLZ	T1,LODDEV	;LOADER RUN DEV: IN SPECIAL PLACE
	HLLM	T1,TMPCHN(T3)	;WHERE IT AUGHT TO BE
	TRNN	FL,LINKFL	;DO WE NEED LINK-10?
	JRST	ALDN1		;NO
	SETZ	T1,		;YES
	EXCH	T1,TMPCHN(T3)	;MOVE DATA FROM LOADER
	MOVEI	T3,CHNLNK	;TO LINK-10
	MOVEM	T1,TMPCHN(T3)	;
ALDN1:	SKIPN	TMPCHN(T3)	;HAS THAT PROCESSOR BEEN SET UP FOR OUTPUT?
	SOJGE	T3,ALDN1	;NO, TRY NEXT (BUT NOT TOO MANY)
	JUMPL	T3,DONE		;IF OUT OF PROCESSORS THEN DONE
	SKIPN	PCNAM		;IS THERE A PROCESSOR FOR IT TO CALL?
	JRST	NONAM		;NO
IFN FORTRAN,<
	CAIN	T3,CHNFOR	;IS THIS FORTRAN?
	JRST	[SKIPN	T1,FORPRC	;YES, BUT SEE WHICH
		 MOVE	T1,PRCNAM(T3)	;EITHER F40 OR F-10
		 CAME	T1,['FORTRA']	;F-10 IS SPECIAL
		 JRST	.+1		;F40
		 MOVE	T2,['/RUN: ']	;AS IT USES SCAN
		 PUSHJ	P,OUTSIX
		 SKIPE	T2,PCDEV	;USE DEVICE IF GIVEN
		 PUSHJ	P,OUTDEV
		 MOVE	T2,PCNAM	;NAME WE WANT TO RUN
		 PUSHJ	P,OUTSIX
		 PUSHJ	P,OUCRLF
		 JRST	NONAM]>
	SKIPE	T2,PCDEV	;GET DEVICE IF GIVEN
	PUSHJ	P,OUTDEV
	MOVE	T2,PCNAM	;RECOVER NAME OF PROCESSOR
	PUSHJ	P,OUTSIX	;YES, PUT OUT ITS NAME
	MOVEI	T1,"!"		;AND THE LOAD SYMBOL
	PUSHJ	P,TMPOUT
	PUSHJ	P,OUCRLF
NONAM:	PUSHJ	P,TMPCHK	;CLOSE IT
	CAIE	T3,CHNLNK	;IS THIS LINK-10?
	CAIN	T3,CHNLOD	;IS THIS THE LOADER?
	SKIPA	T1,PROCTB(T3)	;YES, IT'S SPECIAL
	MOVE	T1,PRCNAM(T3)	;GET THE NAME OF THAT PROCESSOR
IFN FORTRAN,<			;WE HAVE A CHOICE OF FORTRAN COMPILERS
	CAIE	T3,CHNFOR	;BUT ONLY IF THIS IS FORTRAN
	SKIP	2		;NOT
	SKIPE	FORPRC		;USE DEFAULT
	MOVE	T1,FORPRC	;USE WHATEVER IS SET>
	MOVEM	T1,PCNAM	;AND SET AS THE ONE TO LINK TO
NOPDEV:	SOJGE	T3,ALDN1	;GO BACK IF MORE TO LOOK AT
DONE:	TRNE	FL,CMDSN	;DID WE SEE COMMAND FROM TTY?
	JRST	DONE1		;NO, DO NOT WRITE FILE
	MOVE	T1,JOBNAM
	HRRI	T1,'SVC'
	TRNE	FL,EDITF
	HRRI	T1,'EDS'
	MOVEM	T1,LNAM		;SET UP OUTPUT FILE
IFN TEMP,<
	HRLZM	T1,TMPFIL	;SAVE NAME IN TMPFIL
>
	MOVE	T1,TTYPT	;GET BYTE POINTER
	MOVNI	T2,4		;SET UP FOR CHARACTER COUNT
	ILDB	T3,T1		;GET NEXT CHARACTER
	CAIE	T3,177		;IS IT A EOF CHARACTER
	SOJA	T2,.-2		;NO, TRY AGAIN
	IDIVI	T2,5		;CALCULATE CHARACTER COUNT
	HRLM	T2,TMPFIL+1	;STORE IN TMPCOR OUTPUT BLOCK
	LDB	T3,[POINT 6,T1,5]	;PICK UP BIT POS OF LAST CHAR
	SETO	T2,		;PREPARE TO BUILD MASK
	LSH	T2,7(T3)	;MASK OFF REST OF LAST WORD
	ANDM	T2,(T1)		;IN TTY BUFFER
	HRRZ	T2,TTYPT	;GET START OF BUFFER
	SUBI	T2,1		;FOR IOWD
	HRRM	T2,TMPFIL+1	;STORE IN WRITE BLOCK FOR TMPCOR UUO
IFN TEMP,<
	MOVE	T2,[XWD 3,TMPFIL]	;SET UP FOR WRITE
	TMPCOR	T2,		;WRITE OUT FILE INTO CORE
	JRST	NOFIT		;IT DID NOT FIT, TRY DISK
	JRST	DONE1		;GO CLEAN UP AND LEAVE
NOFIT:			>
	MOVE	T1,TMPFIL+1	;GET IOWD
	MOVEM	T1,TMPFIL	;TO FIRST WORD OF PAIR
	SETZM	TMPFIL+1	;ZERO SECOND WORD
	MOVSI	T1,'TMP'
	MOVEM	T1,LEXT
	SETZM	LDAT
	SETZM	LPPN
	CLOSE	LOOK,20		;MAKE SURE NOTHING USING THIS CHANEL
IFE FASTFS,<
	SKIPN	FSNAME		;IS F/S FOUND
	PUSHJ	P,FNDFST	;NO FIND IT>
	RELEAS	LOOK,0		;GIVE UP THE CHANNEL
	MOVEI	T1,16		;DUMP MODE
	MOVEM	T1,FSINIT	;INCASE NOT YET SETUP
	OPEN	LOOK,FSINIT	;INIT THE CHAN.
	JRST	DSKNA		;SHOULDN'T HAPPEN
	ENTER	LOOK,LNAM	;GET SET TO WRITE
	JRST	FIU		;TREAT THIS AS A FATAL ERROR
	OUTPUT	LOOK,TMPFIL	;OUTPUT THE DMP IOWD LIST
DONE2:	CLOSE	LOOK,20		;SAVE THE NAME BLOCKS (LEVEL D)
	RELEASE	LOOK,0		;LET IT GO
DONE1:	SKIPE	TMPCHN+CHNCRF	;DID WE DO ANY CREF?
	PUSHJ	P,FINCRF	;YES, FINISH OFF CREF
	SKIPN	T1,PCNAM	;IS THERE ONE TO LOAD?
	JRST	DOEND		;[206] NO, EXIT
	JRST	NUNDO		;GO LOAD IT
CHKRM:	PUSH	P,T1		;SAVE THE REGISTERS WE ARE USING
	PUSH	P,T2
	MOVSI	T1,-<NESTDP+1>	;LOOK TO SEE IF ANY FREED BUFFERS
	SKIPN	T2,FREBUF(T1)
	AOBJN	T1,.-1		;TRY AGAIN
	JUMPGE	T1,USTOP	;NO, GET IT FROMTOP OF STORAGE
	MOVEM	T2,.JBFF	;YES, SET JOBFF THERE
	SETZM	FREBUF(T1)	;AND MARK IT USED
	JRST	TPOPJ2		;THATS ALL FOR NOW
USTOP:	MOVE	T1,SVJFF	;GET THE CURRENT TOP OF BUFFER AREA
	MOVEM	T1,.JBFF
	ADDI	T1,<203*2>+1	;LEAVE THIS MUCH ROOM
	MOVEM	T1,SVJFF	;THATS THE NEW TOP
	CAMGE	T1,CORTOP	;WILL THAT RUN US OUT OF CORE?
	JRST	TPOPJ2		;NO, LEAVE
	PUSH	P,CTPOPJ
XPAND:	MOVEI	T1,2000		;GET SET TO EXPAND
	ADDM	T1,CORTOP
	ADDM	T1,CORT1
	ADD	T1,.JBREL	;NEW TOP DESIRED
	CALLI	T1,11		;ASK FOR IT
	JRST	NOCOR		;LOSE BIG
	MOVE	T1,.JBREL
MVCR:	MOVE	T2,-2000(T1)	;MOVE CORE UP
	MOVEM	T2,(T1)
	CAMLE	T1,CORTOP	;ARE WE DONE?
	SOJA	T1,MVCR
CTPOPJ:	POPJ	P,TPOPJ2
IFE FASTFS,<
				;USE FIRST F/S IF SEARCH LIST IS OF FORM
				;DSKA/N,DSKB,...FENCE
FNDFST:
IFN TEMP,<
	PUSH	P,T1		;SAVE SOME ACS
	PUSH	P,T2
	PUSH	P,T3
	PUSH	P,T4>
				;THIS TEST INCASE USE HAS ASSIGNED XXX AS DSK
	MOVEI	T1,T2		;ADDRESS OF DATA BLOCK
	MOVSI	T2,'DSK'	;AND DATA IN IT
	DSKCHR	T1,		;GET FIRST ARG
	JRST	USEDSK		;LOSE SOON
	TLNE	T1,(7B17)	;TESR FOR GENERIC DSK
	JRST	USEDSK		;IT WAS N'T SO USE WHAT USER REQUESTED
	MOVE	T1,[3,,T2]	;SET UP BLOCK
	SETOB	T2,T4		;REQUEST FIRST F/S
	JOBSTR	T1,		;GET FIRST F/S IN SEARCH LIST
	JRST	USEDSK		;LEVEL C
	JUMPL	T4,USEDSK	;SWP BIT SET
	TLNN	T4,200000	;IS NO CREATE SET?
	JRST	USEDSK		;NO, GENERIC DSK WILL USE THIS F/S
	DSKCHR	T1,		;GET FIRST 3 ARGS
	JRST	USEDSK		;SHOULD NEVER HAPPEN BUT ...
	TLNN	T1,740200	;RHB!OFL!HWP!SWP!NNA! SET?
	CAIGE	T3,10		;ANY ROOM? ,TEN SHOULD BE ENOUGH
USEDSK:	MOVSI	T2,'DSK'	;JUST USE DSK
	MOVEM	T2,FSNAME	;STORE FASTEST F/S NAME
IFE TEMP,<
	POPJ	P,		;RETURN>
;IFN TEMP,<JRST TPOPJ4	;RESTORE ACS>
>
TPOPJ4:	POP	P,T4
TPOPJ3:	POP	P,T3
TPOPJ2:	POP	P,T2
TPOPJ1:	POP	P,T1
	POPJ	P,0

RPGSET:	MOVE	T1,[POINT 7,FCOMD]
	MOVEM	T1,DINPT
	MOVEI	FL,RECALF!CMDSN
	JRST	RPGRET

	SUBTTL	INITIALIZATION

STPT:	TDZA	T4,T4		;NORMAL ENTRY
	MOVNI	T4,1		;REENTRY FROM AN EDITOR
IFN PURESW,<
	SETZM	.ZZ		;MUST CLEAR LOW CORE
	MOVE	T1,[XWD .ZZ,.ZZ+1]
	BLT	T1,LOWTOP
	MOVE	T1,[XWD INIDAT,INILOW]
	BLT	T1,INILOW+INILEN
>
;STPT + 6 1/2
IFN FTFIX, <	;[241][VIPCED 01] CONFUSION WITH .RELS
	RESET		;STOP THE WORLD
>
	JUMPL	T4,RPGSET
IFE TENEX,<
	RESCAN	1		;[205] RESET POINTER TO START OF COMMAND>
	  SKIP	2		;[211] SOMETHING IN INPUT BUFFER
	SKIPN	.JBDDT##	;[211] WAIT FOR USER IF DEBUGGING
	GOTO	SYNRR2		;[205] INPUT BUFFER EMPTY
IFN TENEX,<
	OUTSTR	[ASCIZ	/
./]>
	MOVEI	FL,0
	HLRZ	T1,.JBSA	;GET .JBFF (AFTER RESET)
	HRLI	T1,(POINT 7)	;FORM BYTE POINTER
	MOVEM	T1,TTYPT	;SAVE INITIAL TTY POINTER
	MOVEM	T1,DINPT
	SETZM	(T1)		;CLEAR WORD INCASE BIT 35 ON
START1:	INCHWL	T2		;READ A COMMAND CHAR INTO T2
	MOVEI	T4,2(T1)	;[223] GET NEXT ADDRESS PLUS SPARE
	CAMG	T4,.JBREL	;[223] WILL IT FIT
	JRST	.+3		;YES
	CORE	T4,		;NO, GET MORE
	  JRST	NOCOR		;YOU LOSE
	IDPB	T2,T1		;STORE IN DDTINBUF
	TLNN	T1,760000	;THIS WORD FULL?
	SETZM	1(T1)		;YES, CLEAR NEXT INCASE BIT 35 ON
	MOVE	T3,CTBL(T2)	;GET CHARACTER DESCRIPTOR
	TLNN	T3,TERMF	;IS IT A BREAK CHAR?
	JRST	START1		;NO. GO GET MORE.
	MOVEI	T2,177		;MARK END WITH AN EOF FLAG
	SETZM	1(T1)		;MAKE SURE BIT 35 IS OFF
	IDPB	T2,T1
	IDPB	T2,T1		;MAKE SURE
	ADDI	T1,1		;SAVE THE LAST WORD
IFN FTFIX, <	;[241][VIPCED 01] CONFUSION WITH .RELS      ... ALSO
		;[262][VIPCED 04,05] DONT BLOW UP CORE
	HRRZM	T1,.JBFF	;[262] UPDATE .JBFF (NOT WITH MOVEM!)
RPGRET:
>
IFE FTFIX, <	;ORIGINAL CODE PRE-EDIT 241 [VIPCED 01]
	HRLM	T1,.JBSA	;CHANGE .JBFF
RPGRET:	RESET
>
	SKIPA	P,.+1		;SET UP PDL
	IOWD	PDL,PDLB
IFN FASTFS,<
	MOVE	T1,[EXP FASTFS]	;IF GIVEN FASTEST F/S
	MOVEM	T1,FSNAME	;USE IT>
IFE TEMP,<IFE FASTFS,<
	PUSHJ	P,FNDFST	;MAY AS WELL GET IT OVER WITH>>
	MOVNI	T1,1		;STANDARD KA/KI TEST
	AOBJN	T1,.+1
	SKIPN	T1
	AOS	CPU		;KA=0, KI=1
	MOVEI	T1,3
	PJOB	T2,
	IDIVI	T2,12
	ADDI	T3,20		;TO SIXBIT
	LSHC	T3,-6
	SOJG	T1,.-3		;THREE DIGITS
	HLLZM	T4,JOBNAM	;SAVE TO MAKE UNIQUE NAMES
	TLO	T4,404040	;NOW TO ASCII FOR ASCIZ'S
	MOVEI	T1,3		;THREE CHARS
	LSH	T3,1
	LSHC	T3,6		;BRING IN A CHAR
	SOJG	T1,.-2
	DPB	T3,[POINT 21,CRFRDR,27]	;SAVE IN ASCIZ
	DPB	T3,[POINT 21,FCOMD,27]
	DPB	T3,[POINT 21,FCOMD2,27]
	MOVSI	T1,377777	;SET COUNT TO A LARGE NUMBER
	MOVEM	T1,DINCT
	MOVE	IOP,[IOWD <NESTDP+1>*3,IOPD]	;AND IO PDL
	MOVSI	IOPNT,-<NESTDP>	;SET NEXT LIMIT
IFE LINK10,<
	TRO	FL,DOLOD	;WE WANT TO LOAD
>
IFN LINK10,<
	TRO	FL,DOLOD!LINKFL	;LOAD USING LINK-10
>
	MOVEI	T1,FORSW	;ASSUME FORTRAN
	MOVEM	T1,DFPROC	;AS DEFAULT PROCESSOR
	SETZM	LOKNAM		;NO ALTERNATE DEVICE YET
	SETZB	FL2,FL3		;AND NO FLAGS EITHER
	OPEN	LOOK,DSKLK	;GET THE DSK
	JRST	DSKNA
	INBUF	LOOK,2
IFE PURESW,<
	SETZM	FREBUF		;MARK NO FREED BUFFERS
	MOVE	T1,[XWD FREBUF,FREBUF+1]
	BLT	T1,FREBUF+NESTDP>
	MOVE	T1,.JBFF
	MOVEM	T1,SVJFF
	MOVE	T1,.JBREL
	MOVEM	T1,CORTOP
	MOVEM	T1,CORT1
IFE PURESW,<
	SETZM	SAVCHR		;TO START THINGS
>
	HLLZS	.JBERR		;RESET	ERROR COUNT
	MOVSI	SVPT,-NFILE
TESTIT:	PUSHJ	P,SCAN		;SCAN PAST THE COMPILE ETC
	MOVE	T1,ACCUM	;FIND OUT WHICH COMMAND
	MOVNI	T2,1
STPT1:	LSH	T1,6
	LSH	T2,-6
	JUMPN	T1,STPT1
	MOVSI	T1,-COMTLG
	SETOM	NUMAT		;-1 TO NUMBER FOUND
STPT2:	MOVE	T3,COMTAB(T1)
	CAMN	T3,ACCUM	;EXACT MATCH?
	JRST	COMATC		;YES, ALL DONE
	ANDCM	T3,T2
	CAME	T3,ACCUM
	JRST	STPT3		;NO MATCH
	AOS	NUMAT		;POSSIBLE MATCH
	MOVEM	T1,SVIND	;SAVE POINTER
STPT3:	AOBJN	T1,STPT2
	SKIPGE	NUMAT		;WAS THERE AT LEAST ONE
	JRST	UNKERR		;NO
	SKIPE	NUMAT		;BUT NO MORE THAN ONE
	JRST	AMBIGU		;NO, SO COMMAND IS AMBIGUOUS
	MOVE	T1,SVIND	;RESTORE THE POINTER
COMATC:	XCT	COMT2(T1)	;DO THE APPROPRIATE THING
	PUSHJ	P,SCAN		;GET NEXT THING
	TRNN	IOPNT,-1	;IF DOWN A LEVEL ITS OK
	TLNN	CS,TERMF	;OR IF NOTHING SEEN
	SKIP	1
	JRST	COMAT1
	TRNE	FL,EDITF
	JRST	DOEDT1
	JRST	NXFIL1
COMAT1:	MOVE	T1,[POINT 7,FCOMD]	;GENERATE FAKE COMMAND TO READ
	TRNE	FL,EDITF
	MOVE	T1,[POINT 7,FCOMD2]
	MOVEM	T1,DINPT	;SAVE FILE
	TRO	FL,RECALF+CMDSN	;MARK RECALLING FILE, DONT WRITE
	SETZM	SAVCHR		;CLEAR OUT SCANNER
	MOVSI	IOPNT,-<NESTDP+1>	;ALLOW EXTRA NESTING
	PUSHJ	P,SCAN
	TRNE	FL,EDITF
	JRST	DOEDIT
NXFIL:	PUSHJ	P,SCAN
NXFIL1:	MOVSI	SVPT,-NFILE	;SET UP FOR NUMBER OF FILES
	MOVEI	SWCNT,SWBK*5	;SET UP FOR SWITCHES
	MOVE	SWPT,[POINT 7,SWBLK]	;AND POINTER
	SETZM	SWBKL
	SETZM	SWBKB
	SETZM	ONAM
	SETZM	OEXT
	SETZM	OPPN
	SETZB	FL2,LOKNAM	;CLEAR LAST PROCESSOR FLAGS AND SOURCE DEV
IFN SFDSW,<X==0
REPEAT SFDLEN,<SETZM	OSFD+X
X==X+1>
>
	HLL	FL3,FL		;SET TEMP FLAGS FROM PERM FLAGS
	MOVE	T1,[POINT 7,LODSBK]	;SET POINTER TO LOADER
	MOVEM	T1,LODSP		;SWITCH BLOCK
	MOVEI	T1,LODSCT
	MOVEM	T1,LODCTR
	MOVEM	T1,LODCT2	;AND SET COUNT FOR AFTER FILE NAME SWITCHES
	MOVE	T1,[POINT 7,LODSB2]
	MOVEM	T1,LODSP2
	SETZM	BROCNT		;CLEAR OUT THE <> COUNT
	SETZM	SAVSW		;[234] INCASE LAST WAS SAVE FILE
	JRST	ILP0A

	XALL
	SUBTTL	COMMAND DISPATCH

DEFINE COMAND (A,B)<
<SIXBIT /A/>>

COMTAB:	CTABLE
COMTLG==.-COMTAB
DEFINE COMAND (A,B)<
B>

COMT2:	CTABLE

	SALL
DEBUG:	SETOM	DEBFL		;DEFER UNTIL WE SEE FIRST FILE
	POPJ	P,

XCTR:	MOVSI	T2,'/E '
	MOVEM	T2,EXECFL	;DEFER UNTIL WE GET CHANCE TO SEE /LINK
	POPJ	P,

	SUBTTL	MAIN LOOP FOR READING INPUT

ILP0:	PUSHJ	P,SCAN		;GET FIRST "THING"
ILP0A:	CAIN	C,"/"		;CHECK FOR PERM COMPILE SWITCHES
	JRST	COMPS1
	CAIN	C,"%"		;CHECK FOR PERM LOADER FLAGS
	JRST	LOADS1
ILP1A:	TRZ	FL,PROCS	;NO PROCESSOR SWITCHES SEEN YET
	SETOM	GOTPST		;GOT PAST SWITCH SCANNER
ILP1:	PUSHJ	P,GETNAM	;GO GET A FILE NAME
	PUSH	P,C		;INCASE WE NEED TO RESTORE IT
	MOVE	C,LODSP		;EXCHANGE POINTERS
	EXCH	C,LODSP2
	MOVEM	C,LODSP
	MOVE	C,LODCTR
	EXCH	C,LODCT2
	MOVEM	C,LODCTR
	POP	P,C		;RESTORE C
	CAIE	C,"]"		;GET RID OF CLOSING PPN IF LAST WAS ONE
	TRNE	FL,IDF		;ALREADY SCANNED FAR ENOUGH IF NO FILE NAME
ILP2A:	PUSHJ	P,SCAN		;GET THE SPECIAL CHR OR WHATEVER
ILP2:	CAIE	C,","		;DONE WITH THIS SET OF NAMES?
	TLNE	CS,TERMF	;WILL ACCEPT A TERMINATOR
	JRST	SETUP		;GO SET UP THE FILES FOR PROCESSORS
	CAIN	C,"("		;MAYBE SWITCHES TO BE PASSED TO PROCESSORS
	JRST	PROCSW
	CAIN	C,"/"		;OR FOR US
	JRST	COMPSW
	CAIN	C,"%"
	JRST	LOADS2
	CAIN	C,">"
	JRST	ENDBRO		;THIS IS THE END OF A BROKET STRING
	CAIN	C,"="		;MAYBE HE IS SETTING THE OUTPUT NAME
	JRST	SETONM
	CAIN	C,"["		;IS IT PROJECT-PROGRAMMER NUMBER?
	JRST	GETDIR		;YES
	CAIE	C,"+"		;IS THIS A SECOND FILE
	GOTO	SYNERR		;IT SHOULD HAVE BEEN ONE OF THOSE
	AOBJP	SVPT,TMNER	;MAYBE TOO MANY FILES
	MOVE	C,LODSP		;EXCHANGE POINTERS AGAIN
	EXCH	C,LODSP2
	MOVEM	C,LODSP
	MOVE	C,LODCTR
	EXCH	C,LODCT2
	MOVEM	C,LODCTR
	PUSHJ	P,SCAN		;GET NEXT
	CAIE	C,"<"		;IS THIS THE <> CONSTRUCTION
	JRST	ILP0A		;NO
	AOS	BROCNT		;WE ARE ONE DEEPER IN BROKETS
	PUSHSZ==.
IFN SFDSW,<
	X==SFDLEN-1
REPEAT SFDLEN,<
	PUSH	P,OSFD+X
	X==X-1>
	>
	PUSH	P,OPPN
	PUSH	P,OEXT
	PUSH	P,SVPT		;SAVE AWAY ALL THE IMPORTANT INFORMATION
	PUSH	P,SWPT
	PUSH	P,SWCNT
	PUSH	P,LODSP
	PUSH	P,LODSP2
	PUSH	P,LODCTR
	PUSH	P,LODCT2
	PUSH	P,SWBKL
	PUSH	P,SWBKB
	PUSH	P,ONAM
	PUSHSZ==.-PUSHSZ
	JRST	ILP0		;GO FINISH THINGS UP

GETDIR:	PUSHJ	P,GETPP1	;GO GET [PPN]
	JRST	ILP2A		;AND SEE WHAT ELSE WE HAVE

ENDBRO:	PUSHJ	P,SCAN		;GO GET NEST THING (SHOULD BE A ",")
	TLNN	CS,TERMF
	CAIN	C,","
	SKIP	1		;"," AND TERMF ARE OK
	CAIN	C,">"		;SO IS ANOTHER END-BRACKET
	SOSGE	BROCNT		;ALSO ERROR IF NO < WAS SEEN
	GOTO	SYNERR
	SUB	P,[PUSHSZ,,PUSHSZ]	;RESET PDL
	CAIN	C,">"		;END-BRACKET GETS DIFFERENT TREATMENT
	JRST	ENDBRO		;TO COMMA
	JRST	SETUP		;GO TAKE CARE OF THINGS

NXFILP:	SKIPG	BROCNT		;ARE WE DONING BROKETS?
	JRST	NXFIL		;NO, JUST CONTINUE
	MOVE	T1,(P)
	MOVEM	T1,ONAM
	MOVE	T1,-1(P)
	MOVEM	T1,SWBKB
	MOVE	T1,-2(P)
	MOVEM	T1,SWBKL
	MOVE	T1,-3(P)
	MOVEM	T1,LODCT2
	MOVE	T1,-4(P)
	MOVEM	T1,LODCTR
	MOVE	T1,-5(P)
	MOVEM	T1,LODSP2
	MOVE	T1,-6(P)
	MOVEM	T1,LODSP
	MOVE	SWCNT,-7(P)
	MOVE	SWPT,-10(P)
	MOVE	SVPT,-11(P)
	MOVE	T1,-12(P)
	MOVEM	T1,OEXT
	MOVE	T1,-13(P)
	MOVEM	T1,OPPN
IFN SFDSW,<
	X==0
REPEAT SFDLEN,<
	MOVE	T1,SFDLEN-PUSHSZ-X(P)
	MOVEM	T1,OSFD+X
	X==X+1>
	>
	JRST	ILP0
COMPS:	PUSHJ	P,SCAN		;GET THE NAME OF THE SWITCH
	TRNN	FL,IDF		;WAS THERE REALLY AN IDENTIFIER THERE?
	GOTO	SYNERR		;LOSE
	MOVE	T1,ACCUM	;GET ITS SIXBIT
	MOVNI	T2,1		;SET UP MASK
CMP1:	LSH	T1,6
	LSH	T2,-6
	JUMPN	T1,CMP1		;WHEN DONE T2 HAS 0'S FOR ALL CHRS IN T1
	MOVSI	T1,-TBLG	;GET SET TO SCAN FOR NAME
	SETOM	NUMAT		;-1 TO NUMBER FOUND
CMP3:	MOVE	T3,SWTAB(T1)	;GET A SWITCH
	CAMN	T3,ACCUM	;EXACT MATCH?
	JRST	MATCH		;YES, ALL DONE
	ANDCM	T3,T2		;0 OUT UNNECESSARY CHRS
	CAME	T3,ACCUM
	JRST	CMP2		;NO MATCH
	AOS	NUMAT		;POSSIBLE MATCH
	MOVEM	T1,SVIND	;SAVE POINTER
CMP2:	AOBJN	T1,CMP3
	SKIPGE	NUMAT		;WAS THERE AT LEAST ONE MATCH
	JRST	UNRECS
	SKIPE	NUMAT		;BUT NO MORE THAN ONE?
	JRST	AMBIGU		;NO, SO COMMAND IS AMBIGUOUS
	MOVE	T1,SVIND	;RESTORE THE POINTER
MATCH:	HRRZ	T1,T1		;INDEX ONLY
	CAIL	T1,ASWTAB-SWTAB	;IN ADDRESS TABLE?
	JRST	[MOVE	T1,SWTAB2(T1)	;YES, LOAD UP JUMP ADDRESS
		 JRST	(T1)]		;GO TO ROUTINE (LEFT HALF MAY BE SET)
	CAIL	T1,PSWTAB-SWTAB	;IN PROCESSOR TABLE?
	JRST	PMATCH		;YES, USE OTHER FLAGS
	MOVE	T1,SWTAB2(T1)	;NO, GET ACTION
SMATCH:	TLZ	FL3,(T1)	;[221] TURN OFF SWITCHES AS NEEDED
	TRNE	FL,PERF		;PERMANENT?
	TLZ	FL,(T1)		;SET THAT TOO
	MOVSS	T1
	TLO	FL3,(T1)	;AND TURN ON OTHERS
	TRNE	FL,PERF
	TLO	FL,(T1)
	ANDI	T1,DEVSWS	;SEE IF FIRST DEVICE SWITCH
	SKIPN	LODDEV		;AND IF SO
	HRLOM	T1,LODDEV	;SAVE AS LOADER DEVICE (RH SET TO -1)
	JRST	SCAN		;GET SOMETHING ELSE

PMATCH:	MOVE	T1,SWTAB2(T1)	;GET SWITCHES
	TRZ	FL2,(T1)	;TURN OFF LOCAL PROCESSOR
	MOVSS	T1
	TRO	FL2,(T1)	;TURN IT ON
	TRNE	FL,PERF
	HRRZM	T1,DFPROC	;CHANGE DEFAULT PROCESSOR TO
	JRST	SCAN

	XALL
DEFINE X (A,B,C,D,E,F,G)<
SWITCH A,<XWD B'SW,ALPROC>>

DEFINE SWITCH (A,B)<
<	SIXBIT /A/>>

SWTAB:	STABLE
PSWTAB:	PTABLE
ASWTAB:	ATABLE
TBLG==.-SWTAB
DEFINE SWITCH (A,B)<
	B>

SWTAB2:	STABLE
	PTABLE
	ATABLE
;HERE ON "/" AFTER A FILE NAME

COMPSW:	TRZ	FL,PERF		;DOING TEMP
	PUSHJ	P,COMPS
	JRST	ILP2

;HERE ON "/" AS FIRST CHAR OF IDENT, I.E. PERM SW

COMPS1:	TRO	FL,PERF
	PUSHJ	P,COMPS
	TLNE	CS,TERMF	;CHECK FOR TERMINATOR
	JRST	SWTERM		;YES, EITHER ERROR OR READ SVC FILE
	CAIE	C,","		;IS NEXT CHAR. A COMMA
	JRST	ILP0A
	JRST	ILP0		;YES,SO SCAN FOR CHAR. AFTER IT

SWTERM:	SKIPN	GOTPST		;IF WE GOT PAST SWITCH SCANNER
	TRNE	FL,RECALF!CMDSN	;OR ALREADY READING SVC FILE
	JRST	ILP0A		;THEN ITS AN ERROR
	JRST	COMAT1		;NO, SO READ SVC FILE
SETMPL:	TRNN	FL,DOLOD	;OR NOT LOADING?
	SKIPA	T3,[-1]		;DON'T STORE ANYTHING
	MOVEI	T3,CHNLOD
	MOVE	T2,['(F1MG)']
	TRNN	FL,LINKFL	;LINK-10
	JRST	SETMP		;NO
	MOVEI	T1,","		;MIGHT NEED A SEPARATOR
	SKIPE	TMPCHN(T3)	;UNLESS NOTHING OUTPUT YET
	PUSHJ	P,TMPOUT	;SEP FROM PREV FILE SPEC
	MOVE	T2,['/CONTE']	;USE NEW SWITCHES
	PUSHJ	P,OUTSIX
	MOVE	T2,[':LOCAL']
	PUSHJ	P,OUTSIX
	PUSHJ	P,OUTSPC	;AND PUT /GO IN MAPSW
	JRST	LNKMAP		;NOW FOR /MAP

SETMAP:	TRNN	FL,DOLOD	;OR NOT LOADING?
	SKIPA	T3,[-1]		;DON'T STORE ANYTHING
	MOVEI	T3,CHNLOD
	MOVE	T2,['(FMG) ']
	TRNN	FL,LINKFL	;LINK-10
	JRST	SETMP		;NO
	MOVEI	T1,","		;MIGHT NEED A SEPARATOR
	SKIPE	TMPCHN(T3)	;UNLESS NOTHING OUTPUT YET
	PUSHJ	P,TMPOUT	;SEP FROM PREV FILE SPEC
LNKMAP:	MOVSI	T2,'/G '	;JUST TO TERMINATE
SETMP:	SKIPN	MAPSW		;ALREADY SET?
	MOVEM	T2,MAPSW	;STORE AND USE AS FLAG
	TRNN	FL,LINKFL	;NOTHING TO OUTPUT YET
	PUSHJ	P,OUCRLF
	PUSHJ	P,SCAN		;LOOK AT NEXT CHAR.
	CAIE	C,":"		;IS THIS A KEY WORD SPECIFICATION
	JRST	SETMP1		;NO
	AOBJP	SVPT,NESTTD	;MAKE SPACE FOR FIELDS
;SETMP + 7 1/2
IFN FTFIX, <	;[302][VIPCED 05] SWITCH ARGS SHOULD NOT STICK
	TRO	FL, F.STKY
>
	PUSHJ	P,SCANAM	;YES, SO GO GET SPECIFICATIONS
IFN FTFIX, <	TRZ	FL, F.STKY	;[302]	>
	SKIPE	T2,SVDEV(SVPT)	;A DEVICE SPECIFIED?
	PUSHJ	P,OUTDEV	;YES
	SKIPE	T2,SVNAM(SVPT)	;NAME SPECIFIED?
	JRST	.+4		;YES
	TRNE	FL,LINKFL	;NO, BUT LINK-10 MAKES ITS OWN
	JRST	.+3		;SO DON'T DO IT HERE
	MOVSI	T2,'MAP'	;DEFAULT NAME
	PUSHJ	P,OUTSIX	;OUTPUT IT
	SKIPE	T2,SVEXT(SVPT)	;AN EXTENSION ALSO?
	PUSHJ	P,OUTEXT	;YES
	SUB	SVPT,[1,,1]	;BACK TO WHERE IT WAS
	CAIN	C,"/"		;IF WE ENDED WITH A SWITCH
	TRNE	FL,IDF		;AND HAVE N'T YET SEEN IT
	PUSHJ	P,SCAN
	TRNN	FL,LINKFL	;IF LINK-10 DON'T FORGET /MAP
	JRST	SETMP2

SETMP1:	MOVSI	T2,'MAP'	;DEFAULT NAME
	TRNE	FL,LINKFL	;LINK-10?
	MOVSI	T2,'/M '	;YES
	PUSHJ	P,OUTSIX
	TRNE	FL,LINKFL
	PUSHJ	P,OUTSPC
SETMP2:	MOVEI	T1,"="		;NEW STANDARD
	PUSHJ	P,TMPOUT
	TRZ	FL,LODOUT	;DO NOT NEED A COMMA FOR NEXT FILE
	POPJ	P,

SETDDT:	SETOM	DDTFL
	PJRST	SCAN		;RETURN VIA SCAN

FORSE:	MOVSI	T1,'/1F'
	TRNE	FL,LINKFL	;LINK-10?
	MOVE	T1,['/FORSE']	;YES
	JRST	SETOTS		;STORE RESULT

FOROTS:	MOVSI	T1,'/2F'
	TRNE	FL,LINKFL	;LINK-10?
	MOVE	T1,['/FOROT']	;YES
SETOTS:	MOVEM	T1,FORLIB
	PJRST	SCAN

LOADIT:	TRZA	FL,LINKFL	;MAKE SURE NOT SET
LINKIT:	TRO	FL,LINKFL	;WANTS LINK-10
	SKIPN	TMPCHN+CHNLOD	;MAKE SURE NO LOADER/LINK-10 OUTPUT
	SKIPE	FORLIB		;OR SPECIAL SWITCHES
	JRST	LLCERR		;YES, ERROR
	SKIPE	MAPSW
	JRST	LLCERR
	MOVEI	T1,LODSCT	;OR LOAD SWITCHES STORED
	CAMG	T1,LODCTR	;FOR FUTURE
	CAMLE	T1,LODCT2	;BUT NOT YET OUTPUT
	JRST	LLCERR		;YES, BOMB USER
	PJRST	SCAN

SETDEB:	PUSH	P,SWPT		;[221] SAVE ACCS INCASE USED
	PUSH	P,SWCNT		;[221] ...
	MOVEI	SWCNT,DEBSIZ*7-1	;[221] NO. OF CHARS ALLOWED TO STOR
	MOVE	SWPT,[POINT 7,DEBPRM]	;[221] WHERE IF PERM?
	TRNN	FL,PERF		;[221] WAS IT?
	HRRI	SWPT,DEBTMP	;[221] NO, BAD GUESS
	SETZM	(SWPT)		;[221] INCASE NO SWITCHES
	AOS	(SWPT)		;[221] BUT MARK IT SEEN
	PUSHJ	P,SCANS		;[221] LOOK AT NEXT CHAR
	CAIE	C,":"		;[221] VALUE SPECIFED
	JRST	RETDB1		;[221] NO
	SETZM	SAVCHR		;[221] GET RID OF ":"
	SETZM	PARLVL		;[221] INCASE WE SEE ENCLOSED LIST
DEBLUP:	PUSHJ	P,GETCH		;[221] GET NEXT CHAR
	TLNE	CS,TERMF	;[221] TERMINATOR?
	JRST	RETDEB		;[221] YES, END
	CAIN	C,"("		;[221] SWITCH LIST?
	AOS	CS,PARLVL	;[221] COUNT UP, AND FAKE OUT CS
	CAIN	C,")"		;[221] END OF SWITCH LIST?
	JRST	[SOSLE	CS,PARLVL	;[221] BACK TO 0 LEVEL
		JRST	OUTDEB		;[221] NOT YET, JUST OUTPUT IT
		PUSHJ	P,STRDEB	;[221] OUTPUT IT
		JRST	RETDEB]		;[221] AND GIVE UP
	SKIPN	PARLVL		;[221] IF NESTED PASS ANYTHING
	JUMPLE	CS,RETDEB	;[221] OTHERWISE GIVE UP ON DELIMITER
OUTDEB:	PUSHJ	P,STRDEB	;[221] OUTPUT THIS CHAR
	JRST	DEBLUP		;[221] LOOP

RETDEB:	MOVEM	CS,SAVCHR	;[221] REPEAT DELIMITER
	SETZ	C,		;[221] MAKE SURE TERMINATED
	IDPB	C,SWPT		;[221] ALWAYS ENOUGH SPACE
RETDB1:	MOVSI	T1,DEBUGSW	;[221] SET SWITCH
	POP	P,SWCNT		;[221] RESTORE
	POP	P,SWPT		;[221] ...
	JRST	SMATCH		;[221] BY NORMAL CODE

STRDEB:	SOJLE	SWCNT,ETMS	;[221] NOT ENOUGH ROOM
	IDPB	C,SWPT		;[221] STORE CHAR
	POPJ	P,		;[221] RETURN

FORDDT:	TLO	FL,DEBUGSW	;[221] SET PERM FLAG
	TLO	FL3,DEBUGSW	;[221] AND TEMP
	SETZM	DEBPRM		;[221] USE DEFAULT
	SETZM	DEBTMP		;[221] ...
	MOVE	T1,['FORDDT']	;[221] NAME OF DEBUGGER
	MOVEM	T1,DDTFL	;[221] PRE-EMPT NORMAL TESTS
	PJRST	SCAN		;[221] RETURN
SAVE:	SKIPA	T2,['/SAVE ']	;[234]
SSAVE:	MOVE	T2,['/SSAVE']	;[234]
	MOVEM	T2,SAVSW	;[234] SAVE WHICH SWITCH
	TRNN	FL,DOLOD	;[234] ARE WE LOADING?
	SKIPA	T3,[-1]		;[234] NO, DON'T CREATE TMP FILE
	MOVEI	T3,CHNLOD	;[234] YES, GET CHAN NO.
	TRNN	FL,LINKFL	;[234] ONLY WORKS FOR LINK-10
	GOTO	LLCERR		;[234] WARN USER IF LOADER SPECIFIED
	PJRST	SCAN		;[234]
PROCSW:	TROE	FL,PROCS	;HAVE WE ALREADY SEEN SOME?
	GOTO	SYNERR		;YES, I DEFINE THIS AS ILLEGAL
	MOVEM	SWPT,SWBKS(SVPT)	;SAVE BYTE POINTER TO NEW ONES
	TRZ	FL,PCM1!PCM2	;NO COMMAS YET
	SETZM	PARLVL		;[221] START AT LEVEL 0 (SEEN 1)
PROCS1:	PUSHJ	P,GETCH		;GIVE ME A CHARACTER
	CAIN	C,")"		;DONE?
	JRST	[SOSGE	PARLVL		;[221] BACK TO LEVEL -1 YET?
		JRST	ESTR		;[221] YES
		JRST	PROCS2]		;[221] NO, STORE ")"

	CAIN	C,","		;POSSIBLY COMMA
	JRST	[SKIPG	PARLVL		;[221] SEE IF NESTED
		JRST	PCCOM		;[221] AT TOP LEVEL, GO TAKE GOOD CARE OF IT
		JRST	PROCS2]		;[221] YES, STORE IT
	CAIE	C,":"		;[221] ALLOW ":" FOR SWITCH VALUES
	CAIN	C," "		;ALLOW SPACE FOR MULTIPLE SWITCHES
	JRST	PROCS2		;TO FORTRAN-10
IFN FQZSIM,<
	CAIN	C,"-"		;ALLOW MINUS FOR SWITCHES TO SIMULA
	JRST	PROCS2
	>
IFN PASCAL< CAIN	C,"/"		;[252] IFI-HH%06-04-76
	    JRST	PROCS2>		;[252] IFI-HH%06-04-76
	CAIN	C,"("		;[221] ALLOW "(" TO ENCLOSE SWITCH VALUES
	AOS	CS,PARLVL	;[221] COUNT LEVEL UP AND FAKE CS
IFE DEBSW,<
	JUMPLE	CS,SYNERR	;NOT ANUMBER OR LETTER, HE LOSES
	>
IFN DEBSW,<
	SKIPG	CS		;SAME CODE BUT LONGER
	GOTO	SYNERR
	>
PROCS2:	IDPB	C,SWPT		;SAVE IT AWAY
	SOJG	SWCNT,PROCS1	;NEXT PLEASE
	JRST	ETMS		;TOO MANY SWITCHES FOR SPACE RESERVED

PCCOM:	TROE	FL,PCM1		;IS THIS THE FIRST OR SECOND COMMA
	JRST	NOTBIN		;NOT FIRST, TRY FOR SECOND
	CAMN	SWPT,SWBKS(SVPT)	;WAS ANYTHING STORED?
	JRST	PROCS1		;NO, JUST IGNORE
	SKIPE	SWBKB		;ARE THERE ALREADY BINARY SWITCHES
	GOTO	SYNERR		;YES, MORE NOT ALLOWED
	MOVE	T1,SWBKS(SVPT)	;GIVE THIS TO BINARY
	MOVEM	T1,SWBKB
COMCOM:	MOVEI	C,0		;MARK END OF STRING
	IDPB	C,SWPT
	SOJLE	SWCNT,ETMS	;HAVE WE RUN OUT?
	MOVEM	SWPT,SWBKS(SVPT)	;AND A NEW ONE FOR SRC
	JRST	PROCS1
NOTBIN:	TROE	FL,PCM2		;SECOND ALREADY SEEN?
	GOTO	SYNERR		;YES, THREE NOT PERMITTED
	CAMN	SWPT,SWBKS(SVPT)	;ANYTHING THERE?
	JRST	PROCS1		;HE WOULD HAVE BEEN JUST AS WELL WITHOUT IT
	SKIPE	SWBKL		;ALREADY LIST SWITCHES?
	GOTO	SYNERR		;YES, HE LOSES
	MOVE	T1,SWBKS(SVPT)	;AND GIVE TO CORRECT PERSON
	MOVEM	T1,SWBKL
	JRST	COMCOM
ESTR:	CAMN	SWPT,SWBKS(SVPT)	;WAS ANYTHING STORED?
	JRST	[SETZM SWBKS(SVPT)	;NO, ZERO IT
		 JRST ILP2A]
	MOVEI	C,0
	IDPB	C,SWPT		;MARK
	SOJLE	SWCNT,ETMS
	JRST	ILP2A		;NEXT
SETONM:	SKIPE	ONAM		;OUTPUT NAME GIVEN BEFORE?
	SKIPLE	BROCNT		;BUT OK IN BROKETS
	TRNE	FL,PROCS	;PROCESSOR SWITCHES NOT PERMITTED HERE
	GOTO	SYNERR
	MOVE	T1,SVNAM(SVPT)	;GET THE NAME
	MOVEM	T1,ONAM		;AND SAVE IT AWAY
	MOVE	T1,SVEXT(SVPT)
	MOVEM	T1,OEXT
	MOVE	T1,SVPPN(SVPT)
	MOVEM	T1,OPPN
	MOVE	T1,SVDEV(SVPT)
	MOVEM	T1,ODEV		;SAVE OUTPUT DEVICE
;SETONM + 13 1/2
IFN FTFIX, <	;[267][VIPCED 05] UNSTICK DEVICE AT =
	SETZM	SVDEVV		;OKAY, DONE WITH STICKY-NESS
>
IFN SFDSW,<
	X==<Y==0>
REPEAT SFDLEN,<
	MOVE	T1,SVSFD+X(SVPT)
	MOVEM	T1,OSFD+Y
	X==X+NFILE
	Y==Y+1
	>
	>
	PUSHJ	P,SCAN
	JRST	ILP1

LOADS1:	PUSHJ	P,LODS1
	JRST	ILP0
LOADS2:	PUSH	P,[ILP2A]	;SET RETURN POINT
LODS1:	PUSHJ	P,GETCH		;NEXT CHR
	CAIG	C," "		;NON-PRINTING CHARS. NOT ALLOWED
	GOTO	SYNERR		;THIS REALLY IS A BUG
	TRNE	FL,LINKFL	;LINK-10?
	JRST	LODS2		;YES, SPECIAL HANDLING
	CAIN	C,"&"		; SYMBOLIC SWITCH
	JRST	LODSWS
	CAIN	C,"-"		;SPECIAL CHECK FOR -SWITCH
LODS1A:	TLO	CS,NUMF		;PRETEND ITS A NUMBER
	IDPB	C,LODSP		;SAVE IT
	SOSG	LODCTR		;CHECK SIZE
	JRST	ETMS
	TLNN	CS,NUMF		;A NUMBER
	POPJ	P,		;NO, DONE
	JRST	LODS1		;YES, THEY GET PASSED ON

;HERE FOR SYMBOLIC SWITCHES %&SYMBOL&SWITCH

LODSWS:	IDPB	C,LODSP
	SOSG	LODCTR
	JRST	ETMS
	PUSHJ	P,GETCH
	CAIE	C,"&"
	JRST	LODSWS
	JRST	LODS1A

;HERE FOR LINK-10 SWITCHES
;THEY ARE IN FORM %'SWITCH:ARG'

LODS2:	PUSH	P,C		;SAVE TERMINATOR
	CAIL	C,"0"		;LOOK FOR POTENTIALLY DANGEROUS
	CAILE	C,"9"		;SWITCH DELIMITERS
	CAIA			;I.E. THOSE THAT COULD BE
	JRST	LODS4		;LOADER SINGLE CHAR SWITCHES
	CAIL	C,"A"		;WARN USER
	CAILE	C,"Z"		;BUT CONTINUE
	CAIA			;REMOVE AT SOME FUTURE DATA
	JRST	LODS4		;WHEN LINK-10 HAS REPLACED LOADER
	CAIL	C,"a"
	CAILE	C,"z"
	CAIA
	CAIE	C,"-"		;DONT FORGET MINUS
	CAIN	C,"&"		;OR SYMBOLIC SWITCH
	JRST	LODS4
LODS3:	PUSHJ	P,GETCH		;NEXT CHR
	CAIG	C," "		;NON-PRINTING CHARS. NOT ALLOWED
	GOTO	SYNERR		;THIS REALLY IS A BUG
	CAMN	C,0(P)		;TERMINATOR?
	JRST	LODS5		;YES, STORE BLANK AND ZERO
	IDPB	C,LODSP		;SAVE IT
	SOSG	LODCTR		;CHECK SIZE
	JRST	ETMS
	JRST	LODS3		;LOOP FOR MORE

;HERE TO WARN USER INCASE CTL FILE CONTAINS LOADER SWITCHES

LODS4:	STRING	[ASCIZ	/%CMLILS Illegal LINK-10 switch delimiter: /]
	OUTCHR	C
	STRING	[ASCIZ	\
\]
	JRST	LODS3

;HERE TO TERMINATE THIS SWITCH
;MARK END WITH BLANK
;STORE ZERO IN CASE END (BUT DON'T INCREMENT BYTE POINTER OR COUNT)

LODS5:	MOVEI	C," "		;NEED TO OUTPUT A SPACE
	IDPB	C,LODSP		;SO STORE IT
	SOSG	LODCTR		;MAKE SURE IT FITS
	JRST	ETMS		;NO
	SETZ	C,		;NULL TERMINATOR
	MOVEM	T2,0(P)		;JUST INCASE
	MOVE	T2,LODSP	;GET BYTE POINTER
	IDPB	C,T2		;WILL GET OVERWRITTEN IF MORE SWITCHES
	MOVE	T2,LODCTR	;MAKE SURE NULL FITTED
	SOJLE	T2,ETMS		;INCASE NO MORE SWITCHES
	POP	P,T2		;RESTORE T2, GET STACK BACK IN SHAPE
	POPJ	P,		;FINISHED
SETUP:	MOVE	T1,SVNAM(SVPT)	;LAST FILE NAME
	SKIPN	ONAM		;SET ONAM IF NOT ALREADY
	MOVEM	T1,ONAM
;SETUP + 2
IFN FTFIX, <	;[240][VIPCED 03] 1/3 SEC. TIME CHECKS
	SETOM	EXTEND		;HERE TO CHECK IF ALL DEVICES ARE DISKS
				;SO CAN USE EXTENDED LOOKUPS FOR MORE
				;ACCURATE CREATION TIME CHECKS
	SKIPN	T1,ODEV		;OUTPUT DEVICE SPECIFIED?
	JRST	.+4		;NO, ASSUME DISK
	 DEVCHR	T1,		;FIND OUT WHAT IT IS
	 TLNN	T1,DV.DSK	;A DISK?
	  JRST	ONSET1		;NO
	MOVSI	T1,-NFILE	;SETUP TO CHECK ALL INPUTS
DSKLUP:	SKIPN	T2,SVDEV(T1)	;DEVICE GIVEN?
	JRST	.+4		;NO, ASSUME A DISK
	 DEVCHR	T2,		;WHAT IS IT?
	 TLNN	T2,DV.DSK	;A DISK?
	 JRST	ONSET1		;NOPE
	AOBJN	T1,DSKLUP	;LOOP FOR ALL DEVICES
	JRST	ONSET		;THEY'RE ALL DISKS!

ONSET1:	SETZM	EXTEND		;THEY'RE NOT ALL DISKS
>
ONSET:	TRZ	FL,NODAT	;WE HAVE NOT SEEN A DIFFERENT DEVICE
	SETZM	SDAT		;LATEST DATE
	SETZM	STIM		;AND LATEST TIME
	TLZ	FL2,-1		;NO PROCESSOR YET
	SKIPE	SAVSW		;[234] IS THIS A SAVE FILE REQUEST?
	TLOA	FL2,RELSW	;[234] YES, PRETEND ITS A REL FOR NOW
	PUSHJ	P,GETPRO	;GO FIND DATE AND PROCESSOR
IFN MANTIS,<
	SKIPE	DEBFL		;IF NOT DEBUGGING
	SKIPE	DDTFL		;OR EXPLICIT DDT REQUEST
	JRST	ONSET1		;DON'T WANT MANTIS
	TLNN	FL2,FORSW	;FIRST PROG F4?
	JRST	ONSET1		;NO, THEN NOT MANTIS BY DEFAULT
	TLNN	FL3,NOMANTSW	;WANT MANTIS FOR THIS PROG?
	TLO	FL3,MANTSW	;YES
	TLO	FL,MANTSW	;AND FOR WHOLE
ONSET1:>
IFN PASCAL< TLNE FL2,PASSW	;FORCE LISTING 
	    TLO  FL3,LISTSW>	;FOR PASCAL
	TLNE	FL2,RELSW	;IF A REL FILE
	JRST	LDREL		;GO LOAD IT NOW
	TRNE	FL,NODAT	;NO DATES ON OTHER DEVICES
	JRST	LBCOMP		;BUT CHECK FOR /LIB FIRST
	TLC	FL3,NOBINSW!LISTSW	;INVERT /NOBIN/LIST SWITCHES
	TLCE	FL3,NOBINSW!LISTSW	;TEST FOR BOTH ON
	TLNE	FL3,COMPLS	;DO WE ALWAYS WANT TO COMPILE?
	JRST	DOCOMP		;YES, COMBINATION FORCES COMPILE
IFN SFDSW,<
	MOVE	T1,SVPPN(SVPT)		;GET PPN
	SKIPN	SVSFD(SVPT)		;ANY SFD'S SPECIFIED?
	JRST	REREL0		;NO
	MOVEM	T1,LSFDPP	;STORE PPN
	X==<Y==0>		;INITIAL CONDITION
REPEAT SFDLEN,<
	MOVE	T1,SVSFD+X(SVPT)
	MOVEM	T1,LSFD+Y
	X==X+NFILE
	Y==Y+1
	>
	SKIPA	T1,[EXP LSFDAD]	;POINT TO SFD BLOCK IN LPPN>
IFE SFDSW,<
	SKIPA	T1,SVPPN(SVPT)	;LOOK ON THIS AREA FOR REL
	>
REREL:	SETZ	T1,
REREL0:	MOVEM	T1,LPPN		;BUT ONLY FIRST TIME
	MOVEM	T1,SVRPP	;SO WE KNOW IF SECOND TIME
	MOVE	T1,ONAM		;SEE IF REL IS THERE
	MOVEM	T1,LNAM
	MOVE	T1,FL2		;[212] GET PROCESSOR FLAGS
	JFFO	T1,.+1		;[212] GET PROCESSOR INDEX INTO T2
	SKIPN	T1,OEXT		;[212] OUTPUT EXTENSION ALREADY SPECIFIED?
	SKIPE	T1,INTEXT(T2)	;[212] NO, GET FROM TABLE
	SKIPN	T1		;[212] HAVE WE GOT SOMETHING YET?
	MOVSI	T1,'REL'	;[212] NO USE REL
	MOVEM	T1,LEXT
;REREL0 + 12 1/2
IFN FTFIX, <	;[240][VIPCED 03] 1/3 SEC. TIME CHECKS
	SKIPE	EXTEND		;ALL DEVICES DISKS?
	 JRST	EREL		;YES, DO EXTENDED LOOKUP
>
	LOOKUP	LOOK,LNAM	;IS IT THERE
	JRST	LBCOMP		;NO, WE MUST RECOMPILE
IFN TENEX,<			;GET EXACT TIMES IN TENEX SYSTEM
	PUSHJ	P,GDTLOK	;GET DATE AND TIME OF LOOK CHANNEL
	JRST	REREL2		;NOT IN THE COMPATIBILITY
	HLRZ	T2,LDAT		;OK. LH LDAT IS DATE IN TENEX FORMAT
	CAMGE	T2,SDAT
	JRST	DOCOMP		;COMPILE THIS
	CAME	T2,SDAT		;SAME DATE?
	JRST	NOCOM1		;NO. DON'T COMPILE
	HRRZ	T2,LDAT		;GET TIME IN SECONDS
	CAMLE	T2,STIM		;NEWER?
	JRST	NOCOM1		;SOURCE OLDER
	JRST	DOCOMP		;SOURCE NEWER OR EQUAL

GDTLOK:	PUSH	P,T1		;SAVE SOME ACS
	PUSH	P,T2
	PUSH	P,T3
	MOVEI	T1,LOOK		;CHANNEL
	CALL	T1,['FILJFN']	;TENEX HANDLE OF THIS CHANNEL
	JRST	TPOPJ3		;NOT FOUND. NOT IN PA1050?
	PUSH	P,T1		;SAVE JFN
	DVCHR			;GET DEVICE BITS
	POP	P,T1		;RESTORE JFN
	TLNE	T2,777		;ON DISK?
	JRST	TPOPJ3		;NO.
	MOVE	T2,[1,,14]	;POINT TO THE WRITE DATE AND TIME
	MOVEI	T3,LDAT		;PUT IT IN LOOKUP BLK DATE WRD
	GTFDB			;DO IT
	AOS	-3(P)		;SUCCESS RETURN
	JRST	TPOPJ3		;RESTORE 3 TEMPS AND RETURN
	>
REREL2:	LDB	T2,[POINT 12,LDAT,35]	;GET LOW 12 BITS OF DATE
	LDB	T1,[POINT 3,LEXT,20]	;GET HIGH 3 BITS OF DATE
	DPB	T1,[POINT 3,T2,23]	;MERGE THE TWO PARTS
	CAMGE	T2,SDAT		;EARLIER
	JRST	DOCOMP		;YES, COMPILE
	CAME	T2,SDAT		;SAME?
	JRST	NOCOM1		;NO, ALL OK
	LDB	T2,[POINT 11,LDAT,23]	;YES, GET TIME
	CAMG	T2,STIM		;LATER?
	JRST	DOCOMP		;NO, RECOMPILE

NOCOM1:	TLNN	FL2,FORSW	;FORTRAN PROG
	JRST	NOCOM3		;NO, SKIP CHECKING REL FILE
	PUSHJ	P,CHKREL	;SEE WHAT TYPE OF REL FILE WE HAVE
	JRST	DOCOMP		;ERROR, SO RECOMPILE
NOCOM3:	SKIPN	SVRPP		;DID WE FIND THE REL FILE SOMEWHERE ELSE?
	JRST	NOCOMP		;NO
	MOVE	T1,OEXT		;MAKE SOURCE EXT = OUTPUT EXT
				;**;[172],NOCOM3+3,HPW,10/25/73
	MOVEM	T1,SVEXT	;[172]
	TLO	FL2,RELSW	;AND PRETEND HE SAID .REL
	JRST	NOCOMP

IFN FTFIX, <	;[240][VIPCED 03] 1/3 SEC TIME CHECKS
EREL:	MOVEI	T2,.RBTIM	;HERE IF DOING EXTENDED LOOKUP.
	MOVEM	T2,EBLK		;SET UP EXTENDED LOOKUP BLOCK.
	MOVE	T2,LPPN
	MOVEM	T2,EPPN
	LOOKUP	LOOK,EBLK	;DO EXTENDED LOOKUP
	 JRST	LBCOMP		;NOT THERE, TOO BAD
	MOVE	T2,EBLK+.RBTIM	;GET CREATION TIME
	CAMG	T2,STIM		;COMPILE?
	 JRST	DOCOMP		;YES.
	JRST	NOCOM1		;NO, UNLESS BAD REL FILE.
>
DOCOMP:	SKIPE	SVRPP		;DID WE LOOK ON THIS AREA?
	JRST	REREL		;NO, TRY IT
	MOVE	T1,FL2		;GET PROCESSOR FLAGS
	JFFO	T1,.+1		;GET COUNT IN T2
	MOVEM	T2,PCNUM	;SAVE IT FOR LATER
	MOVE	T3,T2		;GET THE # OF THE OUTPUT ROUTINE
	TLNE	FL3,NOBINSW	;REL FILE NOT WANTED?
	JRST	[MOVEI	T1,"-"		;NO, LOAD T1
		 CAIN	T3,CHNCBL	;IN CASE THIS IS COBOL
		 PUSHJ	P,TMPOUT	;WHAT A LOSER COBOL IS
		 JRST	DOCOM1]		;BUT LIST ANY RELEVANT SWITCHES
;DOCOMP + 7 1/2
IFN FTFIX, <	;[244][VIPCED 03] PASS USERS OUTPUT DEVICE SPEC
	SKIPE	T2,ODEV		;DID HE SPECIFY A DEVICE?
	 PUSHJ	P,OUTDEV	;YES, USE IT.
>
	MOVE	T2,ONAM		;START PUTTING OUT
	PUSHJ	P,OUTSIX
	SKIPN	T2,OEXT		;[212] EXTENSION EXPLICITLY GIVEN?
	SKIPE	T2,INTEXT(T3)	;[212] NO, SEE IF DEFAULT IS NOT REL
	PUSHJ	P,OUTEXT	;YES
IFN SFDSW,<
	SKIPN	OPPN		;OUTPUT PPN GIVEN?
	SKIPE	OSFD		;OR SFD?
	>
IFE SFDSW,<
	SKIPE	OPPN		;OUTPUT PPN?
	>
	PUSHJ	P,SFDPPN	;YES
IFN MANTIS,<
	TLNN	FL2,FORSW	;FORTRAN PROGRAM?
	JRST	DOCOM1		;NO, CERTAINLY DON'T WANT MANTIS
	MOVSI	T2,'/D '	;ASSUME WE DO
	TLNE	FL3,MANTSW	;WELL DO WE?
	PUSHJ	P,OUTSIX	;YES, OUTPUT DEBUG SWITCH>
DOCOM1:	SKIPE	T2,SWBKB	;ARE THERE SWITCHES
	PUSHJ	P,OUTSW		;YES, OUTPUT THEM
	TLNE	FL2,FORSW	;FORTRAN?
IFE DFORTRAN,<			;YES, BUT IS IT F-10
	TLNN	FL3,F10SW	;DEFINITELY?>
IFN DFORTRAN,<
	TLNE	FL3,F40SW	;DEFINITELY NOT>
	JRST	DOCOM2		;WE DONT WANT FORTRAN-10
	TLNN	FL3,CPUSW	;YES, BUT DO WE CARE WHICH TYPE OF CPU?
	JRST	DOCOMA		;NO, TAKE DEFAULT
	MOVE	T2,['/KA10 ']
	TLNN	FL3,KA10SW	;GUESS RIGHT?
	HRLI	T2,'/KI'	;NO
	PUSHJ	P,OUTSIX
DOCOMA:	TLNN	FL3,OPTSW!NOPTSW	;OPTIMIZER INFO?
	JRST	DOCOMD		;NO, TAKE DEFAULT
	MOVE	T2,['/OPT  ']
	TLNN	FL3,OPTSW	;OPTIMIZE?
	MOVE	T2,['/NOPT ']	;NO
	PUSHJ	P,OUTSIX
DOCOMD:	TLNN	FL3,DEBUGSW	;[221] /DEBUG SEEN?
	JRST	DOCOM2		;[221] NO
	MOVE	T2,['/DEBUG']	;[221] OUTPUT SWITCH
	PUSHJ	P,OUTSIX	;[221]
	SKIPE	T2,DEBPRM	;[221] IF ANY PERM SWITCHES
	MOVE	T2,[POINT 7,DEBPRM]	;[221] LOAD POINTER TO THEM
	SKIPE	DEBTMP		;[221] BUT IF TEMP ONES
	MOVE	T2,[POINT 7,DEBTMP]	;[221] USE THEM
	JUMPE	T2,DOCOM2	;[221] DONE IF NO ARGS
	MOVE	T1,(T2)		;[221] BUT MIGHT JUST BE MARKER
	SOJE	T1,DOCOM2	;[221] IT WAS
	MOVEI	T1,":"		;[221] DELIMITER
	PUSHJ	P,TMPOUT	;[221] BETWEEN SWITCH AND ARGS
	ILDB	T1,T2		;[221] GET NEXT CHAR
	JUMPN	T1,.-2		;[221] END ON NULL
DOCOM2:	TLNN	FL3,LISTSW	;LISTING REQUESTED?
	JRST	[MOVSI	T2,',- '	;NO
		 CAIN	T3,CHNCBL	;TEST FOR COBOL
		 PUSHJ	P,OUTSIX	;YES
		 JRST	NOLST]
	MOVEI	T1,","		;YES, NEED A COMMA
	PUSHJ	P,TMPOUT
IFE FTIPC, <	;[VIPCED 01] ALWAYS OUTPUT LISTINGS TO DSK:
;DOCOM2+4
IFN PASCAL< TLNE FL2,PASSW	;FOR PASCAL NO SPOOLING
	    JRST DOCOM3	>	;LPT FILES
	TLNN	FL2,CBLSW!BLISW	;SKIP /CREF IF COBOL OR BLISS (SPECIAL)
	TLNN	FL3,CRSW	;USE DSK IF /CREF
	SKIPLE	T2,SPDLPT	;OTHERWISE USE SPOOLED LPT
	JRST	DOCOM3		;WE KNOW WE'RE NOT SPOOLED
	JUMPE	T2,[MOVSI T1,'LPT'	;TEST FOR SPOOLED LISTING DEVICE
		MOVEM	T1,SPDLPT	;ASSUME TRUE
		DEVTYP	T1,
		  CAIA			;CERTAINLY NOT SPOOLED
		TLNN	T1,.TYSPL	;TEST SPOOL BIT
		HRRZM	P,SPDLPT	;SET POSITIVE TO SHOW NOT SPOOLED LPT
		SKIPL	T2,SPDLPT	;SEE IF WE WON
		JRST	DOCOM3		;NO
		JRST	.+1]		;YES
	PUSHJ	P,OUTDEV	;SET LIST DEVICE
> ;END OF IFE FTIPC
DOCOM3:	MOVE	T2,ONAM		;SET IT UP
	PUSHJ	P,OUTSIX
IFN SFDSW,<
	SKIPN	OPPN		;OUTPUT PPN GIVEN?
	SKIPE	OSFD		;OR SFD?
	>
IFE SFDSW,<
	SKIPE	OPPN		;OUTPUT PPN?
	>
	PUSHJ	P,SFDPPN	;YES
	TLNN	FL3,CRSW	;CREF MAYBE
	JRST	NOLST1
	MOVSI	T2,'/C '
	PUSHJ	P,OUTSIX
	PUSH	P,T3
IFE FQZSIM,<
	TLNN	FL2,CBLSW!BLISW	;DON'T WRITE /CREF IF COBOL OR BLISS (SPECIAL)
	>
	IFN FQZSIM,<
	TLNN	FL2,CBLSW!BLISW!SIMSW	;NOT FOR SIMULA EITHER
	>
	PUSHJ	P,ENTCRF	;PUT IT IN THE ###CREF FILE
	POP	P,T3
NOLST1:	SKIPE	T2,SWBKL	;SWITCHES?
	PUSHJ	P,OUTSW
NOLST:	MOVE	T1,SEPTAB(T3)	;[233] GET SEPARATOR
	PUSHJ	P,TMPOUT
	MOVE	T4,SVPT		;SAVE CURRENT POINTER
	MOVSI	SVPT,-NFILE	;RESET TO START
PRCLP:	SKIPE	T2,SVDEV(SVPT)	;IS THERE A DEVICE THERE
	PUSHJ	P,OUTDEV	;YES, PRINT IT
	MOVE	T2,SVNAM(SVPT)	;PUT OUT NAME
	PUSHJ	P,OUTSIX
	SKIPE	T2,SVEXT(SVPT)	;AND EXT IF NECESSARY
	PUSHJ	P,OUTEXT
	SKIPE	T2,SVPPN(SVPT)	;NEED PPN?
	PUSHJ	P,OUTPPN	;PUT THEM OUT
	SKIPE	T2,SWBKS(SVPT)	;AND SWITCHES
	PUSHJ	P,OUTSW
	CAMN	T4,SVPT		;ALL DONE?
	JRST	ENDPRC		;YES, GO FINISH UP AND CONSIDER LOADING
	MOVEI	T1,","
	PUSHJ	P,TMPOUT	;NEXT FILE
	AOBJN	SVPT,PRCLP
	MOVE	SVPT,T4		;SHOULD NEVER GET HERE

ENDPRC:	PUSHJ	P,OUCRLF
IFN FORTRAN,<			;CHOICE OF FORTRAN COMPILERS
	TLNE	FL2,FORSW	;IGNORE IF NOT FORTRAN
	TLNN	FL3,F40SW!F10SW	;AND IF NOTHING OF INTEREST
	JRST	ENDFOR		;SKIP REST OF TESTS
	MOVSI	T1,'F40'	;ASSUME F40 WANTED
	TLNN	FL3,F40SW	;GOOD GUESS?
	MOVE	T1,['FORTRA']	;NO, EXACTLY WRONG
	SKIPN	FORPRC		;SETUP ALREADY?
	MOVEM	T1,FORPRC	;NO, DO SO NOW
	CAMN	T1,FORPRC	;[222] SAME VALUE, OR FIRST TIME?
	JRST	ENDFOR		;[222] YES
	STRING	[ASCIZ	/%CMLOFC Only one Fortran compiler allowed, /]
	MOVEI	T1,[ASCIZ /FORTRAN-10/]	;[222]
	TLNN	FL3,F40SW	;[222] SEE WHICH WE WANTED, USE OTHER
	MOVEI	T1,[ASCIZ /F40/]	;[222]
	STRING	(T1)		;[222] TYPE ONE WE WILL USE
	STRING	[ASCIZ	/ used
/]
ENDFOR:>
IFN SPRC,<
	TLNN	FL2,SPRC
	>
	JRST	NOCOMP		;GO LOAD
IFN SPRC,<
	MOVSI	SVPT,-NFILE	;RESET POINTER
	MOVE	T1,ONAM		;AND FAKE WORLD
	MOVEM	T1,SVNAM
	MOVE	T3,PCNUM	;GET BACK PROCESSOR NUMBER
	MOVE	T1,INTEXT(T3)	;GET EXTENSION
	MOVEM	T1,SVEXT
	SETZM	SVPPN
	SETZM	SWBKS
	SETZM	SWBKB
	SETZM	SWBKL
	HRL	FL2,NXPC(T3)	;SET FOR NEXT PROCESSOR
	JRST	DOCOMP		;AND GO EMIT CALLS
>
;HERE TO TEST FOR /LIB
;COMPLICATED BY FACT THAT FOO.LIB IS PROBABLY BINARY
;THEREFORE ONLY COMPIL IF EXT IS A KNOWN ONE
; I.E. FOR, F40, MAC, ALG, CBL, BLI, FAI ETC
;OR NULL

LBCOMP:	TLNN	FL3,LIBSW	;/LIB?
	JRST	DOCOMP		;NO, RECOMPILE
	MOVE	T1,FL2		;GET PROCESSOR FLAGS
	JFFO	T1,.+1		;COUNT THE EASY WAY
	HLLZ	T1,SVEXT(SVPT)	;GET EXT OF INPUT
	JUMPE	T1,DOCOMP	;RECOMPILE IF NULL EXT
	CAME	T1,F4		;ALTERNATIVE FORTRAN EXT
	CAMN	T1,PXTAB+1(T1+1);TEST AGAINST EXPECTED EXT
	JRST	DOCOMP		;IT IS SO RECOMPILE
IFN BLISS,<
	CAMN	T1,B10		;TEST AGAINST ALTERNATIVE EXT
	JRST	DOCOMP		;YES, SO RECOMPILE>
	MOVEM	T1,OEXT		;FAKE OUTPUT EXT SO LOADER SEES IT
	JRST	LDREL		;NOT, SO ASSUME BINARY


SFDPPN:	MOVEI	T1,"["		;START OUT RIGHT
	HRRZM	T2,SAVPPN	;SAME CODE AS OUTPPN (ALMOST)
	PUSHJ	P,TMPOUT
	HLRZ	T1,T2		;GET NUMBER (LH)
	JUMPE	T1,.+2		;ZERO IS JUST ,
	PUSHJ	P,OUTOCT
	MOVEI	T1,","
	PUSHJ	P,TMPOUT
				;**;[155], SFDPPN+8, HPW, 10/19/73
	SKIPE	T1,SAVPPN	;[155] PPN SPECIFIED?
	PUSHJ	P,OUTOCT
IFN SFDSW,<X==0			;INITIAL CONDITION
REPEAT SFDLEN,<	SKIPN	T2,OSFD+X
	JRST	SFDPP1
	PUSHJ	P,SFDOUT
X==X+1>
SFDPP1:	>			;END OF IFN SFDSW
	MOVEI	T1,"]"
	PJRST	TMPOUT
LDREL:	TRNE	SVPT,-1		;CHECK FOR ONLY ONE FILE
	JRST	NOFIL		;IF MORE THAN ONE, THERE IS AN ERROR
NOCOMP:	SKIPE	FDGFLG		;NEED TO MAKE FUDGED LIBRARY?
	PUSHJ	P,ENTFUD	;YES
	TRNN	FL,DOLOD	;DO WE WANT TO LOAD?
	JRST	NXFILP		;NO, GO TO NEXT
	MOVEI	C,0
	IDPB	C,LODSP		;END SECOND SET OF SWITCHES
	IDPB	C,LODSP2
	MOVEI	T3,CHNLOD	;SET FOR LOADER
	TRZE	FL,LODOUT	;IS THERE ALREADY OUTPUT THERE?
	PUSHJ	P,[TRNN	FL,LINKFL	;LINK10?
		PJRST	OUCRLF		;NO, OUTPUT A CRLF AS SEPARATOR
		MOVEI	T1,","		;YES
		PJRST	TMPOUT]		;YES, ALL ON SAME LINE SAVES TIME
	SKIPE	T2,SAVSW	;[234] IS THIS A SAVE FILE?
	PUSHJ	P,[PUSHJ P,OUTSIX	;[234] OUTPUT IT
		MOVEI	T1," "		;[234] SEPARATE BY SPACE
		PJRST	TMPOUT]		;[234] RETURN
	SKIPL	DEBFL		;DEBUG SEEN AND NOT YET SET?
	JRST	NODDT		;NO
	SKIPE	T1,DDTFL	;[221] PRE-EMPTED
	AOJA	T1,[JUMPN T1,[PUSH P,DDTFL	;[221] STORE DEBUG AID
			JRST	GETDD1]		;[221] BYPASS TEST FOR COMPILER TYPE
		MOVSI T2,'/T '		;YES
		TRNN	FL,LINKFL	;LINK-10?
		JRST	ISDDT		;NO, ALWAYS USE UST DDT
		MOVSI	T2,'/D '	;DDT BY DEFAULT
		PUSHJ	P,OUTSIX
		PUSHJ	P,OUTSPC	;TERMINATE SWITCH
		JRST	NODDT]
	HLLZ	T1,FL2		;GET PROCESSOR
	MOVEI	T2,^L<MACSW>-22	;PRESET INCASE REL ONLY
	TLNE	T1,ALPROC-RELSW	;SEE IF ANY SET
	JRST	GETDDT		;YES, FIND OUT WHICH
	HRLZ	T1,FL2		;TRY LOCAL PROCESSOR SWITCHES
	TLNE	T1,ALPROC-RELSW
GETDDT:	JFFO	T1,.+1		;YES, SO SEE WHICH
	PUSH	P,DEBAID(T2)	;STORE NAME
	trne	fl,linkfl	;[220] check for link-10
	jrst	[skipn (p)		;[220] if no debug aid
		 jrst .+1		;[220] then return
		 move t1,prcnam(t2)	;[220] else get process name
		 movem t1,0(p)		;[220] to replace debug aid
		 jrst .+1]		;[220] proceed as before
	CAIN	T2,^L<CBLSW>-22	;COBOL IS A LOSER
	JRST	[SOS	DEBFL	;AS IT MUST LOAD COBDDT
		 JRST	NODDT1]	;AFTER MAIN PROG
	IFN	FQZSIM,<
	CAIN	T2,^L<SIMSW>-22	;SIMULA DEBUG?
	JRST	[POP	P,T2		;JUNK
		 MOVE	T2,[',SYS: ']	;INDICATE SIMULA DEBUG WITH
		 MOVEM	T2,EXECFL	;,SYS: IN EXECFL
		 JRST	NODDT]
	>
GETDD1:	TRNE	FL,LINKFL	;IF LINK-10
	JRST	[MOVSI	T2,'/D '
		 SKIPE	(P)		;BUG IN SCAN (LINK-10)
		 tlO	T2,'  :'	;OBJECTS TO /D: FOR DDT
		 PUSHJ	P,OUTSIX
		 POP	P,T2		;[165] GET NAME OF DEBUGGING AID
		 SKIPE	T2		;[165] IGNORE IF 0
		 PUSHJ	P,OUTSIX	;DEFAULT IS DDT IF 0
		 PUSHJ	P,OUTSPC	;TERMINATE
		 JRST	NODDT]
	MOVSI	T2,'/T '	;USE DDT
	SKIPN	(P)		;IF NULL
	PUSHJ	P,OUTSIX
	MOVE	T2,['SYS:  ']	;GET IT FROM SYS
	SKIPE	(P)		;IF NEEDED
	PUSHJ	P,OUTSIX
	POP	P,T2		;RECOVER FILE
	JUMPE	T2,NODDT	;DONE
	PUSHJ	P,OUTSIX
	MOVE	T2,[',/E/S ']	;SWITCHES AND SEPARATOR
	TRNN	FL,LINKFL	;BUT LINK-10 IS HARDER
	JRST	ISDDT		;JUST LOADER
	HRRI	T2,'/L '	;CHANGE /S TO /L
	PUSHJ	P,OUTSIX	;SWITCH
	PUSHJ	P,OUTSPC	;FOLLOWED BY SPACE
	JRST	NODDT

NODDT1:	MOVE	T2,['/E/S  ']	;COBOL ONLY
	TRNN	FL,LINKFL	;LINK-10
	JRST	ISDDT		;NO
	HRRI	T2,'L  '	;CHANGE /S TO /L
	PUSHJ	P,OUTSIX
	PUSHJ	P,OUTSPC	;TERMINATE WITH SPACE
	JRST	NODDT

ISDDT:	PUSHJ	P,OUTSIX
NODDT:	MOVE	T2,[POINT 7,LODSBK]	;OUTPUT FIRST SWITCHES
	PUSHJ	P,OUTSW
	MOVSI	T2,'DSK'
	TLNN	FL3,LIBSW
	TLNE	FL2,RELSW	;USING A REL FILE?
LODR0:	SKIPE	T2,LOKNAM	;ON NON-DISK DEVICE?
LODR3:	PUSHJ	P,OUTDEV	;YES. OUTPUT DEVICE
LODR1:	MOVE	T2,ONAM		;NOW FILE NAME
	PUSHJ	P,OUTSIX
	TLNN	FL2,RELSW	;REL
	JRST	[SKIPE	T2,OEXT		;EXTENSION GIVEN?
		 PUSHJ	P,OUTEXT	;YES
		 TLNN	FL3,LIBSW	;IF LIBRARY
		 JRST	ELOD3		;NO, CONTINUE
		 JRST	LODR2]		;YES
	SKIPE	T2,SVEXT	;ALSO USE EXT IF GIVEN
	PUSHJ	P,OUTEXT
LODR2:	SKIPE	T2,SVPPN	;THEN THINK ABOUT PPN
	PUSHJ	P,OUTPPN
	MOVSI	T2,'/L '	;TELL LOADER
	TRNE	FL,LINKFL	;LINK-10
	MOVSI	T2,'/S '	;USES SEARCH
	TLNN	FL3,LIBSW	;LIBRARY?
	JRST	ELOD		;NO
	PUSHJ	P,OUTSIX
	TRNE	FL,LINKFL	;LINK-10
	PUSHJ	P,OUTSPC	;NEEDS SPAC
	SETOM	NSWTCH		;[236] SIGNAL /L LAST
ELOD:	TRNN	FL,LINKFL	;[174] LINK-10 OR
	TLNE	FL3,LIBSW	;[174] OR /LIB
	JRST	ELOD1		;[174] YES - /N NOT NEEDED
	SKIPN	NSWTCH		;[236] WAS PREVIOUS /L?
	JRST	ELOD1		;[236] NO
	SETZM	NSWTCH		;[236] SIGNAL /N LAST
	MOVSI	T2,'/N '	;[174] LOADER NEEDS /N
	PUSHJ	P,OUTSIX	;[174] LOADER NEEDS /N
ELOD1:	MOVE	T2,[POINT 7,LODSB2]	;[174] OUTPUT SECOND SET OF SWITCHES
	PUSHJ	P,OUTSW
	SKIPN	T2,FORLIB	;FORSE/FOROTS SWITCH SET?
	JRST	ELOD2		;NO
	PUSHJ	P,OUTSIX	;YES
	SETZM	FORLIB		;ONLY DO IT ONCE
	TRNE	FL,LINKFL
	PUSHJ	P,OUTSPC
ELOD2:	TRO	FL,LODOUT	;MARK AS HAVING OUTPUT THERE
	AOSL	DEBFL		;ARE WE FINISHED WITH DDT?
	JRST	NXFILP
	TRNE	FL,LINKFL	;LINK-10?
	JRST	[MOVSI	T2,'/D:'	;YES, PUT AFTER FILE NAME
		 PUSHJ	P,OUTSIX
		 POP	P,T2		;[220] fixed to be correct
		 PUSHJ	P,OUTSIX
		 PUSHJ	P,OUTSPC
		 JRST	ELOD4]		;OUTPUT /DEBUG:COBOL
	MOVE	T2,[',SYS: ']	;NO, MUST BE COBOL
	PUSHJ	P,OUTSIX
	POP	P,T2		;GET FILE
	PUSHJ	P,OUTSIX
ELOD4:	AOS	DEBFL		;AT LAST
	JRST	NXFILP

ELOD3:
IFN SFDSW,<
	SKIPN	OPPN		;OUTPUT PPN GIVEN?
	SKIPE	OSFD		;OR SFD?
	>
IFE SFDSW,<
	SKIPE	OPPN		;OUTPUT PPN?
	>
	PUSHJ	P,SFDPPN	;YES
	JRST	ELOD		;AND CONTINUE
;HERE TO CHECK REL FILE TO SEE IF IT IS WHAT WE EXPECT
;MAINLY FOR F40 VS FORTRAN-10
;RETURN
;+1	FILE NOT OK, SHOULD RECOMPILE
;+2	FILE OK

CHKREL:	PUSHJ	P,INSREL	;INSPECT REL FILE, T2 POINTS TO WORD IN FILE
	POPJ	P,		;ERROR, SO RECOMPILE
				;T3 CONTAINS TYPE
				;T2 CONTAINS CPU INFO
	SOJE	T3,CHKF40	;1=F40
	CAIE	T3,10-1		;MAKE SURE IT FORTRAN-10
	JRST	CPOPJ1		;NO, SO LEAVE ALONE

CHKFOR:				;10 IS FORTRAN-10
IFE DFORTRAN,<			;IF DEFAULT IS F40
	TLNN	FL3,F10SW	;RECOMPILE UNLESS DEFINITELY WANTS F-10
	>
IFN DFORTRAN,<			;BUT IF DEFAULT IS F-10
	TLNE	FL3,F40SW	;RECOMPILE ONLY IF DEFINITELY WANTS F40
	>
	POPJ	P,
				;OK, NOW CHECK KA/KI TYPE
	SOJE	T2,CHKFKA	;KA-10 =1
	SOJE	T2,CHKFKI	;KI-10 =2
	JRST	CPOPJ1		;DON'T CARE

CHKFKI:				;KI-10 TYPE
	MOVE	T2,CPU		;GET HOST CPU
	XCT	[TLNE	FL3,KI10SW	;RECOMPILE UNLESS DEFINITELY WANTS KI-10
		 TLNN	FL3,KA10SW](T2)	;RECOMPILE ONLY IF DEFINITELY WANTS KA-10
				;**;[176],CHKFKI+3,HPW,10/25/73
CPOPJ1:	AOS	(P)		;[176] SKIP RET, THIS REL WILL DO
	POPJ	P,

CHKFKA:				;HERE IF FOUND REL IS F-10 KA-10 TYPE
	MOVE	T2,CPU		;GET HOST CPU
	XCT	[TLNN	FL3,KI10SW	;RECOMPILE ONLY IF DEFINITELY WANTS KI-10
		 TLNE	FL3,KA10SW](T2)	;RECOMPILE UNLESS DEFINITELY WANTS KA-10
	AOS	(P)		;SKIP RET, THIS REL WILL DO
	POPJ	P,

CHKF40:				;HERE IF FOUND REL WAS F40 STYLE
IFE DFORTRAN,<			;IF DEFAULT IS F40
	TLNE	FL3,F10SW	;RECOMPILE ONLY IF DEFINITELY WANTS F10
	>
IFN DFORTRAN,<			;BUT IF DEFAULT IS F10
	TLNN	FL3,F40SW	;RECOMPILE UNLESS DEFINITELY WANTS F40
	>
	POPJ	P,
IFE MANTIS,<
	JRST	CPOPJ1		;SKIP RET, THIS FILE WILL DO>
IFN MANTIS,<
	TLNE	FL3,MANTSW	;DO WE WANT SPECIAL DATA
	TRC	T2,1		;YES SO COMPLEMENT TYPE CODE
	CAIN	T2,400		;SHOULD WE RECOMPILE?
	AOS	(P)		;NO, RIGHT KIND OF CODE
	POPJ	P,		;YES, WRONG KIND OF REL FILE
	>

;HERE TO READ REL FILE IN USERS [DIRECTORY] ON DSK
;RETURNS
;+1	FILE ERROR, FORCE RECOMPILATION
;+2	FILE READ,	T3 = PROCESSOR CODE
;			T2 = CPU TYPE

INSREL:
INSRL1:
IFN FTFIX, <	;[241][VIPCED 01] CONFUSION WITH .RELS
	MOVE	T2,SVJFF	;GET REAL FIRST FREE
	MOVEM	T2,.JBFF	;AND SETUP FOR A TEMP BUFFER
>
	IN	LOOK,		;YES, MUST CHECK FOR DEBUGGER DATA
	JRST	INSRL3		;IN OK, PICKUP BUFFER ADDRESS
				;**;[176],INSREL+2,HPW,10/25/73
	JRST	INSRL2		;[176] ERROR - FORCE RECOMPILE

INSRL3:	MOVE	T2,LOOKBF	;GET BUFFER POINTER
	ADDI	T2,2		;POINT TO FIRST DATA WORD
INSNXT:	HLRZ	T3,(T2)		;GET LOADER BLOCK TYPE
	CAIN	T3,6		;LOOK FOR NAME BLOCK
	JRST	FNDTY6		;FOUND IT
	CAIE	T3,4		;MUST BE EITHER ENTRY OR NAME
	JRST	[SETZ	T3,		;UNLESS NOT A REL FILE
		 JRST	CPOPJ1]		;IN WHICH CASE DON'T REASSEMBLE
	HRRZ	T3,(T2)		;GET WORD COUNT
	CAIG	T3,^D18		;MORE THAN 1 SUB BLOCK?
	AOJA	T3,INSNXB	;NO
	IDIVI	T3,^D18		;YES, ACCOUNT FOR 1 BYTE WORD
	IMULI	T3,^D19		;PER 18 WORD SUB BLOCK
	JUMPE	T4,INSNXB	;ANY REMAINDER?
	ADDI	T3,1(T4)	;YES, DON'T FORGET BYTE WORD
INSNXB:	ADDI	T2,1(T3)
	JRST	INSNXT		;TRY AGAIN
FNDTY6:	HRRZ	T3,0(T2)	;GET WORD COUNT
	SOSLE	T3		;USE ZERO IF NO 2ND WORD
	HLRZ	T3,3(T2)	;GET PROCESSOR TYPE FROM 2ND DATA WORD
IFN MANTIS,<
	HLRZ	T1,4(T2)	;GET NEXT BLOCK INCASE F40/MANTIS
	>
	HRRZ	T2,T3		;AND COPY FOR CPU INFO
	ANDI	T3,7777		;BITS 6-17
	LSH	T2,-^D12	;BITS 0-5
IFN MANTIS,<
	CAIN	T3,1		;IF F40 AND WANTS MANTIS
	MOVE	T2,T1		;PUT 400 OR 401 IN CPU BLOCK
	>
				;**;[176],FNDTY6+6,HPW,10/25/73
	CLOSE	LOOK,		;[176] CLEAR FILE
	AOS	0(P)		;[176] SET SKIP RETURN
INSRL2:	MOVE	T1,SVJFF	;[176] RESTORE .JBFF
	MOVEM	T1,.JBFF	;[176] TO PRE-INPUT VALUE
	SETZM	LOOKBF		;[176] AVOID MONITOR BUG
	POPJ	P,

	SALL
GETPRO:	MOVSI	T1,-NFILE	;NUMBER OF FILES
	TRNN	FL2,-1		;LOCAL PROCESSOR SET?
	HRR	FL2,DFPROC	;NO, SET FROM GLOBAL
	TRNE	FL2,RELSW	;IF USER SAID /REL
	TRNE	FL3,COMPLS	;AND NOT /COMP
	JRST	GETPR1		;NOT TRUE
	TLO	FL2,RELSW	;DON'T WASTE TIME ON LOOKUPS
	PUSH	P,SVDEV(T1)	;AND COPY "SOURCE" DEVICE
	POP	P,LOKNAM	;TO OUTPUT DEVICE
	POPJ	P,		;JUST SET PROCESSOR=LOADER

GETPR1:	MOVEI	T3,1		;SET UP LOOK OF EXTENSION POINTER
NFIL:	MOVE	T2,SVNAM(T1)	;SET UP NAME AND PPN
	MOVEM	T2,LNAM
	HLLZ	T2,SVEXT(T1)
NXEXT:	MOVEM	T2,LEXT		;START WITH ORIGINAL EXT
	MOVEM	T2,OLDEXT	;SAVE FOR RAS SYSTEM
	MOVE	T2,SVPPN(T1)
IFN SFDSW,<
	SKIPN	SVSFD(T1)	;ANY SFD'S?
	JRST	NXSFD		;NO
	MOVEM	T2,LSFDPP	;SAVE PPN
	X==<Y==0>		;INITIAL CONDITION
REPEAT SFDLEN,<
	MOVE	T2,SVSFD+X(T1)
	MOVEM	T2,LSFD+Y
	X==X+NFILE
	Y==Y+1
	>
	MOVEI	T2,LSFDAD	;POINTER
NXSFD:	>			;END OF IFN SFDSW
	MOVEM	T2,LPPN
	SKIPN	T2,SVDEV(T1)	;A DEVICE?
	SKIPE	T2,LOKNAM	;OR SAVING ONE UP
	JRST	ALTDEV
OKLOOK:
IFN FTFIX, <	;[240][VIPCED 03] 1/3 SEC. TIME CHECKS
	SKIPE	EXTEND		;IS FILE ON DISK?
	 JRST	ELOOK		;YES, DO EXTENDED LOOKUP
>
	LOOKUP	LOOK,LNAM
	JRST NOTYET		;HAVE NOT FOUND IT YET
DNLOK:	HLLZ	T2,LEXT		;GET THE EXTENSION
	CAME	T2,OLDEXT	;WAS IT WHAT WE ASKED FOR
	JRST	NOTYET		;TREAT AS IF LOOKUP FAILED
	HLLM	T2,SVEXT(T1)	;[207] SAVE EXT (WILL HELP <> CODE)
IFN TENEX,<
	PUSHJ	P,GDTLOK	;GET DATE AND TIME OF LOOK CHAN
	JRST	DNLOK1		;NOT IMPL OR NOT DSK
	HLRZ	T2,LDAT		;DO THE COMPARES
	CAMLE	T2,SDAT
	JRST	[MOVEM T2,SDAT
		 HRRZ T2,LDAT	;GET TIME
		 JRST SETTM]	;STORE IT
	CAME	T2,SDAT
	JRST	OLDAT
	HRRZ	T2,LDAT
	CAMLE	T2,STIM
	JRST	SETTM
	JRST	OLDAT
	>
DNLOK1:
IFN FTFIX, <	;[240][VIPCED 03] 1/3 SEC. TIME CHECKS
	SKIPE	EXTEND		;WAS EXTENDED LOOKUP DONE?
	 JRST	[MOVE	T2,EBLK+.RBTIM	;YES, GET CREATION TIME
		 JRST	SETTM1	]	;AND GO TEST IT
>
	LDB	T2,[POINT 12,LDAT,35]	;GET LOW 12 BITS OF DATE
	LDB	T3,[POINT 3,LEXT,20]	;GET HIGH 3 BITS OF DATE
	DPB	T3,[POINT 3,T2,23]	;MERGE THE TWO PARTS
	CAMLE	T2,SDAT		;AND CHECK TO SEE IF LATEST
	JRST	SETDT
	CAME	T2,SDAT
	JRST	OLDAT
	LDB	T2,[POINT 11,LDAT,23]
SETTM1:	CAMLE	T2,STIM			;LABEL ADDED VIPCED 03
SETTM:	MOVEM	T2,STIM		;MARK WITH LATER ONE
OLDAT:	HLLZ	T2,LEXT		;GET THE EXTENSION WE FOUND
	JUMPE	T2,SETCP	;SET TO CURRENT PROCESSOR
	MOVSI	T3,-<NPROCS+1>	;LOOK AT EXTENSION TO FIND PROCESSOR
	CAMN	T2,F4		;TEST FOR ALT FORTRAN EXT
	JRST	[HRROI	T3,^L<FORSW>-21	;FAKE FORTRAN SEEN
		 JRST	.+3]		;AND PROCCESS IT
	CAME	T2,PXTAB(T3)
	AOBJN	T3,.-1
IFE BLISS,<
	JUMPGE	T3,SETCP	;NOT THERE
	>
IFN BLISS,<
	JUMPL	T3,.+4		;JUMP IF FOUND SOMETHING
	CAME	T2,B10		;IS IT ALTERNATIVE BLISS EXT
	JRST	SETCP		;NO
	HRROI	T3,CHNBLI+1	;YES, SET FOR BLISS
	>
	TLNE	FL2,@ISPTAB(T3)	;IS THAT ONE ALREADY SET?
	JRST	NFIL2
	TLNE	FL2,ALPROC	;IS ANY SET?
	JRST	FIXCON		;YES, WE MAY HAVE A CONFLICT
	TLO	FL2,@ISPTAB(T3)	;SET UP FOR THIS ONE
NFIL2:	CAME	T1,SVPT		;ARE WE DONE?
NFIL1:	AOBJN	T1,GETPR1	;NO, GO ON
	POPJ	P,
;THERE IS NO CONFLICT IF THIS IS A REL FILE

FIXCON:	MOVE	T2,ONAM
	CAMN	T2,LNAM
	TRNE	T3,-1		;IF NOT OUTPUT REL FILE
	JRST	PROCON		;THEN WE HAVE A CONFLICT
FIX1:	SETOM	SDAT		;FORCE USE OF REL FILE
	POPJ	P,		;AND RETURN TO SETUP

SETDT:	MOVEM	T2,SDAT
	LDB	T2,[POINT 11,LDAT,23]	;AND TIME
	JRST	SETTM

SETCP:	CAME	T1,SVPT		;AT END?
	JRST	NFIL1		;NO, DO NOT SET
	TLNN	FL2,ALPROC	;SOMETHING ALREADY SET?
	HRL	FL2,FL2		;NO, SET TO CURRENT PROCESSOR
	POPJ	P,		;AND DONE

NOTYET:	MOVE	T2,SVEXT(T1)	;GET THE CURRENT EXT
	JUMPN	T2,OKREL	;IF HE SPECIFIED AN EXT WE LOSE
	TLZE	T3,-1		;WAS THIS A RETRY WITH ALT EXT?
	JRST	NOTYT1		;YES, ONLY DO IT ONCE
	CAIN	T3,CHNFOR+2	;FORTRAN USES EITHER .FOR OR .F4
	MOVE	T2,F4		;SO TRY OTHER
IFN BLISS,<
	CAIN	T3,CHNBLI+2	;BLISS USES .BLI OR .B10
	MOVE	T2,B10		;TRY OTHER
	>
	JUMPE	T2,NOTYT1	;NO SUCH LUCK
	TLO	T3,-1		;MARK IT SO WE DONT LOOP
	JRST	NXEXT		;AND TRY AGAIN

NOTYT1:	JUMPE	T3,NOTYT2	;TRIED ALL IF ZERO
	MOVE	T2,PXTAB(T3)	;ELSE PICK UP ONE
	CAIG	T3,NPROCS	;SEE IF LIST EXHAUSTED
	AOJA	T3,NXEXT	;NO, TRY THIS ONE
				;**;[175],NOTYT1+4,HPW,10/25/73
	TLNE	FL3,COMPLS	;[175] /COMP SEEN?
	JRST	NOTYT2		;[175] YES - DON'T TRY /REL
	SETZ	T3,		;YES, TRY REL AS LAST RESORT
	MOVE	T2,PXTAB
	JRST	NXEXT

NOTYT2:	HLLZ	T2,SVEXT(T1)	;GET THE ORIGINAL EXT
;NOTYT2 + 1
IFN FTFIX, <	;[266][VIPCED 05] BETTER LOOKUP ERROR REPORTING
	HLLM	T2, LEXT
>
IFE FTFIX, <	;[VIPCED 05]
	MOVEM	T2,LEXT
>
	JRST	NOFIL		;ARE OUT OF THINGS TO TRY

;MAKE IT OKAY IF THE OUTPUT REL FILE IS THERE

				;**;[175],OKREL,HPW,10/25/73
OKREL:	TLNN	FL3,COMPLS	;[175] MUST COMPILE IF /COMP
	TRNN	FL,DOLOD	;IF NOT JUST COMPILING
	JRST	LOSE1		;THEN
	MOVE	T3,LNAM		;PROTECT CURRENT NAME
	MOVE	T1,ONAM		;TRY LOOKING UP
	MOVEM	T1,LNAM		;OUTPUT FILE
	SKIPN	T1,OEXT		;USING EXTENSION
	MOVSI	T1,'REL'	;IF GIVEN
	MOVEM	T1,LEXT		;AND TRYING SVPPN
	MOVE	T1,SVPPN
OKREL1:	MOVEM	T1,LPPN
	LOOKUP	LOOK,LNAM
	JRST	.+2
	JRST	FIX1		;FOUND SO NO COMPIL
	JUMPE	T1,LOSE		;IF THIS WASN'T OUR PPN
	SETZ	T1,		;THEN TRY IT NOW
	JRST	OKREL1

LOSE:	MOVEM	T3,LNAM		;RESTORE FILE NAME FOR ERROR MESSAGE
LOSE1:
IFN FTFIX, <	;[266][VIPCED 05] BETTER LOOKUP ERROR REPORTING
	HLLM	T2, LEXT
>
IFE FTFIX, <	;[VIPCED 05]
	MOVEM	T2,LEXT		;RESTORE EXTENSION
>
	JRST	NOFIL		;OUT OF THINGS TO TRY

IFN FTFIX, <	;[240][VIPCED 03] 1/3 SEC. TIME CHECKS
ELOOK:	MOVEI	T2,.RBTIM	;DO EXTENDED LOOKUP
	MOVEM	T2,EBLK		;SETUP LOOKUP BLOCK.
	MOVE	T2,LPPN
	MOVEM	T2,EPPN
	LOOKUP	LOOK,EBLK	;DO THE LOOKUP
	 JRST	NOTYET		;NO SUCH LUCK
	JRST	DNLOK		;GO CHECK IT OUT
>
ALTDEV:	MOVEM	T2,LOKNAM	;SAVE FOR LATER
	MOVEM	T2,SVDEV(T1)	;AND IN DEVICE FOR OUTPUT
	DEVCHR	T2,		;GET CHARACTERISTICS
	TLNE	T2,200000	;A DSK?
	JRST	ALTDSK		;YES
	TLNE	T2,4		;A DECTAPE?
	JRST	ALTDAT		;YES, 
	TRO	FL,NODAT	;NO DATES ON OTHER DEVICES
	JRST	OLDAT		;DON'T BOTHER WITH LOOKUP

ALTDSK:	MOVSI 	T2,'DSK'
	CAMN	T2,LOKNAM	;LOGICAL NAME?
	JRST	OKLOOK		;NO, STILL DSK
ALTDAT:	TRZ	FL,NOLOOK	;NOT FAILED YET
	OPEN	LOOK,LOKINT	;OPEN FOR INPUT
	JRST	DEVNA		;NOT THERE
	LOOKUP	LOOK,LNAM	;SEE IF FILE IS
	TRO	FL,NOLOOK	;NO
	OPEN	LOOK,DSKLK	;GET THE DSK BACK
	JRST	DSKNA		;I HOPE THIS NEVER HAPPENES
	TRZE	FL,NOLOOK	;SEE IF FAILED
	JRST	NOTYET		;IT DID
	TLNN	T2,4		;DECTAPE?
	JRST	DNLOK		;NO, BUT LOOKUP HAPPENED
	HLRZ	T2,LEXT		;GET EXTENSION LOOKED UP
	CAIE	T2,'REL'
	AOS	LDAT		;IF SOURCE FILE MAKE IT MIDNIGHT TONIGHT
	JRST	DNLOK		;AND CONTINUE

IFE STANSW,<
OUTPPN:	HRRZM	T2,SAVPPN	;CONVERT TO SIXBIT FOR OUTPUT
	MOVEI	T1,"["		;START OUT
	PUSHJ	P,TMPOUT
	HLRZ	T1,T2		;GET NUMBER
	JUMPE	T1,.+2		;JUST COMMA IF ZERO
	PUSHJ	P,OUTOCT
	MOVEI	T1,","
	PUSHJ	P,TMPOUT
	SKIPE	T1,SAVPPN
	PUSHJ	P,OUTOCT
IFN SFDSW,<
	SKIPE	SVSFD(SVPT)	;AN SFD SEEN?
	PUSHJ	P,OUTSFD	;YES
	>
	MOVEI	T1,"]"
	JRST	TMPOUT

OUTOCT:	IDIVI	T1,10		;OCTAL OUTPUT
	HRLM	T2,(P)
	SKIPE	T1
	PUSHJ	P,OUTOCT
	HLRZ	T1,(P)
	ADDI	T1,"0"
	PJRST	TMPOUT
	>
	SUBTTL	OUTPUT ROUTINES

OUTSIX:	MOVEI	T1,0
	LSHC	T1,6
	ADDI	T1,40
	PUSHJ	P,TMPOUT
	JUMPN	T2,OUTSIX
CPOPJ:	POPJ	P,

OUTSPC:	MOVEI	T1," "
	PJRST	TMPOUT

IFN STANSW,<
OUTPPN:	MOVEM	T1,SAVPPN	;SAVE IT AWAY
	ANDCMI	T2,-1
	MOVEI	T1,"["
	PUSHJ	P,TMPOUT
	PUSHJ	P,OUTSIX	;PRINT IT
	MOVEI	T1,","		;AND A COMMA
	PUSHJ	P,TMPOUT
	HRLZ	T2,SVPPN
	PUSHJ	P,OUTSIX
	MOVEI	T1,"]"
	JRST	TMPOUT
	>

OUTSW:	MOVEM	T2,SVSWP	;SAVE THE POINTER
	ILDB	T1,T2		;PICK UP THE FIRST CHR
	JUMPE	T1,CPOPJ	;AND CHECK FOR NULL AS A PRECAUTION
				;**;[177],OUTSW+3,HPW,11/13/73
	CAIE	T3,CHNLOD	;[177] LOADER OUTPUT LINE
	JRST	.+3		;[173] NO - DON'T CHECK WHICH LOADER
	TRNE	FL,LINKFL	;LINK-10?
	JRST	OUTSW2		;YES, SPECIAL
	CAIN	T3,CHNFOR	;OR FORTRAN-10
				;**;[200],OUTSW+10,HPW,11/13/73
IFE DFORTRAN,<			;[200] F40 IS DEFAULT
	TLNN	FL,F10SW	;[200] F10 SWITCH SEEN
	>			;[200] END OF CONDITIONAL
IFN DFORTRAN,<			;[200] F10 IS THE DEFAULT
	TLNE	FL,F40SW	;[200] F40 SWITCH SEEN
	>			;[200] END OF CONDITIONAL
	CAIA			;NO
	JRST	OUTSW2		;YES, ALSO USES SCAN
	MOVEI	T1,"("
	PUSHJ	P,TMPOUT	;SWITCHES ARE IN () TO PROCESSOR
OUTSW1:	ILDB	T1,SVSWP
	JUMPE	T1,LPAR
	PUSHJ	P,TMPOUT
	JRST	OUTSW1		;A NULL WILL MARK THE END
LPAR:	MOVEI	T1,")"
	JRST	TMPOUT

;HERE FOR LINK-10 SWITCHES
;OUTPUT AS /SWITCH:ARG
;BLANK MARKS END OF SWITCH
;NULL MARKS END OF SET OF SWITCHES

OUTSW2:	ILDB	T1,SVSWP	;GET 1ST CHAR
	JUMPE	T1,OUTSW5	;ALL DONE IF NULL
	CAIN	T1," "		;IGNORE LEADING BLANKS
	JRST	.-3		;AND MULTIPLE BLANKS
	MOVEI	T1,"/"		;LINK-10 WANT A SLASH FIRST
	PUSHJ	P,TMPOUT
	LDB	T1,SVSWP	;GET FIRST NON-BLANK CHAR AGAIN
	CAIA			;AND PROCESS IT
OUTSW3:	ILDB	T1,SVSWP	;GET NEXT CHAR
	CAIN	T1," "
	JRST	OUTSW4		;END OF THIS SWITCH IF BLANK
	JUMPE	T1,OUTSW5	;OR IF NULL
	PUSHJ	P,TMPOUT
	JRST	OUTSW3		;KEEP GOING

OUTSW4:	PUSHJ	P,TMPOUT	;OUTPUT BLANK INCASE FILE NAME FOLLOWING
	MOVE	T2,SVSWP	;COPY BYTE POINTER
	ILDB	T1,T2		;SEE IF END
	JUMPN	T1,OUTSW2	;NO, MORE SWITCHES
	POPJ	P,		;END

OUTSW5:	MOVEI	T1," "		;OUTPUT BLANK
	PJRST	TMPOUT		;AND RETURN
	SUBTTL	CREF

ENTCRF:	MOVE	T1,CORTOP	;CHECK TO SEE IF NAME ALREADY THERE
	MOVE	T2,ONAM
ENTC1:	CAMN	T1,CORT1
	JRST	ENTC2
	CAMN	T2,1(T1)
	POPJ	P,		;NAME THERE, EXIT
	AOJA	T1,ENTC1	;CHECK ANOTHER
ENTC2:	MOVEM	T2,@CORTOP	;SAVE IT
	SOS	T1,CORTOP
	CAMG	T1,SVJFF	;CHECK TO SEE IF CORE EXCEEDED
	PUSHJ	P,XPAND
	MOVEI	T3,CHNCRF
	MOVEI	T1,"="		;[233]
	PUSHJ	P,TMPOUT
	MOVE	T2,ONAM
	PUSHJ	P,OUTSIX
	PJRST	OUCRLF

FINCRF:	MOVSI	IOPNT,-2	;PERMIT ONLY THIS ONE LEVEL
	TRO	FL,INCRF	;SAY WE ARE FINISHING
	MOVEM	P,SVPDL		;SAVE THE PDL FOR LATER
	MOVE	T1,[POINT 7,CRFRDR]
	MOVEM	T1,DINPT
FINC1:	PUSHJ	P,SCAN		;GET SOMETHING
	TRNN	FL,IDF		;IGNORE ALL BUT IDENTIFIERS
	JRST	FINC1
	MOVE	T1,ACCUM
	MOVEM	T1,ONAM		;SET AS NAME
	PUSHJ	P,ENTCRF	;ENTER IT
	JRST	FINC1

DNCRF:	MOVEI	T3,CHNCRF
	PUSHJ	P,TMPCHK	;CLOSE OUTPUT
	MOVE	P,SVPDL		;GET THE ENTERING PDL BACK
	TRZ	FL,INCRF	;NO LONGER THERE
	POPJ	P,
	SUBTTL	FUDGE
	CHNFUD==CHNPIP

SETFUD:	SKIPE	FDGFLG		;ENTER DONE ALREADY?
	POPJ	P,		;YES , RETURN
	MOVEI	T3,CHNFUD	;USE PIP FOR NOW
	PUSHJ	P,SCAN		;LOOK AT NEXT CHAR
	CAIE	C,":"		;THERE BETTER BE A NAME
	GOTO	SYNERR		;YOU LOSE
	AOBJP	SVPT,NESTTD	;MAKE SPACE FOR FIELDS
IFN FTFIX, <	;[302][VIPCED 05] SWITCH ARGS SHOULD NOT STICK
	TRO	FL, F.STKY
>
	PUSHJ	P,SCANAM	;GO GET THEM
IFN FTFIX, <	TRZ	FL, F.STKY	;[302]	>
	SKIPE	T2,SVDEV(SVPT)	;A DEVICE?
	PUSHJ	P,OUTDEV	;YES
	SKIPN	T2,SVNAM(SVPT)	;THERE HAS TO BE A NAME
	GOTO	SYNERR		;NOT FOUND
	PUSHJ	P,OUTSIX	;OUTPUT IT
	SKIPN	T2,SVEXT(SVPT)	;EXTENSION?
	MOVSI	T2,'REL'	;USE REL  IF MISSING
	PUSHJ	P,OUTEXT
	SKIPE	T2,SVPPN(SVPT)	;PPN
	PUSHJ	P,OUTPPN	;YES
	SUB	SVPT,[1,,1]	;BACK AS IT WAS
	MOVSI	T2,'/B='	;[233] FORSE BINARY
	PUSHJ	P,OUTSIX
	SETOM	FDGFLG		;ONLY DO IT ONCE
	PJRST	SCAN		;RETURN VIA SCAN

ENTFUD:	PUSH	P,T3		;SAVE T3
	MOVEI	T3,CHNFUD	;USE PIP TIL FUDGE2 FIXED FOR CCL
	MOVEI	T1,","		;SETUP COMMA
	SKIPL	FDGFLG		;BUT NOT FIRST TIME THROUGH
	PUSHJ	P,TMPOUT	;OUTPUT SEPARATING COMMA
	MOVE	T2,ONAM		;GET NAME
	PUSHJ	P,OUTSIX	;OUTPUT IT
	SKIPN	T2,OEXT		;SPECIFIED EXT?
	MOVSI	T2,'REL'	;NO USE DEFAULT
	PUSHJ	P,OUTEXT
	HRRZS	FDGFLG		;COMMA NEXT TIME
	POP	P,T3		;RESTORE T3
	POPJ	P,		;RETURN

DNFUDG:	MOVEI	T3,CHNFUD	;MAKE SURE USING PIP
	PUSHJ	P,OUCRLF	;TERMINATE LINE
	PUSHJ	P,TMPCHK
	SETZM	FDGFLG		;CLEAR FLAG
	POPJ	P,		;RETURN

	
SUBTTL	TABLES

	XALL

	DEFINE X (A,B,C,D,E,F,G)<
<SIXBIT /C/>>

PRCNAM:	PROCESS
DEFINE X (A,B,C,D,E,F,G)<
SIXBIT /B/>

PXTAB:	SIXBIT /REL/
	PROCESS
IFN BLISS,<
B10:	SIXBIT	/B10/		;ALTERNATIVE BLISS EXT>
F4:	SIXBIT	/F4/

DEFINE X (A,B,C,D,E,F,G)<
B'SW>

ISPTAB:	RELSW
	PROCESS


	DEFINE X (A,B,C,D,E,F,G)<
	SIXBIT /E/>
INTEXT:	PROCESS

IFN SPRC,<	DEFINE X (A,B,C,D,E,F,G)
	<D'SW>
NXPC:	PROCESS

SW==0>

	DEFINE X (A,B,C,D,E,F,G)<
	SIXBIT /F/>
DEBAID:	PROCESS

	DEFINE X (A,B,C,D,E,F,G)<
	"G">
SEPTAB:	PROCESS

DEFINE X (A,B)<
<	SIXBIT	/B/>>
PRCDEV:	DEVICE

	SALL
	SUBTTL	DIRECT

IFE DIRSW,<
DODIR:	TROA	FL,PIPF		;SO *.* WILL WORK
DODIR0:	PUSHJ	P,GETPP1	;GET PROJ-PROG
DODIR1:	PUSHJ	P,SCAN		;FIND OUT IF HE WANTS /L OR /F SWITCH
DODIR2:	TRNN	FL,IDF		;WAS IT AN IDENT?
	JRST	SLSH		;NO, CHECK FOR  "/"
	PUSH	P,SVPPN		;IN CASE WE HAVE SEEN PPN ALREADY
	PUSHJ	P,GETNAM	;GET DEV AND FILE NAME
	POP	P,T2		;GET PREVIOUS PPN
	JUMPE	T2,.+3		;WASN'T ONE
	SKIPN	SVPPN		;SEEN ONE AFTER DEVICE?
	MOVEM	T2,SVPPN	;NO SO USE ONE BEFORE
	CAIE	C,"]"		;SCAN OVER PPN
	TRNE	FL,IDF		;LAST THING AN IDENT.?
	PUSHJ	P,SCAN		;YES, GET NEXT CHAR
SLSH:	CAIE	C,"/"
	JRST	NOSLSH
	PUSHJ	P,SCAN		;WHICH ONE
	TRNN	FL,IDF		;MUST SEEN AN IDENTIFIER
	JRST	[PUSHJ	P,SCAN	;TRY NEXT (NUL EXT FAILS)
		 TRNN	FL,IDF	;FOUND IDENT. NOW?
		 GOTO	SYNERR	;NO, FATAL ERROR
		 JRST	.+1]	;OK NOW
	MOVS	T1,ACCUM
	CAIN	T1,'F  '
	JRST	SETF
	CAIE	T1,'L  '
	GOTO	SYNERR		;DO NOT RECOGNIZE THIS SWITCH
	TROA	FL,LPTFG	;HE WANTS IT ON THE LINE PRINTER
SETF:	TRO	FL,FFLG
	JRST	DODIR1		;BACK FOR MORE


NOSLSH:	CAIN	C,"["		;PROJ-PROG NUMBER
	JRST	DODIR0		;YES
	MOVE	T2,['TTY:/L']
	TRNE	FL,LPTFG	;ON LINE PRINTER INSTEAD?
	HRLI	T2,'LPT'	;YES
	MOVEI	T3,CHNPIP
	TRNE	FL,FFLG
	HRRI	T2,':/F'
	PUSHJ	P,OUTSIX
	MOVEI	T1,"="		;[233]
	PUSHJ	P,TMPOUT
DODIR3:	SKIPE	T2,SVDEV	;SEE IF DEVICE SPECIFIED
	PUSHJ	P,OUTDEV	;OUTPUT DEVICE AND COLON
	PUSHJ	P,OUTNAM	;SEE IF NAME AND EXT  OR PROJ-PROG
OPIP1A:	CAIE	C,","
	JRST	OPIP1		;FINISHED
	MOVEI	T1,","
	PUSHJ	P,TMPOUT
	PUSHJ	P,SCAN
	CAIN	C,","		;STILL ON COMMA?
	JRST	.-2		;YES, GET RID OF IT
	PUSHJ	P,GETNAM
	JRST	DODIR3
	JRST	OPIP1
	>

	SUBTTL	DELETE

DODEL:	TRO	FL,PIPF		;SET TO ALLOW * AS AN IDENT
	PUSHJ	P,SCANAM
	MOVSI	T1,'DSK'
	SKIPN	SVDEV		;FORCE TO DSK IF NONE
	MOVEM	T1,SVDEV
	JRST	DEL2
DEL3:	PUSHJ	P,SCANAM
DEL2:	MOVEI	T3,CHNPIP
	SKIPN	T2,SVDEV	;DEVICE?
	JRST	NODVC
	PUSHJ	P,OUCRLF
	PUSHJ	P,OUTSIX	;DUMP NAME
	MOVE	T2,[':/D=  ']	;[233]
	PUSHJ	P,OUTSIX
	JRST	DIDDEV
NODVC:	MOVEI	T1,","		;IF NO DEV, JUST A ,
	PUSHJ	P,TMPOUT
DIDDEV:	PUSHJ	P,OUTNAM	;WRITE THE NAME
	PUSHJ	P,SCAN		;SEE IF MORE THERE
	CAIN	C,","
	JRST	DEL3		;GO ON
	TLNN	CS,TERMF	;MAKE SURE THAT LINE ENDS PROPERLY
	GOTO	SYNERR
OPIP1:	PUSHJ	P,OUCRLF
OPIP2:	PUSHJ	P,TMPCHK	;OUTPUT TMP FILE NOW
	MOVSI	T1,'PIP'
	MOVEM	T1,PCNAM	;LOAD THIS ONE
	JRST	DONE1
	SUBTTL	RENAME/COPY

DOCOPY:	MOVEI	T2,9*2000-1	;USE 5K LOW SEG
	MOVEM	T2,RUNCOR	;RUN PIP IN 5K+4K FOR COPY
	SKIPA	T2,['/X=',,0]	;[233] FOR COPY
DOREN:	MOVSI	T2,'/R='	;[233] SET FOR RENAME
	PUSH	P,T2		;SAVE IT
	TRO	FL,PIPF		;PERMIT * IN FILES
NXTNAM:	PUSHJ	P,SCAN		;GET A FILE NAME
	PUSHJ	P,GETNAM	;[154]
	MOVEI	T3,CHNPIP	;[154]
NXTNM0:	CAIE	C,"/"		;[227] CHECK FOR SINGLE SWITCH
	CAIN	C,"("		;CHECK FOR SWITCHES
	JRST	[JFCL			;RETURNS HERE FROM COPYSW
		 CAIA
		 PUSHJ	P,COPYSW	;OUTPUT THEM
		 PUSHJ	P,GETNM0	;[154] TRY AGAIN FOR NAME
		 JRST	NXTNM0]+2	;TRY AGAIN FOR NAME
	CAIN	C,"^"		;TAPE ID?
	JRST	[PUSHJ	P,TAPEID	;[154] GET TAPE ID
		 PUSHJ	P,GETNM0	;[154] TRY AGAIN FOR
		 JRST	NXTNM0]		;[154] NAME
	SKIPN	T2,SVDEV	;SEE IF DEVICE SPECIFIED
	MOVE	T2,LOKNAM	;OR SAVED
	MOVEM	T2,LOKNAM
	JUMPE	T2,.+2		;IF NO NAME SPECIFIED
	PUSHJ	P,OUTDEV	;PUT IT OUT
	PUSHJ	P,OUTNAM
	CAIE	C,"]"		;ALWAYS GET RID OF SPARE "]"
	TRNE	FL,IDF		;DON'T SCAN IF WE ALREADY HAVE IT
	PUSHJ	P,SCAN
	CAIN	C,"^"		;TAPE ID?
	PUSHJ	P,TAPEID	;YES
	CAIE	C,"<"		;IS IT PROTECTION?
	JRST	NXTNM1		;NO
	PUSHJ	P,SCAN		;GET NUMBER
	PUSHJ	P,SCAN		;AND DELIMITER
	CAIE	C,">"		;IT BETTER BE
	GOTO	SYNERR		;IT WASN'T
	HLRZ	T2,ACCUM	;GET 3 NUMBERS
	TLO	T2,'<'
	LSH	T2,^D12		;SHIFT TO LEFT END
	TRO	T2,' > '
	PUSHJ	P,OUTSIX
	PUSHJ	P,SCAN
NXTNM1:	CAIE	C,"["		;[227] CHECK FOR PROJ-PROG
	JRST	NXTNM2		;[227] NO
	PUSHJ	P,GETPP1	;YES, GET IT
	SKIPE	T2,SVPPN	;IF NON-ZERO
	PUSHJ	P,OUTPPN	;PUT IT OUT
	PUSHJ	P,SCAN		;GO BEYOND "]"
NXTNM2:	CAIE	C,"/"		;[227] CHECK FOR SINGLE SWITCH
	CAIN	C,"("		;CHECK FOR SWITCHES
	PUSHJ	P,COPYSW	;AND OUTPUT THEM
	CAIN	C,"^"		;TAPE ID?
	PUSHJ	P,TAPEID	;YES
	MOVE	T2,(P)
	CAME	T2,['/X=',,0]	;[233] IS IT COPY?
	JRST	NOTCPY		;NO, MUST BE RENAME
	MOVS	T1,SVNAM	;GET NAME
	JUMPE	T1,NOTCPY	;ZERO FILE NAME NEEDS /X
	CAIN	T1,'*  '	;WILD CARD?
	JRST	NOTCPY		;YES, USE /X
	TLC	T1,'?  '	;STUPID TEST FOR ? IN FILE NAME
	TLCN	T1,'?  '
	JRST	NOTCPY		;WELL WE FOUND ONE, USE /X
	LSH	T1,6		;SHIFT LEFT
	JUMPN	T1,.-4		;TRY NEXT CHAR
	MOVS	T1,SVEXT	;NO, TRY EXT
	CAIN	T1,'*  '	;IS THIS WILD CARD?
	JRST	NOTCPY		;YES, /X NEEDED
	TLC	T1,'?  '	;SAME TEST FOR EXT
	TLCN	T1,'?  '
	JRST	NOTCPY		;WELL WE FOUND ONE, USE /X
	LSH	T1,6		;SHIFT LEFT
	JUMPN	T1,.-4		;TRY NEXT CHAR
	MOVSI	T2,'=  '	;[233] NO, SO JUST COPY
NOTCPY:	PUSHJ	P,OUTSIX
				;**;[167],NOTCPY+1,HPW,10/19/73
	CAIE	C,"_"		;[167] "_" SEEN
	CAIN	C,"="		;[167] "=" SEEN
	CAIA			;[167] "_" OR "=" MUST BE THERE
	GOTO	SYNERR
	SETZM	SVPPP		;CLEAR STICKY PPN ON OUTPUT SIDE
IFN FTFIX, <	;[260][VIPCED 03,05] DONT LOSE DEV IF NULL FILENAME
	SETZM	SVDEVV		;CLEAR STICKY DEVICE
>
COPY1:	PUSHJ	P,SCANAM
	MOVEI	T3,CHNPIP	;RESET
	CAIN	C,"["		;MIGHT BE *.[PPN]
	PUSHJ	P,GETPP		;SO GET IT
	CAIN	C,"^"		;TAPE ID?
	PUSHJ	P,TAPEID	;YES
	SKIPE	T2,SVDEV	;DEVICE SEEN?
	PUSHJ	P,OUTDEV
	PUSHJ	P,OUTNAM
	SETZM	SVPPP		;CLEAR STICK PPN NOW PIP HAS SEEN IT
	MOVE	T1,(P)		;GET EITHER /X OR /R
	CAMN	T1,['/X=',,0]	;[233] WHICH IS IT?
	JRST	COPY2		;IT WAS COPY
	PUSHJ	P,SCAN		;CHECK FOR MORE
FINCPY:	PUSHJ	P,OUCRLF
	CAIN	C,","
	JRST	NXTNAM		;YES
	TLNN	CS,TERMF	;NO MORE, SEE IF END
	GOTO	SYNERR
	POP	P,T2		;CLEAR STACK
	JRST	OPIP2

COPY2:	CAIE	C,"]"		;IF WE FINISHED ON PPN GET RID OF CHAR
	TRNE	FL,IDF		;SKIP IF WE ALREADY HAVE NEXT CHAR
	PUSHJ	P,SCAN		;GET NEXT CHAR
	CAIE	C,"/"
	CAIN	C,"("		;FIRST SEE IF ANY SWITCHES
	PUSHJ	P,COPYSW	;YES
	CAIE	C,","		;MORE COMMAND?
	JRST	FINCPY		;NO, GIVE UP
	MOVEI	T1,","		;OUTPUT THE COMMA
	PUSHJ	P,TMPOUT
	JRST	COPY1		;GET NEXT NAME


	SUBTTL	LABEL/TAPE ID

IDENT:	TRO	FL,PIPF		;WHY NOT, IT IS PIP
	PUSHJ	P,SCANAM	;GET DEVICE
	MOVEI	T3,CHNPIP	;PIP TMP FILE
	SKIPN	T2,SVDEV	;DEVICE SPECIFIED?
	GOTO	XPDERR		;NO, ERROR
	PUSHJ	P,OUTDEV	;YES, USE IT
	SKIPN	T2,SVNAM	;FILENAME = TAPE ID
	JRST	[PUSHJ P,TAPEID	;NO, USING DELIMITERS
		 JRST	IDENT1]	;FINISH OFF ID WITH UP ARROW
	MOVEI	T1,"^"		;PIP EXPECTS ^ AS DELIMITER
	PUSHJ	P,TMPOUT
	PUSHJ	P,OUTSIX	;OUTPUT SIXBIT LABEL
	MOVEI	T1,"^"		;AND DELIMITER
	PUSHJ	P,TMPOUT
IDENT1:	MOVEI	T1,"="
	PUSHJ	P,TMPOUT
	PUSHJ	P,OUCRLF	;FINISH LINE
	PUSHJ	P,SCAN		;SEE WHATS NEXT
	CAIN	C,","		;MORE
	JRST	IDENT		;YES
	JRST	OPIP2		;NO GIVE UP

TAPEID:	TRO	FL,INPRNT	;TREAT @ AND ; AS NORMAL CHARS
	PUSH	P,C		;SAVE DELIMITER
	MOVEI	T1,"^"
	PUSHJ	P,TMPOUT
IDENT2:	PUSHJ	P,GETCH
	HRRZ	T1,C
	CAMN	T1,(P)		;SAME DELIMITER?
	JRST	IDENT3		;YES
	CAIN	C,177		;EOF ?
	GOTO	SYNERR		;YES, GET OUT OF LOOP
	PUSHJ	P,TMPOUT	;NO
	JRST	IDENT2		;READ MORE

IDENT3:	TRZ	FL,INPRNT	;@ AND ; ARE SPECIAL AGAIN
	SETZM	SAVCHR		;CLEAR "^"
				;**;[154],IDENT3+3,HPW,10/24/73
	PUSHJ	P,SCAN		;[154] CLEAR "^"
	POP	P,T1		;CLEAR STACK
	MOVEI	T1,"^"		;AND DELIMITER
	PJRST	TMPOUT		;UP ARROW AND RETURN
	SUBTTL	PRESERVE/PROTECT

DOPROT:
DOPRES:	MOVE	T2,[12,,16]	;TABLE FOR STANDARD PROTECTION
	GETTAB	T2,		;GET IT
	MOVSI	T2,057000	;BETTER THAN NOTHING
	TLNN	T2,(7B2)	;TEST FOR ALREADY PRESERVED
	TLO	T2,(1B2)	;PRESERVE BIT
	MOVEI	T1,'<'		;START WITH OPEN ANGLE
	LSH	T1,3		;GET FIRST DIGIT
	LSHC	T1,3		;IN AS SIXBIT
	ADDI	T1,20
	JUMPN	T2,.-3		;FOR ALL OF NUMBER
	LSH	T1,^D12		;LEFT JUSTIFY
	TRO	T1,'> '		;CLOSE PROTECTION
	PUSH	P,T1		;AND SAVE IT
	SETZM	LOKNAM		;NO DEVICE YET
	MOVEI	T3,CHNPIP	;USE PIP
	TRO	FL,PIPF		;SO *.* WILL WORK
PROT1:	PUSHJ	P,SCANAM	;GO GET FILE NAME ETC
	CAIN	C,"]"		;DID WE HAVE A PPN?
	PUSHJ	P,SCAN		;YES, GET RID OF "]"
	SKIPN	T2,SVDEV	;A NEW DEVICE?
	SKIPA	T2,LOKNAM	;WELL AN OLD ONE THEN?
	MOVEM	T2,LOKNAM	;STORE NEW ONE AS OLD ONE
	CAIE	C,"<"		;PROTECTION FIELD?
	JRST	.+3		;NO 
	SKIPN	SVNAM		;NAME SEEN YET?
	JRST	PROT3		;NO, GET DEFAULT PROTECTION
	SKIPE	T2,LOKNAM	;DID WE FIND A DEVICE?
	PUSHJ	P,OUTDEV	;YES, OUTPUT IT
	TRNE	FL,IDF		;DON'T IF WE ALREADY HAVE IT
	PUSHJ	P,SCAN
	CAIE	C,"<"		;PROTECTION CODE
	JRST	PROT2		;NO
	PUSHJ	P,GTPROT	;GET PROTECTION IN T2
	PUSHJ	P,OUTSIX
	PUSHJ	P,SCAN
	CAIE	C,"["		;CHECK AGAIN FOR PPN
	JRST	PROT4		;NO
	PUSHJ	P,GETPP1	;YES, GET IT
	PUSHJ	P,SCAN		;PASS OVER "]"
	JRST	PROT4		;ALREADY PUT OUT PROTECTION

PROT2:	MOVE	T2,(P)		;GET DEFAULT PROTECTION
	PUSHJ	P,OUTSIX	;USE IT EVEN IF ZERO
PROT4:	MOVSI	T2,'/R='	;[233] RENAME FOR PIP
	PUSHJ	P,OUTSIX
	PUSHJ	P,OUTNAM	;NAME.EXT [PPN]
	PUSHJ	P,OUCRLF	;END WITH CR-LF
	CAIN	C,","		;MORE TO COME
	JRST	PROT1		;YES
	SUB	P,[1,,1]	;PUT STACK BACK
	JRST	OPIP2		;AND EXIT

PROT3:	PUSHJ	P,GTPROT	;GET PROTECTION
	MOVEM	T2,(P)		;SAVE AS NEW DEFAULT
	JRST	PROT1		;SCAN AGAIN FOR FILE NAME

GTPROT:	PUSHJ	P,SCAN		;GET NUMBER
	PUSHJ	P,SCAN		;AND DELIMITER
	CAIE	C,">"		;IT BETTER BE RIGHT ONE
	GOTO	SYNERR		;IT WASN'T
	MOVS	T2,ACCUM	;[231] GET 3 NUMBERS
	TRC	T2,'000'	;[231] BUT WE NEED ALL 3 
	TRCN	T2,'000'	;[231] OR ITS AN ERROR
	TDNE	T2,[-1,,505050]	;[231] MORE THAN 3 OR NOT ALL OCTAL?
	GOTO	IPCERR		;[231] ERROR
	TLO	T2,'<'
	LSH	T2,^D12		;SHIFT TO LEFT
	TRO	T2,'> '
	POPJ	P,		;RETURN WITH PROTECTION IN T2 IN SIXBIT
	SUBTTL	EDIT

DOEDIT:	PUSHJ	P,SCAN		;START ON THE FILE NAME
DOEDT1:	PUSHJ	P,GETNAM
	MOVEI	T3,CHNEDT
	MOVEI	T1,"S"		;COMMAND FOR LINED
;CROCK IN TECO DELETES FIRST CHARACTER
	TRNN	FL,SOSF		;DON'T GIVE SOS THE S
	PUSHJ	P,TMPOUT	;OUTPUT THE S
	TRNE	FL,TECOF!SOSF	;IF TECO OR SOS
	SKIPN	T2,SVDEV	;AND A DEVICE SEEN
	JRST	.+2		;NO, NOT BOTH CONDITIONS
	PUSHJ	P,OUTDEV	;OUTPUT THE DEVICE
	PUSHJ	P,OUTNAM	;OUTPUT THE NAME & EXT
;THIS CODE PASSES REST OF LINE TO THE EDITOR SO SWITCHES CAN BE USED
;BUT CHANGES (SWITCH) TO /SWITCH
	CAIE	C,POPFIL	;[224] TERMINATOR?
	TLNE	CS,TERMF	;ALREADY TERMINATED?
	JRST	%NOSLS		;YES - HANDLE NORMALLY
	CAIN	C,"("		;IF FIRST CHAR IS OPEN PAREN
	MOVEI	C,"/"		;CHANGE TO SLASH
	CAIE	C,"]"		;GET RID OF "]" IF JUST SEEN PPN
	JRST	%GIVE		;PASS REMAINDER OF STRING TO NEXT CUSP
%MORE:	PUSHJ	P,GETCH		;MORE CHARS COMING (MAYBE SWITCHES)
	CAIN	C,"("		;OPEN PAREN
	MOVEI	C,"/"		;BECOMES SLASH
	CAIN	C,")"		;CLOSE PAREN
	JRST	%MORE		;IS IGNORED
;[210] CODE DELETED HERE
	TLNE	CS,TERMF	;SOME OTHER KIND OF TERMINATOR?
	JRST	%NOSLS		;YES - FINISH UP NORMALLY
%GIVE:	MOVE	T1,C		;PASS THE CHARACTER TO THE EDITOR
				;**;[166],GIVE+1,HPW,10/19/73
	CAIE	C,15		;[166] DON'T PASS CR TO EDITOR
	PUSHJ	P,TMPOUT	;LEAVE ERROR DETECTION TO THE EDITOR
	JRST	%MORE		;GO BACK FOR ANOTHER CHAR
%NOSLS:	TRNE	FL,CREATF	;EDIT OR CREATE?
	JRST	DOEDT3		;CREATE (OR MAKE)
	PUSHJ	P,OUCRLF	;EDIT (OR TECO) - OUTPUT CRLF
DOEDT2:	PUSHJ	P,TMPCHK
	MOVE	T1,[EXP	EDITOR]
;DOEDT2 + 1 1/2
IFN FTIPC, <	;DISTINGUISH BETWEEN EDITS/SOS SYSTEMS [VIPCED 05]
	MOVE	T2, [34,,11]	;%CNVER
	GETTAB	T2,
	 SETZ	T2,
	SKIPL	T2		;IF BIT 0 ON, SKIP TO USE SOS
>
	TRNE	FL,SOSF		;SOS?
	MOVSI	T1,'SOS'	;YES
	TRNE	FL,TECOF
	JRST	ISTECO		;TECO OR MAKE COMMAND
ENDED:	MOVEM	T1,PCNAM
	JRST	DONE	;GO GET IT LOADED

DOEDT3:	MOVEI	T1,175		;OLD ALTMODE
	PUSHJ	P,TMPOUT	;ENDS CREATE OR MAKE COMMAND
	JRST	DOEDT2

ISTECO:	MOVE	14,SVNAM	;EDITING THIS PROGRAM
	TRNE	FL,CREATF	;CHECK FOR MAKE COMMAND
	CAME	14,[SIXBIT /LOVE/]	;WITH ARGUMENT OF LOVE
	JRST	ISTEC1		;NO SUCH HACK
	SKIPE	SVEXT		;BUT ONLY IF EXT IS BLANK
	JRST	ISTEC1		;NO SUCH LUCK
	MOVEI	T2,2		;YES. PAUSE THOUGHTFULLY
	CALLI	T2,31		;BY SLEEPING
	STRING [ASCIZ /not WAR?
/]
ISTEC1:	MOVE	T1,[SIXBIT /TECO/]	;NAME OF CUSP
	JRST	ENDED

;NOTE: LEAVE THE ABOVE HACK IN FOR SALES DEMOS
	SUBTTL	TYPE/LIST

IFE LSTRSW,<
CHNLST==CHNPIP		;USE PIP FOR A LISTER
>

TYPR:	SKIPA	T2,['TTY:/C']	;[214]
LISTR:	MOVE	T2,['LPT:/X']
	MOVEI	T3,CHNLST
	PUSHJ	P,OUTSIX
	MOVEI	T1,"="		;[233]
	PUSHJ	P,TMPOUT	;DON'T FORGET "_"
IFE LSTRSW,<
	TRO	FL,PIPF		;IF IT'S PIP, ALLOW *.MAC, ETC.
	>
LSTLP:	PUSHJ	P,SCANAM	;GET NAME
	SKIPN	T2,SVDEV
	JRST	LSTLP1		;USE PREV NAME IF NO NEW NAME
	PUSHJ	P,OUTDEV	;OUTPUT IT
LSTLP1:	PUSHJ	P,OUTNAM	;FILE NAME
	PUSHJ	P,SCAN
IFE LSTRSW,<
	CAIE	C,"/"
	CAIN	C,"("		;SWITCHES?
	PUSHJ	P,COPYSW	;YES, OUTPUT THEM
	>
IFN LSTRSW,<
	CAIE	C,"("		;PAGE SPEC?
	JRST	ENDLST		;NO
	MOVEI	T1,"("		;OUTPUT THE ( TO FILE
	PUSHJ	P,TMPOUT
LST1:	PUSHJ	P,GETCH		;COPY PAGE SPEC
	MOVE	T1,C		;TO OUTPUT AC
	PUSHJ	P,TMPOUT	;THENCE TO FILE
	CAIE	C,")"		;THROUGH END OF ARG
	JRST	LST1		;MORE
	PUSHJ	P,SCAN		;NOW WHAT?
	>
ENDLST:	CAIN	C,","		;SHOULD BE COMMA OR CR
	JRST	[MOVEI T1,","
		 PUSHJ P,TMPOUT
		 JRST LSTLP]
	TLNN	CS,TERMF	;SHOULD BE TERMINATOR
	GOTO	SYNERR		;WASNT
IFE LSTRSW,<
	JRST	OPIP1
	>
IFN LSTRSW,<
	PUSHJ	P,OUCRLF	;ADD CRLF TO COMMAND
	PUSHJ	P,TMPCHK	;OUTPUT THE FILE
	MOVE	T1,[SIXBIT /LISTER/]
	MOVEM	T1,PCNAM
	JRST	DONE1
	>

	SUBTTL	TAPE FUNCTIONS

DOEOF:	SKIPA	T2,['(MF)= ']	;[233]
DOZERO:	MOVSI	T2,'/Z='	;[233]
	TRO	FL,PIPF		;INCASE *.*
	PUSH	P,T2		;SAVE COMMAND
	MOVEI	T3,CHNPIP	;OUTPUT CHANNEL
TAPEF:	PUSHJ	P,SCANAM	;GO GET DEVICE ETC
	SKIPN	T2,SVDEV	;[213] WAS DEVICE SPECIFIED?
	GOTO	XPDERR		;[213] NO, GIVE ERROR MESSAGE
	PUSHJ	P,OUTDEV	;YES, OUTPUT IT
	PUSHJ	P,OUTNAM	;FILENAME AND PPN
	MOVE	T2,(P)		;GET TAPE FUNCTION
	PUSHJ	P,OUTSIX
	PUSHJ	P,OUCRLF	;FINISH LINE
	CAIE	C,","		;MORE COMMAND?
	JRST	OPIP2		;NO, EXIT
	TRNE	FL,IDF		;MORE THAN JUST DEVICE?
	PUSHJ	P,SCAN		;YES, PASS OVER COMMA
	JRST	TAPEF		;YES

DOSKIP:	TDZA	T2,T2		;SIGNAL FORWARDS BY 0
DOBKSP:	SETO	T2,		;BACKWARDS BY -1
	PUSH	P,T2		;STORE IT
	PUSH	P,[0]		;AND COUNT
	TRO	FL,PIPF		;JUST INCASE
	MOVEI	T3,CHNPIP	;USE PIP
	PUSHJ	P,SCANAM	;GO GET SOMETHING
	SKIPN	T2,SVDEV	;[213] FIND A DEVICE?
	GOTO	XPDERR		;[213] NO, GIVE ERROR MESSAGE
	PUSHJ	P,OUTDEV	;YES
TAPESP:	SKIPN	T2,SVNAM	;[213] FIND SOMETHING IN FILE NAME?
	GOTO	SYNERR		;MUST FIND SOMETHING
	SETO	T1,		;FIND THE MASK
	LSH	T1,-6		;MUST BE AT LEAST ONE CHAR. ANYWAY
	TDNE	T2,T1		;DON'T MASK REAL CHAR.
	JRST	.-2		;SHIFT AND TRY AGAIN
	SETZ	T4,		;START AT FRONT OF TABLE
TPSRCH:	MOVE	T3,TPTBL(T4)	;GET FUNCTION
	ANDCM	T3,T1		;MASK IT
	CAMN	T2,T3		;FOUND IT?
	JRST	TPFND		;YES
	CAIGE	T4,TPLEN	;STILL IN TABLE
	AOJA	T4,TPSRCH	;YES, TRY NEXT
	TLNE	T2,(1B0)	;IS IT A NUMBER?
	GOTO	SYNERR		;NO
	MOVEM	T2,(P)		;REPLACE DUMMY COUNT
	PUSHJ	P,SCANAM	;[213] FIND SOMETHING
	JRST	TAPESP
TPFND:	MOVEI	T3,CHNPIP	;RESTORE PIP
	MOVSI	T2,'(M '	;START OF SWITCH
	SKIPE	(P)		;NUMBER SPECIFIED
	TLO	T2,'  #'	;YES
	PUSHJ	P,OUTSIX	;OUTPUT IT
	POP	P,T2		;GET NUMBER
	SKIPE	T2		;DON'T BOTHER IF ZERO
	PUSHJ	P,OUTSIX
	MOVE	T2,TPFN(T4)	;PICK UP PIP CHAR
	SKIPE	(P)		;IF FORWARDS
	MOVSS	T2		;NO, BACKSPACE
	HLLZS	T2		;CLEAR RIGHT
	PUSHJ	P,OUTSIX
	PUSHJ	P,OUCRLF	;FINISH WITH CRLF
	CAIE	C,","		;MORE TO COME
	JRST	OPIP2		;NO, EXIT
	PUSHJ	P,SCAN		;PASS OVER COMMA
	JRST	DOBKSP+2	;YES, START AGAIN

TPTBL:	SIXBIT	/FILES/
	SIXBIT	/RECORD/
	SIXBIT	/EOT/
TPLEN==.-TPTBL

TPFN:	'A)=',,'B)='		;[233]
	'D)=',,'P)='		;[233]
	'T)=',,'T)='		;[233]

DOREW:	SKIPA	T2,[1]
DOUNLD:	MOVEI	T2,11
	TRO	FL,PIPF
	PUSH	P,T2		;SAVE FUNCTION
DOMTP:	PUSHJ	P,SCANAM	;GET A DEVICE ETC
DOMTP0:	SKIPN	T1,SVDEV	;GET THE DEVICE
	JRST	NOMTPD		;NO DEV: SEEN
DOMTP1:	MOVEM	T1,LOKNAM	;STORE IN LOOKUP BLOCK
	OPEN	LOOK,LOKINT	;INIT
	JRST	DODVNA		;NO SUCH DEVICE
	MTAPE	LOOK,0		;WAIT ON FREE DEVICE
	MTAPE	LOOK,@(P)	;DO FUNCTION
	RELEASE	LOOK,		; AND FREE UP THE DRIVE
DOMTPC:	CAIE	C,","		;MORE TO DO?
	JRST	DOEND		;NO
	TRNE	FL,IDF		;UNLESS DONE ALREADY
	PUSHJ	P,SCAN		;PASS OVER THE COMMA
	JRST	DOMTP		;GET NEXT

NOMTPD:	SKIPN	T1,SVNAM	;DID WE SEE A FILE NAME?
	GOTO	SYNERR		;NO, U LOSE
	CAIN	C,","		;IF A COMMA WE'RE AT END OF THIS SPEC
	JRST	DOMTP1		;SO USE "FILE NAME" AS DEVICE
	PUSH	P,T1		;SAVE IT
	SETZM	SVNAM		;CLEAR NAME
	PUSHJ	P,SCANAM	;SEE IF MORE SPECIFIED
	POP	P,T1		;RECOVE PREV NAME
	SKIPE	SVDEV		;FOUND A DEV AT LAST?
	JRST	DOMTP0		;YES, USE IT
	SKIPE	SVNAM		;BUT NOT 2 NAMES
	GOTO	SYNERR
	JRST	DOMTP1		;USE SINGLE "FILE NAME"
DODVNA:	STRING	[ASCIZ /?CMLDVA Device not available - /]
	MOVE	T3,LOKNAM
	MOVE	T1,[POINT 7,ERRBUF]
	PUSHJ	P,SIXOUT
	MOVEI	T2,":"
	IDPB	T2,T1
	MOVEI	T2,15
	IDPB	T2,T1
	MOVEI	T2,12
	IDPB	T2,T1
	MOVEI	T2,0
	IDPB	T2,T1
	STRING	ERRBUF
	JRST	DOMTPC		;SEE IF MORE TO DO

	SUBTTL	OUTPUT ROUTINES

OUTDEV:	PUSHJ	P,OUTSIX	;OUTPUT DEVICE
	MOVEI	T1,":"		;AND A COLON
	PJRST	TMPOUT		;RETURN TO USER

OUTNAM:	SKIPN	T2,SVPPP	;STICKY PPN?
	JRST	OUTNM1		;NO
IFN SFDSW,<
	PUSH	P,SVPPN		;SAVE 
	SETZM	SVPPN		;MARKER FOR OUTSFD/OUTSFP
	>
	PUSHJ	P,OUTPPN	;OUTPUT [DIRECTORY]
IFE SFDSW,<
	MOVE	T2,SVPPP
	CAMN	T2,SVPPN	;SAME AS NON-STICKY?
	>
IFN SFDSW,<
	POP	P,SVPPN		;RESTORE
	PUSHJ	P,CHKSFD	;SEE IF WHOLE SFD SAME
	>
	SETZM	SVPPN		;YES, PIP CAN HANDLE IT OK
OUTNM1:	SKIPN	T2,SVNAM
	JRST	OUTPP
	PUSHJ	P,OUTSIX
	SKIPE	T2,SVEXT
	PUSHJ	P,OUTEXT
OUTPP:	SKIPE	T2,SVPPN	;GET PPN
	PJRST	OUTPPN		;OUTPUT IF NON-ZERO
	POPJ	P,

OUTEXT:	MOVEI	T1,"."
	PUSHJ	P,TMPOUT
	HLLZ	T2,T2		;3 CHAR ONLY
	JRST	OUTSIX

OUCRLF:	MOVEI	T1,15		;CARRIAGE RETURN
	PUSHJ	P,TMPOUT	;TO CURRENT OUTPUT FILE
	MOVEI	T1,12		;LINE FEED
	JRST	TMPOUT		;TO OUTPUT FILE

	PUSHJ	P,GETCH		;COPY THE SWITCH
COPYSW:	CAIN	C,"/"		;SINGLE SWITCH
	JRST	COPYS1		;YES
	MOVE	T1,C		;TO OUTPUT AC
	PUSHJ	P,TMPOUT	;THENCE TO FILE
	CAIE	C,")"		;UNTIL END OF SWITCH
	JRST	COPYSW-1	;BUT NOT YET
COPYSR:				;BACKUP 3 LOCS INCASE MORE SWITCHES
REPEAT 3,<
	SOS	(P)
	>
				;**;[154],COPYSR+3,HPW,9/18/73
	SETZM	SAVCHR		;[154] GET RID OF "/" OR ")"
	JRST	SCAN		;GET NEXT AND RETURN

COPYS1:	MOVE	T1,C		;GET "/"
	PUSHJ	P,TMPOUT	;OUTPUT IT
	PUSHJ	P,GETCH		;GET NEXT CHAR
	MOVE	T1,C
	PUSHJ	P,TMPOUT	;OUTPUT SWITCH
	JRST	COPYSR		;RETURN

IFN SFDSW,<
OUTSFD:	SKIPN	SVPPN(SVPT)	;STICKY SFD MARKER?
	JRST	OUTSFP		;YES
	X==0			;INITIAL CONDITION
REPEAT SFDLEN,<
	SKIPE	T2,SVSFD+X(SVPT)
	PUSHJ	P,SFDOUT
	X==X+NFILE
	>
	POPJ	P,		;RETURN TO PRINT "]"

OUTSFP:	X==0			;INITIAL CONDITION
REPEAT SFDLEN,<
	SKIPE	T2,SVSFP+X
	PUSHJ	P,SFDOUT
	X==X+1
	>
	POPJ	P,		;RETURN TO PRINT "]"

SFDOUT:	MOVEI	T1,","		;SEPARATOR
	PUSHJ	P,TMPOUT	;OUTPUT IT
	PJRST	OUTSIX		;FOLLOWED BY SFD

CHKSFD:	MOVSI	T1,-SFDLEN	;AOBJN POINTER
	MOVE	T2,SVPPN
	CAME	T2,SVPPP	;CHECK PPN FIRST
	JRST	CPOPJ1		;SKIP IF DIF
	MOVE	T2,SVSFD(T1)	;GET SFD
	CAME	T2,SVSFP(T1)
	JRST	CPOPJ1
	ADDI	T1,NFILE-1	;LENGTH APPART
	AOBJN	T1,.-4		;LOOP FOR ALL SFD'S
	POPJ	P,		;NON-SKIP IF IDENTICAL

	>
	SUBTTL	TMP FILE ROUTINES

;USEFUL SYMBOLS
TMPFST==0		;POINTER TO FIRST BUFFER
TMPCUR==1		;POINTER TO CURRENT BUFFER
TMPPTR==2		;BYTE POINTER
TMPCNT==3		;BYTE COUNT (LEFT TO FILL)
TMPHDR==4		;SIZE OF BUFFER "HEADER"

TMPBUF==^D128+2		;SIZE OF DATA BUFFER
TMPIOW==0		;IOWD FOR DUMP MODE
TMPLNK==1		;LINK TO NEXT BLOCK (GOTO WORD)
TMPDAT==2		;FIRST DATA WORD


;ENTER WITH OUTPUT BYTE IN T1
;INDEX TO TABLE IN T3
;USES T5 AS ADDRESS OF "BUFFER HEADER"

TMPOUT:	JUMPL	T3,CPOPJ	;[230] DO NOT DEPOSIT IF -1
	SKIPN	T5,TMPCHN(T3)	;ALREADY SET UP "HEADER AND BLOCK"?
	PUSHJ	P,TMPINI	;NO, DO SO
	SOSG	TMPCNT(T5)	;ANY ROOM
	PUSHJ	P,TMPOU1	;NONE LEFT
	IDPB	T1,TMPPTR(T5)	;YES, DUMP BYTE
	POPJ	P,		;AND RETURN

TMPINI:	PUSH	P,[EXP	TMPRET]	;WHERE TO RETURN TO ON POPJ
	PUSH	P,T1		;SAVE T1
	PUSH	P,T2		;AND T2
	MOVEI	T1,TMPHDR	;LENGTH WE NEED
	PUSHJ	P,GETSPC	;GET IT, OR ABORT
	HLL	T1,FL3		;GET NEW!OLD!SYS!SELF
	TLZ	T1,-1-DEVSWS	;BUT ONLY THOSE
	MOVEM	T1,TMPCHN(T3)	;STORE INFO
	HRRZ	T5,T1		;AND INTO T5
	MOVEI	T1,TMPBUF	;LENGTH OF DATA BLOCK
	PUSHJ	P,GETSPC	;GET 1 BLOCK TO START WITH
	MOVEM	T1,TMPFST(T5)	;STORE IN HEADER BLOCK
	PJRST	TMPOU2		;AND CLEAR BUFFER
TMPRET:	AOS	TMPCNT(T5)	;SET COUNT TO ^D<5*128>
	POPJ	P,

TMPOU1:	PUSH	P,T1		;SAVE T1
	PUSH	P,T2		;AND T2
	MOVEI	T1,TMPBUF	;LENGTH OF DATA BLOCK
	PUSHJ	P,GETSPC	;GET 1 BLOCK
	MOVE	T2,TMPCUR(T5)	;LINK THIS TO CURRENT
	HRRZM	T1,TMPLNK(T2)
TMPOU2:	MOVEM	T1,TMPCUR(T5)	;STORE IN HEADER BLOCK
	HRRZ	T2,T1		;GET ANOTHER COPY
	ADDI	T1,TMPDAT	;POINT TO DATA AREA
	HRLI	T1,(POINT 7,)	;FORM BYTE POINTER
	MOVEM	T1,TMPPTR(T5)	;STORE BYTE POINTER
	MOVEI	T1,^D<5*128>-1	;BYTE COUNT
	MOVEM	T1,TMPCNT(T5)	;PER BUFFER
	HRRZ	T1,T2		;START OF DATA
	HRL	T1,T1		;FORM XWD
	SETZM	(T1)		;ZERO FIRST WORD
	ADDI	T1,1		;FORM BLT WORD
	BLT	T1,TMPBUF-1(T2)	;CLEAR ALL BUFFER
	POP	P,T2
	POP	P,T1
	POPJ	P,		;NOW DO STORE BYTE
;HERE TO CLOSE THE TMP AREA AND WRITE OUT FILES

TMPCHK:	SKIPN	T5,TMPCHN(T3)	;THERE BETTER BE ONE
	POPJ	P,		;NO, SO GIVE UP
	PUSH	P,T1		;SAVE T1 JUST INCASE
	PUSH	P,T2		;T2 ALSO
	HLLZ	T1,T5		;GET RUN DEV: BITS
	JUMPE	T1,.+3		;NO
	JFFO	T1,.+1		;GET INDEX
	MOVE	T1,PRCDEV(T2)	;GET DEVICE
	MOVEM	T1,PCDEV	;SET TO LINK TO IT
	MOVE	T1,TMPCUR(T5)	;POINT TO LINK IN LAST BLOCK
	ADDI	T1,TMPDAT-1	;POINT TO DATA-1
	HRRZM	T1,@TMPCUR(T5)	;STORE START ADDRESS
	MOVEI	T1,^D<5*128>+4	;BYTE COUNT INITIALLY (PLUS REMAINDER)
	SUB	T1,TMPCNT(T5)	;MINUS WHAT'S LEFT IS WHAT'S USED
	IDIVI	T1,5		;GET WORD COUNT
	POP	P,T2
	MOVN	T1,T1		;NEGATE
	HRLM	T1,@TMPCUR(T5)	;IOWD IS SET UP
	MOVE	T5,TMPCHN(T3)	;GET POINTER TO HEADER AGAIN
	MOVE	T1,TMPFST(T5)	;POINT TO LINK IN FIRST BLOCK
	SKIPE	TMPLNK(T1)	;ONLY ONE BLOCK
	JRST	TMPDSK		;NO SUCH LUCK, USE DSK
	HLLZ	T1,PROCTB(T3)	;GET NAME
	CAMN	T1,['LIN   ']	;IS THIS LINK-10
	MOVSI	T1,'LNK'	;BETTER 3 LETTER NAME
	MOVEM	T1,TMPFIL	;INTO TMPCOR BLOCK
	MOVE	T1,@(T5)	;PICK UP SINGLE IOWD
	MOVEM	T1,TMPFIL+1	;STORE IT
	MOVE	T1,[3,,TMPFIL]	;SET UP FOR WRITE
IFN SNOBOL,<
	CAIE	T3,CHNSNO	;SNOBOL CAN'T READ TMP:
>
	TMPCOR	T1,		;TRY IT
	  JRST	TMPDS2		;YOU LOSE, TRY DSK
TMPXIT:	SETZM	TMPCHN(T3)	;ONLY DO IT ONCE
	POP	P,T1
	POPJ	P,

TMPDSK:	MOVE	T5,(T5)		;POINT TO FIRST DATA BLOCK
TMPDS1:	SKIPGE	(T5)		;IOWD SET UP YET?
	JRST	TMPDS2		;YES, REACHED END
	MOVSI	T1,-^D128	;NO, USE 128 WORD BLOCKS
	HRRI	T1,1(T5)	;POINT TO DATA
	MOVEM	T1,(T5)		;STORE IOWD
	SKIPE	T5,1(T5)	;GET NEXT POINTER
	JRST	TMPDS1		;NOT DONE YET
TMPDS2:	HLRZ	T1,PROCTB(T3)	;GET PROCESSOR
	CAIN	T1,'LIN'	;CHANGE LINK-10 
	MOVEI	T1,'LNK'	;AS THIS IS BETTER
	HLL	T1,JOBNAM	;GET JOB NUMBER IN SIXBIT
	MOVEM	T1,NAME
	MOVE	T1,@TMPCHN(T3)	;MOVE IO LIST POINTER TO
	MOVEM	T1,TMPFIL	;A COMMON TEMP CELL
	PUSHJ	P,TMPDS0	;USE COMMON ROUTINE, FROM "DONE" TOO
	JRST	TMPXIT		;WRAP UP USE OF THIS CHANNEL

TMPDS0:	MOVSI	T1,'TMP'
	MOVEM	T1,NAME+1
	SETZM	NAME+2
	SETZM	NAME+3
IFE TENEX,<
IFE FASTFS,<
	SKIPN	FSNAME		;DO WE HAVE FASTEST F/S
	PUSHJ	P,FNDFST	;NO, GET IT>
	MOVEI	T1,16		;DUMP RECORD
	MOVEM	T1,FSINIT
	SETZM	FSBHD		;CLEAR BUFFER HEADER
	OPEN	LOOK,FSINIT	;INIT THE F/S
	  JRST	DOEND		;[206] ERROR
	ENTER	LOOK,NAME
	  JRST	FIU		;ERROR
	MOVE	T1,@TMPCHN(T3)	;GET ADDRESS OF IOWD LIST
	OUTPUT	LOOK,(T1)	;OUTPUT THE DATA
	CLOSE	LOOK,20		;SAVE THE NAME BLOCKS
>
IFN TENEX,<
	PUSH	P,T3		;SAVE THE CHANNEL NUMBER
	MOVE	T4,[POINT 7,GJFNST];WHERE NAME WILL GO
	MOVE	T2,NAME		;JOB NUMBER AND PROCESSOR
	MOVEI	T1,0		;CLEAR AC FOR ASCII CHAR
	LSHC	T1,6		;PUT A SIXBIT CHAR IN IT
	ADDI	T1,40		;MAKE ASCII
	IDPB	T1,T4		;TO NAME
	JUMPN	T2,.-4		;BUILD 6 CHARS OF NAME
	MOVE	T1,T4		;APPEND FOLLOWING STRING TO IT
	HRROI	T2,[ASCIZ /.TMP;0/]
	MOVEI	T3,0
	SOUT
	POP	P,T3		;RECOVER CHANNEL NUMBER
	MOVSI	T1,401001	;OUTPUT SHORT STRING IGNR DEL
	HRROI	T2,GJFNST	;STRING STORAGE
	GTJFN
	JRST	FIU
	PUSH	P,T1		;SAVE THE JFN
	MOVE	T2,[440000,,100000];WRITE 36 BIT MODE
	OPENF
	JRST	[POP P,T1
		 CLOSF
		 JFCL
		 JRST FIU]
	MOVE	T1,(P)		;JFN
	MOVEM	T3,(P)		;CHANNEL INDEX
	MOVEI	T4,TMPFIL	;GET INITIAL IO LIST POINTER
	MOVE	T2,[1,,1]	;UNDELETE THE FILE
	MOVEI	T3,T3		;GET CONTROL BITS
	GTFDB			; ..
	HRLI	T1,1		;CHANGE WORD 1
	MOVSI	T2,(1B3)	;THIS BIT
	TLZ	T3,(1B3)	;TO THIS VALUE (0)
	CHFDB
	HRRZS	T1		;GET JFN BACK
TMPDSL:	SKIPN	T2,(T4)		;END?
	JRST	TMPDS3		;YES
	JUMPG	T2,[HRRZ T4,T2	;NO. IF PLUS, A JUMP WORD
		  JRST TMPDSL]	;GO TO IT
	HLRE	T3,T2		;NEGATIVE COUNT
	HRLI	T2,4400		;BYTE POINTER WILL COUNT TO FIRST WD
	SOUT			;SEND IT
	AOJA	T4,TMPDSL	;LOOP THRU IO LIST

TMPDS3:	POP	P,T3		;RESTORE CHANNEL NUMBER
	CLOSF			;CLOSE FILE IN T1
	JFCL
U	(GJFNST,4)		;FOR JFN STRING STORAGE
>
	POPJ	P,0		;END OF TMPDS0 ROUTINE


;HERE TO GET SPACE FROM FREE CORE, ENTER WITH T1 CONTAINING
; SPACE REQUIRED, EXIT WITH ADDRESS IN T1

GETSPC:	ADD	T1,SVJFF	;GET ADDRESS OF NEXT FREE WORD
	CAMGE	T1,CORTOP	;ENOUGH SPACE?
	JRST	GOTSPC		;YES
	PUSH	P,T1		;SAVE ACCS
	PUSH	P,T2
	MOVEI	T1,2000		;INCREMENT BY 1K
	ADDM	T1,CORTOP
	ADDM	T1,CORT1
	ADD	T1,.JBREL	;NEW TOP
	CORE	T1,
	  JRST	NOCOR		;LOSE
	MOVE	T1,.JBREL
	MOVE	T2,-2000(T1)	;MOVE CORE UP
	MOVEM	T2,(T1)
	CAMLE	T1,CORTOP	;DONE?
	SOJA	T1,.-3		;NO
	POP	P,T2
	POP	P,T1
GOTSPC:	MOVEM	T1,.JBFF	;STORE HIGHEST LOC IN USE
	EXCH	T1,SVJFF	;AND HERE ALSO
	POPJ	P,

SUBTTL	TABLE OF PROCESSOR NAMES
DEFINE X (A,B,C,D,E,F,G)<
IFDIF <A><MACY11>,<
	<SIXBIT /A/>>
IFIDN <A><MACY11>,<
	<SIXBIT	/B/>>
>
PROCTB:	PROCESS
REPEAT MXPROC-NPROCS,<0>	;FILL IN MISSING ONES
	XPROCESS	;AND THESE
SUBTTL	DATA STORAGE ASSIGNMENTS
	SALL
WORDS	<PCNAM,PCDEV,LODDEV,SAVPPN,SVSWP,PCNUM,OLDEXT,SDAT,STIM,SAVCHR>
WORDS	<ACCUM,DINPT,DINCT,SVJFF,CORTOP,CORT1,SVRPP,NUMAT,DFPROC>
WORDS	<SVIND,SVPDL,JOBNAM,BROCNT,LODSP2,LODCT2,LODSP,LODCTR>

IFN FTFIX, <U (EXTEND,1)>	;NEEDED FOR EDIT 240 [VIPCED 03]
U (LODSBK,<LODSCT/5+1>)
U (LODSB2,<LODSCT/5+1>)

WORDS <SWBKB,SWBKL>

U (SWBKS,NFILE)

U (ODEV,1)
U (ONAM,1)
U (OEXT,1)
U (OPPN,1)
IFN SFDSW,<U (OSFD,SFDLEN)>

IFN FTFIX, <	U (SVDEVV,1)	>	;[VIPCED 03] NEEDED FOR ED 254
U (SVDEV,NFILE)
U (SVNAM,NFILE)
U (SVEXT,NFILE)
U (SVPPN,NFILE)
U (SVPPP,1)
IFN SFDSW,<U (SVSFD,<NFILE*SFDLEN>)
U (SVSFP,SFDLEN)>

U (TTYPT,1)
U (LOOKBF,3)
U (PDLB,PDL+1)
U (SWBLK,SWBK+1)
U (OPENB,3)
U (IOPD,<<NESTDP+1>*3+1>)
U ERRBUF,22		;FOR TYPEOUTS
U BUFTAB,<NESTDP+1>		;WHERE THE BUFFERS ARE FOR FILES
U FREBUF,<NESTDP+1>		;FREED BUFFERS
U (TMPFIL,2)
U (TMPCHN,<MXPROC+XTPROC>)	;NUMBER OF "CHANNELS" REQUIRED
WORDS	<FSINIT,FSNAME,FSBHD>
WORDS <MAPSW,FDGFLG,DEBFL,EXECFL,DDTFL,FORLIB,RUNCOR,MYPPN,SPDLPT,CPU>
IFN FORTRAN,<U (FORPRC,1)>
U (GOTPST,1)			;-1 WHEN PAST SWITCH SCANNER
U (PARLVL,1)			;[221] LEVEL OF PAREN NESTING IN COMPILER SWITCHES
U (DEBPRM,DEBSIZ)		;[221] AREA TO HOLD PERM SWITCHES
U (DEBTMP,DEBSIZ)		;[221] DITTO FOR TEMP
U (SAVSW,1)			;[234] EITHER /SAVE OR /SSAVE FOR THIS FILE
U (NSWTCH,1)			;[236] -1 IF /L SEEN LAST
;THIS IS THE PART THAT MUST BE INITIALIZED IF PURE.
;JUST USED AS IS IF IMPURE

IFN FTFIX, <	;[VIPCED 03] MORE SPACE FOR EXTENDED LOOKUPS - ED.240
WORDS(<EBLK,EPPN,NAME,LEXT,LDAT,LPPN>)
U(EVER,<.RBTIM-.RBSIZ>)		;EXTENSION TO LOOKUP BLOCK
>
IFE FTFIX, <	;AUGMENTED VIPCED 03
WORDS <NAME,LEXT,LDAT,LPPN>
>
LNAM=NAME
IFN SFDSW,<
WORDS <LSFDAD,LSFDSC,LSFDPP>
U (LSFD,SFDLEN)>
IFN PURESW,<
INIDAT:
U (INILOW,0)		;WHERE IT GOES IN THE LOW SEGMENT
	PHASE	INILOW>

LOKINT:	1
LOKNAM:	0
	XWD LOOKBF,LOOKBF
DSKLK:	1
	SIXBIT /DSK/
	XWD LOOKBF,LOOKBF

FCOMD:	ASCII /@***SVC.TMP
/
	BYTE (7) 177,177	;MARK EOF

FCOMD2:	ASCII /@***EDS.TMP
/
	BYTE (7) 177,177

CRFRDR:	ASCII /@***CRE.TMP/
	BYTE (7) 177,177

IFN PURESW,<
	DEPHASE
INITOP==.		;END OF INITIALIZED DATA
INILEN==INITOP-INIDAT	;LENGTH OF DATA
U (INILOW,INILEN)	;BLOCK OF STORAGE FOR DATA
>
U (LOWTOP,0)
IFN DEBSW,<
PATCH:
PAT:	BLOCK	40	;PATCH AREA FOR DEBUGGING>

	END	STPT
>
;SETUFD + 6 1/2