TITLE	COMPIL	22G(605)	CCL CONTROL CUSP
		SUBTTL	OWNER HISTORY
;	WEIHER/CLEMENTS/RCC/PMH/NGP/DMN/HPW/JNG
;		/SMM/JMT/WCL/BCM/GAT/RCB/MEM	9-SEP-87
	SUBTTL	PROGRAM TO COMPILE LOAD EXECUTE AND DEBUG USER PROGRAMS



;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1978,1983,1984,1985,1986,1987.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


	SEARCH	UUOSYM


VCOMPIL==22
VUPDATE==7			;DEC UPDATE LEVEL
VEDIT==605			;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

LOC	<.JBVER==137>
	<VCUSTOM>B2+<VCOMPIL>B11+<VUPDATE>B17+VEDIT
RELOC	0

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 FASTFS,<FASTFS=0>	;FASTEST FILE STRUCTURE
				;IF ZERO COMPIL WILL FIND IT AT RUN TIME
IFNDEF SIMULA,<SIMULA==1>	;[452] ACCEPT SIMULA AS A COMPILER
IFNDEF PASCAL,<PASCAL==1>	;[463] ACCEPT PASCAL AS A COMPILER
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)

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 SFDLEN,<SFDLEN==0>	;[601] MAKE SURE SYMBOL ALWAYS DEFINED
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 DCOBOL,<DCOBOL==1>	;[324] DEFAULT VALUE 0=COBOL-68, 1=COBOL-74
				;[451] MAKE COBOL-74 DEFAULT COBOL COMPILER
IFNDEF EDITOR,<EDITOR=='DTECO '>;EITHER LINED OR EDITS [442] DEF IS DTECO
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

;START OF VERSION 22C

