Google
 

Trailing-Edge - PDP-10 Archives - BB-4157D-BM - sources/comman.mac
There are 8 other files named comman.mac in the archive. Click here to see a list.
TITLE	FTNCMD	%5A(621) COMMAND SCANNER INTERFACE FOR FORTRAN COMPILER
SUBTTL	DONALD LEWINE/DAL/FI/HPW/DBT/NEA/MD/JNT/DCE/SJW/JNG 30-SEP-77



;COPYRIGHT (C) 1972,1977 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.


	TWOSEG
	SUBTTL	REVISION HISTORY

;124	 -----	ADDED MAIN ENTRY SYMBOL MRP0 FOR SINGLE SEGMENT COMPILER
;		/HPW
;125	 -----	ADDED BUGOUT COMPLIER DIAGNOSTIC SWITCH /DBT
;126	 -----	FIXED ERROR TRAP TO CLEAR FIRST PART DONE
;127	 -----	CHANGED SIZE OF POOL
;130	 -----	MOVE APR TRAP INITIALIZATION TO BE RESET AFTER
;		EACH PROGRAM
;131	-----	CHANGED BIT POSITION OF EOCS BIT IN FLAG REGISTER
;132	-----	PUT BOUNDS SWITCH BACK IN
;133	-----	CHANGE NXTFIL TO A SUBROUTINE WHICH WILL OPEN THE INPUT
;		FILE AS WELL AS BUILD THE OPEN BLOCK. PHAZ1 CAN THEN CALL PHAZCO
;		AND THEN NXTFIL SO THAT THE "+" COMPIL CONSTRUCTION
;		WILL WORK
;134	-----	FIX ABSENT SPEC (PRESENT SWITCH)
;		BEING TREATED AS PRESENT SPEC. E.G. /SWT,X=X
;		TREATED AS *.*/SWT,X=X
;135	-----	CATCH THE OCCURRENCE OF "=" COMMAND LINE
;		IE.  NO INPUT FILES  AT ALL
;
;136	-----	CALCULATE THE MAXIMUM CORE REQUIRED FOR THE LIST
;		OF INPUT FILES AND STORE IN BGSTBF.  PHAZ1 WILL RESERVE
;		THIS AMMOUNT OF CORE WHEN THE FIRST FILE IS OPENED
;
;137	-----	PUT ERROR MESSAGES IN NEW FORMAT
;138	-----	PUT IN FTTENX SUPPORT
;********** BEGIN VERSION 4A
;230	DRIVER(14)	-----	ALLOCATE VARIABLE DIMENSIONS PASSED
;	ACT1(99)	-----	AS ARGUMENTS.
;231	ERROUT(32)	-----	CHANGE WARNING 77 (DO INDEX)
;232	ACT1(100)	-----	FIX PROCESSING OF RECORD NUMBER IN BLDUNIT
;233	PEEPOP(71)	-----	FIX PEEPOP OF JUMP INSTRUCTION
;234	PNROPT(144)	14167	FIX PROPAGATION OF LIBRARY FUNCTION
;				CALLS WITH CONSTANT ARGUMENT.
;235	STA3(56)	-----	NAMELIST PROBLEMS
;	ASHELP(3)		1-ITEMS NOT ALLOWED IN COMMON
;	ACT1(101)		2-SOMETIMES NOT ALLOCATED
;				3-NOT CREFED PROPERLY
;236	OUTMOD(63)	14654	EQUIVALENCE PROBLEM
;237	REGAL2(127)	-----	REGISTER ALLOCATION FAILS
;240	PH3G(229)	14569	REGISTER ALLOCATION PROBLEM
;241	OUTMOD(64)	-----	FIX HISEG BLOCK FOR BIG LOW SEG
;242	CODETA(1)	15010	ALLOW CONTINUE AS OBJECT OF
;	SKSTMN(92)		A LOGICAL IF STATEMENT.
;243	GCMNSB(67)	14916	FIX OPTIMIZER (INT COMP ERROR)
;244	GCMNSB(68)	14940	FIX OPTIMIZER (FINDTHESPOT TO MOVE
;				COMMON EXPRESSIONS).
;245	PEEPOP(72)	15039	CORRECT MOVEMENT OF JRST ADDRESS TO INCLUDE
;				THE INDEX AND INDIRECT BITS.
;246	PH3G(230)	15209	FORCE PRELOADS ON BRANCHES IN LOOPS
;247	LISTOU(54)	15349	CHANGE FORMAT LABEL REFERENCES TO P (FROM F)
;250	REGAL2(128)	15356	DON'T ALLOCATE REG WHEN ALCRETREGFLG ON
;251	PEEPOP(73)	15652	DON'T OPT OUT LABELED INDIRECT JRST
;252	DEFPT(116)	14967	CHECK NODES FOR FUNNY OPRCLS IN SELECTIT
;253	PEEPOP(74)	15425	DON'T OPT OUT MOVE FOLLOWING PUSHJ OR DIVIDE
;				OF AC-1
;254	STREGA(202)	15425	FORGET WHAT WAS IN 0 WHEN BOOLEAN FUNCTIONS ALLOCATE
;				THE RETURN VALUE TO 0
;255	STA3(57)	15432	CHECK THE DO LOOP TERMINATION LABEL FOR
;				BEING ON THE DO STATEMENT ITSELF.
;256	CGDO(134)	15493	DON'T COUNT ENTRY LABELS FOR STATEMENT FUNCTIONS
;257	PEEPOP(75)	15511	ELIMINATE REDUNDANT ADDI SUBI PAIRS
;260	SKSTMN(93)	-----	ADD DOT FOR MATERILIZING INDEX AROUND FUNCTION CALLS
;261	STREGA(203)	15772	WHEN COMPILING WITH /DEBUG:LABELS, DO NOT
;	PEEPOP(76)		OPTIMIZE REGISTER USAGE BETWEEN
;	TABLES(154)		STATEMENTS
;262	COMMAN		15710	CORRECT LOOPS ON ENTER FAILURES
;263	PHA2(108)	15865	FIX STACK VALUE SAVED
;264	OPGNTA(119)	15974	FIX COMPLEX DIVIDE TO MEMORY ON KI
;265	ACT1(102)	15946	ADD WARNING FOR MULTIPLY INITIALIZED
;	ERROUT(33)		VARIABLES IN DATA STATEMENTS
;	ASHELP(4)
;266	PH3G(231)	15952	FIX AN OPTIMIZER MOVEMENT BUG
;267	REGAL2(129)	-----	FIX SIDE EFFECT OF 250 IN RELATIONALS
;270	STREGA(204)	16013	CLEAR REGSTATE FOR VARIABLES IN INPUT NAMELIST
;271	COMMAN		-----	CHANGE COMMAN TO SEARCH C AND SCNMAC
;272	ACT1(103)	-----	CHANGE 265 TO NOT CHECK ARRAYS
;273	DATAST(43)	16361	HANDLE NEGATIVE DIMENSIONS RIGHT IN DATA STATEMENTS
;274	REGAL2(130)	16050	ALLOCATE SAVES FOR 0-1 IN FUNCTION CALLS
;				AFTER ALLOCATING UNDER CALL
;275	CNSTCM(65)	-----	CHECK FOR UNDERFLOW RIGHT
;276	TSTR(45)	-----	REDUCE NEGATIVE MULTIPLICATIONS CORRECTLY
;277	PH3G(232)	16112	FIX FLIPCODES TO CALL LEAFLOOKER WITH THE
;				REGS WE REALLY WANT SUBSTITUTED
;300	STREGA(205)	-----	FIX 270
;301	CMPLEX(127)	16154	REMEMBER THAT FUNCTION CALLS CLOBBER 0 AND 1
;	STREGA(206)		SO DON'T USE PROLOG VALUES IN THEM
;302	REGAL2(131)	16181	CATCH ALL CASES OF NOT REMEMBERING REG CONTENTS FOR
;				BOOLEAN EXPRESSIONS WHICH MAY NOT BE COMPLETELY EXECUTED
;303	DRIVER(15)	16369	CATCH ALL CASES OF DIMENSIONED VARIABLES
;				OCCURRING WITHOUT INDICES
;304	REGAL2(132)	16441	CLOBBER BOTH REGISTER STATES ON A DOUBLE
;				TO SINGLE TYPE CONVERSION
;305	PEEPOP(77)	16518	FIX PEEPOP TO CHECK FOR INDEXING WHEN ELIMINATING
;				REDUNDANT MOVE FROM MOVEM-XXXX-MOVE
;306	CGSTMN(124)	16156	FIX CALL/OPEN TO DO FORMAL ARRAYS INDIRECTLY
;307	DRIVER(15)	16611	CHANGE ORDER OF CLEANUP TO FIX PYROTECHNICS
;310	STREGA(207)	16602	CHANGE ORDER OF OPEN/CLOSE REGISTER ALLOCATION
;311	STREGA(208)	16665	ALLOCATE IOLIST REGS ONLY FOR NON-DATA ITEMS
;312	GNRCFN(31)	16668	CHECK MIN AND MAX FUNCTIONS FOR LESS THAN 2 ARGUMENTS
;313	STA1(62)	16666	HANDLE DIALOG W/O = RIGHT
;314	DATAST(44)	QAR	FIX DATA STATEMENT DO LOOPS OF - NUMBERS
;315	DEFPT(117)	16667	FIX ARRAYREFS WITH CONST SS DEFINITION POINT
;316	PH3G(233)	QAR	FIX 277 RIGHT
;317	LISTOU(55)	QAR	FIX 247 RIGHT
;
; BEGIN VERSION 4B, 26-AUG-75
;
;320	STA2(41)	16787	CATCH COMMON /X/A(5)B(5) AS ERROR
;321	TSTR(46)	17005	SCAN FOR INDUCTION VARIABLE IN OPEN/CLOSE WHEN /OPT
;322	IOPT(48)	16688	CHECK FOR DISJOINT IOLISTS BEFORE COLLAPSING
;323	CGDO(135)	16729	CHANGE NAME OF TEMPS USED TO SAVE REGS
;	DOALC(106)		IN FUNCTION PRO/EPI-LOGUE FROM .XXXNN
;				TO .A00NN TO AVOID CONFLICT.
;324	STA3(58)	16750	CLEAN UP SYMBOL TABLE ENTRIES AFTER
;				BAD STATEMENT FUNCTION.
;325	ACT0(52)	17044	CHECK FOR OVERFLOW OF STK CAUSED BY LONG
;				ARGUMENT LISTS, AND REMEDY SITUATION.
;326	REGAL2(133)	17086	FIX REGISTER TARGETING FOR ASSIGNMENT STATEMENTS
;				WITH AND/OR NODES AND FUNCTION CALLS.
;327	GRAPH(117)	16688	PREVENT OPTIMIZER FROM DYING ON
;				PROGRAMS WITH POTENTIALLY INFINITE LOOPS
;330	GRAPH(118)	17150	ENSURE THAT THE OPTIMIZER DOES NOT 
;				CONSIDER ENTRY STATEMENTS TO BE INACCESSIBLE
;331	P2S2(51)	17091	FIX PROPAGATION OF NEGATION FOR SPECIAL
;				OPERATOR: RAISE TO AN ODD CONSTANT INTEGER
;				POWER CANNOT ABSORB A NEGATE FROM BELOW.
;332	DOALC(107)	17045	FIX ASSIGN STATEMENTS WITHIN DO LOOPS
;	LEAFLOOKER(234)
;333	GRAPH(119)	17045	FIX UP CODE GENERATED FOR ASSIGNED GO TO
;				STATEMENTS WITHIN DO LOOPS.
;334	F72BNF.SYN	17420	CORRECT FORMAT OF DO STATEMENT (ADD LINEND)
;335	INOUT(36)	17377	FIX FATLERR SO THAT IT DOES NOT DESTROY
;				THE CONTENT OF NAME FOR LEXICA.
;336	STA0(46)	17259	CHECK FOR I/O LIST WITH NAMELIST
;	ERROUT(34)		DIRECTED I/O
;337	OUTMOD(65)	17305	ROUND UP IMMEDIATE REAL CONSTANTS
;	CGEXPR(71)		BEFORE LISTING THEM
;340	GCMNSB(69)	16989	DO NOT ALLOW CALL TO MATCHER TO
;				CHANGE VALUE OF PHI - OPTIMIZER BUG
;341	REGAL2(134)	17770	FIX REGISTER ALLOCATION FOR EXPONENTIATION
;				INSIDE FUNCTION
;342	LISTNG(10)	17876	MAKE LONG UNCLASSIFIABLE STATEMENTS WORK
;	LEXICA(14)		PROPERLY - SEVERAL MINOR PATCHES
;343	DRIVER(17)	17636	FIX END OF STATEMENT PROCESSING
;				SO THAT THE LINE NUMBER IS CORRECT.
;344	CMPLEX(128)	17768	FIX PROPAGATION OF FNCALL FLAG
;				TO A NEG/NOT NODE.
;345	P2S2(52)	17554	FIX COMMON SUBS INVOLVING EXPONENTIATION
;				TO EVEN POWERS SOMETHING WITH A NEG FLAG
;346	TSTR(47)	17928	PASS OUT RETURN INFORMATION TO OUTER DO LOOPS
;347	PH3G(235)	17545	IN GLOBAL REGISTER ALLOCATION, PREVENT
;				BAD PRELOADS CAUSED BY LOGICAL IF'S.
;350	PH3G(236)	17545	COMMON SUBS MUST ALSO CAUSE PRELOADS
;				OF REGISTERS ON OCCASION - FIX THIS.
;351	LISTNG(11)		FIX EDIT 342 PROPERLY
;352	PH3G(237)	18007	FIX EDIT 266 FOR CASE WITH ONE MATERIALIZATION
;353	PH3G(238)	18004	FIX TWO CALLS GENERATING BAD CODE
;354	TSTR(48)	18015	BAD CODE INVOLVING REDUCTION IN STRENGTH
;355	SRCA(49)	18132	CORE MANAGEMENT INSUFFICIENT FOR LARGE 
;				DATA STATEMENT
;356	LISTOU(56)	18105	MAKE MAIN. GLOBAL SYMBOL FOR MAIN PROGS.
;357	COMMAN		18191	FIX OPEN ERROR REPORTING
;360	CGDO(136)	18243	FIX RETURN STMNT AT END OF DO LOOP 
;361	GRAPH(120)	18451	FIX GO TO END OF DO LOOP
;362	LEXSUP(8)	18245	FIX UP ARGUMENT BLOCK TYPES FOR
;	GLOBAL(75)		LOGICAL AND OCTAL AND DOUBLE OCTAL CONSTANTS
;363	STREGA(209)	18269	CHECK A1NOTFLG BEFORE REMEMBERING REG CONTENTS
;364	OUTMOD(66)	18251	CORRECT EQUIVALENCE PROCESSING
;365	LEXICA(15)	18857	TAKE CARE OF FORM FEEDS BETWEEN ROUTINES
;366	LEXSUP(9)	18210	SAVLINE CANNOT CLOBBER NAME
;	LEXICA(16)		X=.123EQ.A AND X=1.1HABC ARE ILLEGAL
;367	CGSTMN(125)	18239	WRITE(U) GENERATES WRONG CODE
;370	GCMNSB(70)	17938	REMOVE [244] REAL FIX IS IN REDUCE (TSTR)
;	TSTR(49)		FIX CODE MOTION FOR .R VARIABLES
;371	COMSUB(255)	18471	FIX CSE FOR STRAIGHT CASE IN MATCHER
;372	GRAPH(121)	18314	FIX ASSIGN GO TO INSIDE LOOPS
;373	REGAL2(135)	18242	CORRECT REGISTER ALLOCATION FOR LARGE
;				ASSIGNMENT STATEMENTS
;374	GRAPH(122)	-----	FIX MIS-SPELLED MACRO NAME
;375	PNROPT(145)	18450	USE .O INSTEAD OF .R FOR DP TEMPORARY
;376	CGWRIT(126)	18398	FIX WRITE STMNT WITH DEBUG SET
;377	REGAL2(136)	18476	FIX REG ALLOCATION FOR COS(X)*A(I)
;400	PH3G(239)	18704	FIX LOGICAL IF BEFORE NESTED LOOPS
;401	GCMNSB(71)	17813	FIX A(I)=B(I)+B(I)+1.0
;
;	BEGIN VERSION 5, 7-MAY-76
;
;	ACT1   (104)	ARRXPN (52)	CANNON (25)	COMSUB (256V)
;	GCMNSB (72)	OPTMAC		PH3G   (240V)	PHA2  (109)
;	PNROPT (146)	TSTR   (50)	VER5   (1)
;
;402	STA2(42)	18917	RESTORE FLGREG PROPERLY AFTER INCLUDE
;403	STREGA(210)	18961	BAD REG ALLOCATION FOR I=I/J
;404	GOPTIM(53)	18869	MAKE ASSOCIATE VARIABLE LIST CORRECTLY,
;	PH3G(240)		AND DON'T LET THEM LIVE IN REGISTERS
;405	COMSUB(256)	18967	FIX A(P(I)) IN IOLIST
;406	IOPT(49)	18978	FIX CHAR(K(I,J)) IN IOLIST
;407	VERSION 5, 25-JUN-76
;	GRAPH	(123)	STA1	(63)	ADD ERR= ON OPEN/CLOSE
;410	GLOBAL(76)	QA568	MAKE DTABPTR GLOBAL FOR BLDDIM
;	ACT1(105)
;411	CMPLEX(129)	19537	DON'T SWAP ARGS FOR MAX OR MIN IF
;				FIRST ARG IS NEGATIVE
;412	CMPLEX(130)	VER5	NODE WITH ARG1 = DOUBLE ARRAY REF FOR
;				  KA10 MUST HAVE COMPLEXITY AT LEAST 3
;	REGAL2(137)	VER5	USE SUBSCRIPT REG FOR DOUBLE ARRAY REF
;				  VALUE EXCEPT ON KA10
;413	CNSTCM(66)	-----	DON'T USE FADL IN INTDP IF NOT ON KA10
;414	ACT1(106)	QA625	FIX .I OFFSET SHARING SO ONLY SHARES
;				  DIM2 .I IF DIM1 SAME
;415	ACT1(107)	18964	DON'T DESTROY SYMBOL TABLE ENTRY FOR
;				  FORMAL FUNCTION WHEN ENTRY STATMNT
;				  SEEN WITH THE FUNCTION AS A PARAM.
;416	GCMNSB(73)	QA650	FIX MOVCNST SO HASH ENTRY IGNORED ON
;				  NEXT PASS IF .R+X CAN'T BE MOVED AS .O
;417	STA3(58)	QA637	FIX BAD STATEMENT FUNCTION FROM
;				CLOBBERING THINGS ON CLEANUP IN 324
;420	STA3(59)	QA637	AFTER BAD ST FN, CLEAN UP THE NAME
;				SO THAT IT DOES NOT CAUSE TROUBLE LATER
;421	PNROPT(147)	QA651	DON'T PROPAGATE .O IF CAME FROM .R
;422	LISTNG(12)	18493	IMBEDDED NULLS CAUSE LOW LEVEL LOOPING
;423	ACT1(108)	QA709	FIX PATCH 414: DIMNUM IS 1-RELATIVE
;424	STA1(64)	QA690	ERROR IF DIRECTORY= NOT LITERAL OR ARRAY
;				  NAME IN OPENCLOSE
;425	PHA2(110)	QA714	CALL ZTREE TO CLEAR DEFPTS IF 
;				  OPTIMIZATIONS DISCONTINUED IN OPTERR
;426	CMPLEX(131)	18816	SET FNCALLSFLG FOR IMPLICIT FN CALLS,
;	DOALC(108)		SO 0,1, AND 16 ARE KNOWN TO BE CLOBBERED
;427	COMSUB(257)	18871	FIX COMSUBS IN IOLISTS
;430	P2S2(53)	18876	MAKE ARITH IF NODES ABSORB NEGS RIGHT.
;431	PH3G(241)	19121	MATERIALIZE VARIBLES THAT HAVE BEEN
;				ALLOCATED TO REGISTERS DURING A
;				DOUBLY-NESTED DO LOOP CORRECTLY.
;432	REGAL2(138)	19037	FIX CONVERSION OF LOGICAL ARRAY REF
;433	DOXPN(81)	19130	MAKE DO I=10,1 EXECUTE ONCE
;434	P2S1(60)	19211	CHECK FUNCTION CALL CONTAINING DO INDEX
;				AS A PARAMETER AFTER CONSTANT FOLDING.
;435	IOPT(50)	18964	FIX IO LISTS WITH VARIABLE INCREMENT
;436	OUTMOD(67)	19427	CATCH EQUIVALENCE VIOLATION WHEN
;				BUILDING EQUIVALENCE CLASSES.
;437	GCMNSB(74)	QA771	DON'T LET DOTOHASGN MOVE .O=EXPR IF
;				  .O CAME FROM .R
;	VER5(2)			MARK SUBSUMING .O IF SUBSUMEE .O CAME
;				  FROM .R IN DOTOFIX
;440	GCMNSB(75)	QA771	DON'T NEXTUP .O IF CAME FROM .R IN
;				  MOVCNST
;441	REGAL2(139)	19231	FIX REGISTER ALLOCATION FOR A D.P.
;				  ARRAYREF AS A FN CALL PARAMTER.
;442	COMSUB(258)	19233	MAKE THE DELETION OF HASH ELEMENT
;				WORK IF ELEMENT IS FIRST IN ITS LIST
;443	GRAPH(124)	QA656	WARNING + OPT STOPPED IF DISCOVER
;				  ILLEGAL DO NESTING IN LNKEXTND
;	ERROVD			ADD WARNING MESSAGE E140
;	ERROUT(37)
;444	PH3G(242)	19484	FIX TO 246 - DON'T FORCE PRELOAD OF
;				COMPILER VARIABLES IF GOTO ENCOUNTERED.
;445	P2S1(61)	19632	USE FEWER LOCALS ON STACK DURING
;				RECURSIVE CALLS TO P2SKARITH
;446	STREGA(211)	20652	BAD CODE FOR I=I*3 AND I=I**7 (QAR753)
;447	UTIL(85)	19547	NEGATIVES PROPAGATED TOO MUCH IN FORTG
;450	COMSUB(259)	QA784	DON'T NEXTUP ARRAYREF IF INSIDE IOLIST
;451	ERROUT(35)	19610	CORRECT SPELLING IN ERROR MESSAGE
;452	COMMAN(452)	19610	NUL: CAUSES PROBLEMS AS OUTPUT DEV
;453	DEFPT(118)	19695	DON'T MAKE DO BE DEFPT OF ALL VARS
;				MODIFIED INSIDE THE LOOP.
;454	PH3G(243)	19699	DON'T PLACE PRELOADS 1 STATEMENT TOO
;				LATE WHEN PLACING AFTER A DO LOOP.
;455	GCMNSB(76)	QA784	CAN'T MOVE EXPRESSIONS OUT OF IMPLIED DO
;				  IF INSIDE LOGICAL IF
;456	GCMNSB(77)	QA784	FIX FINDTHESPOT SO CALLER TELLS IT WHERE
;				  TO STOP
;				ADD NEW ROUTINE FINDPA FOR GLOBMOV AND
;				  DOTOHASGN
;				CALL FINDTHESPOT WITH 2ND PARAM IN
;				  GLOBMOV AND DOTOHASGN
;	COMSUB(260)		GIVE GLOBMOV ENTIRE HASH ENTRY IN CMNMAK
;				  FOR FINDPA
;	MOVA(26)		CALL FINDTHESPOT WITH 2ND PARAM = TOP IN
;				  HAULASS
;	TSTR(51)		CALL FINDTHESPOT WITH 2ND PARAM = TOP IN
;				  REDUCE
;457	REGAL2(140)	19805	TRY HARDER NOT TO REQUEST A REG IN
;				REGAL2 UNLESS WE REALLY NEED IT - MIGHT
;				RUN OUT EARLY.
;460	ACT1(109)	19477	CHANGE DIMENSION PROCESSING TO BE
;	ERROUT(36)		MORE THOROUGH AND LESS APT TO EXIT EARLY
;461	LISTOU(57)	19477	DETECT WHEN PROGRAM IS TOO LARGE
;	ERROVG(1)		ADD E142
;	ERROUT(38)
;462	DRIVER(18)	19960	FIX MRP1 TO LEAVE SREG<LEFT> WITH THE
;				SAME VALUE IT FOUND IN IT
;463	UTIL(86)	19989	FIX IMPLIED DO'S WHOS INITIAL VALUE OR
;				STEP SIZE COME FROM AN OUTER AOBJN DO.
;464	LISTOU(58)	QA754	ADD LINE-NUMBER/OCTAL-LOCATION MAP IF
;	PHA3(50)	  780	  MACRO LISTING NOT REQUESTED
;	GLOBAL(77)		ADD 3 GLOBALS FOR LINE-HANDLING
;465	PNROPT(148)	20657	CLEAR INDVAR BEFORE CALLING REDUCE FOR
;				STATEMENTS BEFORE THE DO LOOP; WE MIGHT
;				FIND SOME REDUCTIONS OTHERWISE (!!!).
;466	PNROPT(149)	VER5	DELETE CODE TO ZERO DEFPTS BETWEEN
;				LENTRY & TOP (REMOVE 465 AND MORE)
;467	IOFLG(9)	VER5	TAKE OUT FORSWI.REQ
;	INOUT(37)		REQUIRE FTTENX.REQ
;	LISTNG(13)
;	STA2(43)
;	MAIN(29)		REQUIRE FT1SEG.REQ
;470	OUTMOD(68)	20744	MAKE SURE THE HIGH SEG STARTS AT LEAST
;				A PAGE ABOVE THE END OF THE LOW SEG.
;471	STREGA(212)	20309	LHS A LOGICAL EQUIVALENCED VAR MAY
;				GENERATE BAD CODE
;472	OUTMOD(69)	20494	INCORRECT EQUIVALENCE PROCESSING
;				WHEN LAST ELEMENT OF GROUP IN COMMON
;473	OUTMOD(70)	20478	SCALARS AND ARRAYS LISTING TOO WIDE
;474	OUTMOD(71)	20479	OUTPUT CRLF AFTER LAST COMMON BLOCK NAME
;475	IOPT(51)	20813	DON'T COLLAPSE ELISTS THAT WE SHOULDN'T
;476	IOFLG(10)	QA754	MAKE MAPFLG FROM STATFLG IN FLGREG
;	COMMAN(476)	  780	MAKE /MAP A SWITCH TO SCAN
;	LISTOU(59)		MAKE LINE NUMBER/OCTAL LOCATION MAP
;	PHA3(51)		  OPTIONAL UNDER /MAP SWITCH
;477	LEXSUP(10)	QA831	MAKE MESSAGE NAMLEX'S MORE READABLE
;500	TSTR(52)	20818	DON'T SEE IF A NODE IS AN I/O STATEMENT
;				UNLESS IT'S A STATEMENT.
;501	TSTR(53)	21113	DON'T REDUCE .O'S IN OUTER DO LOOPS.
;502	PH3G(244)	20463	SORT SAVED VS NON-SAVED REGS CORRECTLY
;				  IN FLIPCODES; FAKE ITMCT ALSO
;	COMMAN(502)	VER5	REMOVE XLIST'S FOR FTTENEX
;503	STREGA(213)	19976	FOR A(I) = FUNC. CALL, DON'T LEAVE I
;				IN REG 1 WHEN CALCULATING LH FIRST.
;504	REGAL2(141)	QA815	FIX EDIT 412 TO NOT ALLOW FETCHES OF
;				COMPLEX NUMBERS INTO AN AC WHICH IS
;				ALSO THE INDEX REG. NEGATED FETCHES
;				USE TWO INSTRUCTIONS (EVEN ON KI'S),
;				AND NEGFLG'S CAN SNEAK IN MUCH LATER.
;505	VER5(3)		QA815	IN DOTORFIX DON'T MOVE .R INIT IF IT'S
;				  ALREADY IN THE CORRECT PLACE
;506	LISTNG(14)	10056	LINESEQUENCED FILES KILL LOW LEVEL BUFFERING
;507	GCMNSB(100)	-----	FIX EDIT 440 TO ALLOW NEXTUP OF .O WHICH
;				  CAME FROM .R IN MOVCNST IF MOM IS
;				  ARITHMETIC
;510	CMPLEX(132)	-----	DON'T TEST ALCRETREGFLG IN DATAOPR NODES
;511	ERROUT(39)	-----	FIX E37,E79,E100 TO AGREE WITH ERROVD
;				FIX AND MOVE E140 FROM [443]
;				FIX SPELLING IN E74
;	ERROVD(2)		FIX E140
;512	COMMAN(512)	-----	MAKE /MAP FROM [476] CALLED /LNMAP SINCE
;				  /MAP/LMAP ARE LOAD COMPIL SWITCHES
;513	GCMNSB(101)	QA771	IN MOVCNST WHEN .O IS CREATED, PASS UP
;				  ORFIXFLG FROM ANY .O BEING SUBSUMED
;				CHANGE [507] TO FREE VARAIBLE T IN MOVCNST
;514	GCMNSB(102)	QA806	IN MOVCNST IF NARY INSURE .R IS 1ST ARG
;				  SINCE [V5] CODE ASSUMES .R + X
;515	VER5(4)		QA815	REMOVE "TEMP [EXPRUSE] _ 1" IN DOTORFIX
;
;	BEGIN VERSION 5A, 7-NOV-76
;
;516	COMMAN(516)	21215	FIND FILES WITH BLANK EXTENSIONS IN SFDS
;517	COMMAN(517)	21238	MAKE SFD'S IN COMMAND STRINGS WORK.
;520	COMSUB(261)	21271	PROHIBIT NEGATIONS IN RELATIONAL COMSUBS
;521	STA1(65)	QA900	FIX PARAMS TO FATLEX IN OPENCLOSE
;522	STREGA(214)	20819	CHECK NEGFLGS FOR ARRAYREFS IN IOLISTS
;523	COMMAN(523)	QA1038	FIX DEFAULT FLAG SETTINGS FOR SCAN:
;				  SWITCHES COUNT FROM LEFT NOT RIGHT
;524	COMSUB(262)	QA876	PUT BACK ARRAY REF IN STPRECLUDE SO HASH
;				  ENTRY TAKEN OUT OF TREE
;				CALL STPRECLUDE BEFORE CMNMAK SO CAN
;				  HASH SKEWED TREE WITH NEG FLAGS
;				  UNCHANGED
;525	VER5(5)		QA949	DO CORRECT TYPECNV IN DOTOFIX ONLY IF
;				  NECESSARY
;526	GCMNSB(103)	QA1035	IN CHKDOM IF FNARY AND NO MATCH ON 
;				  "FUNC(ARRAYREF), PUT BACK ARRAYREF
;				  SO HASH TBL ENTRY NOT IN TREE
;527	STREGA(215)	20317	BAD CODE FOR ASSOCIATE VARS IN COMMON
;530	P2S2(54)	21606	BAD CODE FOR DOUBLE PRECISION SPECOPS 
;				WHICH GENERATED FSC INSTRUCTIONS
;531	STA1(66)	20323	GIVE WARNING WHEN SUBROUTINE PARAMETER
;	ERROUT(40)		IS USED AS ASSOCIATE VARIABLE
;532	STREGA(216)	20323	FIX CODE GENERATION FOR AN ARRAY ELEMENT
;	CGSTMN(127)		USED AS AN ASSOCIATE VARIABLE
;533	STA2(44)	21796	INCLUDE STMNT DESTROYS LOCS 4400-4402
;534	STA3(60)	21817	INTERNAL COMPILER ERRORS IN FORTB CAUSED
;				BY BADLY STRUCTURED STATEMENT FUNCTIONS
;535	GRAPH(125)	21809	INACCESSIBLE CODE WITH ZERO LINE NUMBER
;536	LEFTFM(23)		ADD RCHAR TO ERR NAME PLIT
;537	LISTNG(15)	21811	BAD PRINTING OF ERROR CONTINUATION LINE
;540	STA2(45)	22191	BAD COMMON STMNT GIVES ICE
;541	LISTNG(16)	-----	-20 ONLY: CLEAR LASTCHARACTER IN READTXT
;				  AFTER ^Z SEEN SO MORE TTY: INPUT MAY
;				  BE DONE
;542	EXPRES(32)	22147	MAKE A NOT IMPLY TYPE LOGICAL ALWAYS.
;543	SRCA(50)	-----	FIX BINARY SEARCH FOR LIBRARY NAME
;544	FIRST(127)	10290	FIND STMNT NODE TOO SMALL - EXPAND IT
;545	REGAL2(142)	22096	FUNCTION VALUES MUST GO INTO REALLY FREE REGS
;546	STREGA(217)	22030	FIX PROBLEMS WITH OPERATIONS WHICH CLOBBER
;				FOLLOWING REGISTER (IDIV)
;547	LEXICA(17)	21280	(QAR863) FIX INITIAL TAB IN COLUMN 6 TO
;				  GO TO COL 7 ON AN INITIAL LINE OR COL
;				  6 IF A CONTINUATION LINE
;550	REGAL2(143)	21824	FIX REG ALLOCATION FOR BIG EXPRESSION
;551	TABLES(155)	21826	FIX TYPE CONVERSION DURING CODE GENERATION
;552	REGAL2(144)	21826	GENERATE BETTER CODE FOR TYPE CONVERSION
;				OF ARRAY REFERENCE
;553	P2S2(55)	21826	TYPE CONVERSION MAY BE NECESSARY IF LOGICAL
;				OPERATION ABOVE IT IS LIQUIDATED
;554	REGAL2(145)	22324	AND NODE WITH THE NEGATION OF A FUNCTION
;	CGEXPR(72)		CALL BELOW IT GIVES BAD CODE
;555	LISTOU(60)	22281	FIX LINE NUMBER/OCTAL MAP WITH ENTRY POINTS
;556	LISTNG(17)	-----	PUT /L IN HEADING OF PAGE IF OCTAL MAP REQUESTED
;557	COMMAN(557)	-----	CATCH WILD PPN OR SFD AS ERROR
;560	COMMAN(560)	-----	-20 ONLY: HANDLE PPNS IN THE COMMAND LINE CORRECTLY
;561	LISTNG(18)	10429	ALLOW CONTINUATION LINES AFTER PAGE
;	LEXICA(18)		MARKS AND FORM FEEDS
;562	PNROPT(150)	22540	IOLISTS IN OPTIMIZATIONS MAY KILL REG 0
;563	GNRCFN(32)	22541	SPURIOUS ERRORS IF FIRST ARG TO LIB FN
;				IS OF UNACCEPTIBLE TYPE
;564	CGSTMN(130)	22693	MAKE CGREAD == CGWRIT: GENERATE FIN CALL
;				  ON UNFORMATTED WRITE WITH NO IOLIST
;565	GRAPH(126)	21810	EXTENDED RANGE DO LOOPS GIVES BAD GRAPH
;566	COMSUB(263)	22701	BAD COMSUBS WITH MANY NOT FLAGS
;				AND SHAPE SKEW
;567	ACT1(110)	22284	EXTERNAL STMNT NOT REMEMBERED AT ENTRY POINTS
;570	STA3(61)	22703	BAD STMNT FN GIVES ICE (FN(2,3))
;571	FIRST(130)	22378	ADD IDUSECNT DEFINITION
;	TABLES(156)		ADD ARALINK DEFINITION
;	ACT1(111)		FIX V5 OPT THAT SHARES 2ND OFFSET OF FORMAL
;				  ARRAY IF 1ST DIMS = SO ALL WILL WORK IF
;				  ARRAY SUBSEQUENTLY TYPED DIFFERENT #
;				  WORDS THAN WHEN SHARING 1ST DONE
;	DRIVER(19)		DEFINE & CALL CLERIDUSECNT AT END OF MRP1
;572	ACT1(112)	21825	CHECK IMPLIED DO INDEX FOR ALREADY ACTIVE
;				  (FROM ENCLOSING IMPLIED OR REAL DO)
;573	DBUGIT		-----	NEW REQUIRE FILE TO HOLD DBUGIT FLAG
;	IOFLG(11)		REMOVE "BIND DBUGIT="
;	DRIVER(20)		REQUIRE DBUGIT.REQ
;	INOUT(40)
;	LEXICA(19)
;	LEXSUP(11)
;574	SRCA(51)	-----	REWRITE BINARY SEARCH IN SRCHLIB TO WORK
;				  AFTER EDIT 543
;575	DEFPT(119)	22820	REWRITE ZAPLEVEL TO PREVENT STACK OVERFLOW
;				FOR VERY LARGE BRANCHING PROGRAM.
;576	GRAPH(127)	22796	FIX LINE NUMBER GIVEN FOR INFINITE LOOP
;577	TSTR(54)	22352	DO LOOP WITH A CALL STATEMENT INSIDE MUST
;				MATERIALIZE LOOP VARIABLE IF IT IS IN COMMON
;600	REGAL2(146)	22990	MORE EFFICIENT STACK USAGE IN FORTE
;601	ACT1(113)	Q20-26	FIX EDIT 572 TO CHECK IMPLIED DO INDEX
;				  IN DATA STATEMENTS FOR ALREADY ACTIVE
;				  FROM ENCLOSING IMPLIED DO
;602	COMSUB(264)	22700	OPTIMIZED IOLISTS WITH SKEWED EXPRESSIONS
;				MAY GENERATE ELISTS INCORRECTLY
;603	ACT0(53)	23442	ADD * AS INITIAL CHAR FOR LABEL CONSTANT
;604	OUTMOD(72)	23425	FIX LISTING OF COMMON BLOCK SO THAT WE
;				DO NOT GET AN EXTRA CARRIAGE RETURN
;605	TSTR(55)	23478	BAD CODE WITH /OPT FOR ASGMNT STMNT WITH
;				LHS LIKE A(I/2) OR A(I**5)
;606	CNSTCM(67)	22795	SOME OVERFLOWS DURING CONSTANT FOLDING
;				NOT DETECTED AND POOR CODE GIVEN.
;607	GLOBAL(100)	22685	MAKE NEW GLOBAL NEDZER TO INDICATE IF 
;				  ZERO-ARG-BLOCK NEEDED
;	CGDO(137)		SET NEDZER IN CGSBPRGM TO "0-A-B NEEDED"
;	CGSTMN(131)		SET NEDZER IN CGEND, CGSTOP & CGPAUS TO
;				  "0-A-B NEEDED"
;	PHA3(52)		GENERATE 0-A-B ONLY IF NEEDED
;610	P2S2(56)	23333	BAD CODE FOR COMSUB WITH NEG FLAG 
;				REPLACES EDIT 345.
;611	OPGNTA(120)	23662	IMMEDIATE SIZE COMPLEX CONSTANTS CAUSE
;				TROUBLE FOR CODE GENERATION.
;612	IOPT(52)	23263	INITIALIZE ARRCOUNT IN IOCLEAR (THIS
;				COMPLETES EDIT 406).
;613	CGDO(140)	QA2114	IGNORE INDIRECT BIT IN FORMAL FUNCTION
;				  TARGET IN ENTRY PROLOGUE
;614	LISTOU(61)	23760	OUTPUT ONLY NON-BLANK LINES ON /LNMAP
;615	PH3G(245)	23116	BE CAREFUL WITH LABELS WHEN PRELOADING
;616	STREGA(218)	22345	I/O LIST UNDER REGISTER SCARCITY GIVES ICE
;617	UTIL(87)	QA2121	ONLY TRY TO SUBSTITUTE THE SUBSCRIPT OF
;				  AN ARRAYREF IF IT ISN'T A CONSTANT
;620	COMSUB(265)	23720	D.P. ARRAY REF IN IO LIST CAUSES PROBLEMS
;				DURING OPTIMIZATION (IOLSCLS NODE PTRS)
;621	LISTNG(19)	QAR2120	ACCOUNT FOR PAGE MARKS AT END OF FILE.

;END REVISION HISTORY


	PAGE
	SUBTTL	VERSION NUMBER

LASTED==0	;LAST EDITOR
MAJVER==5	;MAJOR VERSION NUMBER
MINVER==1	;MINOR VERSION NUMBER
EDNUM==621	;EDIT NUMBER
JOBVER=137

	LOC	JOBVER
	EXP	<LASTED>B2+<MAJVER>B11+<MINVER>B17+<EDNUM>
	ENTRY	NXTFIL


	SEARCH	FTTENX			;ASSEMBLY TIME SWITCHES

;**[560] INSERT AFTER "SEARCH FTTENX"  SJW  6-APR-77
	IFN FTTENX,<	SEARCH MONSYM	>	;[560]
	IF2,<
		IFE FTTENX, <PRINTX ASSEMBLING FORTRAN-10 COMMAN>
		IFN FTTENX, <PRINTX ASSEMBLING FORTRAN-20 COMMAN>
	>				;[560]
;**;[271],COMMAN,JNT,02-MAY-75
;**;[271],VERSION NUMBERS+2
	SEARCH	C,SCNMAC		;[271]
	PAGE
	SUBTTL	SYMBOLIC DEFINITIONS

	RELOC	400000
;AC'S USED COMMAND SCANNER

	F=0		;FLAGS
	T1=1		;TEMP
	T2=2		; ..
	T3=3		; ..
	T4=4		; ..
	P1=5		;PRESERVED AC
	P2=6		; ..
	N=7		;NUMBER AC
	C=10		;CHARACTER AC
IFN FTTENX,<	VREG=15		;BLIS10 VALUE RETURN REG>
	FREG=16		;STACK FRAME POINTER
	P=17		;PUSH DOWN POINTER

;I/O CHANNELS
	BIN==1		;REL FILE OUTPUT
	LST==2		;LISTING FILE OUTPUT
	SRC==3		;SOURCE FILE INPUT
IFN FTTENX,<	ICL==4		;INCLUDE FILE INPUT>

;OFFSETS INTO CHNLTBL
	TBLMAX==^D10
IFN FTTENX,<	JFN==0>
	HDR==3
	PNT==4
	CNT==5
;FLAG BITS IN F (SEE IOFLG.BLI BEFORE CHANGING THESE BITS)

SW.OPT==1B35		;GLOBAL OPTIMIZE
SW.NET==1B34		;NO ERRORS ON TTY
SW.MAC==1B33		;MACRO CODE
SW.IDS==1B32		;INCLUDE DEBUG STATEMENTS
SW.EXP==1B31		;EXPAND
SW.DEB==1B30		;DEBUG
SW.CRF==1B29		;CREF
LSTFLG==1B25		;LISTING FILE BEING MADE
SW.KAX==1B24		;KA-10 FLAG
RELFLG==1B22		;REL FILE BEING MADE
SW.PHO==1B10		;PEEP HOLE OPTIMIZE
COMKA==1B12		;COMPILING ON A KA-10
SW.OCS==1B13		;ONLY CHECK SYNTAX
EOCS==1B28		;END OF COMMAND STRING
;**[476] COMMAN @394 SJW 14-OCT-76 (REPLACE SW.TIM)
SW.MAP==1B16		;[476] LINE NUMBER/OCTAL LOCATION MAP
SW.BOU==1B5		;ARRAY BOUNDS CHECKING SWITCH
TTYDEV==1B1		;LISTING ON TTY:
SW.NOW==1B2		;DON'T PRINT WARNING MESSAGES



EXTERN	FLAGS2		;SECONDARY FLAG REGISTER

TTYINP==1B0		;INPUT DEVICE IS A TTY

IFN	FTTENX,<

	; GTJFN  BITS
	OLDFIL==100000	;OLD FILE ONLY
	OUTPUT==400000	;FOR OUTPUT
	XWILD==000100	;ACCEPT WILD FIELDS
	SHORT==000001	;SHORT FORM

	; OPENF
	INBYT==440000	;NON-TTY INPUT BYTE SIZE
	BINBYT==440000	;BINARY BYTE SIZE
	LSTBYT==070000	;LISTING BYTE SIZE
	TTYBYT==070000	;TTY INPUT BYTE SIZE
	READ==200000	;READABLE
	WRITEE==100000	;WRITEABLE

	TTCODE==600012	;TTY: DEVICE CODE
	DSKCOD==600000	;DSK: DEVICE CODE

;	DEFAULT GTJFN TABLE FOR LISTING

LSTTAB:	XWD	OUTPUT,0	;FLAGS,VERSION DEFAULT
	XWD	377777,377777	;NO JFN'S
	0			;DEVICE
	0			;DIRECTORY
	0			;FILENAME
	XWD	-1,[ASCIZ /LST/]	;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT

;	DEFAULT GTJFN TABLE FOR BINARY OUTPUT FILE

BINTAB:	XWD	OUTPUT,0	;FLAGS,DEFAULT VERSION
	XWD	377777,377777	;NO JFN'S
	0			;DEVICE
	0			;DIRECTORY
	0			;FILE NAME
	XWD	-1,[ASCIZ /REL/]	;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT

;	DEFAULT TABLE FOR SOURCE INPUT

SRCTAB:	XWD	OLDFIL!XWILD,0	;FLAGS,VERSION DEFAULT
	XWD	377777,377777	;NO JFN'S
	0			;DEV
	0			;DIRECTORY
	0			;FILE NAME
	XWD	-1,[ASCIZ /FOR/]	;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT

;	DEFAULT TABLE FOR INCLUDE INPUT

ICLTAB:	XWD	OLDFIL,0	;FLAGS,VERSION DEFAULT
	XWD	377777,377777	;NO JFN'S
	0			;DEV
	0			;DIRECTORY
	0			;FILE NAME
	XWD	-1,[ASCIZ /FOR/]	;EXTENSION
	0			;PROTECTION
	0			;ACCOUNT


	JSYS==104000000000
	OPDEF	DVCHR	[JSYS 117]
	OPDEF	GNJFN	[JSYS 17]
	OPDEF	GTJFN	[JSYS 20]
	OPDEF	OPENF	[JSYS 21]
	OPDEF	PSOUT	[JSYS 76]
	OPDEF	CLOSF	[JSYS 22]
	OPDEF	ERSTR	[JSYS 11]
	OPDEF	GTINF	[JSYS 13]
>			;END TOPS-20 ONLY

	;DEFAULTS


DM	ADV,1,0,1
DM	BAK,1,0,1
DM	BOU,1,0,1
DM	BUG,377777,0,1
DM	CRF,1,0,1
DM	DEB,1,0,1
DM	EXP,1,0,1
DM	INC,1,0,1
DM	MAC,1,0,1
DM	NOE,1,0,1
DM	WEO,1,0,1
DM	ZER,1,0,1
DM	OPT,1,0,1
DM	OCS,1,0,1
DM	NOW,1,0,1
DM	MAP,1,0,1		;[476] REPLACE DM TIM

ND	PDLLEN,^D500 + ^D600		;LENGTH OF PDL
					;NOTE THE ADDITION OF 600 OF SPACE TO PDLLEN!!!
					;SEEDECLARATION POOLSIZ IN FIRST.BLI
					;THIS SPACE WILLACTUALLY BE OCCUPIED BY
					;THE GLOBAL VECTORS STK AND POOL SO THAT
					;MORE SPACE FOR THE STACK CAN BE MADE AVAILABLE
					; TO HIGHLY RECURSIVE OPERATIONS
					;THAT MAY OCCUR IN THE COMPILER

;DEFAULT FLAG SETTINGS
;**[476] COMMAN @437 SJW 14-OCT-76 ADD DEFAULT SETTING OF /MAP = OFF
;**[523] COMMAN @556 SJW 17-DEC-76 FIX DEFAULT SETTINGS: SWITCHES
;[523]				     COUNT FROM LEFT NOT RIGHT
INDADF:	EXP	<<AD.MAP>_<43-^L<SW.MAP>>> ! 
		<<AD.CRF>_<43-^L<SW.CRF>>> ! 
		<<AD.DEB>_<43-^L<SW.DEB>>> ! 
		<<AD.EXP>_<43-^L<SW.EXP>>> ! 
		<<AD.INC>_<43-^L<SW.IDS>>> ! 
		<<AD.MAC>_<43-^L<SW.MAC>>> ! 
		<<AD.NOE>_<43-^L<SW.NET>>>

EXTERNAL DEBGSW

DEFINE	SWTCHS,<

SP	ADVANCE,FAREA+F.ADV,.SWDEC##,ADV
SP	BACKSPACE,FAREA+F.BACK,.SWDEC##,BAK
;SP	BOUNDS,<POINTR(SAVEF,SW.BOU)>,.SWDEC##,BOU
SP	BUGOUT,<POINT 18,BUGINT,35>,.SWOCT##,BUG
SP	CROSSREF,<POINTR(SAVEF,SW.CRF)>,.SWDEC##,CRF
SL	DEBUG,DEBGSD,BUGK,-1,FS.OBV
SP	EXPAND,<POINTR(SAVEF,SW.EXP)>,.SWDEC##,EXP
SS	KA10,<POINTR(SAVEF,SW.KAX)>,1
SS	KI10,<POINTR(SAVEF,SW.KAX)>,0
SP	INCLUDE,<POINTR(SAVEF,SW.IDS)>,.SWDEC##,INC
SP	*MACROCODE,<POINTR(SAVEF,SW.MAC)>,.SWDEC##,MAC
SP	*LNMAP,<POINTR(SAVEF,SW.MAP)>,.SWDEC##,MAP	;[512][476] REPLACE TIME
SP	NOERRORS,<POINTR(SAVEF,SW.NET)>,.SWDEC##,NOE
SP	NOWARNING,<POINTR(SAVEF,SW.NOW)>,.SWDEC##,NOW
SP	*OPTIMIZE,<POINTR(SAVEF,SW.OPT)>,.SWDEC##,OPT
SP	*SYNTAX,<POINTR(SAVEF,SW.OCS)>,.SWDEC##,OCS
SP	TAPEND,FAREA+F.WEOF,.SWDEC##,WEO
SP	ZERO,FAREA+F.DTZR,.SWDEC##,ZER
>
KEYS	BUGK,<DIMENSIONS,LABELS,INDEX,TRACE,BOUNDS>
	XALL
	DOSCAN(FORT)
	SALL
IFE	FTTENX,<
	PAGE
	SUBTTL TOPS-10 COMPILER INITIALIZATION

MRP0::				;SINGLE SEGMENT ENTRY POINT
FORTRA:	TDZA	T1,T1		;FLAG AS NORMAL ENTRY
	MOVEI	T1,1		;FLAG AS CCL ENTRY
	MOVEM	T1,CCLSW##	;SAVE CCL SWITCH
	SKIPE	T1,GETSBL##	;HAVE WE BEEN HER BEFORE?
	JRST	FORTR1		;YES MUST BE DOING ^C START
	MOVEM	11,GETSBL##	;STORE DEVICE NAME FROM RUN
	MOVEM	7,GETSBL+4	;STORE FILE NAME FROM RUN COMMAND
FORTR1:

	MOVE	T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
	SETZM	FIRZER		; ..
	BLT	T2,LASZER	; ..
	JUMPPT	(T1,CP166,KA10)	;FIGURE OUT TYPE OF CPU
	TDZA	T1,T1		;KI-10 CLEAR FLAG
KA10:	MOVX	T1,SW.KAX!COMKA	;KA-10 SET FLAG
	IORM	T1,SAVEF	;STORE SWITCH IN MEMORY
	RESET			;RESET ACTIVE I/O
	MOVE	T1,.JBFF##	;START OF CORE
	CORE	T1,		;REMOVE CRUFT FROM PREVIOUS JOBS
	  JFCL			;DO NOT CARE IF IT FAILS
;
	MOVE	P,[IOWD PDLLEN,STACK##] ;PUSH DOWN LIST
	HRRZI	FREG,(P)	;LIFE IS BLISS
	MOVE	T1,[2,,[EXP 0
			XWD CCLSW##,'FOR']]
	PUSHJ	P,.ISCAN##	;FIRE UP SCAN
COMND:
				;[130] INITIALIZE APR TRAP
;
; SET UP TRAP FOR
;
; AP.POV	PUSHDOWN OVERFLOW
; AP.ABK	ADDRESS BREAK (FUTURE)
; AP.ILM	MEMORY PROTECTION VIOLATION
; AP.NXM	NON-EXISTENT MEMORY
;
	MOVEI	T1,APRTRP	;[130] LOCATE TRAP ROUTINE
	MOVEM	T1,.JBAPR##	;[130] TELL THE MONITOR WHERE TRAP OCCURS
	MOVEI	T1,AP.POV!AP.ABK!AP.ILM!AP.NXM	;[130] SET CONDITIONS
	APRENB	T1,		;[130] ENABLE TRAPS
;
				;SCAN NEXT LINE
	MOVE	T1,[10,,[IOWD FORTL,FORTN
			 XWD  FORTD,FORTM
			 XWD      0,FORTP
			 EXP  -1
			 XWD  CLRALL,CLRFIL
			 XWD  ALLIN,ALLOUT
			 XWD  MEMSTK,APPSTK
			 XWD  CLRSTK,1B18
			 XWD       0,.POPJ1##]]
	PUSHJ	P,.TSCAN##	;SCAN 1 COMMAND LINE
	MOVE	T1,[4,,[IOWD FORTL,FORTN
			XWD  FORTD,FORTM
			XWD      0,FORTP
			EXP  -1]]
	PUSHJ	P,.OSCAN##		;SCAN THE OPTIONS FILE
	PUSHJ	P,ABSDEF	;FILL IN ABSENT DEFAULTS
	SKIPN	T1,FINPTR	;CHECK FOR NO INPUT FILES
	JRST	FORTR1		;NO INPUT FILES
	PUSHJ	P,GETSIZ	;CALCULATE MAXIMUM BUFFER CORE REQUIREMENTS
	PUSHJ	P,NXTFIL	;GET THE NEXT FILE
	  JRST	FORTR1		;NO INPUT FILES GIVEN
	MOVE	T1,LBLOCK+.RBALC;GET THE NUMBER OF BLOCKS ALLOCATED
	MOVEM	T1,LBLOCK+.RBEST; AND ESTIMATE THAT AS THE SIZE OF
	SETZM	LBLOCK+.RBALC	; EACH OUTPUT FILE.

	SKIPN	T2,RELSPC+F.DEV	;IS THERE A REL DEVICE
	JRST	NOREL			;NONE TRY LISTING
	MOVE	T2,RELSPC+F.MOD	;CHECK FOR NUL DEVICE AND NAME
	TXNN	T2,FX.NDV	;NO SKIP MEANS DEVICE THERE
	JRST	ISREL
	SKIPN	RELSPC+F.NAME	;NO SKIP MEANS DEVICE THERE
	JRST	NOREL		;NO NAME SPECIFIED
ISREL:
	MOVE	T2,RELSPC+F.DEV	;SET UP OPEN BLK
	TXO	F,RELFLG	;LIGHT THE REL FILE BIT FOR OUTMOD
	MOVEI	P1,RELSPC	;POINTER TO FILESPEC
	PUSHJ	P,MTMODE	;SET UP MODE FOR MAG TAPE
	ADDX	T1,.IOBIN	;BINARY MODE
	MOVSI	T3,BINHDR	;HEADER POINTER
	OPEN	BIN,T1		;OPEN THE DEVICE
	  JRST	OPNERR		;CAN NOT DO IT!!!
	PUSHJ	P,SETENT	;SET UP FOR ENTER
	JRST	ERRST	;FILE NAME ERROR
	MOVEI	T1,BIN
	DEVCHR	T1,
	TXNN	T1,DV.DTA	;IS DEVICE A DECTAPE
	JRST	REL1		;NO
	ENTER	BIN,LBLOCK+2
	  JRST	UUOERR
	JRST	REL2
REL1:
	ENTER	BIN,LBLOCK	;ENTER IN UFD
	  JRST	UUOERR
REL2:
	OUTBUF	BIN,0		;SET UP O/P BUFFER
NOREL:
	SKIPN	T2,LSTSPC+F.DEV	;IS THERE A LISTING DEVICE
	JRST	NOLST			;NONE TODAY
	MOVE	T2,LSTSPC+F.MOD	;SAME AS FOR .REL FILE
	TXNN	T2,FX.NDV
	JRST	ISLST
	SKIPN	LSTSPC+F.NAME
	JRST	NOLST		;NO LISTING IF ZERO
ISLST:
	MOVE	T2,LSTSPC+F.DEV	;SET UP OPEN BLK
;	MOVE	T3,LSTSPC+F.MOD
;	JRST	NOLST
	TXO	F,LSTFLG	;FLAG THAT A LISTING IS NEEDED
	MOVEI	P1,LSTSPC	;LISTING SPEC POINTER
	MOVE	T3,LSTSPC+F.MOD	;GET MODIFIERS
	TXNE	F,SW.CRF	;CREF ?
	TXNN	T3,FX.NUL	;NUL EXTENSION?
	JRST	NOCREF		;NOT CREF OR EXTENSION ALREADY SPECIFIED
;	MOVE	T3,LSTSPC+F.EXT
;	JUMPL	T3,NOCREF	;SKIP IF EXPLICIT EXTENSION
	MOVEI	T3,'CRF'
	HRLM	T3,F.EXT(P1)	;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
	PUSHJ	P,MTMODE	;SET T1 FOR MAG TAPE MODE
	ADDX	T1,.IOASC	;ASCII MODE
	MOVSI	T3,LSTHDR	;POINTER TO BUFFER HEADER
	OPEN	LST,T1		;OPEN THE DEVICE
	  JRST	OPNERR		;CAN NOT OPEN DEVICE
	PUSHJ	P,SETENT	;SET UP FOR ENTER
	JRST	ERRST	;FILE NAME ERROR
	MOVEI	T1,LST	;SKIP RETURN OK
	DEVCHR	T1,
	TXNE	T1,DV.TTA
	TXO	F,TTYDEV	;SET BIT ON IF LST DEVICE IS TTY
	TXNN	T1,DV.DTA	;IS DEVICE A DECTAPE
	JRST	LST1		;NO
	ENTER	LST,LBLOCK+2
	  JRST	UUOERR
	JRST	LST2
LST1:
	ENTER	LST,LBLOCK	;ENTER THE FILE
	  JRST	UUOERR
LST2:
	MOVE	T1,F.NAME(P1)	;GET LISTING FILENAME
	MOVEM	T1,CHNLTB##+20	;STORE FOR USE IN PHASE1
	OUTBUF	LST,0		;SET UP O/P LST BUFFER
NOLST:	MOVEI	T1,[ASCIZ /%FTNNOF No output files given
/]
	TXNN	F,RELFLG!LSTFLG!SW.OCS	;ANY OUTPUT REQUESTED?
	PUSHJ	P,.TSTRG##	;NO--GIVE THE WARNING
LOOP:
	SKIPN	T1,CCLSW
	JRST	BYNAM
	MOVEI	T1,[ASCIZ /FORTRAN: /]
	PUSHJ	P,.TSTRG##
	SKIPE	T1,CHNLTB##+32	;GET FILE NAME IF ANY
	PUSHJ	P,.TSIXN##	;TYPE AS SIXBIT
	PUSHJ	P,.TCRLF##	;GIVE AN EOL
BYNAM:
	MOVE	T1,DEBGSD	;MOVE LOCAL TO GLOBAL - MACRO BUG
	MOVEM	T1,DEBGSW##
	MOVE	T1,BUGINT
	MOVEM	T1,BUGOUT##	;INTERMEDIATE OUTPUT REQUEST SWITCHWES
	SETZM	SEGINCORE##	;ARGUMENT TO PHASE CONTROL
	PUSHJ	P,PHAZCONTROL##	;GET THE NEXT PHASE
LOOPDN:
	CLOSE	LST,
	CLOSE	SRC,
	CLOSE	BIN,
	MOVE	T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
	SETZM	FIRZER		; ..
	BLT	T2,LASZER	; ..
	JUMPPT	(T1,CP166,KA102)	;FIGURE OUT TYPE OF CPU
	TDZA	T1,T1		;KI-10 CLEAR FLAG
KA102:	MOVX	T1,SW.KAX!COMKA	;KA-10 SET FLAG
	IORM	T1,SAVEF	;STORE SWITCH IN MEMORY
	RESET			;RESET ACTIVE I/O
	MOVE	T1,.JBFF##	;START OF CORE
	CORE	T1,		;REMOVE CRUFT FROM PREVIOUS JOBS
	  JFCL			;DO NOT CARE IF IT FAILS
	JRST	COMND		;INITIALIZE AND LOOK FOR NEXT COMMAND
	PAGE
	SUBTTL	SUBROUTINES CALLED FROM .TSCAN

;SUBROUTINE TO CLEAR ALL ANSWERS
CLRALL:	SKIPA	T2,[LSTCLR]	;THE WHOLE THING

;SUBROUTINE TO CLEAR FILE ANSWERS
CLRFIL:	MOVEI	T2,FAREA+F.LEN	;JUST CLEAR F AREA
	MOVE	T1,[FIRZER,,FIRZER+1] ;CLEAR FROM FIRZER
	SETZM	FIRZER		; ..
	BLT	T1,(T2)		; TO THE END
	POPJ	P,		; ..

;SUBROUTINE TO ALLOCATE AN OUTPUT AREA
ALLOUT:	AOS	T3,OUTCNT	;T3 = COUNT OF OUPUT FILES
	MOVE	T1,[EXP RELSPC,LSTSPC]-1(T3) ;T1 = ADDRESS OF SPEC
	MOVEI	T2,F.SLEN	;T2 = LENGTH OF SPEC
	CAIG	T3,2		;TOO MANY SPECS?
	POPJ	P,		;NO--ALL DONE
	M.FAIL	<FTNTOF More than 2 output files are not allowed>

;SUBROUTINE TO ALLOCATE AN INPUT AREA

ALLIN:	SKIPE	T1,LINPTR	;ANY LAST INPUT SPEC?
	JRST	ALLIN1		;YES--MAKE ANOTHER
	MOVE	T1,.JBFF##	;FIRST INPUT SPEC GOES HERE
	MOVEM	T1,FINPTR	;SAVE FOR LATER
	SUBI	T1,F.LEN	;FIX UP SO FIRST SPEC IS CORRECT
	MOVEM	T1,LINPTR	;SAVE AWAY
ALLIN1:	MOVEI	T2,<F.LEN*2>(T1);ADDRESS OF NEXT SPEC
	CAMGE	T2,.JBREL##	;WILL IT FIT?
	JRST	ALLIN2		;YES--CONTINUE
	CORE	T2,		;NO--EXPAND CORE
	  JRST	E.NCF		;NO CORE--YOU LOOSE
ALLIN2:	MOVEI	T1,F.LEN	;LENGTH OF SPEC
	ADDM	T1,.JBFF##	;UPDATE JOBFF
	ADDB	T1,LINPTR	;UPDATE T1 AND POINTER
	MOVEI	T2,F.SLEN	;AMOUNT SCAN KNOWS ABOUT
	POPJ	P,		;RETURN

;SUBROUTINE TO CLEAR STICKEY DEFAULTS

CLRSTK:	SETZM	PAREA		;ALL THE STICKEY DEFAULTS
	MOVE	T1,[PAREA,,PAREA+1] ; ..
	BLT	T1,PAREA+F.LEN-1; ARE IN THE PAREA
	POPJ	P,
	XALL
DEFINE	MEM(A),<
IRP	A,<
	SKIPE	T1,FAREA+F.'A	;IS A SPECIFIED?
	MOVEM	T1,PAREA+F.'A	;YES--REMEMBER A
>>

;SUBROUTINE TO MEMORIZE STICKEY DEFAULTS

MEMSTK:	MEM	(<ADV,BACK,WEOF,REW,DTZR>)
	POPJ	P,

DEFINE	APPLY(A),<
IRP	A,<
	MOVE	T1,PAREA+F.'A	;PICK UP STICKEY DEFAULT FOR A
	SKIPN	FAREA+F.'A	;IS A LOCAL OVER RIDE PRESENT
	MOVEM	T1,FAREA+F.'A	;NO--APPLY THE DEFAULT


>>

;SUBROUTINE TO APPLY STICKEY DEFAULTS

APPSTK:	APPLY	(<ADV,BACK,WEOF,REW,DTZR>)
	POPJ	P,
	SALL
	PAGE
	SUBTTL	SUBROUTINES FOR COMMAND SCANNING

;SUBROUTINE TO  APPLY ABSENT DEFAULTS

ABSDEF:	SETCM	F,SAVEFM	;T1 GETS A 1 BIT FOR EVERY BIT IN F
				; WHICH WAS NOT EXPLICITLY SPECIFIED
				; BY THE USER.
	AND	F,INDADF	;AND WITH THE DEFAULTS.
	IORB	F,SAVEF		;OR IN THE SELECTED BITS.
	MOVEI	T1,RELSPC	;POINT AT REL FILE
	HRLOI	T2,'REL'	;DEFAULT EXTENSION
	PUSHJ	P,DEFEXT	;FILL IN DEFAULT
	MOVEI	T1,LSTSPC	;POINT TO LISTING FILE SPEC
	HRLOI	T2,'LST'	;DEFAULT EXTENSION
	PUSHJ	P,DEFEXT	;FILL IN DEFAULT
	MOVE	T1,FINPTR	;POINT TO FIRST INPUT SPEC
ABSDF1:	HRLOI	T2,'FOR'	;DEFAULT EXTENSION
	PUSHJ	P,DEFEXT	;GO DEFAULT IT
	CAMN	T1,LINPTR	;LAST INPUT POINTER
	POPJ	P,		;YES--ALL SET UP
	ADDI	T1,F.LEN	;POINT TO NEXT SPEC
	JRST	ABSDF1		;LOOP FOR NEXT SPEC

;SUBROUTINE TO FILL IN A DEFAULT EXTENSION
;CALL WITH:
;	T1 = FILE SPEC POINTER (PRESERVED)
;	T2 = EXTENSION
;	PUSHJ	P,DEFEXT
;	RETURN HERE
DEFEXT:	HLRZ	T3,F.EXT(T1)	;GET EXTENSION
	JUMPN	T3,.POPJ##	;ALL DONE IF IT WAS GIVEN
	HRRE	T3,F.EXT(T1)	;EXPLICITLY NULL
	AOJE	T3,.POPJ##	;JUMP IF YES
	MOVEM	T2,F.EXT(T1)	;NO--SET UP DEFAULT
	POPJ	P,		; RETURN
	PAGE
	SUBTTL	LOOKUP/ENTER SUBROUTINES

;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
;	PUSHJ	P,NXTFIL
;	  NOTHING FOUND
;	SPEC POINTER IN P1
NXTFIL:	MOVE	T1,[4,,[XWD FINPTR,LINPTR
			XWD OBLOCK,LBLOCK
			XWD F.LEN,.RBALC
			EXP 1B0+<SRC>B17+LKTEMP]]
	PUSHJ	P,.LKWLD##	;SCAN THE DISK OR TAPE
	  POPJ	P,		;NON-SKIP WHEN DONE
	MOVE	P1,LKTEMP	;POINTER TO CURRENT SPEC
	CAMN	P1,LINPTR	;SAME AS LAST SPEC
	SKIPE	.WLDFL##	; AND NO WILD CARDS?
	TXZA	F,EOCS		;NO--MAY BE MORE
	TXO	F,EOCS		;YES--THIS IS THE LAST SPEC.
	PUSHJ	P,OPENIN	;OPEN THE INPUT FILE
	MOVE	T1,F.NAME(P1)	;GET SRC FILENAME
	MOVEM	T1,CHNLTBL##+32	;PUT IN TABLE TO BE LOOKED
				; AT BY LISTING HEADER
	MOVE 	T1,F.EXT(P1)	;EXTENSION
	MOVEM	T1,CHNLTBL+33	;EXTENSION FIELD FOR SRC
				;ROUTINE IN CLASS
	JRST	.POPJ1##	;SKIP RETURN


;SUBROUTINE TO OPEN THE INPUT FILE
;CALL WITH:
;	P1 = FILE SPEC POINTER
;	PUSHJ 	P,OPENIN
;	RETURN HERE
OPENIN:	HRRZI	T1,SRCHDR	;BUFFER HEADER
	MOVEM	T1,OBLOCK+2	;STORE IN OPEN BLOCK
	OPEN	SRC,OBLOCK	;OPEN THE DEVICE
	  JRST	OPNER1		;OPEN ERROR
	MOVEI 	T1,SRC
	DEVCHR	T1,
	MOVE	T2,FLAGS2##	;SECONDARY FLAG REGISTER
	TXNE	T1,DV.TTY	;IS DEVICE A TTY
	TXOA	T2,TTYINP	;YES
	TXZ	T2,TTYINP	;NO
	MOVEM	T2,FLAGS2##	;SAVE IT
;**;[516] Insert @ OPENIN+11L	JNG	9-Nov-76
	PUSH	P,LBLOCK+.RBPPN	;[516] SAVE .RBPPN OVER LOOKUP
	TXNN	T1,DV.DTA	;IS DEVICE DECTAPE
	JRST	OPEN1		;NO
	LOOKUP	SRC,LBLOCK+2	;DO DIFFERENT LOOKUP
	JRST	OPNER2
	JRST	OPEN2
OPEN1:
	LOOKUP	SRC,LBLOCK	;LOOKUP THE FILE
	  JRST	OPNER2		;NO CAN DO
OPEN2:
;**;[516] Insert @ OPEN2	JNG	9-Nov-76
	POP	P,LBLOCK+.RBPPN	;[516] RESTORE .RBPPN TO WHAT USER SAID
	MOVE	T2,OBLOCK	;T2 GETS THE DEVICE NAME
	PJRST	MTAOP		;POSITION MAG TAPE
OPNER1:
	PUSHJ	P,E.DFO##
ERRST:			;ERROR ENTRY
	SKIPE	T1,CCLSW
	JRST	COMND
	JRST	FORTR1		;LOOP BACK
OPNER2:
;**;[516] Insert @ OPNER2	JNG	9-Nov-76
	POP	P,LBLOCK+.RBPPN	;[516] RESTORE .RBPPN FROM LOOKUP ERROR
	HRRZ	T1,LBLOCK+.RBEXT
	JUMPN	T1,OPNE2A	;EXPLICIT EXTENSION FILE LOOKUP ERROR
	MOVX	T1,FX.NUL	;NULL EXT MASK
	TDNN	T1,F.MOD(P1)	;WAS NULL EXTENSION INPUT?
	JRST	OPNE2A		;NO
	ANDCAM	T1,F.MOD(P1)	;YES,TURN OFF THAT BIT TO AVOID ALOOP
	HRRZS	LBLOCK+.RBEXT	;ZERO THE EXTENSION FIELD IN LOOKUP BLOCK
	JRST	OPENIN		;TRY AGAIN WITH NULL EXTENSION
OPNE2A:
	PUSHJ	P,E.DFL##	;TRY AGAIN AFTER ERROR MESSAGE
	SKIPE	T1,CCLSW
	JRST	COMND
	JRST	FORTR1		;LOOP BACK


;	SUBROUTINE TO CALCULATE THE MAX CORE REQUIREMENTS FOR THE LIST
;	OF INPUT FILES.  CHECK THE
;	LIST OF FILES AND SAVE THE REQUIREMENTS OF THE LARGEST.
;	CALL WITH:
;		PUSHJ	GETSIZ
;		RETURN	HERE
GETSIZ:MOVE	T1,FINPTR	;FIRST FILE AREA
	SETZM	BGSTBF##	;CLEAR LARGEST SAVE LOCATION
GETSI2:		;SET UP ARG BLOCK
	MOVEI	T2,0	;STATUS
	MOVE	T3,F.DEV(T1)	;DEVICE NAME
	MOVEI	T4,T2	;ARG BLOCK ADDRESS
	DEVSIZ	T4,		;GET DEFAULT NUMBER AND SIZE OF BUFFERS
	MOVE	T4,[2,404]	;ASSUME OLD MONITOR - 2 DSK BUFFERS
	JUMPLE	T4,GETSI1		;IGNORE ANY ERRORS
				;SOMEONE ELSE WILL CATCH THEM
	HLRZ	T3,T4		;MOVE NUMBER OF BUFFERS
	HRRZ	T4,T4		;ZERO T4<LEFT>
	IMUL	T4,T3		;TOTAL SIZE
	CAMLE	T4,BGSTBF##	;IS THIS LARGEST SO FAR?
	MOVEM	T4,BGSTBF##	;YES - SAVE IT
GETSI1:
	CAMN	T1,LINPTR	;ARE WE DONE?
	POPJ	P,		;YES
	ADDI	T1,F.LEN	;NO - DO NEXT ONE
	JRST	GETSI2

;SUBROUTINE TO SET UP FOR AN ENTER
;CALL WITH:
;	P1 = FILE SPEC POINTER
;	PUSHJ	P,SETENT
;	RETURN HERE
SETENT:	PUSHJ	P,MTAOP		;POSITION THE TAPE
	SETZM	LBLOCK+.RBPPN
	SETZM	LBLOCK+.RBSIZ
	SETZM	LBLOCK+.RBVER
	SETZM	LBLOCK+.RBSPL
	SETZM	LBLOCK+.RBALC
	MOVE	T1,F.NAME(P1)	;PICK UP FILE NAME
	MOVE	T2,F.NAMM(P1)	;PICK UP FILE NAME MASK
	AOJN	T2,E.WILD	;CAN NOT BE WILD
	MOVEM	T1,LBLOCK+.RBNAM;STORE THE FILE NAME
	HRRE	T2,F.EXT(P1)	;GET THE EXTION MASK
	AOJN	T2,E.WILD	;MUST BE ALL SPECIFIED
	HLLZ	T2,F.EXT(P1)	;PICK UP THE EXTENSION
	MOVEM	T2,LBLOCK+.RBEXT;STORE FOR THE ENTER
	LDB	T1,[<POINTR(F.MOD(P1),FX.PRO)>] ;GET THE PROTECTION
	ROT	T1,-^D9		;PUT IN THE LEFT 9 BITS
	MOVEM	T1,LBLOCK+.RBPRV;STORE FOR THE ENTER
	MOVX	T1,FX.DIR	;DIRECTORY SPECIFIED?
	TDNN	T1,.FXMOD(P1)	; ??
	JRST	.POPJ1##		;NO--ALL DONE
;**[557] @SETENT+19.5L  SJW  6-APR-77
	MOVE	T2,F.DIRM(P1)	;[557] IS PPN WILD?
	AOJN	T2,E.WILD	;[557] YES == ERROR
	MOVE	T1,F.DIR(P1)	;PICK UP PPN
	MOVEM	T1,LBLOCK+.RBPPN;STORE FOR THE MOMENT
	SKIPN	F.DIR+2(P1)	;NEED ANY SFD'S TODAY
	JRST	.POPJ1##		;NO--ALL DONE
	MOVEI	T2,PATH		;YES--POINT ENTER TO PATH
	MOVEM	T2,LBLOCK+.RBPPN;  ..
	ADDI	T2,2		;SKIP PAST SWITCHES
	MOVEM	T1,(T2)		;STORE PPN
	MOVEI	T1,F.DIR+2(P1)	;POINT TO SFD LIST
;**[557] @SETEN1  SJW  6-APR-77
SETEN1:	MOVE	T3,1(T1)	;[557] IS SFD WILD?
	AOJN	T3,E.WILD	;[557] YES == ERROR
	MOVE	T3,(T1)		;PICK UP SFD
	MOVEM	T3,1(T2)	;STORE IN PATH
	ADDI	T1,2		;SKIP TO NEXT SFD
;**;[517] Change @ SETEN1+3L	JNG	11-Nov-76
	SKIPE	(T1)		;[517] IS IT THERE??
	AOJA	T2,SETEN1	;YES--LOOP OVER IT
	SETZM	2(T2)		;NO--END THE LIST
	JRST	.POPJ1##
;SUBROUTINE TO PERFORM MAG TAPE OPERATIONS
;CALL WITH:
;	MOVEI	P1,FILE-SPEC-POINTER
;	PUSHJ	P,MTAOP
;	RETURN HERE WITH TAPE POSITIONED
MTAOP:	POPJ	P,		;NULL FOR NOW

;SUBROUTINE TO SET UP T1 AS A MODE  WORD FOR MAG TAPES
;CALL WITH:
;	MOVEI	P1,FILE-SPEC-POINTER
;	PUSHJ	P,MTAOP
;	RETURN HERE WITH T1 SET UP
MTMODE:	SETZM	T1		;START WITH A CLEAN SLATE
	POPJ	P,		;RETURN
	PAGE
	SUBTTL	ERROR CONDITIONS

CP166:	OUTSTR	[ASCIZ /?FTNPD6 FORTRAN will not run on a PDP-6
/]
	CLRBFI	
	EXIT

E.NCF:	MOVEI	N,1(T2)
	M.FAID	<FTNNCF Not enough core for file specs. Total K needed=>

UUOERR:	HRRZ	T2,LBLOCK+.RBEXT
	HRRZ	N,P1		
;**;[262],UUOERR+2L,JNT,23-MAR-75
	SETZM	LKTEMP		;[262] CLEAR .LKWLD STATE
	CAIN	T2,2
	JRST	EER02
	CAIN	T2,6
	JRST	EER06
	CAIN	T2,14
	JRST	EER14
	M.FAIF	<FTNETF ENTER failure>
EER02:	M.FAIF	<FTNPRF PROTECTION FAILURE>
EER06:	M.FAIF	<FTNRDE RIB or directory error>
EER14:	M.FAIF	<FTNQEF Quota exceeded or disk full>

	;**[357], COMMAN @827, DCE, 19-MAR-76
	;**[357], FIX ERROR REPORTING FOR OPEN FAILURES
OPNERR:	MOVEM	T2,.WILDZ##		;[357]COPY DEVICE NAME TO FSTR IN WILD
	JRST	OPNER1		;GIVE ERROR MESSAGE

E.WILD:	MOVE	N,P1
	MOVE	T1,F.DEV(P1)	;GET DEVICE NAME
	DEVTYP	T1,		;GET THE DEVICE TYPE
	  HALT	.		;CAN ONLY FAIL IF THERE IS A BUG IN FORTRAN
				; SINCE FOROTS NEEDS THIS CALLI IT MUST EXIST
;**;[452], COMMAN @E.WILD+4L, DCE, 17-SEP-76
;**;[452], ALLOW NUL: AS ACCEPTIBLE SPECIFICATION!
	TXNN	T1,TY.INT	;[452] IF INTERACTIVE, ALWAYS OK
	TXNN	T1,TY.MAN	;LOOKUP/ENTER MANDATORY?
	JRST	.POPJ1##		;NO--IGNORE BAD FILE NAME
	SETOM	T2		;YES--GIVE ERROR MESSAGE
;**;[262],E.WILD+8L,JNT,23-MAR-75
	SETZM	LKTEMP		;[262] CLEAR .LKWLD STATE
	M.FAIF	<FTNNWD Incorrect use of * or ? in>

				; FOR ERROR MESSAGES.
	XLIST
LIT::	LIT
	LIST

	PAGE
	SUBTTL	RESIDENT CODE

	RELOC	0	;IMPURE CODE

; CORE UUO FAILURE ROUTINE IS LOW SEGMENT RESIDENT

CORERR::			;HERE WHEN CORE UUO FAILS
	MOVEM	T1,APRSV1	;STORE T1
	MOVEM	T2,APRSV2	;STORE T2
	SOS	T1,0(P)		;WHERE WERE WE CALLED FROM
	HRRZM	T1,.JBTPC##	;STORE ADDRESS
	MOVEI	T2,CORTXT	;LOCATE MESSAGE
	JRST	APRTR4		;FINISH MESSAGE
	
CORTXT:	ASCIZ	\?FTNUCE USER CORE EXCEEDED\

; APR TRAP ROUTINE IS LOW-SEGMENT RESIDENT

; TEXT FOR APR TRAP ROUTINE

APRNXM:	ASCIZ	\ILLEGAL MEMORY REFERENCE\
APRPOV:	ASCIZ	\STACK EXHAUSTED\
APRILM:	ASCIZ	\MEMORY PROTECTION VIOLATION\
APRABK:	ASCIZ	\ADDRESS BREAK\
APRTX0:	ASCIZ	\
?INTERNAL COMPILER ERROR
?\
APRTX1:	ASCIZ	\ AT LOCATION \
APRTX2:	ASCIZ	\ IN PHASE \
APRTX3:	ASCIZ	\
?WHILE PROCESSING STATEMENT \

APRPN1:	POINT	3,.JBTPC##,17		;USEFUL BYTE POINTER
APRPN2:	POINT	6,400005		;USEFUL BYTE POINTER

APRIOR:	ASCII	\00000\			;MAKE A NUMBER

					;**;[126],HPW,APRTRP,3/5/74
APRTRP:	JRSTF	@.+1			;[126] CLEAR FIRST PART DONE
	0,,.+1				;[126] CLEAR APR FLAGS
	TTCALL	3,APRTX0		;PREFACE MESSAGE
	MOVEM	T1,APRSV1		;SAVE A REGISTER
	MOVEM	T2,APRSV2		;SAVE A REGISTER
	MOVEI	T2,APRNXM		;ASSUME ILL MEM REF
	MOVE	T1,.JBCNI##		;TEST ERROR
	TRNE	T1,AP.POV		;PDL OVERFLOW?
	MOVEI	T2,APRPOV		;LOCATE MESSAGE
	TRNE	T1,AP.ABK		;ADDRESS BREAK
	MOVEI	T2,APRABK		;LOCATE MESSAGE
	TRNE	T1,AP.ILM		;MEMORY PROTECTION
	MOVEI	T2,APRILM		;LOCATE MESSAGE
APRTR4:	TTCALL	3,0(T2)			;TYPE MESSAGE
	TTCALL	3,APRTX1		;CONTINUE
	MOVE	T2,APRPN1		;LOAD POINTER
APRTR1:	ILDB	T1,T2			;TYPE ADDRESS
	MOVEI	T1,"0"(T1)		;TYPE ADDRESS
	TTCALL	1,T1			;TYPE DIGIT
	TLNE	T2,770000		;TYPE 6 DIGITS
	JRST	APRTR1			;TYPE 6 DIGITS
	SKIPN	.JBHRL##		;HIGH SEGMENT?
	JRST	APRTR2			;NO
	TTCALL	3,APRTX2		;CONTINUE
	MOVE	T2,APRPN2		;TYPE SEGMENT NAME
APRTR3:	ILDB	T1,T2			;LOAD BYTE
	MOVEI	T1," "(T1)		;TO ASCII
	TTCALL	1,T1			;TYPE BYTE
	TLNE	T2,770000		;TYPE 6 CHARACTER
	JRST	APRTR3			;TYPE 6 CHARACTER
APRTR2:	TTCALL	3,APRTX3		;CONTINUE
	MOVE	T1,ISN##		;GET STATEMENT #
	MOVEM	T3,APRSV3		;SAVE A REGISTER
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,-7			;STORE
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,-7			;STORE
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,-7			;STORE
	IDIVI	T1,^D10			;BREAK DOWN
	LSHC	T2,^D29			;BUILD NUMBER
	LSHC	T1,^D29			;BUILD NUMBER
	IOR	T1,APRIOR		;CONVERT TO ASCII
	MOVSI	T2,(BYTE (7)15,12)	;FINISH MESSAGE
	TTCALL	3,T1			;FINISH MESSAGE
	MOVE	T1,APRSV1		;RESTORE AC
	MOVE	T2,APRSV2		;RESTORE AC
	MOVE	T3,APRSV3		;RESTORE AC
	EXIT	1,			;DONE
APRSV1:	BLOCK	1
APRSV2:	BLOCK	1
APRSV3:	BLOCK	1

;FILE SPEC AREA DEFINITIONS

;CCLSW:	BLOCK 	1	;0 IF NORMAL START, 1IF CCL START
FIRZER:!		;FIRST LOCATION TO ZERO
FAREA:	PHASE	0
F.DEV:!	BLOCK	1	;DEVICE NAME
F.NAME:!BLOCK	1	;FILE NAME
F.NAMM:!BLOCK	1	;FILE NAME MASK
F.EXT:!	BLOCK	1	;EXTENSION
F.MOD:!	BLOCK	1	;MOD WORD
F.MODM:!BLOCK	1	;MOD MASKS
F.DIR:!	BLOCK	1	;PPN
F.DIRM:!BLOCK	1	;DIRECTORY MASK
	BLOCK	12	;SPACE FOR SFD BIWORDS
;**;[517] Change @ F.SLEN	JNG	11-Nov-76
F.SLEN==.-F.DEV		;[517] SIZE OF THE BLOCK SCAN KNOWS ABOUT
F.ADV:!	BLOCK	1	;NUMBER OF FILES TO ADVANCE TAPE
F.BACK:!BLOCK	1	;NUMBER OF FILES TO BACKSPACE TAPE
F.WEOF:!BLOCK	1	;WRITE AN END OF FILE
F.REW:!	BLOCK	1	;REWIND THE TAPE
F.DTZR:!BLOCK	1	;ZERO THE DTA DIRECTORY
	DEPHASE
F.LEN=.-FAREA		;SIZE OF THE FAREA


;AREA TO REMEMBER STICKEY SWITCHES

PAREA:	BLOCK	F.LEN	;STICKEY SPEC BLOCK

;OTHER FILE SPECIFICATION STORAGE
RELSPC:	BLOCK	F.LEN	;AREA FOR REL FILE SPEC
LSTSPC:	BLOCK	F.LEN	;AREA FOR LIST FILE SPEC
FINPTR:	BLOCK	1	;POINTRER TO FIRST INPUT SPEC
LINPTR:	BLOCK	1	;POINTER TO LAST INPUT SPEC
OUTCNT:	BLOCK	1	;NUMBER OF OUTPUT FILE SPECS
LSTCLR==.-1		;LAST WORD TO ZERO ON A *


;RANDOM LOCATIONS
SAVEF:	BLOCK	1	;HOLDS F WHILE IN SCAN SO .SWDPB DOES NOT
			; HARM T1.
SAVEFM:	BLOCK	1	;MASKS FOR STORED FLAGS

DEBGSD:	BLOCK	1	;LOCAL HOLDER OF DEBUG SWITCHES
BUGINT:	BLOCK	1	;HOLDS INTERNAL OUTPUT SWITCHES

;LOCATIONS IN GLOBAL USED BY INOUT BUT SET UP HERE

DEFINE	BUFHDR(A,B),<
IRP A,<
IRP B,<
	A'B=CHNLTBL##+<<A-1>*TBLMAX>+B
>>>

	BUFHDR	(<BIN,LST,SRC>,<HDR,PNT,CNT>)

;UUO BLOCKS

LBLOCK:	BLOCK	.RBALC+1	;FOR LOOKUPS
OBLOCK:	BLOCK	3		;FOR OPENS
LKTEMP:	BLOCK	1		;FOR WILD
PATH:	BLOCK	1		;FOR PATH. UUO
LASZER==.-1
	PAGE
>				;END TOPS-10 COMMAND PROCESSOR
IFN FTTENX,<		;TOPS-20 COMMAND PROCESSOR

	PAGE
	SUBTTL	TOPS-20 COMPILER INITIALIZATION

MRP0::				;SINGLE SEGMENT ENTRY POINT
FORTRA:	TDZA	T1,T1		;FLAG AS NORMAL ENTRY
	MOVEI	T1,1		;FLAG AS CCL ENTRY
	MOVEM	T1,CCLSW##	;SAVE CCL SWITCH
FORTR1:

	MOVE	T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
	SETZM	FIRZER		; ..
	BLT	T2,LASZER	; ..
	JUMPPT	(T1,CP166,KA10)	;FIGURE OUT TYPE OF CPU
	TDZA	T1,T1		;KI-10 CLEAR FLAG
KA10:	MOVX	T1,SW.KAX!COMKA	;KA-10 SET FLAG
	IORM	T1,SAVEF	;STORE SWITCH IN MEMORY
	RESET			;RESET ACTIVE I/O
	MOVE	T1,.JBFF##	;START OF CORE
	CORE	T1,		;REMOVE CRUFT FROM PREVIOUS JOBS
	  JFCL			;DO NOT CARE IF IT FAILS
;
	MOVE	P,[IOWD PDLLEN,STACK##] ;PUSH DOWN LIST
	HRRZI	FREG,(P)	;LIFE IS BLISS
	MOVE	T1,[2,,[EXP 0
			XWD CCLSW##,'FOR']]
	PUSHJ	P,.ISCAN##	;FIRE UP SCAN
COMND:
				;[130] INITIALIZE APR TRAP
;
; SET UP TRAP FOR
;
; AP.POV	PUSHDOWN OVERFLOW
; AP.ABK	ADDRESS BREAK (FUTURE)
; AP.ILM	MEMORY PROTECTION VIOLATION
; AP.NXM	NON-EXISTENT MEMORY
;
	MOVEI	T1,APRTRP	;[130] LOCATE TRAP ROUTINE
	MOVEM	T1,.JBAPR##	;[130] TELL THE MONITOR WHERE TRAP OCCURS
	MOVEI	T1,AP.POV!AP.ABK!AP.ILM!AP.NXM	;[130] SET CONDITIONS
	APRENB	T1,		;[130] ENABLE TRAPS
;
				;SCAN NEXT LINE
	MOVE	T1,[10,,[IOWD FORTL,FORTN
			 XWD  FORTD,FORTM
			 XWD      0,FORTP
			 EXP  -1
			 XWD  CLRALL,CLRFIL
			 XWD  ALLIN,ALLOUT
			 XWD  MEMSTK,APPSTK
			 XWD  CLRSTK,1B18
			 XWD       0,.POPJ1##]]
	PUSHJ	P,.TSCAN##	;SCAN 1 COMMAND LINE
	MOVE	T1,[4,,[IOWD FORTL,FORTN
			XWD  FORTD,FORTM
			XWD      0,FORTP
			EXP  -1]]
	PUSHJ	P,.OSCAN##		;SCAN THE OPTIONS FILE
	PUSHJ	P,ABSDEF	;FILL IN ABSENT DEFAULTS
	SKIPN	T1,FINPTR	;CHECK FOR NO INPUT FILES
	JRST	FORTR1		;NO INPUT FILES
	SUBI	T1,F.LEN	;INITIALIZE CURRENT INPUT POINTER
	MOVEM	T1,CINPTR	;SAVE
	PUSHJ	P,NEWJFN	;GET THE NEXT FILE
	  JRST	FORTR1		;NO INPUT FILES GIVEN

	SKIPN	T2,RELSPC+F.DEV	;IS THERE A REL DEVICE
	JRST	NOREL			;NONE TRY LISTING
	MOVE	T2,RELSPC+F.MOD	;CHECK FOR NUL DEVICE AND NAME
	TXNN	T2,FX.NDV	;NO SKIP MEANS DEVICE THERE
	JRST	ISREL
	SKIPN	RELSPC+F.NAME	;NO SKIP MEANS DEVICE THERE
	JRST	NOREL		;NO NAME SPECIFIED
ISREL:
	TXO	F,RELFLG	;LIGHT THE REL FILE BIT FOR OUTMOD
	MOVEI	P1,RELSPC	;POINTER TO FILESPEC
	PUSHJ	P,MTMODE	;SET UP MODE FOR MAG TAPE
	PUSHJ	P,XFILCV	;CONVERT REL SPEC BACK TO ASCII
	MOVE	T2,[POINT 7,FILSPC]	;POINTER TO NEW SPEC
	HRRZI	T1,BINTAB	;LONG GTJFN FOR OUTPUT
	GTJFN
	  JRST	FILERR		;PROBLEMS
	MOVEM	T1,BINJFN	;OK - SAVE JFN
	HRRZ	T1,T1		;ZERO LEFT
	MOVE	T2,[XWD BINBYT,WRITEE]	;OPEN FOR WRITE
	OPENF
	  JRST	FILERR		;PROBLEMS

NOREL:
	SKIPN	T2,LSTSPC+F.DEV	;IS THERE A LISTING DEVICE
	JRST	NOLST			;NONE TODAY
	MOVE	T2,LSTSPC+F.MOD	;SAME AS FOR .REL FILE
	TXNN	T2,FX.NDV
	JRST	ISLST
	SKIPN	LSTSPC+F.NAME
	JRST	NOLST		;NO LISTING IF ZERO
ISLST:
	TXO	F,LSTFLG	;FLAG THAT A LISTING IS NEEDED
	MOVEI	P1,LSTSPC	;LISTING SPEC POINTER
	MOVE	T3,LSTSPC+F.MOD	;GET MODIFIERS
	TXNE	F,SW.CRF	;CREF ?
	TXNN	T3,FX.NUL	;NUL EXTENSION?
	JRST	NOCREF		;NOT CREF OR EXTENSION ALREADY SPECIFIED
	MOVEI	T3,'CRF'
	HRLM	T3,F.EXT(P1)	;STORE CRF EXTENSION IN FILESPEC AREA
NOCREF:
	PUSHJ	P,MTMODE	;SET T1 FOR MAG TAPE MODE
	PUSHJ	P,XFILCV	;CONVERT LST SPEC BACK TO ASCII
	MOVE	T2,[POINT 7,FILSPC]	;POINTER TO NEW SPEC
	HRRZI	T1,LSTTAB	;LONG GTJFN FOR OUTPUT
	GTJFN
	  JRST	FILERR		;PROBLEMS
	MOVEM	T1,LSTJFN	;OK - SAVE JFN
	HRRZ	T1,T1		;ZERO LEFT
	MOVE	T2,[XWD LSTBYT,WRITEE]	;OPEN FOR WRITE
	OPENF
	  JRST	FILERR		;PROBLEMS

	;CONTROLLING TERMINAL?
	HRRZ	T1,LSTJFN	;GET JFN
	DVCHR			;CHARACTERISTICS
	HLRZ	T1,T1		;GET DEVICE TYPE
	CAIE	T1,TTCODE	;IS IT A TERMINAL
	JRST	NOTTY		;NO
	HRRZ	T3,T3		;SAVE TERMINAL NUMBER
	PUSH	P,T3
	GTINF			;CONTROLING INFORMATION
	POP	P,T3		;GET TERMINAL NUMBER BACK
	CAMN	T4,T3		;COMPARE TO CONROLLING TERMINAL NUMBER
	TXO	F,TTYDEV	;NOTE LST = CONTROLLING TTY:
NOTTY:
	MOVE	T1,F.NAME(P1)	;GET LISTING FILENAME
	MOVEM	T1,CHNLTB##+20	;STORE FOR USE IN PHASE1
NOLST:	MOVEI	T1,[ASCIZ /%FTNNOF No output files given
/]
	TXNN	F,RELFLG!LSTFLG!SW.OCS	;ANY OUTPUT REQUESTED?
	PUSHJ	P,.TSTRG##	;NO--GIVE THE WARNING
LOOP:
	SKIPN	T1,CCLSW
	JRST	BYNAM
	MOVEI	T1,[ASCIZ /FORTRAN: /]
	PUSHJ	P,.TSTRG##
	SKIPE	T1,CHNLTB##+32	;GET FILE NAME IF ANY
	PUSHJ	P,.TSIXN##	;TYPE AS SIXBIT
	PUSHJ	P,.TCRLF##	;GIVE AN EOL
BYNAM:
	MOVE	T1,DEBGSD	;MOVE LOCAL TO GLOBAL - MACRO BUG
	MOVEM	T1,DEBGSW##
	MOVE	T1,BUGINT
	MOVEM	T1,BUGOUT##	;INTERMEDIATE OUTPUT REQUEST SWITCHWES
	SETZM	SEGINCORE##	;ARGUMENT TO PHASE CONTROL
	PUSHJ	P,PHAZCONTROL##	;GET THE NEXT PHASE
LOOPDN:
	PUSHJ	P,CLOSUP##	;CLOSE EVERYTHING
	MOVE	T2,[FIRZER,,FIRZER+1] ;CLEAR LOCAL STORAGE
	SETZM	FIRZER		; ..
	BLT	T2,LASZER	; ..
	JUMPPT	(T1,CP166,KA102)	;FIGURE OUT TYPE OF CPU
	TDZA	T1,T1		;KI-10 CLEAR FLAG
KA102:	MOVX	T1,SW.KAX!COMKA	;KA-10 SET FLAG
	IORM	T1,SAVEF	;STORE SWITCH IN MEMORY
	RESET			;RESET ACTIVE I/O
	MOVE	T1,.JBFF##	;START OF CORE
	CORE	T1,		;REMOVE CRUFT FROM PREVIOUS JOBS
	  JFCL			;DO NOT CARE IF IT FAILS
	JRST	COMND		;INITIALIZE AND LOOK FOR NEXT COMMAND
	PAGE
	SUBTTL	SUBROUTINES CALLED FROM .TSCAN

;SUBROUTINE TO CLEAR ALL ANSWERS
CLRALL:	SKIPA	T2,[LSTCLR]	;THE WHOLE THING

;SUBROUTINE TO CLEAR FILE ANSWERS
CLRFIL:	MOVEI	T2,FAREA+F.LEN	;JUST CLEAR F AREA
	MOVE	T1,[FIRZER,,FIRZER+1] ;CLEAR FROM FIRZER
	SETZM	FIRZER		; ..
	BLT	T1,(T2)		; TO THE END
	POPJ	P,		; ..

;SUBROUTINE TO ALLOCATE AN OUTPUT AREA
ALLOUT:	AOS	T3,OUTCNT	;T3 = COUNT OF OUPUT FILES
	MOVE	T1,[EXP RELSPC,LSTSPC]-1(T3) ;T1 = ADDRESS OF SPEC
	MOVEI	T2,F.SLEN	;T2 = LENGTH OF SPEC
	CAIG	T3,2		;TOO MANY SPECS?
	POPJ	P,		;NO--ALL DONE
	M.FAIL	<FTNTOF More than 2 output files are not allowed>

;SUBROUTINE TO ALLOCATE AN INPUT AREA

ALLIN:	SKIPE	T1,LINPTR	;ANY LAST INPUT SPEC?
	JRST	ALLIN1		;YES--MAKE ANOTHER
	MOVE	T1,.JBFF##	;FIRST INPUT SPEC GOES HERE
	MOVEM	T1,FINPTR	;SAVE FOR LATER
	SUBI	T1,F.LEN	;FIX UP SO FIRST SPEC IS CORRECT
	MOVEM	T1,LINPTR	;SAVE AWAY
ALLIN1:	MOVEI	T2,<F.LEN*2>(T1);ADDRESS OF NEXT SPEC
	CAMGE	T2,.JBREL##	;WILL IT FIT?
	JRST	ALLIN2		;YES--CONTINUE
	CORE	T2,		;NO--EXPAND CORE
	  JRST	E.NCF		;NO CORE--YOU LOOSE
ALLIN2:	MOVEI	T1,F.LEN	;LENGTH OF SPEC
	ADDM	T1,.JBFF##	;UPDATE JOBFF
	ADDB	T1,LINPTR	;UPDATE T1 AND POINTER
	MOVEI	T2,F.SLEN	;AMOUNT SCAN KNOWS ABOUT
	POPJ	P,		;RETURN

;SUBROUTINE TO CLEAR STICKEY DEFAULTS

CLRSTK:	SETZM	PAREA		;ALL THE STICKEY DEFAULTS
	MOVE	T1,[PAREA,,PAREA+1] ; ..
	BLT	T1,PAREA+F.LEN-1; ARE IN THE PAREA
	POPJ	P,
	XALL
DEFINE	MEM(A),<
IRP	A,<
	SKIPE	T1,FAREA+F.'A	;IS A SPECIFIED?
	MOVEM	T1,PAREA+F.'A	;YES--REMEMBER A
>>

;SUBROUTINE TO MEMORIZE STICKEY DEFAULTS

MEMSTK:	MEM	(<ADV,BACK,WEOF,REW,DTZR>)
	POPJ	P,

DEFINE	APPLY(A),<
IRP	A,<
	MOVE	T1,PAREA+F.'A	;PICK UP STICKEY DEFAULT FOR A
	SKIPN	FAREA+F.'A	;IS A LOCAL OVER RIDE PRESENT
	MOVEM	T1,FAREA+F.'A	;NO--APPLY THE DEFAULT


>>

;SUBROUTINE TO APPLY STICKEY DEFAULTS

APPSTK:	APPLY	(<ADV,BACK,WEOF,REW,DTZR>)
	POPJ	P,
	SALL
	PAGE
	SUBTTL	SUBROUTINES FOR COMMAND SCANNING

;SUBROUTINE TO  APPLY ABSENT DEFAULTS

ABSDEF:	SETCM	F,SAVEFM	;T1 GETS A 1 BIT FOR EVERY BIT IN F
				; WHICH WAS NOT EXPLICITLY SPECIFIED
				; BY THE USER.
	AND	F,INDADF	;AND WITH THE DEFAULTS.
	IORB	F,SAVEF		;OR IN THE SELECTED BITS.
	POPJ	P,		;--ALL SET UP
	PAGE
	SUBTTL	LOOKUP/ENTER SUBROUTINES

;SUBROUTINE TO RETURN THE NEXT FILE TO BE READ BY FORTRAN.
;IT RETURNS WITH THE EOCS BIT SET IN F. IF THIS IS THE
; LAST SPEC IN THE COMMAND STRING. IT SKIP RETURNS IF A
; FILE SPEC HAS BEEN FOUND.
;CALL WITH:
;	PUSHJ	P,NXTFIL
;	  NOTHING FOUND
;	SPEC POINTER IN P1
NXTFIL:
	MOVE	T1,SRCJFN	;GET JFN
	GNJFN			;SEE IF THERE IS ANOTHER FILE HERE
	  JRST	NEWJFN		;NO MORE
	JRST	OPNSRC		;GOT ONE

	;GET 1ST JFN FOR FILE
NEWJFN:
	MOVE	P1,CINPTR	;GET CURRENT SPEC POINTER
	CAMN	P1,LINPTR	;ARE WE DONE
	POPJ	P,		;YES - NONSKIP RETURN
	ADDI	P1,F.LEN	;UPDATE POINTER
	MOVEM	P1,CINPTR	;SAVE IT
	PUSHJ	P,XFILCV	;CONVERT SPEC BACK TO ASCII
	HRRZI	T1,SRCTAB	;SRC LONG JFN TABLE
	MOVE	T2,[POINT 7,FILSPC]	;NEW FILE SPEC
	GTJFN
	  JRST	SRCNUL		;TRY WITHOUT DEFAULT OF "FOR"
NOTFOR:
	MOVEM	T1,SRCJFN	;SAVE JFN

	;WHAT SORT OF DEVICE DO WE HAVE
OPNSRC:
	HRRZ	T1,T1		;ZERO LEFT
	DVCHR
	MOVE	T3,FLAGS2##	;PREPARE TO SET TTY BIT

	HLRZ	T1,T1		;GET DEVICE CODE
	CAIN	T1,TTCODE	;IS IT TTY?
	JRST	TTYSRC		;YES

	;SRC NOT TTY:
	TXZ	T3,TTYINP	;NOTE NOT TTY:
	MOVE	T2,[XWD INBYT,READ]	;SET UP FOR OPEN
	JRST	GOTSRC

	;TTY:
TTYSRC:
	TXO	T3,TTYINP	;NOTE TTY:
	MOVE	T2,[XWD TTYBYT,READ!WRITEE]	;SET UP FOR OPEN

	;OPEN THE FILE
GOTSRC:
	MOVEM	T3,FLAGS2##	;SAVE THOSE FLAGS
	HRRZ	T1,SRCJFN	;GET JFN
	OPENF
	  JRST	FILERR		;PROBLEMS
	MOVE	T1,F.NAME(P1)	;SAVE FILE NAME FOR
	MOVEM	T1,CHNLTBL##+32		; THE COMPILER
	MOVE	T1,F.EXT(P1)		; AND EXTENSION
	MOVEM	T1,CHNLTBL##+33
	TXZ	F,EOCS			;CLEAR END INPUT BIT
	JRST	.POPJ1##		;GOT FILE - SKIP RETURN

	;TRY SRC WITHOUT "FOR"
SRCNUL:
	HRLZI	T1,SHORT!OLDFILE!XWILD	;FLAGS
	MOVE	T2,[POINT 7,FILSPC]	;ASCII FILE SPEC
	GTJFN
	  JRST	FILERR			;GIVE IT UP
	JRST	NOTFOR			;GOT IT WITH "NUL"

	;SUBROUTINE TO CONVERT FILE SPEC BLOCK
	;POINTED TO BY P1 INTO AN ASCII STRING
	; AND PUT IT IN FILSPC
	;CALL WITH
	;	P1 - SPEC POINTER
	;	PUSHJ	XFILCV
	;	RETURN	HERE
XFILCV:
;**[560] @XFILCV  SJW  6-APR-77
	MOVE	T1,[ASCIZ /DSK:/]	;[560] DEFAULT DEVICE
	MOVEM	T1,FILSPC		;[560]  FOR PPNST
	MOVE	T3,[POINT 7,FILSPC,27]	;[560] PTR TO AFTER DEFAULT DEV:

	SKIPN	T2,F.DEV(P1)		;G