;237	(14041) THE COMMAND "PROT DSKA:UFD[,]<765>" WORKED DUE
;	TO A PIP BUG. IMPLEMENT UFD'S CORRECTLY. (JNG)
;240	(14125) ON A TECO, COMPILE, LOAD SEQUENCE, COMPIL OFTEN
;	RECOMPILES AT THE LOAD. DIAGNOSIS: CREATION DATE IS ACCURATE
;	ONLY TO THE NEAREST MINUTE. FIX: DO EXTENDED LOOKUPS FOR
;	.RBTIM (1/3 SEC.) IF DEVICE IS A DISK. (JNG)
;241	(14082) FIX MEMORY MANAGEMENT PROBLEM WITH REL FILE I/O BUFFERS
;	OVERWRITING TMPCOR BUFFERS. (JNG)
;242	(14087) DELAY DECIDING FORMAT OF FOROTS/FORSE SWITCH TO ALLOW
;	"COMP/FOROTS/LINK" TO WORK. (JNG)
;243	(14732) ALLOW A DEVICE TO BE SPECIFIED FOR TMP FILES. THIS
;	WAS BROKEN BY EDIT 226. (JNG)
;244	(14663) USE USER'S DEVICE FOR REL FILE IF HE GAVE ONE.
;245	(14409) ADD SOME SYNTAX CHECKING TO THE PROTECT COMMAND.
;246	(14678) IGNORE FILES IN USER'S LIBRARY IN PREFERENCE TO
;	THOSE IN HIS DEFAULT PATH.
;247	DON'T TRY TO COMPILE REL FILES WITH NO ACCOMPANYING SOURCES.
;	THIS WAS BROKEN BY EDIT 240.
;250	TRY LIBRARY IF USER GAVE AN EXTENSION AND FILE IS NOT IN THE
;	DEFAULT PATH. THIS WENT DOWN WITH EDIT 246.
;251	IMPLEMENT DLIST SWITCH TO SPECIFY LIST FILE SPECIFICALLY
;	ON DISK, LIST WILL NOW SPECIFY TO INIT DEVICE LPT: WHETHER
;	SPOOLED OR UNSPOOLED
;	AREAS AFFECTED: STABLE MACRO DEFINITION, ATABLE MACRO DEFINITION
;		DOCOM2
;	LABELS ADDED: SETDSK,SETLPT
;252	(14995) ALLOW SLASH FOR MULTIPLE CHARACTER SWITCHES TO ALGOL
;	AREAS AFFECTED: PROCS1
;253	COMPLETE EDIT 243
;	AREAS AFFECTED: NEST
;254	MAKE DEVICE SPECIFICATIONS "STICKY"
;	AREAS AFFECTED: GETDEV,NODEV
;	LABELS ADDED: SVDEVV
;255	(15503) FIX MANTIS FEATURE SO THAT WHEN MORE THAN ONE
;	PROGRAM IS COMPILED, ALL PROGRAMS GET THE /D SWITCH SET.
;	NOTE THAT MANTIS IS UNSUPPORTED.  AREA AFFECTED - ONSET
;256	(15575) MAKE /SAVE AND /SSAVE PRODUCE THE CORRECT
;	COMMAND FILE TO LINK.
;	AREAS AFFECTED - SSAVE & NOCOMP & LODR1
;257	(15711) MAKE LINK LOAD LOCAL SYMBOLS FOR /LMAP SWITCH
;	AREAS AFFECTED: SETMPL
;260	(16101,16201) BANDAGE COMPIL AFTER MAULING BY EDIT 254
;	AREAS AFFECTED: GETDEV, NOTCPY
;261	(16120)MAKE COMPIL RESPECT ALL DOCUMENTED BREAK CHARACTERS
;	AREAS AFFECTED: CTBL
;262	(16412)EDIT 241 CAN CAUSE COMPIL TO GROW BY 1K NEEDLESSLY
;	AREAS AFFECTED: RPGRET
;263	(16558)INVALID LOGIC IS USED FOR CONVERTING UFD PROTECTION.
;	IT CAN STOP TOO EARLY.
;	AREAS AFFECTED: UFDSET
;264	(16648)COPY A.=A1,A2 DOESN'T WORK LIKE COPY A=A1,A2
;	AREAS AFFECTED: NXTNM2,NOTCPY
;	LABELS ADDED: NXTNOX
;265	(16774)EDIT 212 HAD ERROR - JFFO WON'T WORK PROPERLY
;	IF AN UNRECOGNIZED PROCESSOR IS SPECIFIED BY EXTENSION
;	AREAS AFFECTED: REREL0
;266	(16808) COMPIL LOSES ACTUAL REASON FOR LOOKUP ERROR
;	AREAS AFFECTED: NOFIL, NOTYT2, LOSE1
;267	(16937)"STICKY" DEVICE NAMES ARE STILL TOO STICKY WITH EDIT 244
;	AREAS AFFECTED: SETONM
;270	(17022) MAKE ".PROT <777>[,].UFD" WORK, & CLEAN UP DEFAULTING.
;	AREAS: DOPROT
;271	(17329) ALLOW TRAILING ASTERISK WILDCARDS IN PIP COMMANDS.
;	AREAS: SCAN
;272	(18957) ALLOW THREE AND ONLY THREE #'S IN RENAMES
;		PROTECTION SPECIFICATION.
;		AREAS: NXTNM0
;273	(18542) REMOVE EDIT #216, TECO,MAKE, ETC. SHOULD
;		GIVE "NO PREVIOUS COMMAND" ERROR AS DOES LOAD , ETC.
;		AREAS: NOFIL
;274	(18807) A PPN OF LEFT SIDE OF AN "=" IN A COMPILE-CLASS
;		COMMAND CAN BE IGNORED !
;		AREAS: DOCOMP, DOCOM3, ELOD3, ENTC2
;275	(17540) PPN NOT PASSED TO LINK TMP FILE CORRECTLY ON 
;		"+" CONSTRUCTIONS.
;		AREAS AFFECTED: LODR2
;276		IF ENTER ON TMP FILE FAILS, TRY GENERIC DEVICE DSK
;		AREAS AFFECTED: NOFIT, TMPDS0
;277		SETZ SHOULD BE A SETZM WHICH CAN CAUSE A RUN
;		UUO FAILURE BECAUSE PPN WORD IS -1. COULD CAUSE
;		OTHER UNPREDICTABLE RESULTS SINCE AC 0 IS CLEARED. ?
;		AREA AFFECTED: RUNIT
;300	(19716)	BLANK LINES AT THE BEGGINING OF A COMMAND FILE
;		CAN CAUSE UNWARRANTED COMMAND ERRORS.
;		AREAS AFFECTED: SYNERP, SCNAGN
;301		EDIT #300 FIXED AN AGE OLD BUG WHICH WAS PARTIALLY
;		FIXED BY A TEMPORAY PATCH AT LOCATION POPFIL.
;		WITH EDIT #300 AND THIS PATCH IN, AN ILL MEM REF
;		WILL OCCUR WHEN ANY PIP COMMAND IS TYPED WITH NO
;		ARGUMENT, THEREFORE REMOVE THIS PATCH !
;		AREA AFFECTED: POPFIL
;302		IN ANSWER TO SPR# 17024, AN EDIT #272 WAS MADE
;		AND UNFORTUNATLY WAS LOST. THIS EDIT REPLACES
;		THAT EDIT AND ONCE AGAIN FIXES A STICKY DEVICE/PPN
;		PROBLEM. DEVICES AND PPN'S AS SWITCH ARGUMENTS
;		SHOULD NOT STICK.
;303		IN ANSWER TO SPR#  17989, ANOTHER EDIT #272 WAS
;		GENERATED AND ALSO UNFORTUNATELY LOST. THIS
;		EDIT REPLACES THAT ONE AND MAKES THE DEFAULT
;		DEBUGGING AIDE FOR FORTRAN TO BE FORDDT WITH
;		REGULAR DDT ALSO LOADED.
;304		AS A SIDE AFFECT OF EDIT #301, LABEL DEV:/ABC/
;		WAS BROKEN. REMOVE EXTRA CALL TO SCAN GENERATED
;		BY EDIT #154.
;		AREA AFFECTED: IDENT3
;305		EDIT #300 IS INCOMPLETE AND CAUSED MANY SIDE AFFECTS.
;		EDIT #301 ATTEMPTED TO FIX ONLY ONE OF THESE EFFECTS
;		AND DID NOT FIX THE FULL SCOPE OF RELATED PROBLEMS.
;		THIS EDIT COMPLETES THE FIX EDIT #300 ATTEMPTED,
;		SUPERCEDES EDIT #301 (PUT TEMP. PATCH BACK),
;		AND ELIMINATES THE SUBTLE SIDE AFFECTS
;306		IF NO DEVICE IS SPECIFIED FOR A REWIND OR UNLOAD
;		COMMAND, THE ERROR MESSAGE SHOULD INDICATE
;		"? EXPLICITE DEVICE REQUIRED"  RATHER THAN
;		"? COMMAND ERROR"
;		AREA AFFECTED:	NOMTPD
;307		(QAR#484)SPACES AFTER A DEVICE SPECIFICATION ARE
;		IGNORED AND DO NOT TERMINATE THE FILE SPECIFICATION.
;		THEY SHOULD !
;		AREA AFFECTED:GETDEV

;START OF VERSION 22D

;310		(SPR 10-21464)PASSES INVALID TMP FILE TO LINK IF
;		A PREVIOUS COMMAND ALSO CONTAINED A MAP OR LMAP
;		SWITCH  AREAS AFFECTED: SETMAP,SETMPL
 
;311		(SPR 10-21882) SKIP MTA: NUM FILES  DOESN'T WORK
;		AREA AFFECTED:  TAPESP

;312		(SPR 10-22043) WRONG AND INVALID DEBUG AID SWITCH BEING 
;		PASSED TO LINK FOR FORTRAN.  IF F40 USE DDT AND IF
;		FORTRAN-10 USE FORDDT.  AREAS AFFECTED: PROCESS MACRO,
;		GETDD1, FOR

;313		(SPR 10-21981) IF SFDSW=0 THEN GOTSTK UNDEFINED.
;		MOVED LABEL OUTSIDE OF CONDITIONAL. AREA AFFECTED:GOTSTK
 
;314		(SPR 10-22084) COBOL PROGRAMS CANNOT BE LISTED TO LPT:
;		WITH /LIST. BUG INTRODUCED WITH EDIT 251. AREA
;		AFFECTED: DOCOM2+5

;315		(SPR 10-22658) STOP TRYING TO FIND FILES IN USER'S AREA
;		IF EXPLICIT DEVICE OR PPN IS GIVEN. ONLY LOOK ON USER'S
;		AREA FOR .REL FILES IF SOURCE FILE IS FOUND ON THE SPECIFIED
;		AREA. AREA AFFECTED: OKREL

;316		(SPR 10-22369) CORRECT RECOMPILATION LOGIC WHERE
;		STRUCTURE NAME IS SPECIFIED. CORRECTS EDIT 240.
;		AREAS AFFECTED: OKLOOK, ELOOK, ALTDAT

;317		(SPR 10-22181) PREVENT UNNECESSARY RECOMPILE WHICH OCCURS
;		IF A SOURCE FILE IS MOVED.
;		AREAS AFFECTED: ONSET,REREL2,EREL,DNLOK1,SETDT

;320		CLEAN UP CODE AND COMMENTS

;321		PROVIDE PROPER OUTPUT IF LISTING SWITCHES FOR A PROCESSOR
;		ARE SPECIFIED WITHOUT A COMPIL LISTING SWITCH.
;		AREAS AFFECTED: DOCOM2

;322		(SPR 10-24292) DON'T PASS PPN OF SOURCE TO LINK IF
;		RECOMPILE IS NECESSARY AND /SEARCH OR /LIBRARY IS GIVEN
;		AREA AFFECTED: LODR2

;323		(SPR 10-24597) WHEN SCANNING TAPE OPTIONS (...), CHECK
;		FOR VALID BREAK CHARACTER.  IF FOUND BEFORE ")" THEN ERROR.
;		AREAS AFFECTED: COPYSW

;324		REMOVE MANTIS CODE (NEED TO REUSE THE FLAG BITS)
;		ADD SUPPORT FOR COBOL-74
;		MAKE /OPT PASS /O TO COBOL
  
  
;START OF VERSION 22(E)
;424  SAVE 100 EDITS FOR DEVELOPMENT
;425	SPR # 10-26362	WCL	10-0CT-78
;	FIX CHARACTER COUNTING WHEN FILLING BLOCK; HAS BEEN PUTTING NULL
;	AS FINAL CHARACTER
;	AREAS AFFECTED: TMPOUT
;426	(SPR 10-25452) COMPIL HANGS ON COMMAND SPECIFYING
;	A DEVICE WHEN ASSEMBLED WITH SFDLEN=1
;	AREA AFFECT:  NODEV
;427	SPR # 10-26000	WKV	11-JAN-79
;	KEEP COMPIL FROM LEAVING CREF TEMP FILE ON DSK AFTER TMPCOR
;	OPENS UP. AREA AFFECTED:	POPFIL
;430	NO SPR #	WCL	05-MAR-79
;	REMOVE CORE REQUIREMENT IN RUN UUO FOR COPY/RENAME TO ALLOW
;	DEBUGGING
;	AREA AFFECTED: DOCOPY
;431	SPR # 27558	WCL	05-MAR-79
;	IGNORE EXTRA VERBIAGE IN COPY SWITCHES; STOP SCAN AFTER ONE CHARACTER
;	(WAS INTERPRETING FOLLOWING CHARACTERS AS FILE NAME)
;	AREA AFFECTED: NXTNM0
;432	SPR # 26360 + 27526
;	SETNAM UUO CAUSES CLEARING OF JB.LSY; BATCON CHECKS THIS TO
;	SEE IF IT SHOULD SEARCH FOR %ERR OR %CERR; SINCE IT'S CLEAR,
;	BATCON INCORRECTLY SEARCHES FOR %ERR; FIX: REMOVE SETNAM
;	AREA AFFECTED: DOEND
;433	SPR #29039	TARL	22-MAR-80
;	FIX EDIT 322 - REMEMBER WHEN WE HAVE DECIDED THAT THIS IS A REL FILE
;	AREA AFFECTED : LBCOMP+13.4
;434	SPR #29593	RKB	23-MAY-80
;	FIX COMMAND SCANNER SO IT WILL ACCEPT EXTRANEOUS SPACES
;	AREA AFFECTED : SCNS2+2
;435	SPR #29887	RKB	5-AUG-80
;	GET RID OF BIZARRE EXTRA CHARACTER SEEN AFTER SOME ERROR MESSAGES
;	AREA AFFECTED : ERRCOM
;436	NO SPR		RKB	5-AUG-80
;	CLEAN UP SOME ERROR MESSAGES AT ERRCOM
;437	SPR #29807	BCM	22-JUL-80
;	FIX PROTECT COMMAND LINE PARSER FOR DOUBLE EXTENSION
;	AREA AFFECTED: PROT1+16
;440	SPR #29975	BCM	16-SEP-80
;	PASS LINK "COBOL" AS THE COBOL-74 DEBUGGING AID
;441	NO SPR		BCM	19-SEP-80
;	EXTENSIVE EDITS TO FEATURE TEST MOST OF OLD CODE
;	ALSO MAKE USEFUL MODS
;442	NO SPR		TARL	11-DEC-80
;	MAKE THE EDIT COMMAND RETAIN THE DEVICE NAME - THIS WAY IT CAN
;	RUN DTECO INSTEAD OF LINED.
;443	NO SPR		BCM	19-FEB-81
;	FIX PROCESSOR vs. SWITCH PROBLEM INTRODUCED BY EDIT 441
;444	10-30513	BCM	24-Mar-81
;	MAKE /SAVE AND /SSAVE WORK RIGHT
;445	10-05955	BCM	28-Apr-81
;	FIX /NOCOMP SWITCH FOR "DEBUG A.MAC/NOCOMP"
;446	10-30567	BCM	16-Jun-81
;	INCREASE BUFFER SIZE FOR NUMBER OF LINK SWITCHES
;447	QAR 10-05958	BCM	8-Aug-81
;	implement global processor switches
;450	NO SPR		BCM	11-Aug-81
;	Fix an assumption that processors can still parse parenthesis.
;451	QAR 10-05959	BCM	12-Aug-81
;	make COBOL-74 the default COBOL compiler
;452	QAR 10-05957	BCM	25-Aug-81
;	add code to support SIMULA compiler
;453	SPR 10-31944	BCM	5-Jan-82
;	Fix edit 444 to not overlay the extension as the output extension.
;
;454	SPR #32066	BCM	2-JAN-82
;	Reinsert the code at IDENT which was removed incorrectly
;	by a zealous edit 441.
;455	SPR #30256	BCM	15-Mar-82
;	We output an "S" as the first chacracter in the TMPCOR file
;	that is passed to LINED or TECO.  Since we removed the LINED
;	support we will gradually remove this from crock from COMPIL.
;	Change the "S" to "<space>" since TECO skips it anyway.
;456	SPR #31279	BCM	15-Mar-82
;	Replace code removed by edit 430.  Makes PIP run faster
;	on copies.
;457	SPR #31693	BCM	16-Mar-82
;	Allow compiler selection switches (/C74,/C68,/F10,/F40) to
;	imply compiler type.  A long overdue correction.
;460	SPR #32659	BCM	28-Sep-82
;	Edit 454 incomplete.  Add LABEL to command table.
;461	SPR #32416	BCM	22-Apr-82
;	Increase the core argument to optimal size.
;462	SPR #31449	BCM	29-Sep-82
;	Always LOOKUP the REL file if the processor is unknown.  This
;	avoids debugging with DDT, when the link block type is Fortran.
;	Made new routine SETPTH which should always be called to set
;	up path for DOLOOK.  Changed all LOOKUP's to call DOLOOK.
;463	NO SPR		BCM	19-Apr-83
;	Add the PASCAL compiler to compiler list and add new compiler
;	attribute flag word.
;
;START OF VERSION 22(F)
;
;564	SPR 10-32178/32177	GAT	4-JAN-84
;	Fix ADDRESS CHECKS/ILL MEM REFS which were not thoroughly
;	eliminated by edits 176/241.
;
;565	10-32625	GAT	19-JAN-84
;	GIVE APPROPRIATE ERROR MESSAGE IF SOURCE FILES ARE NOT FOUND OR  
;	.REL FILES ARE SPECIFIED IN THE "+" CONSTRUCTION.
;566	10-31613	GAT	14-FEB-84
;	DELETE TMPCOR FILE IF WRITING .TMP FILE ONTO DISK.
;567	SPR 10-32007	GAT	10-FEB-84
;	CORRECT PARSING OF COMMAND FILES THAT START WITH A COMMENT LINE(S).
;570	10-34129	GAT	22-MAR-84
;	ALLOW "MINUS SIGN" IN PROCESSOR SWITCHES NEEDED FOR COBOL-74.
;571	33631		GAT	21-MAR-84
;	USE ALGDDT AS DEFAULT DEBUGGER INSTEAD OF DDT FOR ALGOL
;572	10-32034	GAT	8-MAY-84
;	GIVE ERROR IF TRYING TO DEFAULT SFD(S).
;573	SPR 10-31549	GAT	14-MAY-84
;	DON'T PASS EXPLICIT SOURCE DEVICE TO LINK IF A /LIB FILE NEEDS 
;	TO BE RECOMPILED (INTO OUR DIRECTORY).
;574	10-34735	GAT	9-AUG-84
;	MAKE GFLOAT AND F66 SWITCHES KNOWN TO COMPIL.
;575	10-34994	GAT	10-DEC-84
;	INCREASE SIZE OF SWITCH BLOCK (SWBK) TO ALLOW LONGER
;	PROCESSOR SWITCH STRINGS. THIS NOW ALLOWS UP TO 150
;	CHARS TO BE PASSED INSTEAD OF JUST 25 CHARS.
;576	None		LEO	9-AUG-85
;	CHANGE COPYRIGHT STATEMENTS
;577	QAR 868774	DRB	3-FEB-86
;	NEST IS DESTROYING T1 WHEN IT SHOULDN'T.  PUSH IT SOONER AND POP IT
;	LATER.
;
;START OF VERSION 22(G)
;
;600	NO SPR		RCB	6-FEB-86
;	EXTEND 442 TO ALLOW THE PATHOLOGICAL DEVICE EDITOR: TO BE WHAT
;	THE CREATE AND EDIT COMMANDS WILL RUN.  IF EDITOR: IS NOT DEFINED,
;	THEN DEFAULT TO THE EDITOR SYMBOL OF 442 (RUN FROM SYS:).
;
;601	10-35493	RCB	22-JUL-86
;	ALLOW [-] AS A PATH SPEC.
;
;602	10-35500	MEM	16-JAN-87
;	ONLY PUT OUT EXT AND PPN IF /REL WAS SPECIFIED
;
;603	10-35688		 9-SEP-87
;	EXPLICIT "DSK" ON A FILESPEC DOESN'T OVERRIDE STICKY DEVICE NAME
;	FROM A PREVIOUS FILESPEC.
;
;604	10-35708		9-SEP-87
;	EDIT 567 WENT TOO FAR.  DON'T SPECIAL CASE COMMA SEPARATORS WHEN
;	TERMINATING INDIRECT COMMAND FILESPECS UNLESS THEY IMMEDIATELY
;	FOLLOW A TERMINATOR.
;
;605	10-35989		9-SEP-87
;	EDIT 602 WAS TOO RESTRICTIVE.  TRIED TO SUPPRESS THE OUTPUT OF
;	EXTENSIONS, BUT OMITTED THE PPN AS WELL.
;
;;;END OF REVISION HISTORY
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

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>
SWBK==30		;[575] NUMBER OF WORDS FOR SWITCHES TO PROCESSOR
LODSCT==^D200		;[446] # OF CHRS IN LINK SWITCHES PER FILE ALLOWED
DEBSIZ==5		;[221] NO. OF WORDS OF FORDDT SWITCHES
.TYSPL==(1B13)		;DEVTYP BIT FOR SPOOLING
.RBSIZ==5		;[240] LAST WORD USED IN 4-WORD LOOKUP
.RBTIM==35		;[240] INTERNAL CREATION DATE OF DSK FILE
DV.DSK==(1B1)		;[240] DEVICE IS A DSK
FRSCOD==1		;[242] MEANS USE FORSE
FRTCOD==2		;[242] MEANS USE FOROTS
;[463] FLAG WORD
SCANCH==000001	;[463] USE SCAN CHAINING ARG CONVENTIONS

;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 LINK [441]
PERF==200	;PERMANENT TYPE FLAGS
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
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
F.STKY==400000	;[302] DEVICE'S AND PPN'S 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
NOCMPL==2000		;[445] NOCOMPLE REGARDLESS OF DATES
NOBINSW==40		;DON'T DO A REL FILE
C68SW==100		;[324] COMPIL COBOL WITH COBOL-68
C74SW==200		;[324] COMPIL COBOL WITH COBOL-74
F40SW==400		;COMPILE FORTRAN WITH F40
F10SW==1000		;COMPILE FORTRAN WITH FORTRAN-10
F66SW==2000		;[574] F66 CODE
GFLSW==4000		;[574] GFLOATING CODE
OPTSW==10000		;OPTIMIZED CODE
NOPTSW==20000		;NON-OPTIMIZED CODE
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 "_"
	H	COMPILER ATTRIBUTE FLAGS, USED FOR SCAN VS. BANG CHAINING
>

DEFINE PROCESS<
IFN DFORTRAN,<X FORTRAN,FOR,FORTRAN,,,FORDDT,=,SCANCH>
IFE DFORTRAN,<X FORTRAN,FOR,F40,,,,=>
IFN PASCAL,<X PASCAL,PAS,PASCAL,,,PASDDT,=,SCANCH>;[462] PASCAL USES SCAN ARGS
X MACRO,MAC,MACRO,,,,=
IFN SIMULA,<X SIMULA,SIM,SIMULA,,,SIMDDT,=>	;[452] SW,EXT,PROC,,,DEBUG
IFE DCOBOL,<X COBOL,CBL,COBOL,,,COBDDT,=>
IFN DCOBOL,<X COBOL,CBL,CBL74,,,COBDDT,=>
X ALGOL,ALG,ALGOL,,,ALGDDT,=
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,,,,=>
>

DEFINE XPROCESS<
X LINK,LNK,LINK			;[441] FT 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,H)<
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,H)<
CHN'B==MXPROC+XTPROC
XTPROC==XTPROC+1>
XPROCESS

IFE SIMULA,<SIMSW==0>		;[452] FOR LATER TESTS
IFE BLISS,<BLISW==0>		;MAKES TESTS EASIER AND NEATER
UNKSW==0			;[462] AN UNKNOWN PROC TYPE
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>

;[324] LINK BLOCK TYPE 6 COMPILER CODES

L%F40==1		;F40
L%C68==2		;COBOL-68
L%F10==10		;FORTRAN
L%C74==16		;COBOL-74

SUBTTL	MACROS

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

%LOREL:!			;RELOCATABLE BEGINNING OF LOW SEGMENT

IFN PURESW,<	TWOSEGMENTS
.ZZ:
	RELOC	400000>

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO

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	LABEL,<JRST	IDENT>	;[460] REINSERT COMMAND
>
	DEFINE STABLE<
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 N,LISTSW
SWITCH COMPILE,<XWD COMPLS,0>
SWITCH NOCOMPILE,<NOCMPL,,0>		;;[445] MAKE A SEPERATE BIT FOR NOCOMP
SWITCH	NOBINARY,<NOBINSW,,0>
SWITCH	BINARY,NOBINSW
SWITCH	NODEBUG,DEBUGSW
SWITCH	C68,<C68SW,,C74SW>
SWITCH	C74,<C74SW,,C68SW>
SWITCH	F40,<F40SW,,F10SW>
SWITCH	F10,<F10SW,,F40SW>
SWITCH	F66,<F66SW,,0>			;[574]
SWITCH	GFLOATING,<GFLSW,,0>		;[574]
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	LINK,<0,,LINKIT>
SWITCH	DEBUG,<0,,SETDEB>
SWITCH	FORDDT,<0,,FORDDT>
SWITCH	SAVE,<0,,SAVE>
SWITCH	SSAVE,<0,,SSAVE>
SWITCH	LIST,<0,,SETLPT>	;[251]
SWITCH	L,<0,,SETLPT>		;[251]
SWITCH	DLIST,<0,,SETDSK>	;[251]
SWITCH	DL,<0,,SETDSK>		;[251]
>
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
	SETZM	 %RNBLK+4	;[277] 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,%RUNT2	;RESET T2
%RUNT2:	Z			;SET FROM HIGH SEG
	JRST	%RUN		;TRY AGAIN

%RUN2:	OUTSTR	RUNER1		;WARN USER OF FAILURE
	IDIVI	T1,10		;[170] MAY BE 2 DIGITS
	JUMPE	T1,LRUN3	;NO, ONLY ONE [441] use LRUN3
	ADDI	T1,"0"		;MAKE ASCII
	OUTCHR	T1		;OUTPUT IT
LRUN3:	ADDI	T2,"0"		;[441] loop out
	OUTCHR	T2
	OUTSTR	RUNER2		;REST OF MESSAGE
	MOVE	T2,%RNBLK	;PICK UP DEVICE
LRUN4:	SETZ	T1,		;CLEAR OUT JUNK [441] label LRUN4
	LSHC	T1,6		;MOVE LEADING CHARACTER INTO T1
	MOVEI	T1,40(T1)	;FORM ASCII
	OUTCHR	T1		;PRINT IT
	JUMPN	T2,LRUN4	;MORE TO GO [441] use LRUN4
	MOVEI	T1,":"		;USUAL SEPARATOR
	OUTCHR	T1
	MOVE	T2,%RNBLK+1	;FILE NAME
LRUN5:	SETZ	T1,		;[441] label LRUN5
	LSHC	T1,6
	MOVEI	T1,40(T1)
	OUTCHR	T1
	JUMPN	T2,LRUN5	;[441] use LRUN5
	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
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 "]"
	SETOM	INLFLG		;[305] SET IN-LINE FLAG
	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:	SETOM	INLFLG		;[305] SET IN-LINE FLAG
	PUSH	P,ACCUM
	PUSHJ	P,SCANS		;CHECK FOR EXT OR PPN
	CAIE	C,":"		;IS IT A DEVICE NAME
	JRST	NODEV		;NO
	POP	P,T1		;[260]WE WERE HIDING IT IN THE STACK
	TRNN	FL,F.STKY	;[302] DON'T MAKE STICKY IF FROM SWITCH
	MOVEM	T1,SVDEVV	;[260]REMEMBER FOR 'STICKINESS'
	MOVEM	T1,SVDEV(SVPT)	;[260]SAVE IT AS DEVICE NOW
	PUSHJ	P,SCAN		;BYPASS
	PUSHJ	P,SCANS		;[307] DO LOOK AHEAD
	SKIPN	SAVCHR		;[307] NEXT CHARACTER A BLANK ?
	POPJ	P,		;[307] YES--THAT'S IT, RETURN
	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
	IFG	SFDLEN-1,<	;[426]
	MOVE	T1,[SVSFP,,SVSFP+1]
	BLT	T1,SVSFP+SFDLEN-1>>	;[425]
NODEV:	POP	P,SVNAM(SVPT)
	SKIPN	T1,SVDEVV	;[302] IF DEVICE, SKIP
	JRST	NODEV1		;[302] OTHERWISE, PROCEED
	TRNN	FL,F.STKY	;[302] IF FROM SWITCH, DON'T SAVE
	MOVEM	T1,SVDEV(SVPT)	;[254]ELSE, MAKE DEVICE HAPPEN
NODEV1:	TRNE	FL,F.STKY	;[302] SHOULD PPN STICK ?
	JRST	GOTSTK		;[302] 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: 			;[313] 
	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)
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?
	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)
		 CAIE	C,"-"		;[601] MIGHT IT BE [-]?
		 JRST	GETPP2		;[601] NO, CONTINUE WITH [,,] CASE
		 PUSHJ	P,SCAN		;[601] YES, SKIP PAST THE "-"
		 SETOM	PTHBLK		;[601] SETUP TO READ DEFAULT PATH
		 MOVE	T1,[.PTPPN+SFDLEN,,PTHBLK]
		 PATH.	T1,		;[601] FETCH IT
		   JRST	GETPP3		;[601] NON-SFD MONITOR?  TRY FOR END.
		 MOVE	T1,PTHBLK+.PTPPN ;[601] GET PTHPPN
		 MOVEM	T1,SVPPN(SVPT)	;[601] SAVE
	IFN SFDSW,<
		X==0			;[601] FIRST SFD
		.X==0			;[601] MONITOR'S FIRST SFD
		REPEAT SFDLEN,<
		 MOVE	T1,PTHBLK+.PTSFD+.X	;[601] GET NEXT SFD TO STORE
		 MOVEM	T1,SVSFD+X(SVPT)	;[601] SAVE AWAY
		X==X+NFILE
		.X==.X+1		;[601] ADVANCE POINTERS
		>			;[601] END REPEAT SFDLEN
	>				;[601] END IFN SFDSW
		 JRST	GETPP3]		;[601] LOOK FOR END OF PATH
	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
	TRNN	FL,IDF		;[572] MUST SEE IDENTIFIER HERE
	JRST	SFDER2		;[572] NO, GIVE SFD ERROR AND ABORT
	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
	CAMN	T1,[-1]		;[434] FOUND A SPECIAL CHARACTER?
	JRST	SCNS2		;NO, LOOP BACK
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,CONSN	;IGNORE BLANKS [441] and loop
	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
	CAIN	C,"*"		;[271] DID WE STOP ON A "*"?
	TRNN	FL,PIPF		;[271] YES, IS THIS PIP MODE?
	JRST	SCAN2		;[271] NO, STOP THE SCAN
	MOVEI	CS,'*'		;[271] YES, "*" IS JUST ANOTHER CHAR
	JRST	SCAN1		;[271] SO GO STORE IT AWAY
SCAN2:	TRO	FL,IDF		;[271] 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
	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 6,<	XWD	SPCF,.-CTBL>		;[261]
	XWD	SPCF!SPACT!TERMF+7,CHKTRM	;[261]BELL
	XWD	SPCF,.-CTBL			;[261]
	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 14,<	XWD	SPCF,.-CTBL>		;[261]
	XWD	SPCF!TERMF!SPACT+32,CHKTRM	;[261]SUB
	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,T1		;[577] SAVE TEMP AC
	PUSH	P,ACCUM		;SAVE STATE OF SCANNER
	PUSH	P,FL		;SAVE THE FLAGS (AS IDF?)
	SETZM	FAKEOL		;[305] CLEAR FAKE EOL FLAG
	SETOM	INLFLG		;[305] SET IN-LINE FLAG
	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
	TRO	FL,F.STKY	;[302] SET FLAG FOR NO STICKINESS
	PUSHJ	P,SCANAM	;GET ONE TO USE
	TRZ	FL,F.STKY	;[302] CLEAR FLAG
	PUSH	IOP,SAVCHR
	PUSHJ	P,CHKRM		;GET BUFFER SPACE
	AOBJP	IOPNT,NESTTD	;TOO DEEP?
	MOVS	C,SVDEV(SVPT)	;[226] GET DEVICE
	MOVSM	C,OPENB+1	;[226] STORE DEV OR 0
	CAIN	C,'TMP'		;[226] TEST FOR TMPCOR
	JRST	[MOVSS C	;[253] GET IN PLACE FOR DEVCHR
		DEVCHR	C,		;[226] BUT NOT IF A REAL DEVICE
		JUMPN	C,NSTDV1	;[226] IT REALLY EXISTS
		JRST	LNST1]		;[226] TRY TMPCOR ONLY [441] use LNST1
	JUMPN	C,NSTDV1	;[243] DEVICE SPECIFIED
LNST1:	MOVE	C,.JBFF		;GET START OF BUFFER [441] label LNST1
	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,FL
	POP	P,ACCUM
	TRZ	FL,RECALF	;WE HAVE DONE THE FIND
	SETZM	INLFLG		;[305] CLEAR IN-LINE FLAG
	PUSHJ	P,CHKTRM	;[567] EAT ANY TERMINATORS
	MOVE	T1,SAVCHR	;[604] GET PREVIOUS CHARACTER AND BITS
	TLNE	T1,TERMF	;[604] LAST CHARACTER A LINE TERMINATOR?
	CAME	CS,COMMA	;[604] AND COMMA AT START OF NEW LINE?
	SKIPA	T1,[70000,,]	;[604] RE-EAT CHARACTER
	JRST	NEXT2A		;[604] ELSE IGNORE LEADING COMMA
	ADDM	T1,@GETB3(IOPNT);[567] AND BACK UP BYTE POINTER
	AOS	@GETB1(IOPNT)	;[567] ALSO BACKUP COUNT
NEXT2A:	SETZB	CS,SAVCHR	;[567] DON'T SAVE ANY CHARS
	MOVEI	C," "		;[567] SUPPLY A FREE BLANK SO COM@FOO WORKS
	POP	P,T1		;[577] RESTORE TEMP AC
	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)
		 SETOM	FAKEOL	;[305] SET FAKE EOL FLAG
		 POPJ	P,]	;AND RETURN IT
;END OF "FIX"
	TRNN	FL,INCRF	;[427] DOING CREF?
	JRST	POPFL0		;[427] NO, SKIP THIS
	MOVE	T2,[RENAME 0,0]	;[427] GET RENAME INSTRUCTION
	LDB	T1,[POINT 4,RELTAB(IOPNT),12] ;[427] GET CHANNEL NUMBER
	JUMPE	T1,POPFL0	;[427] CAREFUL OF CHANNEL ZERO
	DPB	T1,[POINT 4,T2,12] ;[427] PUT CHANNEL IN
	SETZM	LNAM		;[427] CLEAR NAME
	SETZM	LEXT		;[427]   ''  EXT
	SETZM	LDAT		;[427]   ''  DATE
	SETZM	LPPN		;[427]   ''  PPN
	HRRI	T2,NAME		;[427] FINISH SET UP
	XCT	T2		;[427] DO THE RENAME(DELETE)
	OUTSTR	[ASCIZ/%CMLNDC -- Could not Delete CREF temp file
/]
POPFL0:	XCT	RELTAB(IOPNT)	;RELEASE HIM
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
	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:	OUTSTR	[ASCIZ / detected before: /] ;[435] TELL USER WHAT THE STORY IS
	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
	TRZ	FL,PIPF		;[305] CLEAR PIP FLAG
	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
	TRNE	C,400000	;[435] IS THIS A BREAK CHARACTER?
	JRST	NOFIL0		;[435] STOP TYPING CHARACTERS
	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
RLFERR:	STRING	[ASCIZ	.?CMLRLF Problem with REL file and /REL was specified.]
	JRST	ABORT		;[462] DIE GRACEFULLY
RLFER1:	STRING	[ASCIZ	.?CMLRLS Problem with REL file and no source specified.]
	JRST	ABORT		;[462] DIE GRACEFULLY
SAVERR:	STRING	[ASCIZ .?CMLNFS No file on SAVE or SSAVE.] ;[256]
	JRST	ABORT		;[256]
SAVER2:	STRING	[ASCIZ .?CMLASF Ambiguous /SAVE or /SSAVE usage on files.]
	JRST	ABORT		;[444] THIS IS ON USING THE SWITCH TWICE
NOSRCS:	STRING	[ASCIZ .?CMLMSF Must have source files for "+" contruction.]
	JRST	ABORT		;[565]
NOFIL:	TRNN	FL,RECALF	;WE WERE LOOKING UP A SVC FILE
	JRST	FIU		;[266]YES, TELL OF ERROR
	JRST	SYNRR1		;NO, SO GIVE SPECIAL 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
	RESET
DOEND:	SETZB	0,.JBSA		;SO START FAILS
	EXIT	1,
	JRST	.-1		;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:	SKIPN	INLFLG		;[305] ARE WE AT BEGINNING OF LINE ?
	SKIPE	FAKEOL		;[305] AND IS THIS A REAL TERMINATOR ?
	JRST	ERP1		;[305] NO--PROCEED
	TLNE	CS,TERMF	;[305] YES--IS THIS A LINE TERMINATOR ?
	JRST	SCNAGN		;[300] YES--TRY FOR IDENTIFIER AGAIN
ERP1:	TRNN	FL,PIPF		;A PIP COMMAND?
	GOTO	SYNERR		;NO, YOU LOSE
	CAIN	C,"["		;START OF PPN?
	JRST	GETPP1		;YES, AND PROBABLY NO DEVICE
	SETZM	FAKEOL		;[305] CLEAR FAKE EOL FLAG
	POPJ	P,		;RETURN AND HOPE IT MAKES SENSE

SCNAGN:	PUSHJ	P,SCAN		;[300] LOOK FOR AN IDENTIFIER
	JRST	GETNM0		;[300] AND TRY AGAIN

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
SFDER2:	STRING	[ASCIZ .?CMLISS Illegal SFD specification.]	;[572]
	CAIE	C,","
	CAIN	C,"]"
	MOVEM	CS,SAVCHR
	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,CHNLNK	;START WITH LINK
	TRNN	FL,DOLOD	;ARE WE LOADING?
	JRST	ALDN1		;NO
	SKIPN	T2,EXECFL	;WANT EXECUTION?
	JRST	ALDN0		;NO [441] use ALDN0
	PUSHJ	P,OUTSIX	;YES, /E
	PUSHJ	P,OUTSPC	;NEEDS SEPARATOR
ALDN0:	SKIPN	T2,MAPSW	;SKIP IF MAP REQUIRED [441] label ALDN0
	MOVSI	T2,'/G '	;SET UP FOR TERMINATE LOADING
	PUSHJ	P,OUTSIX	;YES, PUT IT OUT
	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
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
	SKIPN	T1,PRCFLG(T3)	;[463] ARE THERE ANY FLAGS FOR THIS PROC
	  JRST	NOTSCN		;[463] NONE, DO THE BANG PROCESSING BY DEFAULT
	TLNN	T1,SCANCH	;[463] DOES THIS PROCESS USE SCAN CHAINING?
	  JRST	NOTSCN		;[463] NOPE, USE OLD STYLE BANG STUFF
	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

NOTSCN:	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
	CAIN	T3,CHNLNK	;[443] IS THIS LINK-10?
	SKIPA	T1,PROCTB(T3)	;[443] YES, ITS SPECIAL
	MOVE	T1,PRCNAM(T3)	;[443] NO, SO GET THE PROCESSOR NAME
IFN FORTRAN,<			;WE HAVE A CHOICE OF FORTRAN COMPILERS
	CAIE	T3,CHNFOR	;BUT ONLY IF THIS IS FORTRAN
	JRST	LNFTN		;[441] NOT
	SKIPE	FORPRC		;USE DEFAULT
	MOVE	T1,FORPRC	;USE WHATEVER IS SET
LNFTN:
>
				;[324] WE HAVE A CHOICE OF COBOL COMPILERS
	CAIE	T3,CHNCBL	;[324] BUT ONLY IF THIS IS COBOL
	JRST	LNTCB		;[441] NOT
	SKIPE	COBPRC		;[324] USE DEFAULT
	MOVE	T1,COBPRC	;[324] USE WHATEVER IS SET
LNTCB:				;[441] not cobol
	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
	HRLZM	T1,TMPFIL	;SAVE NAME IN TMPFIL
	MOVE	T1,TTYPT	;GET BYTE POINTER
	MOVNI	T2,4		;SET UP FOR CHARACTER COUNT
LDN1:	ILDB	T3,T1		;GET NEXT CHARACTER
	CAIE	T3,177		;IS IT A EOF CHARACTER
	SOJA	T2,LDN1		;[441] NO, JUMP BACK TO 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
	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
TRYAG1:	OPEN	LOOK,FSINIT	;INIT THE CHAN.
	JRST	DSKNA		;SHOULDN'T HAPPEN
	ENTER	LOOK,LNAM	;GET SET TO WRITE
	  JRST	[PUSHJ	P,TRYDSK;[276] TRY GENERIC DSK(ONLY RETURN IF YES)?
		JRST	TRYAG1]	;[276] YES--TRY AGAIN
	OUTPUT	LOOK,TMPFIL	;OUTPUT THE DMP IOWD LIST
	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	[TRNE	FL,EDITF	;WAS THIS FOR EDIT?
		 TRNE	FL,TECOF	;AND NOT TECO?
		 JRST	DOEND		;[206] NO, EXIT
		 SKIPN	PCDEV		;IS THERE ANOTHER TO RUN?
		 JRST	DOEND		;NOPE
		 JRST	NUNDO]		;YES, DO IT
	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
CKRM1:	SKIPN	T2,FREBUF(T1)
	AOBJN	T1,CKRM1	;[441] JUMP BACK AND 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:	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
;	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
>
	RESET			;[241]STOP THE WORLD
	JUMPL	T4,RPGSET
	RESCAN	1		;[205] RESET POINTER TO START OF COMMAND
	JRST	LINBF		;[441] something in input buffer
	SKIPN	.JBDDT##	;[211] WAIT FOR USER IF DEBUGGING
	GOTO	SYNRR2		;[205] INPUT BUFFER EMPTY
LINBF:				;[441] come here when something in buffer
	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	LFITY		;YES [441] jrst to LFITY
	CORE	T4,		;NO, GET MORE
	  JRST	NOCOR		;YOU LOSE
LFITY:				;[441] when it will fit
	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
	HRRZM	T1,.JBFF	;[262]UPDATE .JBFF
RPGRET:	SKIPA	P,RP1		;[441] SET UP PDL
RP1:	IOWD	PDL,PDLB	;[441] label as RP1
	MOVNI	T1,1		;STANDARD KA/KI TEST
	AOBJN	T1,.+1
	SKIPN	T1
	AOS	CPU		;KA=0, KI=1
	MOVEI	T1,3
	PJOB	T2,
LSOJ1:	IDIVI	T2,12		;[441] label is LSOJ1
	ADDI	T3,20		;TO SIXBIT
	LSHC	T3,-6
	SOJG	T1,LSOJ1	;[441] THREE DIGITS
	HLLZM	T4,JOBNAM	;SAVE TO MAKE UNIQUE NAMES
	TLO	T4,404040	;NOW TO ASCII FOR ASCIZ'S
	MOVEI	T1,3		;THREE CHARS
LSOJ2:	LSH	T3,1		;[441] label is LSOJ2
	LSHC	T3,6		;BRING IN A CHAR
	SOJG	T1,LSOJ2	;[441] use LSOJ2
	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
	TRO	FL,DOLOD	;LOAD USING LINK-10
	SETZM	DEFPRO		;[303] CLEAR DEFAULT PROCESSOR FLAG
	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
	HRRZ	T1,.JBFF	;[564] DISK BUFFERS WILL GET PUT HERE
	MOVEM	T1,DSKBUF	;[564] SAVE BUFFER ADDRESS
	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
	SETZM	SWGKB		;[447]
	SETZM	SWGKL		;[447]
	SETZM	SWGKS		;[447]
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
	TRNA			;[441] a much faster single skip
	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
	CAIN	C,"("		;[447]
	  JRST	PROCSX		;[447]
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,","
	TRNA			;[441] "," AND TERMF ARE OK SO SKIP
	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)
;**;[457] after SMATCH + 6L, insert
	TLNN	FL3,C74SW!C68SW!F10SW!F40SW	;[457] IMPLY COMPILER?
	JRST	SMATC1		;[457] NO, CONTINUE NORMALLY
	TLNE	FL3,C74SW!C68SW	;[457] IMPLY COBOL?
	TRZA	FL2,ALPROC-CBLSW ;[457] YES, TURN OFF ALL BUT COBOL
	TRZA	FL2,ALPROC-FORSW ;[457] NO, TURN OFF ALL BUT FORTRA
	TROA	FL2,CBLSW	;[457] YES, SET PROC TYPE
	TRO	FL2,FORSW	;[457] NO, MUST FOR FORTRA
	TRNE	FL,PERF		;[457] WAS IT PERMANENT?
	HRRZM	FL2,DFPROC	;[457] YES, STORE DEF PROC
SMATC1:	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,H)<
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
SETLPT:	SKIPA	T1,[SIXBIT /LPT/]	;[251] SET TO USE LPT:
SETDSK:	MOVEI	T1,.		;[251] SET AS DSK:
	MOVEM	T1,SPDLPT	;[251] SAVE IN SWITCH WORD
	MOVE	T1,[LISTSW,,CRSW]	;[251] SET UP T1 AS A SWITCH
	JRST	SMATCH		;[251] TABLE MATCH AND DO THAT PROCESS

SETMPL:	SKIPE	MAPSW		;[310] ALREADY SEEN ONE MAP
	JRST	MPTWIC		;[310] YES DON'T PROCESS THIS ONE
	TRNN	FL,DOLOD	;[441] are we loading?
	SKIPA	T3,[-1]		;[441] NO, DON'T STORE ANYTHING
	SKIPA	T3,[CHNLNK]	;[441] yes, load link chan. no.
	JRST	SETMP		;[441] not loading so jump
	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
	MOVE	T2,['/LOCAL']	;[257]LOCAL MAP NEEDS LOCAL SYMBOLS
	PUSHJ	P,OUTSIX	;[257]PUT SPEC INTO TMPCOR
	PUSHJ	P,OUTSPC	;[257]PLUS A SPACE
	JRST	LNKMAP		;NOW FOR /MAP

SETMAP:	SKIPE	MAPSW		;[310] ALREADY SEEN ONE MAP
	JRST	MPTWIC		;[310] YES DON'T PROCESS THIS ONE
	TRNN	FL,DOLOD	;[441] are we loading?
	SKIPA	T3,[-1]		;[441] NO, DON'T STORE ANYTHING
	SKIPA	T3,[CHNLNK]	;[441] yes, load link chan. no.
	JRST	SETMP		;[441] not loading so jump
	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
	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
	TRO	FL,F.STKY	;[302] SET FLAG FOR NO STICKINESS
	PUSHJ	P,SCANAM	;YES, SO GO GET SPECIFICATIONS
	TRZ	FL,F.STKY	;[302] CLEAR FLAG
	SKIPE	T2,SVDEV(SVPT)	;A DEVICE SPECIFIED?
	PUSHJ	P,OUTDEV	;YES
	SKIPE	T2,SVNAM(SVPT)	;NAME SPECIFIED?
	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
SETMP1:
	MOVSI	T2,'/M '	;YES
	PUSHJ	P,OUTSIX
SETMP2:	MOVEI	T1,"="		;NEW STANDARD
	PUSHJ	P,TMPOUT
	TRZ	FL,LODOUT	;DO NOT NEED A COMMA FOR NEXT FILE
	POPJ	P,

MPTWIC:	PUSHJ	P,SCAN		;[310] GET NEXT CHARACTER
	CAIE	C,":"		;[310] OUTPUT FIL SPEC GIVEN
	POPJ	P,		;[310] NO CONTINUE
	AOBJP	SVPT,NESTTD	;[310] MAKE SPACE FOR FIELDS
	TRO	FL,F.STKY	;[310] NO STICKINESS
	PUSHJ	P,SCANAM	;[310] GOBBLE FIL SPEC
	TRZ	FL,F.STKY	;[310] CLEAR FLAG
	SUB	SVPT,[1,,1]	;[310] BACK TO WHERE IT WAS
	PUSHJ	P,SCAN		;[310]
	POPJ	P,		;[310] CONTIUE
SETDDT:	SETOM	DDTFL
	PJRST	SCAN		;RETURN VIA SCAN

FORSE:	MOVEI	T1,FRSCOD	;[242] FLAG USE OF FORSE
	JRST	SETOTS		;STORE RESULT

FOROTS:	MOVEI	T1,FRTCOD	;[242] FLAG USE OF FOROTS
SETOTS:	MOVEM	T1,FORLIB
	PJRST	SCAN

LINKIT:	SKIPN	TMPCHN+CHNLNK	;MAKE SURE NO LINK-10 OUTPUT
	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]
	SKIPN	SVNAM(SVPT)	;[256] IS THERE A SAVE NAME?
	 JRST	SAVERR		;[256] NO, THAT IS AN ERROR
;**; [444] at SSAVE plus 3
	SKIPE	SAVSW		;[444] IS THIS THING ALREADY SET?
	 JRST	SAVER2		;[444] YES, YOU CAN'T SAVE TWO DIF FILES
	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,CHNLNK	;[441] load chan no. for link
	PJRST	SCAN		;[234]
;here on "(" as first char of ident, i.e. perm proc sw
PROCSX:	PUSH	P,SWPT		;[447] save switch pointer
	MOVE	SWPT,[POINT 7,SWGLK]
	PUSHJ	P,PROCS0	;[447] get switches
	POP	P,SWPT		;[447] restore switch pointer
	MOVE	T1,SWBKB	;[447] transfer binary switch ptr.
	MOVEM	T1,SWGKB	;[447]
	SETZM	SWBKB		;[447]
	MOVE	T1,SWBKL	;[447] listing switch ptr.
	MOVEM	T1,SWGKL	;[447]
	SETZM	SWBKL		;[447]
	MOVE	T1,SWBKS(SVPT)	;[447] source switches
	MOVEM	T1,SWGKS	;[447]
	SETZM	SWBKS(SVPT)	;[447]
	JRST	ILP0
;here on "(" after a file name
PROCSW:	TROE	FL,PROCS	;HAVE WE ALREADY SEEN SOME?
	GOTO	SYNERR		;YES, I DEFINE THIS AS ILLEGAL
	PUSHJ	P,PROCS0	;[447] get switches
	JRST	ILP2A
PROCS0:
	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
	CAIN	C,"/"		;[252] ALLOW "/" FOR SWITCH VALUE
	JRST	PROCS2		;[252]  FOR ALGOL
	CAIN	C,"("		;[221] ALLOW "(" TO ENCLOSE SWITCH VALUES
	AOS	CS,PARLVL	;[221] COUNT LEVEL UP AND FAKE CS
	CAIN	C,"-"		;[570] ALLOW "-"
	JRST	PROCS2		;[570]  FOR COBOL-74
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
		POPJ	P,]		;[447]
	MOVEI	C,0
	IDPB	C,SWPT		;MARK
	SOJLE	SWCNT,ETMS
	POPJ	P,		;[447] 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
	SETZM	SVDEVV		;[267]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
;HERE FOR LINK-10 SWITCHES
;THEY ARE IN FORM %'SWITCH:ARG'
;
	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
	SETOM	EXTEND		;[240] HERE TO CHECK IF ALL DEVICES
				;[240] ARE DISKS SO CAN USE EXTENDED
				;[240] LOOKUPS FOR MORE ACCURATE
				;[240] CREATION TIME CHECKS.
	SKIPN	T1,ODEV		;[240] OUTPUT DEVICE SPECIFIED?
	JRST	LSET1		;[240] NO, ASSUME DISK
	DEVCHR	T1,		;[240] FIND OUT WHAT IT IS
	TLNN	T1,DV.DSK	;[240] A DISK?
	JRST	ONSET1		;[240] NO.
LSET1:	MOVSI	T1,-NFILE	;[240] SETUP TO CHECK ALL INPUTS
DSKLUP:	SKIPN	T2,SVDEV(T1)	;[240] DEVICE GIVEN?
	JRST	LDSK1		;[240] NO, ASSUME A DISK
	DEVCHR	T2,		;[240] WHAT IS IT?
	TLNN	T2,DV.DSK	;[240] A DISK?
	JRST	ONSET1		;[240] NOPE.
LDSK1:	AOBJN	T1,DSKLUP	;[240] LOOP FOR ALL DEVICES
	JRST	ONSET		;[240] THEY'RE ALL DISKS!
ONSET1:	SETZM	EXTEND		;[240] 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
	SETZM	ETIM		;[317] INTERNAL CREATION DATE AND TIME
	TLZ	FL2,-1		;NO PROCESSOR YET
	PUSHJ	P,GETPRO	;GO FIND DATE AND PROCESSOR
	SKIPE	SAVSW		;[444] IS THIS A SAVE FILE REQUEST
	PUSHJ	P,OUTSAV	;[444] YES, PUT OUT OUTPUT FILENAME NOW
	TLNE	FL2,RELSW	;IF A REL FILE
	JRST	LKREL		;[462] SETUP THE PROCESSOR TYPE FROM REL FILE
	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
	MOVE	T1,SVPT		;[462] USE THE CURRENT FILE POINTER
	PUSHJ	P,SETPTH	;[462] SETUP THE LOOKUP PATH
	TRNA			;[462] SKIP THE FIRST TIME
REREL:	SETZ	T2,		;[462] CLEAR THE FLAG
	MOVEM	T2,LPPN		;[462] SAVE THE PATH POINTER OR 0
	MOVEM	T2,SVRPP	;[462] STORE RESULT SO WE KNOW IF SECOND TIME
	MOVE	T1,ONAM		;SEE IF REL IS THERE
	MOVEM	T1,LNAM
	HLLZ	T1,FL2		;[265]GET ONLY LH SO DEFUALT TO 'REL'
	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
	PUSHJ	P,DOLOOK	;[462] LOOKUP THE REL FILE
	JRST	LBCOMP		;[462] COULD NOT FIND IT, RECOMP

REREL2:	PUSHJ	P,CHKAGE	;[317] COMPARE THE AGE OF THE FILE
	JRST	DOCOMP		;[317] OLDER - RECOMPILE

NOCOM1:	TLNN	FL2,FORSW!CBLSW	;[324] FORTRAN OR COBOL 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
	MOVEM	T1,SVEXT	;[172]
	TLO	FL2,RELSW	;AND PRETEND HE SAID .REL
	JRST	NOCOMP

;GENERAL ROUTINE TO SEE IF CURRENT FILE IS NEWER OR OLDER THAN THAT
;SPECIFIED BY SDAT, STIM, ETIM. EXTENDED LOOKKUP INFO IS USED IF AVAILABLE
CHKAGE:	PUSH	P,T1		;[317] SAVE A COUPLE OF AC'S
	PUSH	P,T2		;[317]
	LDB	T2,[POINT 12,LDAT,35]	;[317] GET LOW 12 BITS OF DATE
	LDB	T1,[POINT 3,LEXT,20]	;[317] GET HIGH 3 BITS OF DATE
	DPB	T1,[POINT 3,T2,23]	;[317] MERGE THE TWO PARTS
	CAMGE	T2,SDAT		;[317] CURRENT FILE EARLIER?
	JRST	CHKAG2		;[317] YES, NO NEED TO CHECK FURTHER
	CAME	T2,SDAT		;[317] SAME DAY?
	JRST	CHKAG1		;[317] NO, MUST BE NEWER
	LDB	T2,[POINT 11,LDAT,23]	;[317] GET TIME
	CAMGE	T2,STIM		;[317] CURRENT FILE EARLIER?
	JRST	CHKAG2		;[317] YES
	CAME	T2,STIM		;[317] SAME MINUTE?
	JRST	CHKAG1		;[317] NO, MUST BE NEWER
	SKIPN	EXTEND		;[317] EXTENDED INFO AVIALABLE?
	JRST	CHKAG2		;[317] NO, TREAT AS OLDER TO BE SAFE
	MOVE	T2,EBLK+.RBTIM	;[317] GET INTERNAL DATE/TIME
	CAMLE	T2,ETIM		;[317] NEWER FILE?
CHKAG1:	AOS	-2(P)		;[317] YES, SET FOR SKIP RETURN
CHKAG2:	POP	P,T2		;[317] NO, SET FOR NON-SKIP RETURN
	POP	P,T1		;[317] RESTORE AC'S
	POPJ	P,		;[317] RETURN
;
;	This routine does not decide wether to COMPILE or not but
;	simply sets the processor type from the REL file if it is
;	as yet, unknown.
;
LKREL:	SKIPGE	DEBFL		;[462] IF NOT DEBUG, DON'T WASTE TIME ON REL
	TLNE	FL2,ALPROC-RELSW ;[462] SEE IF ANY PROCESSORS ALREADY SET
	JRST	LDREL		;[462] YES, GO LOAD REL FILE NOW!
	SKIPN	T1,LOKNAM	;[462] PICK UP A DEVICE IF THERE
	SKIPA	T1,['DSK   ']	;[462] ELSE USE DSK:
	TRNA			;[462] SKIP STORAGE IF ALREADY THERE
	MOVEM	T1,LOKNAM	;[462] STORE IT AWAY
	OPEN	LOOK,LOKINT	;[462] OPEN FOR INPUT
	JRST	DEVNA		;[462] NOT THERE
	MOVE	T1,SVPT		;[462] USE CURRENT FILE POINTER
	PUSHJ	P,SETPTH	;[462] SET UP THE LOOKUP BLOCK
	MOVE	T1,ONAM		;[462] SEE IF REL IS THERE
	MOVEM	T1,LNAM		;[462]
	SKIPN	T1,OEXT		;[462] OUTPUT EXTENSION ALREADY SPECIFIED?
	SKIPE	T1,SVEXT(SVPT)	;[462] NO, GET INPUT SPECIFIED
	SKIPN	T1		;[462] DO WE HAVE SOMETHING?
	MOVSI	T1,'REL'	;[462] NO USE REL
	MOVEM	T1,LEXT		;[462] STORE LOOKUP EXTENSION
	PUSHJ	P,DOLOOK	;[462] IS IT THERE?
	JRST	FIU		;[462] NO, GIVE ERROR SINCE /REL IS SET
	PUSHJ	P,INSREL	;[462] GET THE LINK BLOCK TYPE FROM REL FILE
	JRST	LKRER		;[462] PROBLEM, TRY TO ISOLATE THE ERROR
	PUSHJ	P,SETPRC	;[462] SET THE PROC TYPE FROM TABLE
	JRST	LDREL		;[462] CONTINUE LOADING
;
;	There are two cases for falling through here:
;		1) user type /REL
;		2) we only found a .REL file
;
LKRER:	HLRZ	T1,SVEXT(SVPT)	;[462] GET THE USERS SPECIFIED EXTENSION
	JUMPN	T1,RLFER1	;[462] PROB WITH REL FILE SPECIFIED
	JRST	RLFERR		;[462] ASSUME /REL WAS SPECIFIED
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
	SKIPE	T2,ODEV		;[244] DID HE SPECIFY A DEVICE?
	PUSHJ	P,OUTDEV	;[244] 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	T2,OPPN		;[274] OUTPUT PPN GIVEN?
	SKIPE	OSFD		;OR SFD?
>
IFE SFDSW,<
	SKIPE	T2,OPPN		;[274] OUTPUT PPN GIVEN?
>
	PUSHJ	P,SFDPPN	;YES
DOCOM1:	TRNE	FL,PROCS	;[447] local switches ?
	SKIPA	T2,SWBKB	;[447] yes, get them
	MOVE	T2,SWGKB	;[447] get global switches
	SKIPE	T2		;[447] anything ?
	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
DOCOMA:	TLNN	FL3,OPTSW!NOPTSW	;OPTIMIZER INFO?
	JRST	DOCOMB		;[574] NO, TAKE DEFAULT
	MOVE	T2,['/OPT  ']
	TLNN	FL3,OPTSW	;OPTIMIZE?
	MOVE	T2,['/NOPT ']	;NO
	PUSHJ	P,OUTSIX
DOCOMB:	TLNN	FL3,F66SW	;[574] /F66 SEEN?
	JRST	DOCOMC		;[574] NO, TAKE DEFAULT
	MOVE	T2,['/F66  ']	;[574] OUTPUT SWITCH
	PUSHJ	P,OUTSIX	;[574]
DOCOMC:	TLNN	FL3,GFLSW	;[574] /GFLOAT SEEN?
	JRST	DOCOMD		;[574] NO, TAKE DEFAULT
	MOVE	T2,['/GFLO ']	;[574] OUTPUT SWITCH
	PUSHJ	P,OUTSIX	;[574]
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:	MOVSI	T2,'/O'		;[324] GET READY FOR /OPT
	CAIN	T3,CHNCBL	;[324] IS IT COBOL?
	TLNN	FL3,OPTSW	;[324] AND /OPT?
	CAIA			;[324] NO
	PUSHJ	P,OUTSIX	;[324] YES
IFN PASCAL,<
	CAIE	T3,CHNPAS	;[463] IS IT PASCAL?
	JRST	DOCM2B		;[463] NO, SKIP THIS JUNK
	MOVE	T2,['/DEBUG']	;[463] GET READY FOR /DEBUG
	TLNN	FL3,DEBUGSW	;[463] AND /DEBUG?
	SKIPGE	DEBFL		;[463] OR DEBUG COMMAND?
	PUSHJ	P,OUTSIX	;[463] YES, SO TELL THE COMPILER
DOCM2B:
	>
	TRNE	FL,PROCS	;[447] local switches ?
	SKIPA	T2,SWBKL	;[447] yes, get them
	MOVE	T2,SWGKL	;[447] get global switches
	SKIPN	T2		;[447] any switches ?
	TLNE	FL3,LISTSW	;[321] OR LISTING REQUESTED?
	JRST	DOCM2A		;[321] YES, OUTPUT THE NAME AND SWITCHES
	MOVSI	T2,',- '	;NO
	CAIN	T3,CHNCBL	;TEST FOR COBOL
	PUSHJ	P,OUTSIX	;YES
	JRST	NOLST

DOCM2A:	MOVEI	T1,","		;[321] YES, NEED A COMMA
	PUSHJ	P,TMPOUT
	TLNN	FL2,CBLSW!BLISW	;SKIP /CREF IF COBOL OR BLISS (SPECIAL)
	TLNN	FL3,CRSW	;[314]USE DSK: IF /CREF
	TRNA			;[314] CHECK FOR /LIST SWITCH IF COBOL 
	JRST	DOCOM3		;[251]
	SKIPGE	T2,SPDLPT	;[321] ELSE, IS THIS /DLIST OR /LIST?
	PUSHJ	P,OUTDEV	;SET LIST DEVICE
DOCOM3:	MOVE	T2,ONAM		;SET IT UP
	PUSHJ	P,OUTSIX
IFN SFDSW,<
	SKIPN	T2,OPPN		;[274] OUTPUT PPN GIVEN?
	SKIPE	OSFD		;OR SFD?
>
IFE SFDSW,<
	SKIPE	T2,OPPN		;[274] OUTPUT PPN GIVEN?
>
	PUSHJ	P,SFDPPN	;YES
	TLNN	FL3,CRSW	;CREF MAYBE
	JRST	NOLST1
	MOVSI	T2,'/C '
	PUSHJ	P,OUTSIX
	PUSH	P,T3
;**; at DOCOM3 plus 16 lines change 1 line
	TLNN	FL2,CBLSW!BLISW!SIMSW		;[452] DON'T WRITE /CREF IF
						;[452] COBOL, BLISS OR SIMULA
	PUSHJ	P,ENTCRF	;PUT IT IN THE ###CREF FILE
	POP	P,T3
NOLST1:	TRNE	FL,PROCS	;[447] local switches ?
	SKIPA	T2,SWBKL	;[447] yes, get them
	MOVE	T2,SWGKL	;[447] get global switches
	SKIPE	T2		;[447] anything ?
	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
	TRNE	FL,PROCS	;[447] local switches ?
	SKIPA	T2,SWBKS(SVPT)	;[447] yes, get them
	MOVE	T2,SWGKS	;[447] get global switches
	SKIPE	T2		;[447] anything ?
	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
	TLNN	FL3,F40SW	;WHICH ONE?
	SKIPA	T1,['FORTRA']	;FORTRAN-10 WANTED
	MOVSI	T1,'F40'	;F40 WANTED
	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:
>
				;[324] CHOICE OF COBOL COMPILERS
	TLNE	FL2,CBLSW	;[324] IGNORE IF NOT COBOL
	TLNN	FL3,C68SW!C74SW	;[324] AND IF NOTHING OF INTEREST
	JRST	ENDCOB		;[324] IGNORE IF NOT COBOL
	TLNN	FL3,C74SW	;[324] WHICH ONE?
	SKIPA	T1,['COBOL ']	;[324] COBOL-68 WANTED
	MOVE	T1,['CBL74 ']	;[324] COBOL-74 WANTED
	SKIPN	COBPRC		;[324] SETUP ALREADY?
	MOVEM	T1,COBPRC	;[324] NO, DO SO NOW
	CAMN	T1,COBPRC	;[324] SAME VALUE, OR FIRST TIME?
	JRST	ENDCOB		;[324] YES
	STRING	[ASCIZ	/%CMLOCC Only one COBOL compiler allowed, /]
	MOVEI	T1,[ASCIZ /COBOL-68/]	;[324]
	TLNN	FL3,C68SW	;[324] SEE WHICH WE WANTED, USE OTHER
	MOVEI	T1,[ASCIZ /COBOL-74/]	;[324]
	STRING	(T1)		;[324] TYPE ONE WE WILL USE
	STRING	[ASCIZ	/ used
/]
ENDCOB:
IFN SPRC,<
	TLNN	FL2,SPRC
>
	JRST	NOCOMP		;GO LOAD
IFN SPRC,<
	MOVSI	SVPT,-NFILE	;RESET POINTER
	MOVE	T1,ONAM		;AND FAKE WORLD
;**; [444] at ENDCOB plus 9 lines
	MOVEM	T1,SVNAM(SVPT)	;PUT IT AS CURRENT FILENAME
	MOVE	T3,PCNUM	;GET BACK PROCESSOR NUMBER
	MOVE	T1,INTEXT(T3)	;GET EXTENSION
	MOVEM	T1,SVEXT(SVPT)	;AND PUT IT AS CURRENT EXTENSION
	SETZM	SVPPN(SVPT)
	SETZM	SWBKS(SVPT)
	SETZM	SWBKB(SVPT)
	SETZM	SWBKL(SVPT)
	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
	TLO	FL2,RELSW	;[433] REMEMBER THIS IS A REL FILE
	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,LSFP1	;ZERO IS JUST
	PUSHJ	P,OUTOCT
LSFP1:	MOVEI	T1,","		;[441] output a comma
	PUSHJ	P,TMPOUT
	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	NOSRCS		;[565] 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,CHNLNK	;[441] SET FOR LINK
;**; [444] at NOCOMP plus 7
	TRZE	FL,LODOUT	;IS THERE ALREADY OUTPUT THERE?
	PUSHJ	P,[
		MOVEI	T1,","		;YES
		PJRST	TMPOUT]		;YES, ALL ON SAME LINE SAVES TIME
;**; [444] at NOCOMP plus 9
	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 COMP TYPE
		MOVSI	T2,'/D '	;DDT BY DEFAULT
		JRST	ND2]		;[441] go out everything
	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
	SKIPGE	DEFPRO		;[303] DID WE USE DEFAULT PROCESSOR ?
	JRST	USEDEF		;[303] THEN SKIP LOCAL PROCESSOR TEST
	HRLZ	T1,FL2		;TRY LOCAL PROCESSOR SWITCHES
	TLNE	T1,ALPROC-RELSW
GETDDT:	JFFO	T1,.+1		;YES, SO SEE WHICH
USEDEF:	PUSH	P,DEBAID(T2)	;STORE NAME
		skipn (p)		;[220] if no debug aid
		 jrst NDBA		;[220] then return
		 move t1,prcnam(t2)	;[220] else get process name
		 movem t1,0(p)		;[220] to replace debug aid
NDBA:					;[441] no debug aid
	CAIN	T2,^L<CBLSW>-22	;COBOL IS A LOSER
	JRST	[SOS	DEBFL	;AS IT MUST LOAD COBDDT
		 JRST	NODDT1]	;AFTER MAIN PROG
GETDD1: 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
	  CAMN	T2,[SIXBIT/FORTRA/]	;[303] FORDDT ?
	  JRST	FOR			;[303] YES--PROCESS DIFFERENTLY
	  TLNE	FL3,F10SW		;[312] F10 SWITCH SEEN
	  JRST	[MOVE	T2,[SIXBIT/:/]	;YES INCLUDE FORDDT
	  	PUSHJ	P,OUTSIX	;[312]
		MOVE	T2,[SIXBIT/FORTRA/]  ;[312]
		JRST	ND2]		;[441] go output everything
	  JUMPE	T2,ND2P1	;[165] IGNORE IF 0
	  JRST	ND2		;[441] output everything
	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/L ']	;[441] LINK-10 switches & separators
	JRST	ND2		;[441] output everything

NODDT1:	MOVE	T2,[SIXBIT/COBOL/]	;[440] COBDDT IS DEBUGGING AID
	MOVEM	T2,0(P)			;[440] USE INSTEAD OF PROCESS
	MOVE	T2,['/E/L  ']	;[441] LINK-10 switches for COBOL
	JRST	ND2		;[441] output it all

FOR:	TLNE	FL3,F40SW	;[312] F40 SWITCH SEEN
	JRST	[MOVE	T2,[SIXBIT/DDT/]	;[312] USE DDT ONLY
		JRST	ND2]		;[441] output everything
	PUSH	P,T2			;[312] SAVE NAME ON STACK
	MOVE	T2,[SIXBIT/(DDT,/]	;[303] LOAD REGULAR
	PUSHJ	P,OUTSIX	;[303] DDT AS WELL AS
	POP	P,T2		;[303] FORDDT.
	PUSHJ	P,OUTSIX	;[303] . .
	MOVSI	T2,')  '	;[303] . .

ND2:	PUSHJ	P,OUTSIX	;[441] common code for most of the above
ND2P1:	PUSHJ	P,OUTSPC	;[441]

NODDT:	MOVE	T2,[POINT 7,LODSBK]	;OUTPUT FIRST SWITCHES
	PUSHJ	P,OUTSW
	MOVSI	T2,'DSK'
	TLNE	FL2,RELSW		;[573] DO WE HAVE A REL FILE?
LODR0:	SKIPE	T2,LOKNAM		;ON NON-DISK DEVICE?
LODR3:	PUSHJ	P,OUTDEV		;YES. OUTPUT DEVICE
LODR1:	MOVE	T2,ONAM			;[444] IN WHICH CASE USE ONAM
	PUSHJ	P,OUTSIX
	TLNN	FL2,RELSW		;REL
	JRST	[SKIPE	T2,OEXT		;[444] OUTPUT EXTENSION GIVEN?
		 PUSHJ	P,OUTEXT	;YES
		 TLNN	FL3,LIBSW	;IF LIBRARY
		 JRST	ELOD3		;NO, CONTINUE
		 JRST	LODR2]		;YES
	TRNN	FL2,RELSW		;[602] ONLY PUT OUT EXT IS /REL GIVEN
	JRST	LODR4			;[605] ON TO THE PPN
	SKIPE	T2,SVEXT(SVPT)		;ALSO USE EXT IF GIVEN
	PUSHJ	P,OUTEXT
LODR4:	SKIPE	T2,SVPPN(SVPT)		;[605] OUTPUT PPN IF SPECIFIED
	PUSHJ	P,OUTPPN
LODR2:	MOVSI	T2,'/S '		;[602]USES SEARCH
	TLNN	FL3,LIBSW		;LIBRARY?
	JRST	ELOD			;NO
	PUSHJ	P,OUTSIX
	PUSHJ	P,OUTSPC		;NEEDS SPAC
	SETOM	NSWTCH			;[236] SIGNAL /L LAST
ELOD:	MOVE	T2,[POINT 7,LODSB2]	;[174] OUTPUT SECOND SET OF SWITCHES
	PUSHJ	P,OUTSW
	SKIPN	T2,FORLIB		;FORSE/FOROTS SWITCH SET?
	JRST	ELOD2			;NO
	MOVE	T2,[ '/FORSE'
		     '/FOROT']-1(T2) ;[242] YES, GET RIGHT NEW SWITCH
	PUSHJ	P,OUTSIX	;[242] AND TYPE THE SWITCH
	SETZM	FORLIB		;ONLY DO IT ONCE
	PUSHJ	P,OUTSPC
ELOD2:	TRO	FL,LODOUT	;MARK AS HAVING OUTPUT THERE
	AOSL	DEBFL		;ARE WE FINISHED WITH DDT?
	JRST	NXFILP
	TRNN	FL,DOLOD	;[441] are we loading?
	  JRST	ELCBL		;[441] no, must be COBOL
	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
ELCBL:	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	T2,OPPN		;[274] OUTPUT PPN GIVEN?
	SKIPE	OSFD		;OR SFD?
>
IFE SFDSW,<
	SKIPE	T2,OPPN		;[274] OUTPUT PPN GIVEN?
>
	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,L%F10-1	;[324] MAKE SURE ITS FORTRAN-10
	JRST	CHKCBL		;[324] NO, TRY COBOL

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,
CPOPJ1:	AOS	(P)		;[176] SKIP RET, THIS REL WILL DO
	POPJ	P,
CHKF40:				;HERE IF FOUND REL WAS F40 STYLE
IFE DFORTRAN,<			;IF DEFAULT IS F40
	TLNN	FL3,F10SW	;RECOMPILE ONLY IF DEFINITELY WANTS F10
>
IFN DFORTRAN,<			;BUT IF DEFAULT IS F10
	TLNE	FL3,F40SW	;RECOMPILE UNLESS DEFINITELY WANTS F40
>
	AOS	(P)		;SKIP RET, THIS FILE WILL DO
	POPJ	P,
;[324] HERE FOR COBOL REL FIL

CHKCBL:	SOJE	T3,CHKC68	;[324] 2=COBOL-68
	CAIE	T3,L%C74-2	;[324] MAKE SURE ITS COBOL-74
	JRST	CPOPJ1		;[324] NO, SO LEAVE ALONE

;[324] HERE IF REL FILE WAS COBOL-74
IFE DCOBOL,<		;[324] IF DEFAULT IS COBOL-68
	TLNE	FL3,C74SW;[324] RECOMPILE UNLESS DEFINITELY WANTS COBOL-74
>
IFN DCOBOL,<		;[324] BUT IF DEFAULT IS COBOL-74
	TLNN	FL3,C68SW;[324] RECOMPILE ONLY IF DEFINITELY WANTS COBOL-68
>
	AOS	(P)		;[324] SKIP RET, THIS FILE WILL DO
	POPJ	P,		;[324] RECOMPILE

;HERE IF REL FILE WAS COBOL-68
CHKC68:
IFE DCOBOL,<		;[324] IF DEFAULT IS COBOL-68
	TLNN	FL3,C74SW;[324] RECOMPILE ONLY IF DEFINITELY WANTS COBOL-74
>
IFN DCOBOL,<		;[324] BUT IF DEFAULT IS COBOL-68
	TLNE	FL3,C68SW;[324] RECOMPILE UNLESS DEFINITELY WANTS COBOL-68
>
	AOS	(P)		;[324] SKIP RET, THIS FILE WILL DO
	POPJ	P,		;[324] RECOMPILE
;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:	SKIPGE	LOOKBF		;[564] DO WE HAVE BUFFERS?
	JRST	INSRIN		;[564] YES, CONTINUE
	MOVE	T1,DSKBUF	;[564] GET DISK BUFFER ADDRESS
	EXCH	T1,.JBFF	;[564] SET .JBFF TO DSKBUF ADDRESS
	INBUF	LOOK,2		;[241]SETUP THE BUFFERS
	EXCH	T1,.JBFF	;[564] RESTORE .JBFF TO ORIGINAL VALUE
INSRIN:	IN	LOOK,		;YES, MUST CHECK FOR DEBUGGER DATA
	JRST	INSRL3		;IN OK, PICKUP BUFFER ADDRESS
	POPJ	P,		;[564] 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	INSERR		;[462] IF NOT A REL FILE, THEN 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
	HRRZ	T2,T3		;AND COPY FOR CPU INFO
	ANDI	T3,7777		;BITS 6-17
	LSH	T2,-^D12	;BITS 0-5
	TRNA			;[462] SKIP THE ERROR JUMP ENTRY
INSERR:	SETZ	T3,		;[462] CLEAR TYPE IF NOT REL FILE
	CLOSE	LOOK,		;[564] CLOSE FILE
	OPEN	LOOK,DSKLK	;[603] SET LOOK BACK TO DSK
	  SKIPA			;[603] SHOULD NEVER HAPPEN
	AOS	0(P)		;[176] SET SKIP RETURN
	POPJ	P,

;[462]
; This routine sets up for a DOLOOK call by setting up
; LPPN and associated locations for lookups.
;	T1/ contains file pointer
; Returns:
;	T2/ pointer to LSFDAD or SVPPN if SFDSW is 0
; Always returns with POPJ, no skip return.
;
SETPTH:	MOVE	T2,SVPPN(T1)	;[462] GET USER SPECIFIED PPN
IFN SFDSW,<
	SKIPN	SVSFD(T1)	;[462] ANY SFD'S?
	JRST	NXSFD		;[462] NO
	MOVEM	T2,LSFDPP	;[462] SAVE PPN
	X==<Y==0>		;[462] INITIAL CONDITION
REPEAT SFDLEN,<
	MOVE	T2,SVSFD+X(T1)
	MOVEM	T2,LSFD+Y
	X==X+NFILE
	Y==Y+1
>
	MOVEI	T2,LSFDAD	;[462] POINTER TO PATH
NXSFD:
>				;[462] END OF IFN SFDSW
	MOVEM	T2,LPPN		;[462] STORE THE POINTER OR PPN
	POPJ	P,		;[462] RETURN
;
;[462] This routine will set the processor type from the REL file.
;	It will also recognize processor conflicts and take an error
;	path if necessary.  The compiler codes in table CMPCOD are
;	expanded from the macro CMPTBL.  These codes are taken from the
;	LINK version 5 manual, page A-13.  Those compiler types that
;	COMPIL does not know, have zero entries which cause no action.
;	
;	Assumes:
;		T3/ contains compiler type, usually set by INSREL
;	Returns: +1
;		T3/ contains processor flags
;
SETPRC:	SKIPLE	T3		;[462] CHECK LOW RANGE
	CAMLE	T3,CMPLEN	;[462] CHECK HIGH RANGE
	POPJ	P,		;[462] DO NOTHING IF BAD
	SKIPN	T3,CMPCOD(T3)	;[462] GET THE PROC CODE
	  POPJ	P,		;[462] IF ZERO, DO NOTHING
	TLO	FL2,(T3)	;[462] SET THE FLAG FOR THIS PROC
	POPJ	P,		;[462] AND RETURN

;
;	The X macro takes two arguments:
;	A = compiler type code
;	B = processor flags to set in FL2
;
	DEFINE CMPTBL,<
	    X	0,UNKSW			;;Code 0, unknown
	    X	1,FORSW			;;Code 1, F40
	    X	2,CBLSW			;;Code 2, COBOL-68
	    X	3,ALGSW			;;Code 3, ALGOL
	    X	6,BLISW			;;Code 6, BLISS
	    X	7,SAISW			;;Code 7, SAIL
	    X	10,FORSW		;;Code 10, FORTRAN-10
	    X	11,MACSW		;;Code 11, MACRO
	    X	12,FAISW		;;Code 12, FAIL
	    X	15,SIMSW		;;Code 15, SIMULA
	    X	16,CBLSW		;;Code 16, COBOL-74
	    X	24,PASSW		;;Code 24, PASCAL-36
>
	SALL
GETPRO:	MOVSI	T1,-NFILE	;NUMBER OF FILES
	TRNN	FL2,-1		;[303] LOCAL PROCEESOR SET ?
	SETOM	DEFPRO		;[303] SET FLAG SAYING DEFAULT PROC USED
	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:	SETOM	PTHBLK		;[246] SETUP TO FIND THIS JOB'S PATH
	MOVE	T3,[3,,PTHBLK]	;[246] POINT TO 3 WORD PATH BLOCK
	PATH.	T3,		;[246] FIND USER'S DEFAULT PATH
	  SETZM	PTHBLK+1	;[246] NO LIB: IF NO PATH
	MOVE	T3,PTHBLK+1	;[246] GET PATH FLAGS
	TRNN	T3,20		;[246] DOES USER HAVE A LIBRARY?
	  SETZM	PTHBLK+2	;[246] NO, ONLY 1 PASS NEEDED.
	SKIPE	T3,SVPPN(T1)	;[246] DID USER TYPE A PPN?
	SKIPN	PTHBLK+2	;[246] AND HAS HE A LIBRARY?
	  SKIPA			;[246] NO, FORGE AHEAD
	MOVEM	T3,PTHBLK+2	;[246] YES, PUT "MUST MATCH" PPN IN
GETPR2:	MOVEI	T3,1		;[246] 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
	PUSHJ	P,SETPTH	;[462] SET UP LOOKUP BLOCK
	SKIPN	T2,SVDEV(T1)	;A DEVICE?
	SKIPE	T2,LOKNAM	;OR SAVING ONE UP
	JRST	ALTDEV
OKLOOK:	PUSHJ	P,DOLOOK	;[316] DO THE LOOKUP
	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)
DNLOK1:	PUSHJ	P,CHKAGE		;[317] CHECK AGE OF CURRENT FILE
	JRST	OLDAT			;[317] OLDER FILE
	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
	MOVEM	T2,SDAT			;[317] STORE THE DATE
	LDB	T2,[POINT 11,LDAT,23]
SETTM:	MOVEM	T2,STIM		;MARK WITH LATER ONE
	MOVE	T2,EBLK+.RBTIM	;[317] GET THE INTERNAL CREATION DATE/TIME
	MOVEM	T2,ETIM		;[317] STORE IT
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	LOLD1]		;AND PROCCESS IT [441] use LOLD1
	CAME	T2,PXTAB(T3)
	AOBJN	T3,.-1
LOLD1:

IFE BLISS,<
	JUMPGE	T3,SETCP	;NOT THERE
>
IFN BLISS,<
	JUMPL	T3,LBLS1	;JUMP IF FOUND SOMETHING
	CAME	T2,B10		;IS IT ALTERNATIVE BLISS EXT
	JRST	SETCP		;NO
	HRROI	T3,CHNBLI+1	;YES, SET FOR BLISS
LBLS1:
>
	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	STIM		;[247] FORCE REL FILE USEAGE
	SETOM	SDAT		;[247] BY MAKING SOURCE OLD
	POPJ	P,		;AND RETURN TO SETUP

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
	SKIPN	PTHBLK+2	;[246] WAS THIS ONLY PASS 1?
	  JRST	LNTY1		;[246] NO, FORGET IT
	SETZM	PTHBLK+2	;[246] YES, RETRY WITH LIBRARY
	JRST	GETPR2		;[246] AND TRY AGAIN
LNTY1:	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
	HLLM	T2,LEXT		;[266]
	JRST	NOFIL		;ARE OUT OF THINGS TO TRY

;MAKE IT OKAY IF THE OUTPUT REL FILE IS THERE

OKREL:	SKIPN	PTHBLK+2	;[250] WAS LIB: SEARCHED?
	JRST	NOFIL		;[441] OUT OF THINGS TO TRY
	SETZM	PTHBLK+2	;[250] NO, SEARCH IT NOW
	JRST	GETPR2		;[250] ...

;ROUTINE TO DO LOOKUPS EITHER NORMAL OR EXTENDED

DOLOOK:	SKIPE	EXTEND		;[316] IS FILE ON DISK?
	JRST	ELOOK		;[316] YES, DO EXTENDED LOOKUP
	LOOKUP	LOOK,LNAM	;[316] NO, USE SHORT FORM
	 POPJ	P,		;[316] NOT FOUND - NON SKIP RETURN
	JRST	ELOOK1		;[316] FOUND - SKIP RETURN
ELOOK:	MOVEI	T2,.RBTIM	;[240] DO EXTENDED LOOKUP
	MOVEM	T2,EBLK		;[240] SETUP LOOKUP BLOCK..
	MOVE	T2,LPPN		;[240]
	MOVEM	T2,EPPN		;[240]
	LOOKUP	LOOK,EBLK	;[240] DO THE LOOKUP
	 POPJ	P,		;[316] NOT FOUND - NON SKIP RETURN
	SKIPE	T2,PTHBLK+2	;[246] FORCING PPNS TO MATCH?
	CAMN	T2,EPPN		;[246] AND DO THEY?
ELOOK1:	AOS	(P)		;[316] GOOD LOOKUP, SET UP TO SKIP
	POPJ	P,		;[316] RETURN
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
	PUSHJ	P,DOLOOK	;[316] DO THE LOOKUP
	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
	MOVE	T2,LOKNAM	;[316] GET DEVICE NAME
	DEVCHR	T2,		;[316] GET CHARACTERISTICS
	TLNN	T2,100		;[316] 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
>
;
;[450]	Routine to output a set of switches.  This routine defines a
;	switch as a string of non-blank characters delimited by a
;	blank.  A set of switches is a series of multiple switches
;	delimited by a null.
;

OUTSW:	MOVEM	T2,SVSWP	;SAVE THE POINTER
OUTSW2:	ILDB	T1,SVSWP	;GET 1ST CHAR
	JUMPE	T1,OUTSW5	;ALL DONE IF NULL
	CAIN	T1," "		;IGNORE LEADING BLANKS
	  JRST	OUTSW2		;AND MULTIPLE BLANKS
	MOVEI	T1,"/"		;A SLASH SAYS THIS IS A SWITCH
	PUSHJ	P,TMPOUT	;SO TELL WHOMEVER
	LDB	T1,SVSWP	;GET FIRST NON-BLANK CHAR AGAIN
	CAIA			;AND PROCESS IT
OUTSW3:	ILDB	T1,SVSWP	;GET NEXT CHAR
	JUMPE	T1,OUTSW5	;IS THIS NULL? (IF YES, DONE)
	PUSHJ	P,TMPOUT	;NON-NULL SO OUTPUT THIS CHAR
	CAIN	T1," "		;WAS THAT A BLANK?
	JRST	OUTSW2		;YES, END OF SWITCH SO GET A NEW ONE
	JRST	OUTSW3		;NO, LOOP UNTIL DONE

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
IFN SFDSW,<
	SKIPN	T2,OPPN		;OUTPUT PPN GIVEN?
	SKIPE	OSFD		;OR SFD?
>
IFE SFDSW,<
	SKIPE	T2,OPPN		;OUTPUT PPN GIVEN?
>
	PUSHJ	P,SFDPPN	;YES
	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
	TRO	FL,F.STKY	;[302] SET FLAG FOR NO STICKINESS
	PUSHJ	P,SCANAM	;GO GET THEM
	TRZ	FL,F.STKY	;[302] CLEAR FALG
	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,H)<
<SIXBIT /C/>>

PRCNAM:	PROCESS
DEFINE X (A,B,C,D,E,F,G,H)<
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,H)<
B'SW>

ISPTAB:	RELSW
	PROCESS


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

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

SW==0>

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

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

;[463] SETUP PROCESS FLAGS IF ANY
DEFINE X (A,B,C,D,E,F,G,H)<
	IFNB "H",<	XWD	H,0>	;;put flags in left half(arbitrary)
	IFB "H",<	EXP	0 > ;;no process flags
	>
PRCFLG:	PROCESS

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

	SALL
	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,<<^D29+^D11>*1000>-1	;[461] USE 29P LOW WITH 11P HIGH
	MOVEM	T2,RUNCOR	;[461] STORE CORE ARGUMENT
	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
	  SKIPN	SVNAM(SVPT)	;[431] CHECK IF FILE NAME ALREADY SCANNED
	  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,GTPROT	;[272] GET PROTECTION CODE
	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
	CAMN	T1,[XWD -1,0]	;[264]WAS IT FNAME.  ?
	JRST	NXTNOX		;[264]YES, DO COPY
	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
NXTNOX:	MOVSI	T2,'=  '	;[233] NO, SO JUST COPY
NOTCPY:	PUSHJ	P,OUTSIX
	CAIE	C,"_"		;[167] "_" SEEN
	CAIN	C,"="		;[167] "=" SEEN
	CAIA			;[167] "_" OR "=" MUST BE THERE
	GOTO	SYNERR
	SETZM	SVPPP		;CLEAR STICKY PPN ON OUTPUT SIDE
	SETZM	SVDEVV		;[260]CLEAR STICKY DEVICE ON =
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 "^"
	POP	P,T1		;CLEAR STACK
	MOVEI	T1,"^"		;AND DELIMITER
	PJRST	TMPOUT		;UP ARROW AND RETURN
	SUBTTL	PRESERVE/PROTECT

DOPROT:
DOPRES:	PUSH	P,[0]		;[270] RESERVE SPACE FOR PROTECTION
	SETZM	LOKNAM		;[237] 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,"."		;[237] EXTENSION WITHOUT FILENAME?
	JRST	PROT5		;[237] NO.
	SKIPE	SVEXT		;[437] IS EXT ALREADY SEEN?
	  JRST	SYNERR		;[437] OOPS! 2 "."'S SEEN IN FILE SPEC
	PUSHJ	P,SCAN		;[237] GET EXTENSION.
	TLNE	CS,TERMF	;[245] IS THIS EOL?
	  SETZM	ACCUM		;[245] YES, WE DIDN'T READ ANYTHING
	MOVE	T2,ACCUM	;[237] INTO AN AC...
	MOVEM	T2,SVEXT	;[237] SAVE IT.
	PUSHJ	P,SCAN		;[237] SETUP FOR PROT5
	CAME	T2,[SIXBIT/UFD/]  ;[237] A UFD?
	JRST	PROT6		;[237] NO.
	SKIPN	T1,SVPPN	;[237] WAS PPN TYPED?
	PUSHJ	P,USRPPN	;[237] NO, GET IT.
	MOVEM	T1,SVPPP	;[237] AND PUT BACK.
	JRST	PROT5		;[237] CONTINUE...
PROT6:	MOVSI	T2,(SIXBIT/*/)	;[237] NO FILENAME MEANS ALL
	MOVEM	T2,SVNAM	;[237] ..
PROT5:	CAIE	C,"<"		;[237] 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:	SKIPN	T2,(P)		;[270] GET PROTECTION IF GIVEN
	PUSHJ	P,DFPROT	;[270] DO SOME DEFAULTING IF NOT
	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
	TLNN	CS,TERMF	;[245] IS THIS EOL?
	  GOTO	SYNERR		;[245] NOT EOL AND NOT COMMA IS VERY BAD
	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


;[270] HERE TO DEFAULT THE PROTECTION

DFPROT:	HLRZ	T3,SVEXT	;[270] GET EXTENSION READ
	CAIE	T3,'UFD'	;[270] IF A DIRECTORY...
	CAIN	T3,'SFD'	;[270] THEN READ THE CORRECT DEFAULT
	SKIPA	T3,[13,,16]	;[270] STANDARD UFD PROTECTION
	MOVE	T3,[12,,16]	;[270] TABLE FOR STANDARD PROTECTION
	GETTAB	T3,		;[270] GET IT
	MOVSI	T3,057000	;[270] BETTER THAN NOTHING
	TLNN	T3,(7B2)	;[270] TEST FOR ALREADY PRESERVED
	TLO	T3,(1B2)	;[270] PRESERVE BIT
	MOVEI	T2,'<'		;[270] START WITH OPEN ANGLE
	MOVEI	T4,3		;[270] SET UP LOOP COUNTER
	LSH	T2,3		;[270] GET FIRST DIGIT
	LSHC	T2,3		;[270] IN AS SIXBIT
	ADDI	T2,20		;[270]
	SOJG	T4,.-3		;[270] LOOP FOR ALL THREE DIGITS
	LSH	T2,^D12		;[270] LEFT JUSTIFY
	TRO	T2,'> '		;[270] CLOSE PROTECTION
	MOVEI	T3,CHNPIP	;[270] RESTORE TMPFILE CHANNEL
	POPJ	P,		;[270] AND RETURN
	SUBTTL	EDIT

DOEDIT:	PUSHJ	P,SCAN		;START ON THE FILE NAME
DOEDT1:	PUSHJ	P,GETNAM
	MOVEI	T3,CHNEDT
	MOVEI	T1,"S"		;COMMAND FOR LINED
	TRNE	FL,TECOF	;[455] DO WE WANT TECO?
	MOVEI	T1," "		;[455] YES, PASS A SPACE
	PUSHJ	P,TMPOUT	;OUTPUT THE S
	SKIPE	T2,SVDEV	;[441] AND A DEVICE SEEN ELSE SKIP
	PUSHJ	P,OUTDEV	;OUTPUT THE DEVICE
LDE2:	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
	TLNE	CS,TERMF	;SOME OTHER KIND OF TERMINATOR?
	JRST	%NOSLS		;YES - FINISH UP NORMALLY
%GIVE:	MOVE	T1,C		;PASS THE CHARACTER TO THE EDITOR
	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,['EDITOR']
	TRNE	FL,TECOF
	JRST	ISTECO		;TECO OR MAKE COMMAND
	MOVEM	T1,PNMBLK+2	;SAVE AS NAME FOR INFO
	MOVSI	T2,(PT.RCN)	;RETURN CURRENT NAME
	MOVEM	T2,PNMBLK+1	;SET FLAG FOR UUO
	MOVEI	T2,.PTFRN	;READ NAME
	MOVEM	T2,PNMBLK+0	;SET FUNCTION CODE
	MOVE	T2,[5,,PNMBLK];UUO ARG POINTER
	PATH.	T2,		;SEE IF EDITOR: IS DEFINED
	  JRST	[MOVE	T1,[EDITOR]	;NO, GET DEFAULT VALUE
		 JRST	ENDED]		;AND DO IT THE OLD WAY
	MOVEM	T1,PCDEV	;YES, USE AS DEVICE
	SETZ	T1,		;AND NOT NAME
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:	SKIPE	T2,SVNAM	;[311] ANY ARGUMENTS
	JRST	TAPSP1		;[311] YES PROCESS
	SKIPE	SAVCHR		;[311] TAB OR BLANK
	GOTO	SYNERR		;[311] NO  ERROR
	PUSHJ	P,SCAN		;[311] GET ARGUMENT
	MOVE	T2,ACCUM	;[311] PUT IN AC
TAPSP1:	SETO	T1,		;FIND THE MASK
LTPS1:	LSH	T1,-6		;MUST BE AT LEAST ONE CHAR. ANYWAY
	TDNE	T2,T1		;DON'T MASK REAL CHAR.
	JRST	LTPS1		;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	XPDERR		;[306] 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:	SKIPE	T2,SVNAM	;[237]
	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
;**;[323] @COPYSW+2 1/2, KPY, 3-JAN-78
	TLNE	CS,TERMF	;[323]  SEE IF END
	GOTO	SYNERR		;[323]  YES--ERROR
	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)
>
	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

>
;
;	This routine will output ONAM with a /SAVE (/SSAVE)
;	and check to see where in the flow it is.  If it is the
;	first output out to the LNK tmpcor file, then it puts a
;	comma after.  If there is already output there, it prefixes
;	a comma.
;
OUTSAV:	PUSH	P,T3		;[444] PUSH THE CURRENT CHAN NO. DOWN
	MOVEI	T3,CHNLNK	;[444] SET CHAN NO. FOR LINK
	TRNE	FL,LODOUT	;[444] IS OUTPUT THERE?
	SKIPA	T1,[","]	;[444] YES, SO PREFIX WITH A COMMA
	TRNA			;[444] A PSUEDO SKIP TO KEEP FLOW
	PUSHJ	P,TMPOUT	;[444] OUTPUT THE COMMA AND CONTINUE
	SKIPE	T2,ODEV  	;[444] OUTPUT DEVICE THERE?
	PUSHJ	P,OUTDEV	;[444] YES, OUTPUT IT
	MOVE	T2,SVDEV(SVPT)	;[444] GET THE CURRENT DEV NAME
	MOVEM	T2,ODEV		;[444] AND MAKE IT THE OUTPUT DEV
	MOVE	T2,ONAM		;[444] GET OUTPUT FILENAME
	PUSHJ	P,OUTSIX	;[444] PUT IT OUT THERE
	MOVE	T2,SVNAM(SVPT)	;[444] GET CURRENT FILENAME
	MOVEM	T2,ONAM		;[444] STORE IT AS OUTPUT NAME
	SKIPE	T2,OEXT		;[444] GET OUTPUT EXTENSION
	PUSHJ	P,OUTEXT	;[444] PUT IT OUT IF THERE
	SETZM	OEXT		;[453] CLEAR OUTPUT FILE EXTENSION
	MOVE	T2,SAVSW	;[444] GET THE SWITCH AGAIN
	PUSHJ	P,OUTSIX	;[444] OUTPUT IT
	MOVEI	T1,","		;[444] THIS IS THE OUTPUT FILE
	TRNN	FL,LODOUT	;[444] IS THERE ALREADY OUTPUT THERE?
	PUSHJ	P,TMPOUT	;[444] NO, SO OUTPUT A COMMA, ELSE DON'T
	POP	P,T3		;[444] PUT THE ORIGINAL CHAN NO. BACK
	POPJ	P,		;[444] AND RETURN
	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
	SOSGE	TMPCNT(T5)	;[425] 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:	HLLZ	T1,PROCTB(T3)	;[566] GET TMPCOR FILE
	MOVEM	T1,TMPFIL	;[566]   TO DELETE
	SETZM	TMPFIL+1	;[566] ZERO I/O WORD
	MOVE	T1,[2,,TMPFIL]	;[566] DELETE TMPCOR FILE
	TMPCOR	T1,		;[566]
	  JFCL			;[566] MUST NOT BE ONE
	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 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
TRYAGN:	OPEN	LOOK,FSINIT	;INIT THE F/S
	  JRST	DOEND		;[206] ERROR
	ENTER	LOOK,NAME
	  JRST	[PUSHJ	P,TRYDSK	;[276] TRY GENERIC DSK (ONLY RETURN IS YES) ?
		JRST	TRYAGN]		;[276] YES--TRY AGAIN
	MOVE	T1,@TMPCHN(T3)	;GET ADDRESS OF IOWD LIST
	OUTPUT	LOOK,(T1)	;OUTPUT THE DATA
	CLOSE	LOOK,20		;SAVE THE NAME BLOCKS
	POPJ	P,		;[441] faster than JRSTing to it

TRYDSK:	HRRZ	T1,LEXT		;[276] GET ERROR CODE
	CAIE	T1,0		;[276] NON-EXISTANT FILE
	CAIN	T1,1		;[276] OR UFD ?
	JRST	DODSK		;[276] YES--GO TRY GENERIC DSK
	CAIE	T1,23		;[276] NON-EXISTANT SFD ?
	JRST	FIU		;[276] NO--GIVE ERROR
DODSK:	MOVSI	T1,'DSK'	;[276]
	CAMN	T1,FSNAME	;[276] LAST DEVICE GENERIC DSK ?
	JRST	FIU		;[276] YES--OH WELL WE TRIED
	MOVEM	T1,FSNAME	;[276] NO
	SETZM	LPPN		;[276] RESET PPN
	SETZM	LDAT		;[276] AND OTHER GOOD
	HLRM	T1,LEXT		;[276] STUFF
	POPJ	P,		;[276] SO TRY IT

;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,H)<
IFDIF <A><MACY11>,<
	<SIXBIT /A/>>
IFIDN <A><MACY11>,<
	<SIXBIT	/B/>>
>
PROCTB:	PROCESS
REPEAT MXPROC-NPROCS,<0>	;FILL IN MISSING ONES
	XPROCESS	;AND THESE
	SUBTTL	COMPILER TYPE TABLE
;[462] EXPAND CMPTBL MACRO INTO COMPILER TYPES AND PROCESSOR FLAGS
;	A = compiler type code
;	B = processor flags to set in FL2
;
	DEFINE	X(A,B),<
IFLE A,< .CMPTD==1			;;crock it once
> ;;ENDIFE
IFG A,<	.CMPTD==A-.CMPTC		;;calc dif in entries
> ;;ENDIFG
IFLE .CMPTD,<
PRINTX ?CMPTBL IS OUT OF ORDER
.CMPTD==1
>;;ENDIFLE			;;make a best guess at this point
    REPEAT .CMPTD-1,<
	XWD	0,UNKSW		;;not used
	>;;END REPEAT
    IFDEF B,<
	XWD	0,B		;;Code A
	> ;;ENDIFDEF
    IFNDEF B,<
	XWD	0,UNKSW		;;Zero entry, not defined here
	> ;;ENDIFNDEF
.CMPTC==A			;;set our counter
>;;ENDDEF X
CMPCOD:	CMPTBL
CMPLEN:	.-CMPCOD-1			;[462] length of table
SUBTTL	DATA STORAGE ASSIGNMENTS
WORDS	<PCNAM,PCDEV,LODDEV,SAVPPN,SVSWP,PCNUM,OLDEXT,SDAT,STIM,SAVCHR,ETIM>
WORDS	<ACCUM,DINPT,DINCT,SVJFF,CORTOP,CORT1,SVRPP,NUMAT,DFPROC,DEFPRO>
WORDS	<SVIND,SVPDL,JOBNAM,BROCNT,LODSP2,LODCT2,LODSP,LODCTR,EXTEND>

U (LODSBK,<LODSCT/5+1>)
U (LODSB2,<LODSCT/5+1>)
WORDS <SWGKB,SWGKL,SWGKS>		;[447]
U (SWGLK,SWBK+1)			;[447]
WORDS <SWBKB,SWBKL>

U (SWBKS,NFILE)

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

U (SVDEVV,1)		;[254] SAVE AREA FOR DEVICE
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 (DSKBUF,1)		;[564] DISK BUFFER ADDRESS
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)
>			;NAME OF FORTRAN COMPILER
U (COBPRC,1)		;[324] NAME OF COBOL COMPILER
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

WORDS(<EBLK,EPPN,NAME,LEXT,LDAT,LPPN>)	;[240]
U(EVER,<.RBTIM-.RBSIZ>)			;[240] EXTENSION TO LOOKUP BLOCK
LNAM=NAME
U(PTHBLK,3+SFDLEN)			;[601] ARG,FLAGS,PPN,SFDS
U(PNMBLK,5)				;PATHOLOGICAL NAME BLOCK
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 0,LOOKBF	;[462] NO NEED FOR OUTPUT BUFFER
DSKLK:	1
	SIXBIT /DSK/
	XWD 0,LOOKBF	;[462] DON'T USE UNNECESSARY OUTPUT BUFFER

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

INLFLG:	BLOCK 1		;[305] -1 = CURRENTLY NOT AT BEGINNING OF LINE
FAKEOL:	BLOCK 1		;[305] -1 = ROUTINE POPFIL FAKED A LF FOR PIP

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