Google
 

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

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

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

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

;INTERNAL AC USAGE

;P1 - FLAGS
;P2 - DESC BLOCK POINTER
;P3 - COUNT OF CHARS IN STRING
;P4 - POINTER TO STRING (PARSE)
;     LANGUAGE TYPE (LSCAN)
;P5 - FLAGS DURING LSCAN
;P6 - INTENTIONALLY NOT TOUCHED, SINCE TRVAR USES IT

;CHARACTER TYPE DEFINITIONS

C.SPAC==1		;SPACE
C.COMA==6		;COMMA
C.EOL==7		;END-OF-LINE
C.COLN==12		;COLON (SWITCH DELIM)
;FLAGS IN LH OF P1 (PARSE AND GLOBAL)

F%LAHD==1B0		;LOOK AHEAD FLAG
F%SLSH==1B1		;SLASH SEEN
F%FILE==1B2		;POSSIBLE FILESPEC
F%OBJ==1B3		;OBJECT SPEC IS NEXT
F%DDT==1B4		;LOAD DDT
F%TOPN==1B5		;TEMP FILE OPEN
F%GO==1B6		;START EXECUTION
F%SDDT==1B7		;GO TO DDT
F%NLOD==1B8		;DON'T LOAD
F%NCMA==1B9		;NEED COMMA FLAG
 F%CMOK==1B9		;(PARSE) COMMA OK FOR NULL SPEC
F%SPEC==1B10		;FIRST FILESPEC SEEN (SWITCH HACK)
F%SUPP==1B11		;LOADING SUPPRESSED
F%DSYM==1B12		;DOING LOCAL SYMBOLS
F%AGN==1B13		;DO OLD COMMAND AGAIN
;**;[716] Replace 1 line with 4 here (No label) JRG	29-MAR-82
F%NLOB==1B14		;[716] GTLANG MAY NOT LOOK FOR OBJECT FILE
F%XPXT==1B15		;[716] GTLANG HAS SEEN AN EXPLICIT EXTENSION TYPED
F%FWKE==1B16		;[716] GTLANG HAS FOUND A FILE WITH A KNOWN EXTENSION
F%STOJ==1B17		;[716] GTLANG HAS A STACKED OUTPUT JFN

;FLAGS IN RH OF P1 (LOCAL FOR FILESPEC BLOCKS)

F%LIST==1B18		;MAKE LISTING
F%CREF==1B19		;CREF
F%CMPL==1B20		;FORCE COMPILATION
F%NBIN==1B21		;NOBINARY FOR THIS FILE
F%OPT==1B22		;PRODUCE OPTIMIZED OUTPUT
F%DEB==1B23		;DEBUG CODE FOR THIS FILE
F%LIB==1B24		;LIBRARY SEARCH OF THIS FILE
;**;[930]Change one line at F%LSYM== +0L	RWW	5-Nov-82
F%LSYM==1B25		;Don't load local symbols
F%ABT==1B26		;ABORT-ON-ERROR
F%MACH==1B27		;MACHINE-CODE
F%FLAG==1B28		;FLAG-NON-STANDARD
;**;[947]	Modify one line		FEB-8-83	YKT
F%NWAR==1B29		;[947] NO WARNINGS
F%CHK==1B30		;CHECK
;F%ERR==1B31		;ERROR LIMIT
F%LANG==1B31		;GLOBAL LANGUAGE SWITCH SEEN
			;BITS 32-35 ARE LANG TYPE
F.LMSK==17B35		;MASK FOR LANG TYPE
F.ALL==776000		;MASK FOR ALL FILE RELEVENT SWS
;OFFSETS IN FILE DESCRIPTOR BLOCK

LNK==0			;LINK TO NEXT BLOCK
SRC==0			;POINTER TO SOURCE DESC OR 0
NAM==1			;BYTE POINTER TO FILESPEC
FLG==2			;FLAG WORD
;**;[716] Replace 5 lines with 6 here (No label)	JRG	29-MAR-82
SVER==3			;[716] SOURCE VERSION D/T
OVER==4			;[716] OBJECT VERSION D/T
HDD==5			;[716] HACKED DEVICE DESIGNATOR (DD OR PROG #,,RH OF DISK DD)
HDDO==6			;[716] HACKED DEVICE DESIGNATOR FOR OLD OBJECT FILE
HDDNO==7		;[716] HACKED DEVICE DESIGNATOR FOR NEW OBJECT FILE
SWP==8			;[716] POINTER TO LANGUAGE SWITCHES
B.SIZE==9		;SIZE OF BLOCK
L.SIZE==3		;SIZE OF LINK-20 SWITCH BLOCK
CMPWDS==FRESIZ/3	;MAX WORDS TO ALLOW IN COMMAND.  BE CAREFUL RAISING
			;THIS, SINCE A "LOAD" AFTER "LOAD FOO" CAUSES TWO
			;PASSES, AND FREE SPACE IS FRAGMENTED DURING THE SECOND
			;PASS
CMPMSZ==CMPWDS*5	;MAXIMUM CHARACTERS IN COMMAND INCLUDING ALL INDIRECT FILES

;FLAGS IN LH OF FILE DESC BLOCK FLAG WORD

D%LINK==1B1		;LINK-20 SWITCH SPEC
D%EXTN==1B2		;EXPLICIT EXTENSION TYPED
D%FNF==1B3		;FILE DOES NOT EXIST
;**;[716] Delete 1 line here (No label)	JRG	29-MAR-82

;SWITCH TABLE DEFINITIONS (BITS IN LHS OF VALUE)

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

;ARGUMENT BLOCK DEFINITIONS FOR SENDING DATA TO COMPATABILITY PACKAGE

TMPCOR==BUF0			;TMPCOR AREA BEGINS AT BUF0
NFILES==TMPCOR			;WORD 0, HOLDS NUMBER OF FILES BEING SENT
ADDTAB==TMPCOR+1		;WORD 1, BEGINNING OF TABLE OF FILE S/A'S
ADDTLN==%LT+1			;ONE FILE FOR EACH SOURCE TRANSLATOR + ONE FOR LINK
TMPBUF==ADDTAB+ADDTLN		;ADDRESSES FOLLOWED BY FILES THEMSELVES
;LANGUAGE PROCESSOR DEFINITIONS
;**;[739] change next line from "LANGUAGE NAME" TO "DEBUG SWITCH NAME"
;**;[739]				YKT	22-JUN-82
;ARGS:	A - DEBUG SWITCH NAME	;[739] USED IN DBTAB:
;	B - EXTENSION
;	C - PROCESSOR NAME
;	D - TEMP FILE NAME
;	E - TEMP FILE NAME FOR NATIVE COMPILER

DEFINE LANGUAGE <
	L (BINARY,REL,LINK,LNK)
	L (FORTRAN,FOR,FORTRA,FOR,NFO)
	L (SAIL,SAI,SAIL,SAI)
	L (FAIL,FAI,FAIL,FAI)
	L (SNOBOL,SNO,SNOBOL,SNO)
	L (PASCAL,PAS,PASCAL,PAS,NPO)
	L (SIMULA,SIM,SIMULA,SIM)
;**;[739] change debug switch name in next line		YKT	22-JUN-82
	L (DDT,BLI,BLIS10,BLI)		;[739] DEBUG SW NAME USED IN DBTAB:
	L (ALGOL,ALG,ALGOL,ALG)
	L (COBOL,68C,CBL68,COB,NCO)
	L (COBOL,74C,CBL74,COB,NCO)
	L (COBOL,C68,CBL68,COB,NCO)
	L (COBOL,C74,CBL74,COB,NCO)
	L (COBOL,CBL,COBOL,COB,NCO)
	L (MACRO,MAC,MACRO,MAC)
>
;CSCAN - ENTRY FROM COMMAND DECODER
;PRIMARY COMMAND ALREADY IN CBUF
;READ REMAINDER OF COMMAND

.COMPI::CALL	CNSE		;NOISE STUFF
	TXO	P1,F%NLOD	;SET NO LOAD
	JRST	CSCAN		;CALL SCANNER

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

CNSE:	MOVEI B,[FLDDB. .CMNOI,,<-1,,[ASCIZ /FROM/]>]
	CALL CFIELD		;TYPE NOISE BUT DON'T ALLOW "@"!
	MOVEI P1,0		;CLEAR FLAGS
	RET

;ENTRY FROM CREF COMMAND

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

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

CMAGN1:	CALL	CSCANR		;RESET PARSER
	CALL	TIRST		;RESET TEXTI/GTJFN BLOCKS
	MOVE	P1,CSVCC	;GET COMMAND INFO
	JRST	CSCAN2		;PARSE OLD ARGS IF ANY
;ROUTINE TO INIT SCANNER POINTERS, VALUES, ETC...

CSCANR:	GJINF			;GET JOB RELATED INFO
	MOVEM	C,CSJOB		;JOB #
	MOVE A,B		;CONNECTED DIRECTORY NUMBER
	STPPN			;CONVERT TO PPN
;**;[716] Replace 1 line with 9 at CSCANR:+4L	JRG	29-MAR-82
	HRLZM B,CHDD		;[716] SAVE RH OF PPN INTO LH OF CHDD (LH ALWAYS 4)
	MOVE B,A		;[716] PUT DIRECTORY NUMBER BACK INTO B
	HRROI A,FSPEC		;[716] WRITE STRING TO FSPEC
	DIRST			;[716]
	 ERCAL CJERRE		;[716] IN CASE ERROR
	HRROI A,FSPEC		;[716] TRANSLATE STRING TO DEVICE DESIGNATOR
	STDEV			;[716]
	 ERCAL CJERRE		;[716] IN CASE ERROR
	HRRM B,CHDD		;[716] SAVE RH OF DD INTO RH OF CHDD
	SETZM LHED		;INITIALIZE VARIABLES
	SETZM CRFHED
	SETZM SAVPNT
	SETZM LSWPTR		;NO GLOBAL /LANG: YET
	SETZM MAPPNT		;NO /MAP YET
	MOVEI	Q1,LT.FOR	;INITIAL LANGUAGE TYPE
	DPB	Q1,[POINTR (P1,F.LMSK)]
	MOVEI	P2,LHED		;BEGINNING OF FILE LIST
	MOVEI A,STRSIZ*5
	CALL GETBUF		;ALLOCATE FREE SPACE FOR TEXTI DESTINATION BUFFER
	HRLI A,440700		;MAKE A BYTE POINTER
	MOVEM A,TXTPR		;REMEMBER POINTER
	RET			;RETURN

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

;**;[716] Change 1 line at CSCAN:+0L	JRG	29-MAR-82
;**;[954] Change 1 line at CSCAN:+0L	YKT	28-MAR-83
;**;[958] Change 1 line at CSCAN:+0L    YKT     03-MAY-83
;**;[974] Change 1 line at CSCAN:+0L	YKT	15-AUG-83
CSCAN:	TRVAR <NEWPT0,NEWJFN,OLDJFN,NATIVF,SAVQS,CSPTR,CDPTR,CMPPT0,BAKPTR,TXTPR,NFIAR,NFILS,<SWIBUF,SWISIZ>,BMSKA,LSWPTR,LHED,CRFHED,SAVPNT,<FSPEC,FILWDS>,<CWBUF,LCWBUF>,<CSTXTB,10>,SRCSAV,CSJOB,CHDD,SAVBRK,EXTP,COMPBP,LPROC,DEBAID,TMPJFN,INDJFN,INDSIZ,CJEPTR,CMPBUF,ADDSIZ,CMPSIZ,LNGJFN,GJNSF,OUTJFN,LNGTYP,RELDAT,NXPROC,MAPPNT,BSTDAT,SAILF,FSPEXT,QQQFLG,DEFSW,RELOSW,BINYSW,WARNSW,NOCRSW,NODBSW,NOFGSW,NOLISW,NOMASW,NOOPSW> ;[974][716][954][958]

;**;[974] Add 8 lines at CSCAN:+0L	YKT	15-AUG-83
	SETZM BINYSW		;[974]
	SETZM WARNSW		;[974]
	SETZM NOCRSW		;[974]
	SETZM NODBSW		;[974]
	SETZM NOFGSW		;[974]
	SETZM NOLISW		;[974]
	SETZM NOMASW		;[974]
	SETZM NOOPSW		;[974]
	SETZM STAYF		;DON'T STAY AT COMMAND LEVEL UNLESS /STAY
	MOVE A,CMPTR		;GET POINTER TO FOLLOWING "COMPILE (FROM)"
	MOVEM A,.RDIOJ+CSTXTB	;POINT TEXTI BLOCK AT ORIGINAL COMMAND STRING
	MOVEM A,COMPBP		;REMEMBER POINTER FOR CREATING DEFAULT STRING LATER
	TXNE P1,F%AGN		;DOING OLD COMMAND AGAIN?
	JRST CMAGN1		;YES, GO DO IT
	CALL	TI		;READ A LINE
	CALL	CSCANR		;SCAN RESET
	MOVEM	P1,CSVCC	;SAVE COMMAND INFO FOR EDIT
CSCAN1:	MOVEI A,7		;ALLOCATE ROOM IN TEXTI BLOCK
	MOVEM A,CSTXTB
	SETZM .RDRTY+CSTXTB	;SAY NO ^R POINTER
	SETZM .RDBFP+CSTXTB	;NO SPECIAL BACKUP POINTER
	MOVE	A,[TMPCOR,,TMPCOR+1]	;GET READY
	SETZM	TMPCOR		;TO CLEAR THE TEMPORARY FILE AREA
	BLT	A,TMPCOR+777	;DO IT
	MOVEI A,BMSK		;SET UP STANDARD BREAK MASK
	MOVEM A,BMSKA
	SETZM LNGJFN		;SAY NO LANGUAGE JFN YET
	SETZM SAILF		;ASSUME NOT SAIL
	SETZM	INDJFN		;NO INDIRECT YET
	SETZM	SRCSAV		;NO PARTIAL SOURCE LIST
	SETZM	DEBAID		;NO DEBUGGING AID
	SETOM	LPROC		;UNKNOWN LANG PROCESSOR
;**;[958]	Add two lines at CSCAN1+16	YKT	03-MAY-83
	SETZM   DEFSW		;[958] SET DEFAULT
	SETZM   RELOSW		;[958] RELOCATABLE SW
	MOVEI A,NATWDS		;NUMBER OF WORDS FOR NATIVE STRING
	CALL GETBUF		;GET BUFFER FOR NATIVE COMMAND STRING
	HRLI A,440700		;MAKE BYTE POINTER TO AREA
	MOVEM A,NEWPT0		;REMEMBER POINTER TO AREA FOR NATIVE STRING
	CALL CMPRES		;GET RID OF UNEEDED SPACES
	CALL	PARSE		;CALL PARSER
	CALL	RLJFNS		;RELEASE JFNS
	TXNN	P1,F%SPEC	;SEEN FILE SPEC?
CSCAN2:	JRST	[SKIPN A,CSVC	;NO, USE SAVED COPY
		 ERROR <No saved arguments>
		 MOVEM A,.RDIOJ+CSTXTB	;REMEMBER POINTER TO COPY
		 MOVEM A,COMPBP	;REMEMBER THAT WE'RE USING SAVED ONE
		 JRST CSCAN1]	;AND REPARSE
	MOVE A,COMPBP		;BUFFER THE NEW ONE
	CAMN A,CSVC		;IF STRING ALREADY SAVED,
	JRST CSCANO		;DON'T DO IT AGAIN
	CALL XBUFFS		;IN PERMANENT SPACE
	EXCH A,CSVC		;REMEMBER POINTER TO SAVED STRING
	CAIE A,0		;MAKE SURE THERE WAS A PREVIOUS STRING
	CALL STREM		;RELEASE SPACE IT TOOK UP
	MOVEI A,.CHLFD		;PCL Fix buffer
	DPB A,CMPTR		;PCL So .CMINI works again
CSCANO:	HLRO	A,PRTAB+LT.REL	;GET NAME OF LINK-20
	TXNE	P1,F%NLOD	;ARE WE GOING TO LOAD?
	MOVEI	A,0		;NO - THEN NO FILESPEC
	MOVEM	A,NXPROC	;SAVE AS NEXT PROCESSOR
		;;;; FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE

	MOVEI	P4,%LT		;GET HIGHEST LANG TYPE
P1LUP:	MOVE A,NEWPT0		;GET POINTER TO AREA FOR CREATING NATIVE STRING
	MOVEM A,NEWJFN		;INITIALIZE POINTER TO END OF NATIVE STRING
	CALL	LSCAN		;SCAN LIST
	  JRST	PASS1		;CO-ROUTINE ADDRS
	TXNN	P1,F%TOPN	;FILE OPEN?
	JRST	P1LPA		;NO - SKIP CLOSE STUFF
	SETZM NATIVF		;SAY WE'RE DOING OLD-STYLE LINE
	MOVE	A,OLDJFN	;GET JFN
	CALL PUTLNK		;GO PUT LINK TO NEXT PROCESSOR IN TEXT
	CALL CLSTMP		;CLOSE TMP FILE FOR OLD-STYLE LINE
P1LPA:	MOVE A,NEWJFN		;GET POINTER TO NATIVE STRING
	CAMN A,NEWPT0		;IS THERE ANY NATIVE STRING?
	JRST P1LPB		;NO
	SETOM NATIVF		;YES, SAY WE'RE DOING NATIVE-STYLE LINE
	CALL PUTLNK		;PUT IN LINK INFORMATION FOR NATIVE LINE
	CALL OPNTMP		;CREATE TMP FILE FOR NATIVE COMMAND STRING
	MOVE B,NEWPT0		;GET POINTER TO BEGINNING OF NATIVE STRING
	CALL TSOUT0		;WRITE COMMAND STRING INTO TEMP FILE
	CALL CLSTMP		;CLOSE TEMP FILE FOR NEW STYLE COMMAND STRING
P1LPB:	MOVE A,NEWJFN
	HLRO	B,PRTAB(P4)	;LINK TO OURSELVES
	TXZN P1,F%TOPN
	CAME A,NEWPT0
	MOVEM	B,NXPROC	;SAVE NEXT PROCESSOR ONLY IF THIS COMPILER WILL BE RUN
	SOS P4			;DECREMENT LANG
	CAIE	P4,LT.REL	;DONE IF LANG TYPE = RELOC
	JRST	P1LUP		;CONTINUE
	JRST	P2ST		;START PASS2

PUTLNK:	SKIPN	B,NXPROC	;WHERE TO GO WHEN DONE
	JRST	P1LPN		;NONE
	SKIPE NATIVF		;NATIVE STYLE LINE?
	JRST [	HRROI B,[ASCIZ "/RUN:"]
		CALL TSOUT0	;YES, PUT /RUN:PROG/OFFSET:1
		MOVE B,NXPROC
		CALL TSOUT0	;PUT PROGRAM NAME
		HRROI B,[ASCIZ "/OFFSET:1"]
		CALL TSOUT0
		JRST P1LPC1]	;JOIN COMMON CODE
	CAIN	P4,LT.FOR	;FORTRAN?
	JRST	P1LFOR		;SPECIAL FORTRAN HACK
	CAIE	P4,LT.C68	;68 COBOL,
	CAIN	P4,LT.C74	; OR 74 COBOL?
	JRST	P1LBLI		;YES
	CAIE	P4,LT.CBL	;COBOL SPECIAL HACK
	CAIN	P4,LT.BLI	;BLISS?
	JRST	P1LBLI		;SPECIAL BLISS HACK
;**;[909]	Insert two lines	YKT	21-SEP-82
	CAIN    P4,LT.PAS	;[909] SPECIAL PASCAL HACK
	JRST	P1LFOR		;[909] YES
	CALL	TSOUT0		;DUMP FILESPEC
P1LPC:	MOVEI B,"!"
	CALL TBOUT
P1LPC1:	HRROI	B,[BYTE (7)15,12]
	CALLRET	TSOUT0		;TERMINATE

;**;[716] Add 2 lines at P1LPN:+0L	JRG	29-MAR-82
P1LPN:	MOVEI B,.CHNUL		;[716] ASSUME LINK TO PROCESSOR IS END OF STRING
	IDPB B,A		;[716] GUARANTEE NULL AT END OF STRING
	RET

;SPECIAL LANGUAGE HACKS

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

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

P2XIT:	CALL	FINCRF		;FINISH UP CREF FILE
	SKIPE	B,NXPROC	;SEE IF SOMEWHERE TO GO
	JRST RUNGO		;YES, GO START COMPILER OR LINK
	CALL UNMAP		;UNMAP FREE SPACE USED
	CALLRET	RLJFNS		;RELEASE JFNS & RETURN IF DONE

;PERFORM RUN AND CCL START ON THE PROCESS

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

;**** Old style CCL start ***** Remove this code sometime ****
;(such as when SFRKV allows XWD 1,0 in AC2 regardless of whether program
;is TOPS10-style)
;
;The following code handles both the case where the "entry vector address" as
;returned by GEVEC is the location of the first instruction of the program,
;and the case where the address is actually that containing a JRST to the
;first instruction.

RUNGO1:	CALL GETENT		;GET ENTRY VECTOR
	MOVE A,C		;NO, GET ADDRESS OF ENTRY VECTOR
	MOVEM A,ENT0		;REMEMER WHERE ENTRY VECTOR IS
	CALL LOADF		;READ WHAT MIGHT BE FIRST INSTRUCTION
	 CALL CJERRE		;IF CAN'T, SAY WHY AND DIE
	HLRZ B,A		;GET LEFT HALF OF WHAT MIGHT BE FIRST REAL INSTRUCTION
	CAIE B,(JRST)		;IS IT REALLY FIRST INSTRUCTION?
	HRRZ A,ENT0		;NO, FIRST INSTRUCTION IS THE ENTRY VECTOR!
	MOVEI B,1(A)		;INCREMENT TO CREATE CCL ENTRY POINT
	CALLRET GOTO2		;GO START COMPILER
;ROUTINE TO DUMP /MAP AND/OR /SAVE INFO AND SWITCHES

MAPSAV:	SKIPN	B,MAPPNT	;NEED MAP?
	JRST	MAPSV1		;NO - MUST BE SAVE
	TLNE	B,-1		;CHECK FOR ARG
	CALL	TSOUT0		;OUTPUT ARG
	HRROI	B,[ASCIZ "/MAP"]
	CALL	TSOUT0		;DUMP SWITCH NAME
	SKIPN	SAVPNT		;/SAVE ALSO?
	JRST	MAPSVX		;NO - JUST EXIT
	CALL	CMOUT		;YES - NEED COMMA
MAPSV1:	MOVE	B,SAVPNT	;NO - MUST BE SAVE FILE
	TLNE	B,-1		;NO ARG IF LHS := 0
	CALL	TSOUT0		;DUMP IF NECESSARY
	HRROI	B,[ASCIZ "/SAVE"]
	CALL	TSOUT0		;DUMP SWITCH NAME
MAPSVX:	MOVEI	B,","		;TERMINATE WITH A COMMA
	CALLRET	TBOUT		;...

;ROUTINE TO SETUP DEBUG AID IF ANY

SETDEB:	HRROI	B,[ASCIZ "/DEBUG"]
	CALL	TSOUT0		;DUMP LINK SWITCH
	TXNN	P1,F%LANG	;WAS A LANGUAGE SWITCH SEEN?
	JRST	TRYDDT		;NO, HOW ABOUT /DDT ?
	LDB	B,[POINTR(P1,F.LMSK)]	;GET DEFAULT LANG COMPILER NAME
	CAIE	B,0		;IF NONE, MOVE ON...
	MOVEM	B,DEBAID	;OTHERWISE, USE IT TO SELECT DEBUGGER
TRYDDT:	MOVEI	B,LT.MAC	;BUT FIRST,
	TXNE	P1,F%DDT	;CHECK FOR /DDT IN COMMAND
	MOVEM	B,DEBAID	;YES, SO USE REAL DDT INSTEAD!
	SKIPN	B,DEBAID	;ANYTHING ELSE?
	CALLRET	SPOUT		;NO
	HRRO	B,DBTAB(B)	;YES - GET AID NAME
	CALL	TSOUT0		;DUMP IT
	CALLRET	SPOUT		;AND SPACE
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;CALL:	CALL	LSCAN
;	<COROUTINE ADDRS>
;	RETURN ON EMPTY LIST

LSCAN:	MOVEI	P2,LHED		;GET LIST HEAD
LSCAN0:	HRRZ	P2,LNK(P2)	;LOOK AT NEXT ENTRY
	JUMPE	P2,RSKP		;SKIP RETURN WHEN DONE
	SKIPGE	P5,FLG(P2)	;LOAD FLAGS
	JRST	LSCAN0		;YES - SKIP IT
	HLL	P2,SRC(P2)	;LOAD SOURCE POINTER IF ANY
	CALL	@0(P)		;INVOKE COROUTINE
	JRST	LSCAN0		;TRY NEXT

;SRCSCN - ROUTINE TO SCAN ALL SOURCES AND CALL SOURCE COROUTINE

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

SRCSC2:	CALL	@0(P)		;INVOKE COROUTINE
	RETSKP			;RETURN, SKIPPING COROUTINE ADDRESS
;PASS1 - DETERMINE WHAT TO COMPILE AND CONSTRUCT COMMAND

PASS1:	TXNE	P5,D%LINK	;LINK-20 SWITCH?
	RET			;YES - IGNORE
	MOVNI	Q2,1		;INIT TO -1
	CALL	SRCSCN		;SCAN SOURCES
	  JRST	P1SRC		;ROUTINE FOR SOURCE ON PASS1
	JUMPE	Q2,R		;RETURN IF NO SOURCE
;**;[716] Add 6 lines at PASS1:+6L	JRG	29-MAR-82
	SKIPN	A,OVER(P2)	;[716] IS THERE A VALID OBJECT FILE?
	 JRST	[TXO P1,F%SUPP	;[716] LOSAGE NOTED
		 TYPE <?Invalid object file: > ;[716]
		 MOVE B,NAM(P2)	;[716] TELL HIM WHAT
		 CALL DSOUTR	;[716] PRINT SPEC
		 RET]		;[716] RETURN
	TXNN	P5,F%CMPL	;FORCED COMPILE?
;**;[716] Change 2 lines at PASS1:+7L	JRG	29-MAR-82
	CAML	Q2,A		;[716] COMPARE SOURCE & REL TIMES
	CALLRET	BLDCOM		;[716] BUILD COMMAND STRING
	RET			;DON'T COMPILE

P1SRC:	LDB	A,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
	CAIE	A,(P4)		;MATCH?
	JRST	P1SRCX		;NO - SKIP OVER
	JUMPE	Q2,P1SRC1	;IF Q2 IS ZERO WE HAVE ALREADY LOST
	CAMG	Q2,SVER(P2)	;SAVE LARGEST TO DATE
	MOVE	Q2,SVER(P2)	;LOAD D/T OR 0
P1SRC1:	TXNN	P5,D%FNF	;FILE PRESENT?
	RET			;YES - RETURN
	TXO	P1,F%SUPP	;SET SUPPRESSED
	TYPE	<?Source file missing: >
	MOVE	B,NAM(P2)
	CALL	DSOUTR		;FILE NAME & CRLF
P1SRCX:	MOVEI	Q2,0		;SAY WE LOST
	RET			;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE

PASS2:	TXNE	P5,D%LINK	;LINK SWITCH
	JRST	PASS2S		;YES - HANDLE SPECIAL
	SKIPN	OVER(P2)	;HAVE REL SOMEWHERE?
	JRST	[TXO P1,F%SUPP	;LOSAGE NOTED
		 PUSH P,A	;SAVE JFN
		 TYPE <?Object file missing: >
		 MOVE B,NAM(P2)	;TELL HIM WHAT
		 CALL DSOUTR	;PRINT SPEC
		 POP P,A	;RESTORE JFN
		 RET]		;RETURN
	TXZE	P1,F%NCMA	;NEED COMMA?
	CALL	CMOUT		;YES - PUT ONE IN
	CALL	P2SYMS		;DO SYMBOL CODE
;**;[716] Replace 7 lines with 1 at PASS2:+13L	JRG	29-MAR-82
	CALL	PUTDFO		;[716] OUTPUT DEVICE AND FILENAME
	  JRST	PASS2A		;END-OF-SPEC USE REL EXTENSION
	LDB	Q2,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
	CAIN	Q2,LT.REL	;LANG TYPE = REL?
	TXNN	P5,D%EXTN	;EXPLICIT EXTENSION TYPED?
	JRST	PASS2A		;NO - USE DEFAULT
	CALL	PROUT		;YES - DUMP PERIOD
	CALL	PUTDF0		;REMAINDER OF TYPED EXTENSION
	  NOP			;IGNORE END-OF-SPEC
	JRST	PASS2B		;DONE WITH SPEC

PASS2A:	HRROI	B,[ASCIZ ".REL"] ;DEFAULT EXTENSION
	CALL	TSOUT0		;DUMP INTO FILE
PASS2B:	TXO	P1,F%NCMA	;SAY WE NEED A COMMA
;**;[716] Replace 4 lines with 2 at PASS2B:+1L	JRG	29-MAR-82
	MOVE	B,HDDO(P2)	;[716] MOVE IN HDDO
	CALL	PUTPPN		;[716] DUMP PPN IF NECESSARY
	TXNN	P5,F%LIB	;WANT LIB FOR THIS?
	JRST PASOUT		;DONE
	HRROI	B,[ASCIZ "/SEARCH"]
	CALL	TSOUT0		;YES - DUMP SWITCH
	JRST PASOUT		;DONE, SAVE JFN AND RETURN

;PASS2S CALLED TO DUMP LINK SWITCH

PASS2S:	MOVEI	B,"/"		;OUTPUT SLASH
	MOVE	Q1,NAM(P2)	;GET STRING POINTER
	ILDB	Q1,Q1		;PEEK AT FIRST CHAR
	CAIE	Q1,"/"		;IS IT A SLASH?
	CALL	TBOUT		;NO - DUMP ONE
	MOVE	B,NAM(P2)	;GET STRING
	CALL	TSOUT0		;DUMP IT
	TXO	P1,F%NCMA	;NO COMMA YET
PASOUT:	MOVEM A,TMPJFN		;SAVE UPDATED JFN
	RET

;ROUTINE TO OUTPUT /LOCAL OR /NOLOCAL ETC...
;**;[930]Replace 10 lines with 8 at P2SYMS: +2L	RWW	5-Nov-82
P2SYMS:	TXNE	P5,F%LSYM	;[930]test if /NOSYMBOL given as local switch
	JRST	P2SYM1		;[930]yes, force /NOLOCAL switch
	TXNN	P1,F%LSYM	;[930]local /NOSYMBOL not given, test if global
	RET			;[930]no, return with no switches set
	TXNN	P5,F%LSYM	;[930]was global /NOSYMBOL turned off with
				;[930] local /SYMBOL switch?
	RET			;[930]yes, return with no special switches set
P2SYM1:	HRROI	B,[ASCIZ "/NOLOCAL "] ;here when /NOSYMBOL switch given
	CALLRET	TSOUT0		;[930]dump switch to link.
;BLDCOM - ROUTINE TO BUILD A COMMAND STRING
;CHECK FOR FILE OPEN FOR THIS LANGUAGE

;**;[716] Change 2 lines at BLDCOM:+0L	JRG	29-MAR-82
BLDCOM:	SKIPE	A,HDDNO(P2)	;[716] GET HDDNO WORD FROM BLOCK
	MOVEM	A,HDDO(P2)	;[716] IF NON-ZERO, IT SHOULD REPLACE HDDO
	SETOM	OVER(P2)	;MARK REL EXISTANCE
	SKIPN SIXTAB(P4)	;DOES OLD-STYLE COMPILER EXIST FOR THIS LANGUAGE?
	JRST BLDCMN		;NO, SKIP OLD-STYLE
	SETZM NATIVF		;SAY WE'RE DOING OLD-STYLE LINE
	MOVE A,OLDJFN		;OLDJFN => TMPJFN IN CASE OPNTMP ISN'T CALLED
	MOVEM A,TMPJFN
	TXNE	P1,F%TOPN	;TEMP FILE OPEN?
	JRST	BLDCM1		;YES - GO ON
	CALL	OPNTMP		;OPEN TEMP FILE
	MOVEM	A,TMPJFN	;SAVE JFN
	TXO	P1,F%TOPN	;FLAG FILE OPEN
BLDCM1:	CALL BILDIT		;DO OLD-STYLE COMMAND LINE
	MOVEM A,OLDJFN		;REMEMBER LATEST OLD POINTER
BLDCMN:	SKIPN NSXTAB(P4)	;IS THERE A NATIVE VERSION FOR THIS COMPILER?
	RET			;NO - DONE
	SETOM NATIVF		;MARK THAT WE'RE DOING NEW STYLE
	MOVE A,NEWJFN		;SET UP WHICH BYTE POINTER TO USE
	MOVEM A,TMPJFN
	CALL BILDNC		;BUILD NEW-STYLE COMMAND STRING
	MOVEM A,NEWJFN		;REMEMBER POINTER TO NATIVE-STYLE STRING
	RET

;SUBROUTINE TO BUILD THE COMMAND LINE FOR A NATIVE COMPILER

BILDNC:	MOVE	A,TMPJFN	;GET JFN TO OUTPUT TO
	TXZ	P1,F%NCMA	;SAY NO COMMA HAS BEEN SEEN YET
	CALL	SRCSCN		;LOOP THROUGH SOURCES
	  JRST	BLDSRN		;(ADDRESS OF COROUTINE FOR SOURCE FILES)
	TXNN	P5,F%NBIN	;WANT AN OBJECT FILE?
;**;[938]	Modify 1 line at BILDNC+5	YKT 	21-DEC-82
	JRST	[CALL BILOBN	;[938] YES - OUTPUT IT (AS A SWITCH)
		 JRST .+3]	;[938]
	HRROI	B,[ASCIZ "/NOBINARY"]	;[938] NO,
	CALL 	TSOUT0		;[938]
	HRROI	B,[ASCIZ "/ABORT"] ;SWITCH FOR ABORT
	TXNE	P5,F%ABT	;WANT IT?
	CALL	TSOUT0		;YES - DUMP IT
	HRROI	B,[ASCIZ "/MACH"] ;SWITCH FOR MACHINE-CODE
;**;[974]	Change 1 line and Add 4 lines 		YKT	15-AUG-83
	TXNN	P5,F%MACH	;[974] WANT IT?
	 JRST [SKIPN NOMASW	;[974] NO, IS NOMACH SW EXPLICITLY TYPED?
	       JRST .+2		;[974] NO, DON'T WRITE	
	       HRROI B,[ASCIZ "/NOMACH"]	;[974] YES,
	       JRST .+1]	;[974]
	CALL	TSOUT0		;YES - DUMP IT
	HRROI	B,[ASCIZ "/FLAG"] ;SWITCH FOR FLAG-NON-STANDARD
;**;[974]	Change 1 line and Add 4 lines		YKT	15-AUG-83
	TXNN	P5,F%FLAG	;[974]WANT IT?
	 JRST [SKIPN NOFGSW	;[974] NO, IS NOFLAG SW EXPLICITLY TYPED?
	       JRST .+2		;[974] NO, DON'T WRITE
	       HRROI B,[ASCIZ "/NOFLAG"]	;[974] YES,
	       JRST .+1]	;[974]
	CALL	TSOUT0		;YES - DUMP IT
;**;[947]	Modify next 9 lines   			YKT     FEB-08-83
;**;[931]	Replace next 3 lines by 7 lines		YKT	NOV-22-82
	HRROI	B,[ASCIZ "/NOWARN"] ;[947] SWITCH FOR NO WARNINGS
;**;[974]	Change 1 line and Add 4 lines		YKT	15-AUG-83
	TXNN	P5,F%NWAR	;[974][947] WANT IT?
	 JRST [SKIPN WARNSW	;[974] NO, IS WARN SW EXPLICITLY TYPED?
	       JRST .+2		;[974] NO, DON'T WRITE
	       HRROI B,[ASCIZ "/WARN"]	;[974] YES,
	       JRST .+1]	;[974]
;**;[955]	Delete next two lines			YKT	MAR-28-83
;	CAIE 	P4,LT.FOR	;[955][947][931] IS FORTRAN TYPE?
;	 JRST 	NEXTT		;[955][947][931] NO, 
;	TXNE	P5,F%WARN	;[947][931] WANT IT?
;	 JRST	[HRROI B,[ASCIZ "/WARNINGS"]	;[947][931] YES,
;		 JRST 	.+2]	;[947][931] WRITE IT
;	HRROI	B,[ASCIZ "/NOWARNINGS"]	;[947][931] NO,
	CALL	TSOUT0		;YES - DUMP IT
;**;[955]	Modify next line			YKT	MAR-28-83
;**;[974]	Delete next 3 lines			YKT	15-AUG-83
;	HRROI	B,[ASCIZ "/CHECK"] ;[974][955][947][931] SWITCH FOR CHECK
;	TXNE	P5,F%CHK	;[974]WANT IT?
;	CALL	TSOUT0		;[974]YES - DUMP IT
	TXNN	P5,F%LIST	;WANT LISTING?
;**;[974]	Add 1 line			YKT	15-AUG-83
	JRST  [CALL NOCRLI	;[974] NO, SKIP OVER LIST STUFF
	       JRST BLDNC1]	;
	TXNN	P5,F%CREF	;YES - WANT CREF, TOO?
	JRST	[HRROI B,[ASCIZ "/LIST:LPT:"] ;YES - OUTPUT SWITCH
;**;[974]	Add 2 lines 			YKT	15-AUG-83
		 CAIN P4,LT.PAS	;[974]
		 HRROI B,[ASCIZ "/LIST:"]	;[974]
		 CALL TSOUT0
;**;[716] Replace 3 lines with 1 at BILDNC:+25L	JRG	29-MAR-82
		 CALL PUTDF1	;[716] DUMP NAME
		  NOP		;IGNORE EXTENSION
		 JRST BLDNC1]	;CONTINUE
	HRROI B,[ASCIZ "/CREF"]
	CALL TSOUT0		;ELSE JUST PUT IN CREF SWITCH WITH NO FILENAME
BLDNC1:	SKIPE B,LSWPTR		;GOT GLOBAL LANGUAGE SWITCHES?
	CALL TSOUT0		;YES - DUMP THEM
	SKIPE B,SWP(P2)		;GOT LANGUAGE SWITCHES?
	CALL TSOUT0		;YES - DUMP THEM
	CALL EOLOUT		;END THE SPECS
	MOVEM A,TMPJFN		;SAVE UPDATED JFN
	RET			;RETURN

;**;[974]	Add 7 lines			YKT	15-AUG-83
NOCRLI: HRROI B,[ASCIZ "/NOLIST"]	;[974]
        SKIPE NOLISW		;[974] NOLIST SW EXPLICIT TYPED?
        CALL TSOUT0      	;[974] YES,
       	HRROI B,[ASCIZ "/NOCREF"]	;[974]
        SKIPE NOCRSW	        ;[974] NOCREF SW EXPLICIT TYPED?
        CALL TSOUT0     	;[974] YES,
        RET   	         	;[974] NO,


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

BLDSRN:	MOVEI B,"+"		;FOR NATIVE MODE, PLUS BETWEEN SOURCE SPECS
	TXZE P1,F%NCMA		;NEED SEPARATOR?
	CALL TBOUT		;YES, PUT IT IN
;**;[716] Replace 5 lines with 1 at BLDSRN:+3L	JRG	29-MAR-82
	CALL PUTDF		;[716] OUTPUT DEVICE AND FILE NAME
	 JRST BLDN1		;SPEC OVER, NO PERIOD
	CALL PROUT		;PUT IN PERIOD
	CALL PUTDF0		;CONTINUE SPEC
	 NOP			;SHOULD BE OVER BY NOW
BLDN1:	TXO P1,F%NCMA		;MAKE SURE SEPARATOR PUT IN IF MORE SPECS
	RET			;DONE WITH THIS SPEC

;SUBROUTINE TO BUILD THE COMMAND LINE FOR AN OLD-STYLE COMPILER

BILDIT:	MOVE	A,TMPJFN	;GET JFN TO OUTPUT TO
	TXNE	P5,F%NBIN	;WANT OBJECT?
	CALL	CKCOB		;NO - OUTPUT A HYPHEN IF COBOL
	TXNN	P5,F%NBIN	;WANT OBJECT?
	CALL	BILOBO		;YES - OUTPUT OBJECT SPECS
	MOVEI	B,","		;SEPARATE WITH A COMMA
	CALL	TBOUT
	TXNN	P5,F%LIST	;WANT LISTING?
	JRST	[CALL CKCOB	;NO - CHECK COBOL
		 JRST BLDIT1]	;SKIP OVER LIST STUFF
	TXNN	P5,F%CREF	;YES - WAS A CREF REQUESTED TOO?
	JRST	[HRROI B,[ASCIZ "LPT:"]
		 CALL TSOUT0	;NO - DUMP DEVICE (FOR LIST FILE)
		 MOVE Q1,NAM(P2);GET POINTER TO FILESPEC
;**;[716] Replace 2 lines with 1 at BILDIT:+14L	JRG	29-MAR-82
		 CALL PUTDF1	;[716] DUMP NAME
		  NOP		;IGNORE EXTENSION
		 JRST BLDIT1]	;CONTINUE
;**;[716] Replace 12 lines with 5 at BILDIT:+18L	JRG	29-MAR-82
	MOVE	B,CHDD		;[716] OUTPUT CREF FILE TO CONNECTED DIRECTORY
	CALL	PUTDEV		;[716]
	MOVE	Q1,NAM(P2)	;[716] GET POINTER TO FILENAME AGAIN
	CALL	PUTDF0		;[716] OUTPUT FILENAME
	  NOP			;[716] IGNORE
	MOVEI	D,"C"		;OUTPUT SW
	CALL	SWOUT		;...
	CAIE	P4,LT.C68	;68 COBOL,
	CAIN	P4,LT.C74	; OR 74 COBOL?
	JRST	BLDIT1		;YES, SO DON'T CREF
	CAIE	P4,LT.CBL	;IF COBOL
	CAIN	P4,LT.BLI	; OR BLISS
	JRST	BLDIT1		; THEN DON'T CREF
	CALL	ENTCRF		;ENTER NAME IN CREF FILE
BLDIT1:	MOVEI	B,"="		;DELIMIT
	CALL	TBOUT
	TXZ	P1,F%NCMA	;SAY NO COMMA SEEN YET
	CALL	SRCSCN		;LOOP THROUGH SOURCES
	  JRST	BLDSRC		;(ADDRESS OF COROUTINE FOR SOURCE FILES)
	SKIPE B,LSWPTR		;GOT GLOBAL LANGUAGE SWITCHES?
	CALL TSOUT0		;YES - DUMP THEM
	SKIPE B,SWP(P2)		;GOT LANGUAGE SWITCHES?
	CALL TSOUT0		;YES - DUMP THEM
	CALL EOLOUT		;END OF SPECS
	MOVEM A,TMPJFN		;SAVE UPDATED JFN
	RET			;RETURN

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

BLDSRC:	TXZE	P1,F%NCMA	;NEED COMMA?
	CALL	CMOUT		;YES - DUMP ONE
	CALL	PUTDF		;OUTPUT DEVICE & FILE
	  JRST	BSRC1		;END OF SPEC
	CALL	PROUT		;DUMP PERIOD
	CALL	PUTDF0		;CONTINE SPEC
	  NOP			;IGNORE
BSRC1:	TXO	P1,F%NCMA	;SET NEED-COMMA FLAG
;**;[716] Change 1 line at BSRC1:+1L	JRG	29-MAR-82
	MOVE	B,HDD(P2)	;[716] GET HACKED DEVICE DESIGNATOR
	CALLRET	PUTPPN		;DUMP ONE AND RETURN
;**;[716] Delete 1 line at BSRC1:+3L	JRG	29-MAR-82

;SUBROUTINE TO OUTPUT THE OBJECT FILE
;BILOBO: ENTRY FOR OLD-STYLE
;BILOBN: ENTRY FOR NATIVE MODE

BILOBN:	HRROI B,[ASCIZ "/OBJECT:"]
	CALL TSOUT0		;NATIVE MODE: OUTPUT OBJECT FILE AS A SWITCH
;**;[716] Replace 26 lines with 1 at BILOBN:+2L	JRG	29-MAR-82
BILOBO:	CALL	PUTDFO		;[716] OUTPUT DEVICE AND FILENAME
	  JRST	BLDOB1		;END OF SPEC
	LDB	Q2,[POINTR (P5,F.LMSK)] ;GET LANGUAGE TYPE
	CAIN	Q2,LT.REL	;IS IT "RELOC"?
	TXNN	P5,D%EXTN	;YES - EXPLICIT EXTENSION?
	JRST	BLDOB1		;NO - PROCEED
	CALL	PROUT		;DUMP PERIOD
	CALL	PUTDF0		;Q1 STILL HAS POINTER
	  NOP			;IGNORE END-OF-SPEC RETURN
;**;[716] Replace 7 lines at BLDOB1:+0L	JRG	29-MAR-82
BLDOB1:	MOVE	B,HDDO(P2)	;[716]
	SKIPE	NATIVF		;[716] NATIVE COMPILER?
	JRST	BLDOB2		;[716] YES - SKIP PPN, BUT DO SWITCHES
	CALL	PUTPPN		;[716] NO - DUMP PPN
	CAIE	P4,LT.FOR	;[716] FORTRAN?
	RET			;[716] NO - DONE
;**;[974]	Change 2 lines and Add 4 lines		YKT	15-AUG-83
BLDOB2:	HRROI	B,[ASCIZ "/OPTIM"] ;[974][716] SWITCH FOR OPTIMIZE
	TXNN	P5,F%OPT	;[974] WANT IT
	 JRST [SKIPN NOOPSW	;[974] NO, IS NOOPT SW EXPLICITLY TYPED?
	        JRST .+2	;[974] NO, DON'T WRITE
               HRROI B,[ASCIZ "/NOOPTIM"]	;[974] YES,
	       JRST .+1]	;[974]
	CALL	TSOUT0		;YES - DUMP IT
	HRROI	B,[ASCIZ "/DEBUG"] ;SWITCH FOR DEBUG
;**;[974]	Change 1 line and Add 4 lines 		YKT	15-AUG-83
	TXNN	P5,F%DEB	;[974] WANT DEBUG CODE?
	 JRST [SKIPN NODBSW	;[974] NO, IS NODEBUG SW EXPLICITLY TYPED?
		JRST .+2	;[974] NO, DON'T WRITE
               HRROI B,[ASCIZ "/NODEBUG"]	;[974] YES,
	       JRST .+1]	;[974]
	CALLRET	TSOUT0		;YES - DUMP IT AND RETURN
	RET			;NO - JUST RETURN
;ROUTINE TO CHECK FOR COBOL AND OUTPUT A "-" TO THE COMMAND FILE

CKCOB:	CAIE	P4,LT.C68	;COBOL 68,
	CAIN	P4,LT.C74	; OR COBOL 74?
	JRST	CKCOB1		;YES
	CAIE	P4,LT.CBL	;IS IT COBOL?
	RET			;NO - RETURN
CKCOB1:	MOVEI	B,"-"
	CALLRET TBOUT		;YES - DUMP MINUS

;ROUTINE TO PUT PPN IN OUTPUT STREAM

;**;[716] Replace 18 lines with 8 at PUTPPN:+0L	JRG	29-MAR-82
PUTPPN:	TLNN B,600000		;[716] IS THIS A NON-DIRECTORY DEVICE?
	TLNN B,777777		;[716] OR IS THIS THE CONNECTED DIRECTORY?
	RET			;[716] YES TO ONE, LEAVE
	PUSH	P,B		;[716] SAVE ARG
	HRROI	B,[ASCIZ "[4,"]	;[716] MOVE IN PROJECT NUMBER (ALWAYS 4)
	CALL	TSOUT0		;[716] DUMP IT
	POP	P,B		;[716] GET PPN BACK
	HLRZS	B		;[716] PUT PROGRAMMER NUMBER IN RHS
	LDF	C,1B0+10	;...
	NOUT			;MAJIK
	  CALL	CJERR
	MOVEI	B,"]"		;CLOSE BRACKET
	CALLRET	TBOUT		;DUMP AND RETURN
;ROUTINE TO ADD NEW FILESPEC TO THINGS THAT NEED CREFING

ENTCRF:	PUSH	P,A		;SAVE POSIBLE JFN
;**;[716] Replace 3 lines with 5 at ENTCRF:+1L	JRG	29-MAR-82
	MOVE	A,CSBUFP	;[716] CURRENT POINTER
	MOVE	B,CHDD		;[716] OUTPUT DEVICE FOR CONNECTED STRUCTURE
	CALL	PUTDEV		;[716] OUTPUT CURRENT STRUCTURE
	MOVE	C,A		;[716] MOVE UPDATED POINTER TO C
	MOVE	Q1,NAM(P2)	;[716] POINTER TO NAME
	CALL	CPYDF		;COPY FILE NAME
	  NOP			;IGNORE THIS RETURN
	MOVEI	B,0		;TERMINATE STRING
	IDPB	B,C		;...
	CALL	CHKCRF		;CHECK AND ENTER IF UNIQUE
	POP	P,A		;RESTORE ACCUM
	RET			;RETURN

;CHECK FOR ALREADY EXISTING FILESPEC

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

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

;ROUTINE TO MERGE EXISTING CREF FILE WITH CORE INFO

FINCRF:	SKIPN	CRFHED		;ANYTHING NEW?
	RET			;NO - THEN DONE
	CALL	TJNUM		;GO MAKE A FILENAME
	MOVEI	A,"CR"
	DPB	A,[POINT 14,FSPEC,34]
	MOVE	A,[ASCII "E.TMP"]
	MOVEM	A,1+FSPEC	;COMPLETE NAME
	SETZM	2+FSPEC		;MAKE ASCIZ
	LDF	A,GJ%SHT!GJ%PHY!GJ%OLD
	HRROI	B,FSPEC		;ARGS FOR GTJFN
	CALL GTJFS		;SEE IF FILE EXISTS
	  JRST	DONCRF		;NO - JUST DUMP CORE
	LDF	B,7B5+1B19	;BITS FOR READ
	OPENF			;OPEN FILE
	  CALL	CJERR		;LOSAGE
	PUSH	P,A		;SAVE JFN ON STACK
	PUSH	P,EOFDSP	;SAVE EOF TRAP
	MOVEI	A,CRFEOF	;NEW ADDRS FOR TRAP
	MOVEM	A,EOFDSP	;...
			;;;; FALL INTO FNCRFN
;HERE TO SCAN FILE FOR SPEC

FNCRFN:	MOVE	A,-1(P)		;FETCH JFN
FNCRF1:	BIN		;READ A CHAR
	CAIE	B,"="		;SEARCH FOR BEGINNING OF SPEC
	JRST	FNCRF1		;LOOP TILL FOUND
	MOVE	C,CSBUFP	;  "  POINTER
FNCRF2:	BIN			;GOBBLE CHAR
	CAIN	B,LF		;LOOK FOR EOL
	JRST	FNCRF3		;FOUND - CHECK FOR MERGE
	IDPB	B,C		;COPY TO STRING SPACE
	JRST FNCRF2

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

;HERE ON EOF INTERUPT FROM READING CREF FILE

CRFEOF:	POP	P,EOFDSP	;RESTORE THIS
	MOVE	A,0(P)		;GET JFN
	TLO	A,(1B0)		;RETAIN IT
	CLOSF			;CLOSE FILE
	  CALL	CJERR		;NEVER HAPPEN
	LDF	B,7B5+1B20	;OPEN FOR WRITE
	TLZ	A,(1B0)		;CLEAR FLAG
	OPENF			;...
	  CALL	CJERR		;SOMETHING WENT WRONG
	JRST	DNCRF1		;JOIN WRITE
;ROUTINE TO WRITE OUT NEW CREF FILE

DONCRF:	CALL	TOPNF		;OPEN TMP FILE IN FSPEC
	PUSH	P,A		;STACK JFN
DNCRF1:	MOVE	Q1,CRFHED	;GET LIST HEAD
	MOVE	A,0(P)		;GET JFN
DNCRF2:	MOVEI	B,"="		;EQUAL SIGN
	CALL	TBOUT		;DUMP IT
	MOVE	B,1(Q1)		;POINTER TO FILESPEC
	CALL	TSOUT0		;DUMP IT NEXT
	CALL	EOLOUT		;  AND CRLF
	SKIPE	Q1,0(Q1)	;SEE IF MORE
	JRST	DNCRF2		;YES - LOOP BACK
	POP	P,A		;NO - CLOSE OUT FILE
	CLOSF			;...
	  CALL	CJERR		;WHOOPS
	RET			;ALL DONE - RETURN
;PUTDF - ROUTINE TO OUTPUT FILESPEC AS FOLLOWS:
;OUTPUT DEVICE IF ANY , DUMP FILENAME
;  TERMINATE ON FIRST PERIOD OR ; OR NULL.
;NON-SKIP IF FILESPEC TERMINATED (; OR NULL).
;SKIP IF PERIOD FIRST.
;PUTDF0 - IF Q1 ALREADY SET UP

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

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

;**;[716] Change comment for CPYDF:	JRG	29-MAR-82
;[716] ROUTINE LIKE PUTDF0 ONLY COPIES TO CORE

CPYDF:	PUSH	P,[CPYDF1]	;ROUTINE TO USE
	JRST	PUTDFC		;JOIN COMMON CODE

CPYDF1:	IDPB	B,C		;POINTER IN C
	RET

;**;[716] Delete routine SKPDEV	JRG	29-MAR-82
;**;[716] Add routine PUTDEV	JRG	29-MAR-82
;ROUTINE TO OUTPUT DEVICE FROM HDD TO DEVICE DESIGNATOR IN A

PUTDEV:	TLC B,600000		;CHANGE PROJECT NUMBER LH TO 600000+.DVDSK
	TLCE B,600000
	HRLI B,600000		;NOTE: .DVDSK = 0
	DEVST			;COPY THE DEVICE NAME
	 ERCAL JERRE		;HORRIBLE ERROR
	MOVEI B,":"		;OUTPUT A COLON
	CALLRET TBOUT		;AND RETURN
;OPEN TMP CORE FILE

OPNTMP:	AOS A,NFILES		;INCREASE NUMBER OF TMP FILES BY ONE
	CAIN A,1		;FIRST ONE?
	JRST OPNT2		;YES
	MOVE B,ADDTAB-2(A)	;NO, IT STARTS RIGHT AFTER LAST ONE
	ADD B,TMPCOR(B)		;GET ADDRESS OF NEXT FILE
	AOJ B,			;LENGTH DOESN'T INCLUDE HEADER
OPNT1:	HRRZM B,ADDTAB-1(A)	;REMEMBER STARTING ADDRESS OF TMP FILE
	HLLZ C,SIXTAB(P4)	;GET NAME OF TMP FILE, MAC, FOR, LNK ETC.
	SKIPE NATIVF		;DOING NATIVE-STYLE?
	HLLZ C,NSXTAB(P4)	;YES, GET CORRECT NAME FOR NATIVE COMPILER
	MOVEM C,TMPCOR(B)	;STORE NAME IN LEFT HALF OF FIRST WORD
	MOVEI A,TMPCOR+1(B)	;MAKE BYTE POINTER TO SECOND WORD OF
	HRLI A,440700		;FILE
	RET			;GIVE CALLER THE BYTE POINTER ("JFN")

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

;CLOSE TEMP FILE

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

;ROUTINE TO ATTEMPT TO OPEN FILE IN FSPEC

TOPNF:	LDF	A,GJ%SHT!GJ%FOU!GJ%PHY!GJ%TMP
	HRROI	B,FSPEC		;POINT TO FILESPEC
	CALL GTJFS		;GET A JFN
	  CALL	CJERR		;TEMP FILE LOSAGE
	LDF	B,7B5+1B20	;BYTE SIZE + WRITE
	OPENF			;OPEN FILE
	  CALL	CJERR		;TEMP FILE LOSAGE
	RET			;RETURN

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

;The CMPRES routine tidies up command strings for the COMPILE-class
;commands.  Lots of these petty chores are normally handled by the monitor
;via the COMND jsys.  However, since the PARSE routine doesn't use COMND,
;this CMPRES routine is needed.
;CMPRES does the following:
;
;	o	Carriage returns are ignored.  Linefeeds are changed to
;		commas.  This is so that multiple-line indirect files work.
;
;	o	All multiple spaces are compressed to at most one space
;
;	o	Any spaces following end of line are
;		deleted.  Neglecting to remove spaces at end of line causes
;		"COMP FOO.MAC " to force a compilation.
;
;	o	Spaces preceding percent signs are deleted.
;		If spaces aren't removed in front of percent, the command
;		LOAD FOO %"text" fails to call the compiler!
;	o	Comments enclosed in exclams (!) are removed
;
;	o	Comments starting with semicolon (;) last through the next
;		linefeed or end of command
;
;	o	All spaces other than those sandwiched between filespecs
;		are removed.

;Accepts:	AC1/	Pointer to command string

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

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

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

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

;SKPFCH SKIPS IF CHARACTER IS A FILE CONSTITUENT FOR COMPIL-CLASS COMMANDS.
;
;ACCEPTS:	A/	CHARACTER
;
;RETURNS:	+1:	CHARACTER IS NOT PART OF A FILESPEC
;		+2:	CHARACTER IS PART OF A FILESPEC

SKPFCH:	IDIVI A,4*8		;GET INDEX AND OFFSET
	MOVE B,BITS(B)		;GET BIT POSITION
	TDNE B,NFLBTS(A)	;SKIP IF BIT NOT ON
	RET			;BIT ON, CHARACTER IS NOT PART OF FILESPEC
	RETSKP			;CHARACTER IS PART OF FILESPEC, SKIP.

;TABLE OF CHARACTERS NOT INCLUDED IN COMPIL-CLASS FILESPECS.  THERE ARE
;FOUR WORDS, EACH OF WHICH CONTAINING 32 LEFT-JUSTIFIED BITS, YIELDING A TOTAL
;OF 128 BITS, ONE FOR EACH POSSIBLE CHARACTER.  THE BIT IS ON IF THE CHARACTER
;IS NOT PART OF A FILESPEC

NFLBTS:	BRMSK. FILB0.,FILB1.,FILB2.,FILB3.,,<%>	;PERCENT IS PART OF A LINK SWITCH

;GET CHARACTER, STRIP COMMENT OR CARRIAGE RETURN IF SEEN

GCMC:	ILDB A,CSPTR		;LOOK AT CHARACTER FROM OLD STRING
;**;[740]  INSERT 20 LINES			YKT	14-JUL-82
	CAIN A,"-"		;[740] CHECK THE LINE-CONTINUATION "-" 
	JRST [MOVE D,A          ;[740] YES, MAY BE, SO SAVE THE CHARACTER
	      ILDB A,CSPTR      ;[740] LOAD NEXT BYTE
	      CAIE A,.CHCRT     ;[740] IS CR ?
	      JRST ADJBP1       ;[740] NO, IT IS NOT A LINE-CONTINUATION "-"
	      ILDB A,CSPTR      ;[740] YES, LOAD THE NEXT BYTE
	      CAIE A,.CHLFD     ;[740] IS LF ?
	      JRST ADJBP2       ;[740] NO, IT IS NOT A LINE-CONTINUATION "-"
	      JRST GCMC]        ;[740] YES, STRIP THE LINE-CONTINUATION
	JRST CMIND		;[740] NO, IT IS NOT A LINE-CONTINUATION
ADJBP1:	MOVEM D,A		;[740] RESTORE THE BYTE "-"
	MOVNI C,1		;[740] 
	IBP  C,CSPTR		;[740] ADJUST THE SOURCE POINTER BACKWARD BY 1
	MOVEM C,CSPTR		;[740]
	JRST CMIND		;[740] 
ADJBP2:	MOVEM D,A		;[740] RESTORE THE BYTE "-"
	MOVNI C,2		;[740] 
	IBP C,CSPTR		;[740] ADJUST THE SOURCE POINTER BACKWARD BY 2
	MOVEM C,CSPTR		;[740]
	JRST CMIND		;[740]
;**;[740]  ADD A LABEL TO THE NEXT LINE		YKT	14-JUL-82
CMIND:	CAIN A,"@"		;[740] INDIRECT FILE?
	JRST GCMIND		;YES, GO STUFF IT INTO THE STRING
	CAIN A,.CHCRT		;CARRIAGE RETURN
	JRST GCMC		;YES, IGNORE IT
	CAIN A,""""		;QUOTED STRING?
	JRST GCMQT		;YES, FIND THE END OF IT
	CAIE A,","		;COMMA IS SAME AS LINEFEED!
	CAIN A,.CHLFD		;END OF LINE?
	JRST GCMLF		;YES
	CAIN A,";"		;IS REST OF LINE A COMMENT?
	JRST CMP6		;YES, GO FIND END OF LINE
;**;[941]	Modify 1 line & add 3 lines	YKT	JAN-17-83
;	CAIE A,"!"		;INTERNAL COMMENT IN LINE?
	CAIN A,"!"		;[941] INTERNAL COMMENT IN LINE?
	JRST CMP5		;[941] YES,
	CAIN A,"%"		;[941] LINK SWITCH?
	JRST CMPER		;[941] YES,
	RET			;NO
CMP5:	ILDB A,CSPTR		;YES, FIND END OF IT
	JUMPE A,R		;IF COMMAND ENDS BEFORE COMMENT, CATCH IT.
	CAIN A,.CHLFD		;END OF LINE SEEN?
	JRST GCMLF		;YES, ENDS COMMENT AND ACTS AS END OF LINE
	CAIE A,"!"		;END OF COMMENT YET?
	JRST CMP5		;NO, KEEP LOOKING
	JRST GCMC		;COMMENT OVER, READ NEXT CHARACTER

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

;GET HERE WHEN ATSIGN (@) SEEN IN COMMAND STRING.  SHOVE EVERYTHING TO
;THE LEFT OF IT MORE TO THE LEFT, SO THE INDIRECT FILE'S CONTENTS MAY BE STUFFED
;IN INSTEAD OF THE ATSIGN AND THE FILESPEC

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

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

;REMNUL USES CSPTR AS POINTER TO "REST" OF UNCOMPRESSED STRING AND REMOVES
;ANY NULLS EXCEPT THE ONE TERMINATING THE STRING.  THE REASON WE DON'T MERELY
;STRIP NULLS AS WE SCAN THE STRING, IS THAT WHEN ATSIGN IS SEEN, GTJFN IS
;SCANNING, SO WE MUST MAKE SURE WE STRIP AT LEAST THOSE NULLS THAT MAY FALL
;WITHIN A FILESPEC.

REMNUL:	MOVE A,CSPTR		;START SCANNING HERE
	MOVE B,CSPTR		;STORE NON-NULLS WITH B POINTER
REMN1:	ILDB C,A		;PICK UP NEXT CHARACTER FROM COMMAND STRING
	IDPB C,B		;STORE IT, NULL OR NOT.
	JUMPN C,REMN1		;JUST CONTINUE IF NON-NULL
	MOVE C,CMPSIZ		;NULL FOUND, CALCULATE POINTER TO END OF STRING
	ADJBP C,CMPPT0
	CAMN B,C		;IS THIS NULL AT END OF STRING?
	RET			;YES, WE'RE DONE
	MOVNI C,1		;STRING DIDN'T END, BACK UP DESTINATION POINTER
	ADJBP C,B
	MOVE B,C		;CAUSE INTERNAL NULL TO BE OVERWRITTEN
	SOS CMPSIZ		;REMEMBER REDUCED SIZE TOO
	JRST REMN1		;LOOP FOR CHARACTERS AFTER INTERNAL NULL

;HERE DURING INDIRECT PROCESSING IF INDIRECT FILE CONTENTS IS SHORTER THAN
;ITS NAME.  HANDLE THIS BY COPYING THE INDIRECT FILE CONTENTS OVER THE FILESPEC
;AND THEN SLIDING THE REMAINDER OF THE COMMAND STRING TO THE LEFT

GSHRNK:	MOVE A,INDJFN		;GET HANDLE OF INDIRECT FILE
	MOVE B,CSPTR		;COPY OVER THE ATSIGN AND FILESPEC
	MOVN C,INDSIZ		;INPUT EXACT NUMBER OF CHARACTERS
	CALL GEOFQ		;DO SIN AND CHECK FOR EOF
	MOVE A,CJEPTR		;NOW INPUT CHARACTERS STARTING AFTER FILESPEC
	MOVEI C,0		;READ UNTIL NULL FOUND
	SIN			;SLIDE STUFF LEFT THAT WAS AFTER INDIRECT SPEC
	JRST GCOMMN		;JOIN COMMON CODE

;GEOFQ DOES SIN AND VERIFIES THAT THE FAILING SIN JSYS READING THE INDIRECT FILE WAS DUE
;TO EOF.  THIS IS EXPECTED IF THE INDIRECT FILE HAS LINE NUMBERS.
;
;RETURNS	+1	EOF WAS THE CAUSE OF THE ERROR.  ALL AC'S PRESERVED.
;		NEVER	IF SOME STRANGE ERROR OCCURRED

GEOFQ:	SIN			;READ ENTIRE FILE
	 ERJMP .+2		;FAILED, GO INVESTIAGE
	RET			;SUCCEEDED, RETURN
	ADDM C,CMPSIZ		;FIX COMMAND SIZE.  C WILL BE NEGATIVE IF LINE NUMBERS IN INDIRECT FILE
	SAVEAC <A,B,C,D>	;SAVE WHAT THE SIN JSYS RETURNED
	CALL DGETER		;GET THE ERROR CODE
	CAIE A,IOX4		;END OF FILE REACHED?
	CALL CJERRE		;NO, SO BOMB OUT
	RET			;YES, SO RETURN GOOD

;COME HERE IF COMMA OR LF.  WE MUST FILTER OUT MULTIPLE COMMAS, SINCE CRLF AT THE
;END OF INDIRECT FILES GENERATES ONE COMMA, AND THEN THE COMMA IN THE COMMAND
;FOLLOWING THE INDIRECT SPEC WOULD CAUSE A MULTIPLE ONE.

GCMLF:	MOVE B,CDPTR
	CAMN B,CMPPT0		;IS LINEFEED AT BEGINNING OF COMMAND?
	JRST GCMC		;YES, SO IGNORE IT
	LDB A,CDPTR		;LINEFEED IS USUALLY COMMA, BUT SEE IF COMMA ALREADY
	CAIN A,","		;DO WE ALREADY HAVE A COMMA?
	JRST GCMC		;YES, IGNORE THIS LINEFEED
	MOVEI A,","		;TREAT END OF LINE AS COMMA
	DPB A,CSPTR		;STORE IN SOURCE STRING IN FOR LDB INSTRUCTION
	RET			;ACCOUNT FOR COMMA

;**;[941]	Add 6 lines	YKT	JAN-17-83
;COME HERE IF "%" SIGN SEEN, WE MUST WRITE A COMMA PRECEEDING THE "%" SIGN. IF
;THE PRECEEDING FILE IS AN INDIRECT FILE, JUST FORGET ABOUT THE COMMA. BECAUSE 
;AT THE END OF AN INDIRECT FILE, THE COMMA WILL BE CREATED.

CMPER:	LDB Q1,CDPTR		;[941] LOAD LAST WRITTEN CHARACTER
	CAIN Q1,","		;[941] IS A COMMA?
	RET			;[941] YES, DON'T WORRY
;**;[1003] Replaced 3 L with 15 L at CMPER+3	BCM	MAY-07-84
	SETO B,			;[1003] GET -1
	ADJBP B,CMPPT0		;[1003] ADJUST POINTER TO STRING BACK ONE CHAR
	MOVEM B,CMPPT0		;[1003] SAVE THIS AS ORIGINAL BYTE POINTER
	MOVE A,CDPTR		;[1003] GET POINTER TO DESTINATION BYTE
	CALL SUBBP		;[1003] GET NUMBER OF BYTES TO MOVE
	SOJ A,			;[1003] ADJUST BY ONE
	MOVN C,A		;[1003] TELL SOUT EXACT NUMBER OF BYTES TO MOVE
	MOVE A,CMPPT0		;[1003] WHERE TO MOVE STRING TO
	MOVE B,CMPPT0		;[1003] GET NEW START OF STRING
	IBP B			;[1003] MAKE OLD START OF STRING
	SKIPGE C		;[1003] DON'T DO SOUT IF ZERO!
	SOUT%			;[1003] MOVE THE STRING BACKWARDS
	MOVEI B,","		;[1003] GET A COMMA
	IDPB B,A		;[1003] STORE IT BEFORE "%"
	MOVEI A,"%"		;[1003] GET BACK '%'
	RET			;[1003] DONE. CONTINUE PROCESSING

;MAIN PARSER

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

;TRANSFER TABLE FOR CHARACTER TYPE DISPATCH

XTAB:	ERROR	<Illegal character in command>	;0 - ILLEGAL
	JRST	RDSPAC				;1 - SPACE SEEN
	JRST	RDPLUS				;2 - PLUS SEEN
	JRST	RDSLSH				;3 - SLASH SEEN
	ERROR	<Illegal character in command>	;4 - ILLEGAL
	ERROR	<Illegal character in command>	;5 - ILLEGAL
	JRST	RDCOMA				;6 - COMMA SEEN
	RET					;NULL IS END OF COMMAND
	ERROR	<Illegal character in command>	;10 - ILLEGAL
	JRST	RDPERC				;11 - PERCENT SEEN
	JRST	RDCOLN				;12 - COLON SEEN
	JRST	RDQS				;13 - QUOTED STRING STARTING
	ERROR	<Illegal character in command>	;14 - ILLEGAL
	ERROR	<Illegal character in command>	;15 - ILLEGAL
	ERROR	<Illegal character in command>	;16 - ILLEGAL
;HERE TO HANDLE QUOTED STRING

RDQS:	MOVE A,P4		;GET POINTER TO SWITCH
	CALL SWMOV		;SAVE SWITCH STRING IN FSPEC
	CALL RDQOT1		;READ QUOTED STRING (OPEN QUOTE ALREADY SEEN)
	MOVEM A,SAVQS		;REMEMBER POINTER TO QUOTED STRING
	HRROI A,FSPEC		;POINT TO THE SAVED SWITCH
	CALL DOSWI0		;HANDLE THE PARTICULAR SWITCH
	TXZ P1,F%SLSH		;SAY WE ARE DONE PROCESSING THE SWITCH
	TXO P1,F%CMOK		;SAY NULL SPEC IS OK
	JRST PARSE		;GO READ THE NEXT ITEM IN THE COMMAND

;HERE TO PROCESS COLON (MAY BE SWITCH DELIM OR DEVICE)

RDCOLN:	CAIG	P3,1		;ANYTHING?
	ERROR	<Null spec before colon>
	CALL	CAPND		;APPEND COLON TO BUFFER
;**;[954]	Add one line at RDCOLN+2	YKT	28-MAR-83
	CAIE 	A,0		;[954] SPECIAL CHARACTER?
         JRST	XTAB(A)		;YES, DISPATCH
;**;[954]	Add one line at RDCOLN+3	YKT	28-MAR-83
	 JRST   [TXO P1,F%LAHD
		 JRST RDSPAC]	;[954] NO, MAY BE A FILESPEC

CAPND:	MOVEI	Q1,":"		;REPLACE DELIMITER
CAPND1:	DPB	Q1,3+CSTXTB	;IN BUFFER
	PUSH	P,P3		;SAVE COUNT
;**;[954]	Modify one line at CAPND1+2	YKT	28-MAR-83
	CALL	RDFLDN		;[954] SPECIAL READ
	ADDM	P3,0(P)		;UPDATE COUNT
	POP	P,P3		;PRUNE PDL
	RET			;RETURN

;HERE TO PROCESS LINK SWITCH SPEC

RDPERC:	CAILE	P3,1		;BETTER STAND ALONE
	JRST	RDSLH1		;ELSE MAY BE LOCAL SW
	MOVEI	A,L.SIZE	;SIZE FOR L20 SWITCH
	CALL	BALLOC		;ALLOCATE BLOCK
	HRRM	A,LNK(P2)	;LINK TO NEW BLOCK
	MOVE	P2,A		;UPDATE AC P2
	CALL RDQUOT		;READ QUOTED STRING
	MOVEM	A,NAM(P2)	;STORE STRING POINTER
	LDF	Q2,D%LINK	;SAY LINK SWITCH
	IORM	Q2,FLG(P2)	;...
	TXO	P1,F%CMOK	;SAY NULL SPEC OK
	JRST	PARSE		;CONTINUE
;HERE TO PROCESS COMMA (MUST HAVE COMPLETE FILESPEC NOW)

RDCOMA:	TXZE	P1,F%SLSH	;SWITCH FIELD?
	JRST	RDCMA3		;YES - PROCESS
	CAILE	P3,1		;DO WE HAVE AN ATOM?
	JRST	[CALL FILBLK	;YES - GEN BLOCK
		 TXZ P1,F%FILE	;DONE WITH THIS SPEC
		 JRST RDCMA1]	;PROCEDE
	TXNN	P1,F%CMOK	;NULL ATOM - IS IT OK?
	JRST PARSE		;NO, MUST BE END OF INDIRECT FILE
;**;[716] Add 1 line at RDCMA1:+0L	JRG	29-MAR-82
RDCMA1:	SETZM	GJNSF		;[716] CLEAR GJ%NS FLAG (ONLY HERE MUST ATOM BE DONE)
	TXZ	P1,F%CMOK	;CLEAR FLAG FOR NULL SPEC
	SKIPN	Q1,SRCSAV	;DID WE HAVE SEPARATE SOURCES
;**;[716] Replace 1 line with 6 at RDCMA1:+2L	JRG	29-MAR-82
	JRST	[MOVE A,FLG(P2)	;[716] NO, CHECK TO SEE IF LINK SWITCH
		 TXNN A,D%LINK	;[716] IF LINK SWITCH, DON'T STORE
		 SKIPGE A,RELDAT ;[716] IF NOT LINK SWITCH, STORE IF GE 0
		 JRST RDCMA2	;[716] DON'T STORE, GO SET UP LANG TYPE
		 MOVEM A,OVER(P2) ;[716] STORE
		 JRST RDCMA2]	;[716] GO SET UP LANG TYPE
	MOVE B,BAKPTR		;GET PREVIOUS BLOCK POINTER
	TXNE	P1,F%OBJ	;HAVE OBJECT?
	SETZM	LNK(B)		;YES - CLEAR OLD SRC LINK
	TXZN	P1,F%OBJ	;CHECK FOR OBJ GIVEN
	CALL	MAKOBJ		;MAKE OBJECT BLOCK
	HRLM	Q1,SRC(P2)	;POINTER TO SOURCE LIST
	HLRZ	Q1,SRCSAV	;POINTER TO LAST OBJ BLOCK
	HRRM	P2,LNK(Q1)	;POINT TO NEW ONE
	MOVEI	Q2,LT.REL	;MARK AS RELOC
	DPB	Q2,[POINTR (<FLG(P2)>,F.LMSK)]
	SETZM	SRCSAV		;CLEAR POINTER
RDCMA2:	SKIPGE	B,LPROC		;HAVE A PROCESSOR?
	LDB	B,[POINTR (P1,F.LMSK)] ;USE DEFAULT
	SETOM	LPROC		;CLEAR THIS NOW
	MOVE	Q1,B		;COPY TYPE
	CAIE	Q1,LT.REL	;NO DEBUG AID FOR REL FILES
	CAIN	Q1,LT.MAC	;  OR MACRO
	MOVEI	Q1,0		;YES - NO AID FOR YOU
	CAIN B,LT.SAI		;IF SAIL
	SETOM SAILF		;SAY WE HAVE SEEN SAIL
	CAMLE	Q1,DEBAID	;CHECK BEST SEEN SO FAR
	MOVEM	Q1,DEBAID	;SAVE BETTER
	PUSH	P,P2		;SAVE THIS POINTER
	HLL	P2,SRC(P2)	;POINTER TO SOURCE LIST
	MOVE	P5,FLG(P2)	;GET FLAGS
	MOVEI	Q2,0		;INIT REG
	CALL	SRCSCN		;LOOP THROUGH SOURCES
;**;[941]	Remove Edit 932 & 933   YKT	JAN-17-82
;**;[933]	Add 2 lines		YKT	DEC-13-82
;	  JRST	[MOVE P2,BAKPTR	;[933] GET PREVIOUS BLOCK POINTER
;		 HRRZ P2,LNK(P2) ;[933] LOOK AT NEXT BLOCK
	  JRST  [DPB B,[POINTR (<FLG(P2)>,F.LMSK)] ;STORE TYPE
		 ANDI P5,F.ALL	;MASK FLAGS WE WANT
		 IOR Q2,P5	;ACCUMULATE RESULT
;**;[933]	Remove EDIT #932	YKT	DEC-13-82
;**;[932]	Add 3 lines 		YKT	NOV-22-82
;		 MOVEI P2,LHED	;[932] GET LIST HEAD
;		 HRRZ P2,LNK(P2)	;[932] LOOK AT NEXT BLOCK
;                DPB B,[POINTR (<FLG(P2)>,F.LMSK)] ;[932] STORE TYPE
		 RET]		; AND EXIT
	POP	P,P2		;RESTORE ORIG POINTER
	IORM	Q2,FLG(P2)	;SET AGGREGATE FLAGS
	JRST	PARSE		;CONTINUE SCAN
;HERE TO PROCESS SWITCH

RDCMA3:	TXZE	P1,F%FILE	;FILE SPEC SEEN?
	JRST	[CALL DOSWIT	;PROCESS SWITCH
		 JRST RDCMA1]	;CHECK FOR 2ND PART
	CALL	DOSWIT		;DO SWITCH
	TXNE	P1,F%SPEC	;ANYTHING YET?
	SKIPGE	LPROC		;YES - LANG SWITCH?
	JRST	PARSE		;NO - CONTINUE
	JRST	RDCMA2		;YES - HANDLE SOURCE UPDATE

;ROUTINE TO MAKE OBJ BLOCK FROM LAST SRC BLOCK (P2)

MAKOBJ:	MOVEI	A,B.SIZE	;GET SOME SPACE
	CALL	BALLOC		;...
	EXCH	A,P2		;P2 POINTS TO NEW BLK
	MOVEI	Q2,NAM(P2)	;SET UP BLT POINTER
	HRLI	Q2,NAM(A)	;...
;**;[716] Replace 1 line with 3 at MAKOBJ:+5L	JRG	29-MAR-82
	BLT	Q2,B.SIZE-1(P2)	;[716] MOVE VALUES
	SKIPL	A,RELDAT	;[716] DO WE WANT TO STORE?
	MOVEM	A,OVER(P2)	;[716] YES, DO SO
	LDF	A,D%EXTN	;CLEAR EXPLICIT EXTENSION
	ANDCAM	A,FLG(P2)	;  FLAG IN IMPLICIT NAME
	RET			;RETURN
;HERE TO PROCESS SLASH

RDSLSH:	CAILE	P3,1		;ANYTHING BEFORE SLASH?
	JRST	RDSLH1		;HANDLE FILESPEC
	TXOE	P1,F%SLSH	;SET SLASH SEEN
	ERROR	<Illegal slash>
	JRST	PARSE		;CONTINUE SCAN

;HERE TO HANDLE SPEC BEFORE SLASH IS PROCESSED

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

;HERE TO PROCESS SPACE (DELIMITS OBJECT MODULE)

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

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

;HERE TO PROCESS PLUS SIGN (MULTIPLE SOURCES)

RDPLUS:	CAILE	P3,1		;BETTER HAVE SPEC
	TXNE	P1,F%OBJ	;AND BE IN SOURCE FIELD
	ERROR	<Illegal plus sign>
	CALL	RDFILB		;STASH SPEC AND CHECK SRCSAV
	JRST	PARSE		;GET NEXT SPEC

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

;ROUTINE TO ALLOCATE AND FILL A FILE DESCR BLOCK
;RETURNS POINTER TO PREVIOUS BLOCK IN B, NEW BLOCK IN P2.

;**;[716] Change 2 lines at FILBLK:+0L	JRG	29-MAR-82
FILBLK:	TXZA	P1,F%NLOB	;[716] SAY OK TO LOOK FOR OBJECT
FILBK1:	TXO	P1,F%NLOB	;[716] SAY NOT TO LOOK FOR OBJCECT
	MOVE	B,[POINT 7,FSPEC] ;COPY STRING TO FSPEC
;**;[947]	Delete next line		YKT	FEB-08-83
;**;[931]	Add one line at FILBK1+1	YKT 	NOV-22-82
;	TXO	P1,F%WARN	;[947][931] DEFAULT
FILBK2:	ILDB	A,P4		;...
	IDPB	A,B
	JUMPN	A,FILBK2
	MOVEI	A,B.SIZE	;SIZE OF BLOCK
	CALL	BALLOC		;ALLOCATE IT
	HRRM	A,LNK(P2)	;STORE POINTER TO NEW BLOCK
	PUSH	P,P2		;SAVE OLD POINTER
	MOVE	P2,A		;SET UP NEW POINTER
	HRRM	P1,FLG(P2)	;SET DEFAULTS
	SETZM	NAM(P2)		;NONE YET
	TXO	P1,F%FILE!F%SPEC ;SAY FILE SEEN
	CALL	GTLANG		;FILL IN LANG TYPE INFO
	  JRST	[LDF A,D%FNF	;SET FILE NOT FOUND
		 IORM A,FLG(P2) ;IN FLAGS OF SPEC
		 JRST NODEF]	;KEEP GOING
	MOVE A,EXTP		;GET POINTER TO EXTENSION
	TXNN P1,F%OBJ		;ON OBJECT OR FILE NOT FOUND?
	CALL PARDEF		;NO, GOBBLE THE DEFAULT SWITCHES
NODEF:	POP	P,B		;RETURN BACK POINTER
	MOVEM B,BAKPTR		;STORE IN BAKPTR TOO
	RET			;...
;ROUTINE TO ALLOCATE SOME SPACE IN STRING SPACE
;CALL:	MOVEI	A,<SIZE-IN-WORDS>
;	CALL	BALLOC
;	<RETURN>	C(A) := ADDRS OF BLOCK, BLOCK ZEROED

BALLOC:	STKVAR <BSZ>
	MOVEM A,BSZ		;REMEMBER HOW MUCH IS WANTED
	CALL GETBUF		;GET THE MEMORY
	SETZM (A)		;CLEAR OUT THE BLOCK
	SOSGE B,BSZ		;GET ONE LESS THAN SIZE
	RET			;NO MORE TO CLEAR, BLOCK IS ONE ONE WORD
	ADD B,A			;GET LAS WORD TO CLEAR
	HRRI C,1(A)		;MAKE BLT POINTER FOR 0ING BLOCK
	HRL C,A
	BLT C,(B)		;0 THE BLOCK
	RET
;GTLANG - ROUTINE TO DETERMINE LANGUAGE TYPE AND CHECK FOR
;EXISTING OBJECT FILE.

GTLANG:	CALL	GTLNGX		;CALL SUBROUTINE
	  JRST	GTLNGA		;NO SUCH FILE RETURN
	AOS	0(P)		;SKIP RETURN
GTLNGB:	HRRZ	A,LNGJFN	;GET JFN USED
	JUMPE	A,R		;NONE - RETURN
	CALL RJFN		;RELEASE LNGJFN
	SETZM	LNGJFN		;SAY RELEASED
	RET			;GIVE DESIRED RETURN

;**;[958]	Add two lines at GTLNGA+0L	YKT	03-MAY-83
GTLNGA: TXNN P1,F%OBJ		;[958] IS IN OBJECT FILE?
	CALL CJERR		;[958] NO, IT IS SOURCE FILE
	HRROI A,FSPEC		;POINT TO SPEC
	CALL BUFFS		;ISOLATE IT
	MOVEM A,NAM(P2)		;REMEMBER POINTER
	JRST	GTLNGB		;JOIN COMMON CODE

;**;[716] Replace routines GTLNGX through GTLNG1	JRG	29-MAR-82
GTLNGX:	DMOVE A,[POINT 7,[ASCII "*"]
		 GJ%OLD+GJ%IFG+GJ%FLG] ;LOAD DEFAULTS FOR NON-OBJECT FIELD
	TXNE	P1,F%OBJ	;IN OBJECT FIELD?
	 DMOVE	A,[POINT 7,[ASCII "REL"]
		   GJ%FOU+GJ%FLG] ;YES, THEN USE THESE DEFAULTS INSTEAD
	MOVEM	A,CJFNBK+.GJEXT	;SAVE DEFAULTS
	MOVEM	B,CJFNBK
	MOVE	A,[377777,,377777] ;DON'T USE ANY OTHER INPUT
	MOVEM	A,CJFNBK+.GJSRC
	MOVEI	A,CJFNBK	;BLOCK ADDRS
	HRROI	B,FSPEC		;POINT TO STRING
	CALL GTJFS		;LOOK UP FILE
	 JRST	[CAIN A,GJFX24	;FILE NOT FOUND RETURN
		 RET		;RETURN ERROR
		 CAIL A,GJFX16	;VARIOUS OTHER FNF RETURNS
		 CAILE A,GJFX21	;...
		 CALL CJERR	;SYNTAX ERROR
		 RET]		;ERROR RETURN
	HRRZM	A,LNGJFN	;SAVE JFN
	LDB	B,B		;CHECK TERMINATOR
	JUMPN B,[HRROI A,FSPEC
		 ERROR <Illegal character in filespec: %1m>]
	TXNE	A,GJ%EXT	;WAS AN EXPLICIT EXTENSION TYPED?
	TXZA	P1,F%XPXT	;NO, CLEAR F%XPXT
	TXO	P1,F%XPXT	;YES, SET F%XPXT
	TXNN	P1,F%OBJ	;ARE WE IN OBJECT FIELD?
	JRST	GTLNX0		;NO, GO HANDLE
	MOVX A,GJ%OLD+GJ%FLG	;IN OBJECT FIELD, TRY TO DO INPUT GTJFN
	SKIPE GJNSF		;DO WE WANT TO SET GJ%NS?
	TXO A,GJ%NS		;YES, SET IT
	MOVEM A,CJFNBK		;STORE FLAGS
	MOVEI A,CJFNBK		;BLOCK ADDRS
	HRROI B,FSPEC		;POINT TO STRING
	CALL GTJFS		;LOOK UP .REL FILE
	 JRST GTLNX0		;FAILS, NO STACKED OUTPUT JFN
	TXO P1,F%STOJ		;THERE IS STACKED OUTPUT JFN
	HRRZS A			;TAKE THE FLAGS OFF THE JFN FOR DVCHR
	EXCH A,LNGJFN		;INPUT JFN BECOMES LNGJFN
	MOVEM A,OUTJFN		;OUTPUT JFN IS SAVED AS OUTJFN
	CALL GTHDD		;GET THE HDD
	MOVEM C,HDDNO(P2)	;STORE IT IN HDDNO
	JRST	GTLNX1		;PROCEED
GTLNX0:	TXZ P1,F%STOJ		;NO STACKED OUTPUT JFN
	SETZM HDDO(P2)		;INDICATE NOT DIFFERENT DIRECTORY FOR OBJECT
GTLNX1:	LDF	A,GJ%OFG!GJ%XTN	;LOAD FLAGS
	MOVEM	A,CJFNBK	;STORE FLAGS
	LDF	A,G1%SLN	;SUPRESS LOGICAL NAME EXPANSION
	MOVEM	A,CJFNBK+.GJF2
	SETZM	CJFNBK+.GJEXT	;NO MORE DEFAULT EXTENSION
	MOVEI	A,CJFNBK	;POINT TO BLOCK
	HRROI	B,FSPEC		;POINT TO STRING
	CALL GTJFS		;LOOK UP FILE
	 CALL JERRE		;SHOULD NEVER FAIL
	MOVE	B,A		;WRITE DEVICE AND DIRECTORY FIELDS
	HRROI	A,FSPEC		;INTO FSPEC
	MOVX	C,1B2+1B5+JS%PAF
	JFNS
	MOVEM	A,NAM(P2)	;SAVE BYTE POINTER TO BEGINNING OF FILE NAME
	MOVE	B,LNGJFN	;WRITE FILENAME FIELD
	MOVX	C,1B8		;FROM OTHER JFN INTO FSPEC
	JFNS
	MOVEM	A,FSPEXT	;SAVE EXTENSION POINTER HERE
	CALL	RJFN		;RELEASE PARSE-ONLY JFN
	MOVE	A,LNGJFN	;JFN
	DVCHR			;GET DEVICE CHARACTERISTICS
	TXNN	B,DV%IN		;IS DEVICE OUTPUT ONLY
	TXNE	P1,F%NLOD	;AND ARE WE LOADING?
	TRNA			;NO, SKIP
	RET			;YES, LEAVE
	TXNE	B,DV%DIR	;DIRECTORY DEVICE?
	 TDZA	C,C		;YES, CLEAR
	HRLOI	C,377777	;NO, FUNNY LARGE DATE
	TXNE	P1,F%OBJ	;ARE WE IN OBJECT FIELD?
	TXNE	P1,F%STOJ	;IF SO, DO WE HAVE STACKED OUTPUT JFN
	TRNA			;NOT IN OBJECT FIELD OR THIS IS INPUT JFN, SKIP
	SETO	C,		;FORCE COMPILE (NO INPUT FILE TO CHECK)
	MOVEM	C,BSTDAT	;SAVE IN BSTDAT
	TXNN	B,DV%DIR	;IS IT A DIRECTORY DEVICE?
	SKIPA	C,A		;NO, SAVE REAL DEVICE DESIGNATOR
	SETZ	C,		;YES, SAVE ZERO (FILL IN LATER WITH GTHDDF)
	MOVEM	C,HDD(P2)
	JUMPE	C,GTLNX2	;DON'T SAVE IN HDDNO IF NOT FORCED COMP
	TXNE	P1,F%OBJ	;ARE WE IN OBJECT FIELD?
	MOVEM	C,HDDNO(P2)	;YES, SAVE FORCED COMP IN HDDNO
GTLNX2:	MOVEI	A,LT.REL	;DEFAULT SOURCE LANGUAGE TYPE SEEN IS REL
	MOVEM	A,LNGTYP
	TXZ	P1,F%FWKE	;CLEAR "FILE WITH KNOWN EXTENSION" BIT
	LDF	A,GJ%OLD	;FILES WE'RE LOOKING FOR ARE OLD
	MOVEM	A,CJFNBK	;SAVE FLAGS IN GTJFN BLOCK
	SKIPN	BSTDAT		;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT
	TXNE	P1,F%XPXT	;OR WAS AN EXPLICIT EXTENSION TYPED?
	 TRNA			;YES TO ONE, SKIP
	 JRST	GTLNG2		;NO, START LOOKING AT STANDARD EXTENSIONS
	TXNE P1,F%OBJ		;IN OBJECT SPEC?
	SKIPN BSTDAT		;NON-TWO-WAY SPEC (NON-DIR OR INPUT FAILED)?
	TRNA			;NO TO ONE, SKIP
	 JRST	[MOVX B,LT.REL	;YES TO BOTH, EXTENSION MIGHT NOT BE THERE,
		 JRST GTLNX3]	;SO IT'S ARBITRARILY TYPE .REL
	MOVE A,LNGJFN		;GET BACK LNGJFN
	CALL DJFNSE		;PUT EXTENSION IN CWBUF
	MOVE B,CWBUF		;PUT EXTENSION INTO B
	CALL LOOKE		;LOOK UP EXTENSION IN LTAB
	 SETZ B,		;FAILED, MAKE LANGUAGE TYPE ZERO
GTLNX3:	MOVEM B,LNGTYP		;STORE LNGTYP
	MOVE A,LNGJFN		;GET BACK LNGJFN AGAIN
;**;[919] Add 1 line at GTLNX:+3L	PED	11-OCT-82
	MOVEM A,TMPJFN		;[919] PUT IT WHERE GTLN1S WILL FIND IT
	SKIPE BSTDAT		;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT?
	 JRST GTLNG4		;YES, SKIP CHECKING FOR BETTER THINGS
	MOVE Q1,B		;GET IN LANGUAGE TYPE FOR GTLN1S
	CALL GTLN1S		;MAKE SHORT CALL TO LOOK AT THIS FILE
	MOVE B,LNGTYP		;SEE IF WE JUST LOOKED AT .REL FILE
	CAIN B,LT.REL		;DID WE?
	JRST GTLNG4		;YES, SKIP CHECKING IT AGAIN
GTLNG2:	MOVE	Q1,[1-LTABL,,1]	;GET LANGUAGE TABLE INDEX (SKIP NULL EXTENSION)
	SETOM	RELDAT		;SET REL FILE DATE-TIME TO -1 (FORCE COMPILE)
;**;[749]	Modify one line at GTLNG2+2	YKT 	16-NOV-82
	TXNN	P1,F%NLOB	;[749] CAN WE USE AN OBJECT FILE?
GTLNG3:	CALL	GTLNG1		;CHECK THIS FILE TYPE
				;WE CAN'T USE AN OBJECT FILE, SKIP .REL ENTRY
				;NOTE THAT .REL MUST ALWAYS BE
				;THE FIRST ENTRY IN THE LANGUAGE TABLE
	TXNN	P1,F%XPXT	;STOP HERE IF EXPLICIT EXTENSION WAS TYPED
	AOBJN	Q1,GTLNG3	;SEE IF ANY OTHERS
	TXZN	P1,F%FWKE	;DID WE SEE A FILE WITH A KNOWN EXT?
	RET			;NO, FAIL

GTLNG4:	LDF	A,D%EXTN	;EXPLICIT EXTENSION GIVEN
	IORM	A,FLG(P2)
;**;[958]	Add 4 lines at GTLNG4+1L	YKT	03-MAY-83
	SKIPE RELOSW		;[958] IS RELOCATABLE SW SEEN?
	 JRST [TXNN P1,F%XPXT	;[958] YES, IS EXPLICIT FILE TYPE EXISTING?
	       ANDCAM A,FLG(P2)	;[958] NO, 
	       JRST .+1]	;[958] YES,
	MOVE	A,LNGJFN	;RESTORE LANGUAGE JFN
	CALL	DJFNSE		;GET EXTENSION
	CALL	COPEXT		;COPY EXTENSION
	SKIPE	B,LNGTYP	;DO WE HAVE LANGUAGE TYPE FROM BEFORE?
	CALL	SETLTP		;YES, SET IT
	PUSH	P,B		;SAVE LANG TYPE TEMPORARILY
	MOVE	A,LNGJFN	;GET BACK LNGJFN
	SKIPN	C,HDD(P2)	;IS IT A NON-DIRECTORY DEVICE?
	CALL	GTHDDF		;NO, GET HDD FOR FILE
	MOVEM	C,HDD(P2)	;STORE IT
;**;[919] Replace 2 lines with 7 at GTLNG4:+12.L	PED	11-OCT-82
	TLNE C,-1		;[919] CONNECTED DIRECTORY
	IFSKP.
	  SETOM	GJNSF		;[919] YES, FOLLOWING OBJECT SPEC USES GJ%NS
	  MOVE B,HDDO(P2)	;[919] CHECK OBJECT HDD
	  TLNE B,-1		;[919] CONNECTED DIR TOO?
	  SETOM RELDAT		;[919] NO, CAN'T USE IT
	ENDIF.
	POP	P,B		;RESTORE LANG TYPE
	CAIN	B,LT.REL	;IS IT A .REL FILE?
	MOVEM	C,HDDO(P2)	;YES, STORE HDD IN HDDO ALSO
	MOVE	A,BSTDAT	;GET BEST D/T FOUND EARLIER
	CAIN	B,LT.REL	;IS IT A .REL FILE?
	MOVE	A,RELDAT	;YES, GET D/T FROM HERE INSTEAD
	CALL	STODT		;STORE D/T ACCORDING TO TYPE
	CAIE	B,LT.REL	;IS OBJECT TYPE ALREADY
	TXNE	P1,F%NLOB	;OR CAN'T WE LOOK FOR OBJECT?
	 CALLRET STEXNA		;YES, UPDATE FSPEC, STORE NAME, LEAVE
	TXNE	P1,F%STOJ	;IS THERE A STACKED OUTPUT JFN?
	 JRST	[MOVE A,OUTJFN	;YES, GET IT BACK
		 JRST GTLNG5]	;AND SKIP OVER GETTING A NEW JFN
	SETZM	CJFNBK+2	;CLEAR DEFAULTS
	MOVE	Q1,[CJFNBK+2,,CJFNBK+3]
	BLT	Q1,XTNCNT-1	;...
	HRROI	A,[ASCIZ /REL/]	;STORE DEFAULT FOR FILE EXTENSION
	MOVEM	A,CJFNBK+.GJEXT
	LDF	A,GJ%FOU	;FIND OUT WHERE .REL FILE WILL GO
	MOVEM	A,CJFNBK	;...
	MOVEI	A,CJFNBK	;GET GTJFN BLOCK ADDRESS
	MOVE	B,NAM(P2)	;ENTER .REL FILE ON CONNECTED DIR
	CALL GTJFS		;(OR ON DSK:)
	  CALLRET STEXNA	;FAILED, UPDATE FSPEC AND STORE NAME, AND LEAVE
GTLNG5:	SETOM	OVER(P2)	;SAY WE HAVE CREATED A NEW .REL FILE
	TXO	P1,F%STOJ	;WE HAVE A STACKED OUTPUT JFN
	MOVEM	A,OUTJFN	;SAVE FOR AFTER DVCHR
	CALL	GTHDD		;GET HDD FOR THE FILE
	MOVEM	C,HDDNO(P2)	;SAVE FOR LATER
	CALLRET	STEXNA		;UPDATE FSPEC, STORE FILE NAME, AND LEAVE

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

SETLTP:	SKIPGE	LPROC		;HAVE PROCESSOR SET YET?
	JRST	[MOVEM B,LPROC	;NO -SET IT
		 RET]		; AND RETURN
	TXNE	P1,F%OBJ	;OK IF OBJECT FIELD
	CAIE	B,LT.REL	;OK IF RELOC
	CAMN	B,LPROC		;OR SAME AS BEFORE
	RET			;...
	ERROR <Language processor conflict>

;ROUTINE TO COPY EXTENSION FROM CWBUF .  THE COPY IS
;USED AS THE FILE-TYPE USED FOR LOOKING UP DEFAULTS IF IT ISN'T IN THE
;OBJECT FIELD.
;POINTER TO THE COPY IS STORED IN EXTP

COPEXT:	HRROI A,CWBUF		;POINT TO EXTENSION
	CALL BUFFS		;MAKE A COPY
	MOVEM A,EXTP		;REMEMBER POINTER TO COPY
	RET
;**;[716] Delete routines GTLNGS and GTASC	JRG	29-MAR-82
;**;[716] Insert routine CHK10	JRG	29-MAR-82
;CHK10 -  CHECK FILE NAME TO BE OUTPUT FOR TOPS10 COMPAT.
;TAKES JFN IN B
CHK10:	MOVE A,CSBUFP		;BEGINNING OF STRING SPACE
	MOVE D,A		;POINTER TO FILESPEC'S END SO FAR
	LDF C,1B2+1B35		;GET DEVICE
	JFNS
	CALL	GTASIZ		;GET STRING SIZE
	CAILE	C,7		;MAX LEGAL (INCLUDES ":")
	JRST [	HRROI A,FSPEC
		ERROR <Device name exceeds 6 characters: %1M>]
	HRRZ	B,LNGJFN	;JFN
	LDF	C,1B8+1B35	;FILE NAME
	JFNS
	CALL	GTASIZ		;GET SIZE
	CAILE	C,6		;MAX LEGAL
 	JRST [	HRROI A,FSPEC
		ERROR <File name exceeds 6 characters: %1M>]
	HRRZ	B,LNGJFN	;JFN
	LDF	C,1B11+1B35	;GET EXTENSION
	JFNS
	CALL	GTASIZ
	CAILE	C,4		;MAX LEGAL (INCLUDES ".")
 	JRST [	HRROI A,FSPEC
		ERROR <File type exceeds 3 characters: %1M>]
	RET

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

ILCHR:	HRROI A,FSPEC		;GET FILESPEC THAT'S WRONG
	ERROR	<Illegal character %2\ in file: %1m">
;DOSWIT - DECODE SWITCH AND TAKE ACTION

DOSWIT:	MOVE	A,P4		;STR POINTER TO A
	CALL	SWMOV		;MOVE STR TO FSPEC
	MOVE B,A		;REMEMBER POINTER TO LAST CHARACTER
	HRROI	A,FSPEC		;POINTER TO SW NAME
;	CALLRET DOSWI0		;DO THE SWITCH

;ROUTINE TO PARSE A SWITCH.  GIVE IT POINTER TO SWITCH IN A.
;GIVE IT POINTER TO END OF SWITCH IN B.

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

;HERE TO HANDLE ADDITIONAL VALUES AND LINK-20 SWITCHES

SWVAL:	RET			;RETURN FOR NOW

;/STAY CAUSES EXEC TO STAY AT COMMAND LEVEL DURING COMPILATION/LOADING.

DOSTAY:	SETOM STAYF		;REMEMBER TO STAY
	RET

;HANDLE /LANGUAGE-SWITCHES:

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

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

;HERE TO HANDLE LANGUAGE TYPE SWITCHES

SWLTYP:	CAIN B,LT.SAI		;IF SAIL
	SETOM SAILF		;SAY WE HAVE SEEN SAIL
;**;[958]	Add 7 lines at SWLTYP+1L	YKT	03-MAY-83
	CAIN B,LT.REL		;[958] IS RELOCATABLE SW?
	 JRST [SETOM RELOSW	;[958] YES, SO SET THE SW SEEN
	       TXNE P1,F%XPXT	;[958] IS FILE TYPE SEEN?
		JRST .+1	;[958] YES,
	       LDF Q3,D%EXTN	;[958] NO, LET THE .REL FILE BEEN USED
	       ANDCAM Q3,FLG(P2);[958] MAKE SURE AN EXPLICIT EXTEN ISN'T USED
	       JRST .+1]	;[958]
;**;[716] Replace 8 lines with 21 at SWLTYP:+2L	JRG	29-MAR-82
	TXNN P1,F%SPEC		;[716] SPEC SEEN YET?
	 JRST SWLTP2		;[716] NO, GO HANDLE GLOBAL SWITCH
	MOVE C,LPROC		;[716] MOVE IN LANGUAGE TYPE WE ARE REPLACING
	CAIN C,LT.REL		;[716] IS IT .REL?
	 RET			;[716] YES, DON'T CHANGE, LEAVE
;**;[746] Add 2 lines  at SWLTYP:+7L		YKT	19-AUG-82
;**;[958] Modify next 4 lines			YKT	03-MAY-83
	SKIPN DEFSW		;[958] SET DEFAULT SW SEEN?
	JRST .+3		;[958] NO,
	SETZM DEFSW		;[958] YES, SET FLAG ON
	TRNN P1,F%LANG		;[958] IS GLOBAL LANGUAGE SWITCH SEEN?
	MOVEM B,LPROC		;[716] NO, SET PROCESSOR TYPE
	CAIE B,LT.REL		;[716] IS THIS /REL WE'RE SETTING?
	 RET			;[716] NO, WE ARE DONE
	JUMPE C,SWLTP1		;[716] IF WAS NULL TYPE, MOVE SOURCE TO OBJECT
	SKIPN HDDO(P2)		;[716] IF WAS NON-NULL, IS OBJECT FILE SET UP?
	 JRST SWLTP1		;[716] NO, MOVE SOURCE TO OBJECT
;**;[958]	Delete next two lines		YKT	03-MAY-83
;	LDF B,D%EXTN		;[958][716] YES, LET THE OBJECT FILE BE USED:
;	ANDCAM B,FLG(P2)	;[958][716] CORRECT EXTENSION IS .REL, MAKE SURE AN
	RET			;[716] EXPLICIT EXTENSION ISN'T USED

SWLTP1:	MOVE B,SVER(P2)		;[716] MOVE SOURCE TIME/DATE
	MOVEM B,OVER(P2)	;[716] TO OBJECT TIME/DATE
	MOVE B,HDD(P2)		;[716] ALSO SET UP HDD
	MOVEM B,HDDO(P2)	;[716] FOR OBJECT FILE
	RET			;[716] LEAVE
SWLTP2:	DPB	B,[POINTR (P1,F.LMSK)] ;[716] SET PERM TYPE
	TRON	P1,F%LANG	;SET GLOBAL LANG SWITCH SEEN
	RET			;RETURN

;ERROR RETURNS

AMBIG:	HRROI A,FSPEC
;**;[716] Replace 1 line at AMBIG:+1L	JRG	29-MAR-82
	ERROR <Switch name ambiguous: %1M> ;[716]
NOMAT:	HRROI A,FSPEC
	ERROR <No such switch: %1M>

;ROUTINE TO PARSE THE DEFAULT SWITCHES FOR A FILE TYPE
;PASS IT POINTER TO THE FILE TYPE IN A.

PARDEF:	STKVAR <QUOF,PAREND,SWIPTR,<ABSAV,2>>
	CALL GETDL		;GET DEFAULT SWITCHES FOR FILE TYPE
;**;[958] Add two lines at PARDEF+1L	YKT 	03-MAY-83
	SKIPE A			;[958] IS DEFAULT SW EXISTING?
	SETOM DEFSW		;[958] YES, SET THE FLAG ON
	MOVEM A,SWIPTR		;INITIALIZE POINTER TO SWITCH LIST
PARD0:	MOVE A,[440700,,SWIBUF]	;POINTER TO SWITCH BUFFER
	MOVE B,SWIPTR		;POINTER TO NEXT SWITCH
	MOVEI C,SWISIZ*5	;MAXIMUM CHARACTERS TO READ
	ILDB D,B		;READ THE SLASH
	JUMPE D,R		;IF NULL, LAST ONE WAS LAST SWITCH
	SETZM QUOF		;NOT IN QUOTED STRING YET
PARD3:	ILDB D,B		;READ CHARACTER OF SWITCH
	JUMPE D,PARD4		;IF NULL, SWITCH OVER
	SKIPE QUOF		;IN QUOTED STRING?
	JRST PARD5		;YES, SO "/" DOESN'T START NEXT SWITCH
	CAIN D,"/"		;OR IF SLASH OF NEXT SWITCH, SWITCH OVER
	JRST PARD4		;YES, SWITCH OVER
PARD5:	IDPB D,A		;SWITCH NOT OVER, ACCUMULATE NAME
	CAIE D,QUOTE		;A QUOTE?
	 JRST PARD6		;NO, GO DECREMENT COUNT
;**;[935]	Insert 9 lines at PARD5+2	YKT	21-DEC-82
	SKIPN QUOF		;[935] OPEN QUOTE?
	JRST PARD2		;[935] YES,
	MOVE Q3,B		;[935] NO, SAVE PTR
	SOSG C			;[935] DECREASE THE COUNT
	JRST .+6		;[935] NO MORE SPACES FOR SW
	ILDB D,B		;[935] READ CHARACTER OF SW
	CAIE D,0		;[935] END OF STRING?
	JRST PARD5		;[935] NO, KEEP ON
	MOVEM Q3,B		;[935] YES, RESTORE PREVIOUS PTR
	SKIPE QUOF		;START OR END OF A QUOTED STRING?
	 JRST	[DMOVEM A,ABSAV	;END, SAVE A AND B
		 MOVEM C,PAREND	;AND C TOO
		 MOVEI B,0	;PUT ZERO BYTE AT END OF STRING
		 DPB B,A
		 MOVE A,QUOF	;GET QUOTED STRING POINTER
		 CALL BUFFS	;BUFFER THE QUOTED STRING
		 MOVEM A,SAVQS	;AND SAVE THE POINTER
		 SETZM QUOF	;NOT IN QUOTED STRING ANY MORE
		 DMOVE A,ABSAV	;RESTORE A AND B
		 MOVE C,PAREND	;AND C
		 MOVEI D,QUOTE	;AND D
		 DPB D,A	;RESTORE QUOTE AT END OF STRING
		 JRST PARD6]	;GO DECREMENT COUNT
;**;[935]	Modify 1 line at PARD2		YKT	21-DEC-82
PARD2:	MOVEM A,QUOF		;[935] BEGINNING OF QUOTED STRING, SAVE PTR
PARD6:	SOJG C,PARD3		;READ REST OF NAME
	ERROR <Default switch too long>
PARD4:	MOVEM A,PAREND		;REMEMBER POINTER TO END OF SWITCH
	MOVEI C,0		;PUT NULL AFTER NAME
	IDPB C,A
	MOVNI A,1
	ADJBP A,B		;BACK SOURCE POINTER BACK TO BEGINNING OF NEXT SWITCH
	MOVEM A,SWIPTR		;REMEMBER POINTER FOR NEXT SWITCH
	HRROI A,SWIBUF		;POINT AT THE DEFAULT SWITCH
	MOVE B,PAREND		;PASS POINTER TO END OF SWITCH
	CALL DOSWI0		;PARSE THE SWITCH
	JRST PARD0		;LOOP FOR REST OF SWITCHES
;ROUTINES TO PROCESS /MAP AND /SAVE SWITCHES

SWMAP:	PUSH	P,[MAPPNT]	;SAVE ADDRS ON STACK
	SKIPE	@0(P)		;ALREADY SEE THIS SWITCH?
	ERROR	<MAP or SAVE switch seen twice>
	CAIE	P5,":"		;MORE COMING?
	JRST	[MOVEI P4,-1	;NO - SET FLAG
		 JRST SWSAV2]	;AND EXIT
	CALL	RDFLD		;YES - READ NEXT FIELD
	CAIN	P5,":"		;CHECK FOR DEVICE
	CALL	CAPND		;AND APPEND TO COLON
SWSAV2:	EXCH	P4,0(P)		;REVERSE ARGS
	POP	P,@P4		;AND SAVE VALUE
	RET			;RETURN
;**;[716] Delete routine GTPPN	JRG	29-MAR-82
;**;[716] Add routines GTHDD and GTHDDF	JRG	29-MAR-82
;GTHDD - ROUTINE TO GET HDD FOR JFN IN A AND OUTJFN

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

;GTHDDF - ROUTINE TO GET HDD FOR FILE

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

DJFNSE:	LDF	C,1B11		;EXTENSION ONLY ENTRY
	SETZM	CWBUF		;CLEAR DESTINATION
	HRRZ	B,A		;JFN TO B
	HRROI	A,CWBUF		;POINTER TO DEST
	JFNS			;GET EXTENSION
	RET			;RETURN

;DOJFNS - OBTAIN DESIRED TEXT FOR JFN IN A
;FORMAT DESIRED IN C
;RETURNS ASCIZ IN CSBUF

DOJFNS:	HRRZ	B,A		;JFN TO B
	MOVE	A,CSBUFP	;POINTER TO DEST
	JFNS			;GET IT
	RET			;RETURN

;**;[716] Replace 5 lines with 4 at DOJFNS:+5L	JRG	29-MAR-82
;[716] ROUTINE TO LOOK UP EXTENSION FOUND IN B AND RETURN
;[716] LANG TYPE IN B

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

;**;[716] Add routine STEXNA	JRG	29-MAR-82
;ROUTINE TO WRITE EXTENSION OF LNGJFN AT FSPEXT, ISOLATE THE FILENAME AND
;EXTENSION, AND STORE POINTER IN NAM OF FDB

STEXNA:	MOVE A,FSPEXT		;PLACE TO WRITE FILE EXTENSION
	LDB B,A			;BUT CHECK TO SEE IF THERE'S A FILENAME FIRST
	CAIN B,":"
	JRST [	MOVEI A,1		;NO THERE ISN'T
		CALL GETBUF		;GET A WORD
		SETZM (A)		;ZERO IT
		HRLI A,440700		;POINT TO IT
		JRST STEXN1]		;AND SAVE THE POINTER
	MOVEI B,"."		;(BUT PUT IN DOT FIRST)
	IDPB B,A
	MOVE B,LNGJFN
	LDF C,1B11
	JFNS
	MOVE	A,NAM(P2)	;ONLY COPY OVER THE PORTION WE WANT
	CALL	BUFFS
STEXN1:	MOVEM	A,NAM(P2)	;SAVE NEW FILENAME BYTE POINTER
	MOVE	B,LNGJFN	;CHECK JFN TO BE OUTPUT
	CALL	CHK10		;FOR TOPS-10 LEGALITY
	TXZN	P1,F%STOJ	;IS THERE AN EXTRA JFN TO RELEASE?
	RETSKP			;NO, LEAVE, GIVING GOOD RETURN
	MOVE	B,OUTJFN	;CHECK THIS JFN TOO
	CALL	CHK10		;FOR TOPS-10 LEGALITY
	CALL	RJFN		;RELEASE EXTRA JFN
	RETSKP			;LEAVE, GIVING GOOD RETURN

;ROUTINE TO SEND TMP FILE TO COMPATABILITY PACKAGE

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

;THE PRARG FAILED, PROBABLY BECAUSE WE TRIED TO SEND TOO MUCH.
;WRITE FILES TO DISK.

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

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

;ROUTINE TO STORE DATE/TIME IN SPEC BLOCK ACCORDING TO
;LANGUAGE TYPE (I.E. REL OR NOT)

STODT:	CAIN	B,LT.REL	;RELOC TYPE?
;**;[716] Replace 15 lines with 9 at STODT:+1L	JRG	29-MAR-82
	MOVEM	A,OVER(P2)	;[716] YES - STORE IN OBJECT
	MOVEM	A,SVER(P2)	;[716] STORE IN SOURCE REGARDLESS,
	RET			;[716] DUE TO /BINARY, AND RETURN
;[716] OUTPUT SUBROUTINE DSOUTR

DSOUTR:	MOVE	A,COJFN		;[716] OUTPUT JFN
	MOVEI	C,0		;[716]
	SOUT			;[716] PRINT STRING
	ETYPE	<%_>		;[716] AND CRLF
	RET			;RETURN

;PUNCTUATION ROUTINES

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

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

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

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

RDFLD:	MOVE	Q1,.RDIOJ+CSTXTB ;CURRENT POINTER
	TXZE	P1,F%LAHD	;CHECK IF NEED BACKUP
	ADD	Q1,[B.BP]	;YES - ADD CONST
	MOVEM	Q1,.RDIOJ+CSTXTB ;NOW HAVE CORRECT POSITION
	MOVE	P4,TXTPR	;POINTER TO STRING SPACE
	MOVEM	P4,3+CSTXTB	;OUTPUT STRING HERE
RDFLD0:	MOVEI P3,STRSIZ		;ENOUGH LENGTH FOR ANY REASNABLE FIELD
	MOVEM	P3,4+CSTXTB	; IN STRING SPACE
	MOVE A,BMSKA		;GET SPECIAL BREAK MASK ADDRESS
	MOVEM A,7+CSTXTB
	LDF	Q1,RD%RIE	;RETURN ON EMPTY STRING
	MOVEM	Q1,1+CSTXTB	;...
	MOVEI	A,CSTXTB	;POINT AT ARGS
	TEXTI			;SNARF FIELD
	 CALL EOFJER		;CHECK FOR END OF FILE
	MOVE	Q1,1+CSTXTB	;GET FLAGS
	TXNN	Q1,RD%BTM	;BREAK ON TERM?
	ERROR	<Command string space exhausted>
	LDB	P5,3+CSTXTB	;GET BREAK CHAR
	CALL	GTYP		;GET CHAR TYPE
	MOVEI	Q1,0		;NULL OUT DELIM
	DPB	Q1,3+CSTXTB	;...
	SUB	P3,4+CSTXTB	;SIZE = ORIG - NEW COUNT
	RET			;AND RETURN
;FOLLOW THE ":" IN A SWITCH
;**;[954]	Add new routine		YKT	28-MAR-83	
RDFLDN:	MOVE	Q1,.RDIOJ+CSTXTB ;[954] CURRENT POINTER
	TXZE	P1,F%LAHD	;[954] CHECK IF NEED BACKUP
	ADD	Q1,[B.BP]	;[954] YES - ADD CONST
	MOVEM	Q1,.RDIOJ+CSTXTB ;[954] NOW HAVE CORRECT POSITION
	MOVEI   P3,STRSIZ	;[954] ENOUGH LENGTH FOR ANY REASNABLE FIELD
	MOVEM	P3,4+CSTXTB	;[954] IN STRING SPACE
	TXNN 	P1,F%SLSH	;[954] SLASH SEEN (SWITCH)?
	 JRST RDFLDX		;[954] NO
	MOVE 	A,QQQFLG	;[954] YES, IT'S A SWITCH
	TXNE	A,S%QUO+S%VAL	;[954] IS A /LANGUAGE-SWITCH:?
	 JRST RDFLDX		;[954] YES,
	MOVEI	A,BMSKSW	;[954] NO, IT'S A REGULAR SW, SET NEW BRK MSK
	CAIA			;[954]
RDFLDX:	MOVE A,BMSKA		;[954] GET SPECIAL BREAK MASK ADDRESS
	MOVEM A,7+CSTXTB	;[954]
	LDF	Q1,RD%RIE	;[954] RETURN ON EMPTY STRING
	MOVEM	Q1,1+CSTXTB	;[954] ...
	MOVEI	A,CSTXTB	;[954] POINT AT ARGS
	TEXTI			;[954] SNARF FIELD
	 CALL EOFJER		;[954] CHECK FOR END OF FILE
	MOVE	Q1,1+CSTXTB	;[954] GET FLAGS
	TXNN	Q1,RD%BTM	;[954] BREAK ON TERM?
	ERROR	<Command string space exhausted>
	LDB	P5,3+CSTXTB	;[954] GET BREAK CHAR
	CALL	GTYP		;[954] GET CHAR TYPE
	MOVEI	Q1,0		;[954] NULL OUT DELIM
	DPB	Q1,3+CSTXTB	;[954] ...
	SUB	P3,4+CSTXTB	;[954] SIZE = ORIG - NEW COUNT
	RET			;[954] AND RETURN
;ROUTINE TO READ A QUOTED STRING.  RETURNS POINTER TO IT IN A.

RDQUOT:	CALL	LDCHR		;GET A CHAR
	CAIE	P5,QUOTE	;GRNTEE QUOTED
	ERROR	<String must be quoted>
RDQOT1:	MOVE	P4,CSBUFP	;PICK UP STRING POINTER
RDPRC1:	CALL	LDCHR		;GET CHAR
	CAIN	A,C.EOL	;CHECK END
	ERROR	<Unterminated quoted string>
	CAIN	P5,QUOTE	;END OF SWITCH?
;**;[935]	Modify 1 line at RDPRC1+4	YKT	21-DEC-82
	JRST 	[MOVE A,.RDIOJ+CSTXTB	;[935] SAVE THE POINTER
		 ILDB P5,.RDIOJ+CSTXTB	;[935] LOAD & INCR PTR
		 CAIN P5,QUOTE		;[935] QUOTE MARK?
		 JRST RDPRC1+5		;[935] YES,
		 MOVEM A,.RDIOJ+CSTXTB	;[935] NO,
		 JRST	RDPRC2]		;[935] YES - SET UP BLOCK
	IDPB	P5,P4		;STUFF CHAR
	JRST RDPRC1

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

;LDCHR - ROUTINE TO GET NEXT CHARACTER
;RETURNS: P5: = CHARACTER
;	  A := CHAR TYPE

LDCHR:	TXZN	P1,F%LAHD	;CHECK FLAG
	IBP	.RDIOJ+CSTXTB	;INCR BYTE POINTER
	LDB	P5,.RDIOJ+CSTXTB ;GET CHAR
;	CALLRET	GTYP		;GET TYPE INFO AND EXIT

;GTYP - GET CHAR TYPE IN A

GTYP:	MOVE	Q1,P5		;COPY IT
	IDIVI	Q1,^D9		;LOOK IT UP IN TABLE
	LDB	A,PTAB(Q2)	;...
	RET			;RETURN

;THE FOLLOWING ROUTINE GETS A POINTER TO THE STRING OF DEFAULT
;SWITCHES FOR A PARTICULAR EXTENSION.  THE ROUTINE RETURNS WITH 0
;OR A POINTER IN A.
;PASS THE ROUTINE IN A A POINTER TO THE DESIRED EXTENSION

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

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

;INFO DEFAULT COMPILE-SWITCHES

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

;SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)

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

;HERE IF A TOKEN WAS TYPED. IF "*" DELETE ALL DEFAULTS. IF "." DELETE "."

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

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

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

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

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

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

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

;ROUTINE USED ABOVE TO DO SOUT ASSUMING POSITIVE COUNT IN C.  BACKS
;UP COUNT AND DESTINATION POINTER SO AS NOT TO KEEP NULL CHARACTER IN
;STRING

SOUTN:	SOUT			;WRITE THE DATA
	BKJFN			;BACK UP THE POINTER
	 CALL JERR		;SHOULDN'T FAIL
	AOJA C,R		;UNCOUNT THE FINAL NULL AND RETURN
SUBTTL TI - TEXT INPUT ROUTINE

;TEXTI/GTJFN BLOCK INIT ROUTINE

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

;ROUTINE FOR DOING COMND JSYS FOR COMPILE-CLASS COMMANDS.  PREVENTS
;"@" FROM HAVING STANDARD EFFECT, AS COMPILE-CLASS COMMANDS WANT TO
;PROCESS "@" THEMSELVES.

CFIELD::MOVX A,CM%XIF		;WE WANT TO DO INDIRECT FILESPEC OURSELF
	IORM A,CMFLG
	CALLRET FIELD		;READ INPUT AND RETURN

;MAIN ROUTINE
;INPUT ROUTINE, MERELY INPUTS ENTIRE LINE, DOING RECOGNITION ON
;FILESPECS AND SWITCHES

TI:	SETZM NFIAR		;NO FILES IN A ROW YET
	SETZM NFILS		;NO FILES AT ALL
	MOVEI B,[
		FLDDB. .CMCFM,,	,,,[			    ;CR IS LEGAL
		FLDDB. .CMSWI,,SWTAB,,,[		    ;SWITCH
		FLDDB. .CMFIL,CM%SDH,,<File name>,,[	    ;FILESPEC
		FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[    ;INDIRECT FILE
		FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]] ;PERCENT SIGN
	CALL COMIN		;INPUT THE FIELD
	CAIA			;FAILED
	JRST @D			;DISPATCH ON FIELD FLAVOR
	CALL SKCROK		;DIFFERENT ERROR DEPENDING ON WHETHER CR ALLOWED
	 CMERRX <Switch, filespec, "@", or "%" required>
	 CMERRX <Carriage return, switch, filespec, "@", or "%" required>

;CR GOT TYPED

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

;AT SIGN TYPED

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

;FILE SPEC SEEN.  MAY BE FOLLOWED BY ANYTHING.

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

;PLUS SIGN SEEN

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

;GET HERE WHEN ANYTHING MAY BE TYPED

TALL:	MOVEI B,[
		FLDDB. .CMCFM,,	,,,[			      ;CR IS LEGAL
		FLDDB. .CMSWI,,SWTAB,,,[		      ;SWITCH
		FLDDB. .CMFIL,CM%SDH,,<File name>,,[	      ;FILESPEC
		FLDDB. .CMCMA,,,,,[			      ;COMMA
		FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[      ;INDIRECT FILE
		FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[      ;PLUS SIGN
		FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]]] ;PERCENT SIGN
	CALL COMIN		;INPUT THE FIELD
	 CAIA			;FAILED
	JRST @D			;DISPATCH ON FIELD FLAVOR
	CALL SKCROK		;SEE IF CARRIAGE RETURN ALLOWED
	 CMERRX <Switch, filespec, comma, "@", "+", or "%" required>
	 CMERRX <Carriage return, switch, filespec, comma, "@", "+", or "%" required>

;SKCROK SKIPS IF CARRIAGE RETURN VALID NOW.  CLOBBERS NOTHING.

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

;ROUTINE TO DO INPUT FOR COMPILE-CLASS COMMAND.  TAKES NON-SKIP
;RETURN IF FIELD DOESN'T MATCH SOMETHING IN THE REQUESTED CHAIN (FED
;BY AC2 ON THE CALL).  SKIP RETURNS WITH ADDRESS OF SUPPORT ROUTINE
;IN D IF SUCCESSFUL PARSE.

COMIN:	CALL SKCROK		;SEE IF CARRIAGE RETURN LEGAL
	MOVE B,(B)		;NO, SO CR INVALID ON EMPTY LINE
COMIN1:	PUSH P,B		;SAVE FUNCTION CHAIN
	DEXTX			;NO DEFAULT EXTENSION ON FILESPEC
	MOVX A,GJ%XTN		;WE HAVE AN EXTENDED FLAG, SO WE NEED THIS BIT
	MOVEM A,CJFNBK+.GJGEN
	MOVX A,G1%NLN		;EXTENDED FLAG SAYS ONLY ALLOW TOPS-10 STYLE NAMES (SHORT NAMES AND NO GENERATION FIELDS AND ATTRIBUTES ALLOWED)
	MOVEM A,CJFNBK+.GJF2	;STORE EXTENDED FLAGS
	POP P,B			;RESTORE FUNCTION CHAIN
	CALL CFIELD		;DO COMND JSYS
;**;[990]	Replace two lines by 24 LINES at COMIN1+10L	YKT	DEC-19-83
;	TXNE A,CM%NOP		;MAKE SURE A LEGAL POSSIBILITY WAS TYPED
;	 JRST COM1		;GO TRY PARSE ONLY
	TXNN A,CM%NOP		;[990]
	  IFSKP.                ;[990]
	    CAIE B,NPXAMB       ;[990]
	      IFSKP.            ;[990]
		CMERRX		;[990]
	      ENDIF.		;[990]
	    CAIE B,NPXNOM	;[990]
	      IFSKP.		;[990]
		CMERRX		;[990]
	      ENDIF.		;[990]
	    CAIE B,NPXNUL	;[990]
	      IFSKP.		;[990]
		CMERRX		;[990]
	      ENDIF.		;[990]
	    CAIE B,NPXNC	;[990]
	      IFSKP.		;[990]
		CMERRX		;[990]
	      ENDIF.		;[990]
	    JRST COM1		;[990]
	  ENDIF.		;[990]
	CALL IDEN		;FIND OUT WHAT GOT TYPED
	RETSKP			;SKIP ON SUCCESS

;REGULAR GTJFN FAILED, SO TRY OLD-FILE ONLY.  NOTE THAT IT ISN'T
;GOOD TO TRY OLD-FILE-ONLY FIRST, BECAUSE SIMPLE COMMON CASE OF
;"COMPILE FOO" WOULD FAIL, AS FILE ISN'T CALLED "FOO", BUT "FOO.FOR"
;OR SOMETHING LIKE THAT.  HOWEVER, THE ORIGINAL GTJFN WE DID WITH
;NO BITS ON WILL FAIL ON "COMP X:FOO" WHERE X: IS DEFINED WITH
;"DEFINE X: (AS) <A>,<B>", AND DIRECTORY <A> IS NOT WRITABLE BY THE
;USER.  OLD-FILE-ONLY WILL CAUSE THE LOGICAL NAME TO BE STEPPED
;WHEN LOOKING FOR "FOO" IF NOT FOUND IN <A>.
;ACTUALLY, OLD-FILE-ONLY WILL ALSO FAIL FOR "COMP X:FOO"!  HOWEVER,
;IF FOO.MAC IS UNIQUE IN X:, "COMP X:FOO$" WILL RECOGNIZE IT WITH
;OLD-FILE-ONLY.  BUT IF NO RECOGNITION IS ATTEMPTED, "COMP X:FOO" WILL
;FAIL, SINCE THERE'S NO OLD FILE CALLED "FOO" IN X:.  HENCE, IF OLD-FILE-ONLY
;FAILS, WE HAVE TO TRY PARSE-ONLY GTJFN!!  NOTE THAT PARSE-ONLY
;MUST BE TRIED LAST TO ALLOW RECOGNITION TO WORK.

COM1:	MOVE A,NFIAR		;SEE HOW MANY FILES IN A ROW SO FAR
	CAIL A,2		;TWO?
	RET			;YES, DON'T ALLOW ANY MORE
	MOVX A,GJ%OLD		;TRY OLD-FILE-ONLY
	IORM A,CJFNBK+.GJGEN
	MOVEI B,[FLDDB. .CMFIL]
	CALL CFIELD
	TXNN A,CM%NOP		;SKIP IF FAILED
	JRST COM2		;SUCCEEDED
	MOVE A,CJFNBK+.GJGEN	;GET FLAGS
	TXZ A,GJ%OLD		;TURN OFF OLD-FILE-ONLY
	TXO A,GJ%Ofg		;TRY PARSE-ONLY
	IORM A,CJFNBK+.GJGEN
	MOVEI B,[FLDDB. .CMFIL]
	CALL CFIELD
;**;[957]	Replace next two lines by 6 new lines	YKT	APR-01-83
	TXNN A,CM%NOP		;[957] FAIL?
	 JRST COM2		;[957] NO,
	CAIE B,600060		;[957] YES, BECAUSE GENER #, ATTRIBUTES OR INVALID CHARACTER?
	RET			;[957] NO, LET NORMAL TO HANDLE ERROR
	MOVE D,[440700,,ATMBUF]	;[957] YES, PRINT SOME SPECIAL MESSAGE
	ERROR <No generation field or attributes allowed, or invalid character in file name - %4M>		;[957] 
COM2:	MOVE A,CSBUFP		;GET POINTER TO TEMPORARY STORAGE
	MOVSI C,(1B8)		;ALWAYS OUTPUT THE FILE NAME ONLY
	JFNS			;GET THE FILE NAME THAT WAS ENTERED
	ILDB A,CSBUFP		;TAKE A LOOK AT THE FIRST CHARACTER
	JUMPE A,R		;ERROR IF FILE NAME IS NULL
;**;[973] Add 2 lines after COM2+4   JMP	15-Aug-83
	TXNE B,GJ%NAM!GJ%EXT	;[973] CHECK GTJFN FLAGS FOR WILDCARDS
	 ERROR <No wildcards allowed in file specification> ;[973]
	MOVEI D,TFILE		;SAY THAT FILESPEC TYPED
	RETSKP

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

IDEN:	MOVE A,B		;IF FILE TYPED, JFN NOW IN A!
	LDB D,[331100,,.CMFNP(C)] ;FIND OUT WHAT WAS TYPED
	CAIE D,.CMFIL		;FILESPEC?
	SETZM NFIAR		;NO, SO TALLY ZERO FILESPECS IN A ROW
	EXCH C,D		;FUNCTION CODE IN C, POINTER IN D
	CAIN C,.CMTOK		;TOKEN?
	JRST IDTOK		;YES, GO INVESTIGATE FURTHER
	CAIN C,.CMCMA		;COMMA?
	MOVEI D,TCOMM		;YES
	CAIN C,.CMCFM		;CARRIAGE RETURN?
	MOVEI D,TCR		;YES
	CAIN C,.CMFIL		;FILESPEC?
	MOVEI D,TFILE		;YES
	CAIN C,.CMSWI		;SWITCH?
	MOVEI D,TSWI		;YES
	RET

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

;% TYPED.  READ THE LINK SWITCH

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

;SWITCH TYPED.  ANYTHING MAY FOLLOW

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

;ROUTINE TO DO SWITCH-SPECIFIC PARSING
;GIVE IT TABLE ADDRESS IN A.  IT SKIPS WITH ARG PARSED, IFF A SPECIAL
;ARG IS REQUIRED
;RETURNS VALID SETTING OF S%QUO IN A.

HANSWI:	STKVAR <QQQ>
	HRRZ A,(A)		;GET ADDRESS OF SWITCH DATA
	MOVEI B,1(A)		;GET ADDRESS CONTAINING SPECIAL DISPATCH ADDRESS
	MOVE A,(A)		;GET SWITCH DATA
;**;[954]	Add one line at HANSWI+3	YKT	28-MAR-83
	MOVEM A,QQQFLG		;[954] SAVE IT
	MOVEM A,QQQ		;REMEMBER FLAGS
	TXNE A,S%QUO+S%VAL	;QUOTED STRING OR VALUE TO FOLLOW?
	 IFSKP.			; NO, BUT CHECK IF ONE WAS TYPED ANYWAY
	  MOVE D,SBLOCK+.CMFLG	;SET UP COMND% FLAGS
	  TXNE D,CM%SWT		;WAS ILLEGAL COLON TYPED IN SWITCH?
	   ERROR <Invalid use of colon in switch> ; YES, COMPLAIN ABOUT IT.
	  RET			;NO PROBLEM FOUND
	 ENDIF.
	CALL @(B)		;GO GET VALUE TYPED IN TO SWITCH
	MOVE A,QQQ		;RETURN FLAGS IN A
	RETSKP			;SKIP TO SAY SOMETHING MORE WAS READ

;READ VALUE FOR /LANGUAGE-SWITCHES

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

;COMMA TYPED.  DON'T ALLOW END OF LINE AFTER COMMA, OR ANOTHER COMMA,
;OR A PLUS SIGN.

TCOMM:	MOVEI B,[
		FLDDB. .CMFIL,CM%SDH,,<File name>,,[	  ;FILESPEC
		FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[  ;INDIRECT FILE
		FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]] ;PERCENT SIGN
	CALL COMIN1		;INPUT FIELD
	 CMERRX <Filespec, "@", or "%" required after comma>
	JRST @D			;DISPATCH

;SWMOV - ROUTINE TO PLACE SWITCH NAME IN BUFFER IN PROPER
;FORMAT FOR FSYM
;CALL:	MOVE A,<POINTER-TO-STRING>
;	CALL SWMOV
;	RETURN HERE (STRING IN FSPEC), POINTER TO LAST CHAR IN A

SWMOV:	MOVE B,A		;SOURCE POINTER IN B
	HRROI A,FSPEC		;COPY TO FSPEC
	MOVEI C,0		;STOP ON NULL
	SOUT
	RET

;LANGUAGE EXTENSION TABLE

DEFINE L(LANG,EXT,PROC,TNAME) <
	LT.'EXT==<%LT==%LT+1>
	ASCII	"EXT"
>
%LT==0				;INITIAL VALUE

;**;[716] Replace 2 lines with 5 at SWMOV:+14L	JRG	29-MAR-82
;[716] Note that LT.REL, which must be the first entry, for GTLNG1, must be 1,
;[716] because language type 0 is reserved for the null extension

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

LTABL==.-LTAB			;LENGTH OF TABLE

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

;TABLE OF SIXBIT TMP FILE NAMES

SIXTAB:	0		;TYPE 0 UNUSED
DEFINE L(A,B,C,D)
<IFNB <D>,	SIXBIT /D/	;;SIXBIT IF OLD-STYLE LINE EXISTS
 IFB <D>,	0		;;0 IF NO OLD-STYLE LINE EXISTS
>
LANGUAGE

;TABLE OF SIXBIT TMP FILE NAMES FOR NATIVE-COMPILERS

NSXTAB:	0
DEFINE L(A,B,C,D,E)
<IFB <E>,	0		;;0 IF NO NATIVE COMPILER FOR THIS LANGUAGE
 IFNB <E>,	SIXBIT /E/	;;SIXBIT FOR NATIVE COMPILER TEMP FILE NAME
>
LANGUAGE

;LANGUAGE TMP FILE NAME TABLE

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

;DEBUG AID TABLE

DEFINE L(LANG,EXT,PROC,TNAME) <
	0,,[ASCIZ \:'LANG\]
>
DBTAB:	0			;LOSAGE ENTRY
	LANGUAGE		;EXPAND
;**;[747] Take edit 746 out at NAMES+1L		YKT	20-AUG-82
;**;[746] Modify one line at NAMES+1L		YKT	19-AUG-82
DEFINE NAMES <
	NM (68-COBOL,S%LTYP,LT.C68)	;[747] STILL USE THE ORIGINAL ONE
	NM (74-COBOL,S%LTYP,LT.C74)
;**;[944] Modify two lines at NAMES+3L		YKT	20-JAN-83
	NM (ABORT,S%FRH,F%ABT)		;[944]
	NM (ALGOL,S%LTYP,LT.ALG)	;[944]
	NM (BINARY,S%TOFF!S%FRH,F%NBIN)
;**;[956]	Delete /CHECK,/NOCHECK switches	YKT	28-MAR-83
;	NM (CHECK,S%FRH,F%CHK)		;[956]
	NM (COBOL,S%LTYP,LT.CBL)
	NM (COMPILE,S%FRH,F%CMPL)
	NM (CREF,S%FRH,F%CREF!F%LIST)
	NM (CROSS-REFERENCE,S%FRH,F%CREF!F%LIST)
	NM (DDT,S%FLH,F%DDT)
	NM (DEBUG,S%FRH,F%DEB)
;	NM (ERROR-LIMIT,S%FRH,F%ERR)
	NM (FAIL,S%LTYP,LT.FAI)
	NM (FLAG-NON-STANDARD,S%FRH,F%FLAG)
	NM (FORTRAN,S%LTYP,LT.FOR)
	NM (LANGUAGE-SWITCHES:,S%QUO!S%DSP,DOLSW,RDLSW)
	NM (LIBRARY,S%FRH,F%LIB)
	NM (LIST,S%FRH,F%LIST)
	NM (MACHINE-CODE,S%FRH,F%MACH)
	NM (MACRO,S%LTYP,LT.MAC)
	NM (MAP,S%DSP,SWMAP,[RET])
	NM (NOBINARY,S%FRH,F%NBIN)
;	NM (NOCHECK,S%TOFF!S%FRH,F%CHK)		;[956]
	NM (NOCOMPILE,S%TOFF!S%FRH,F%CMPL)
	NM (NOCREF,S%TOFF!S%FRH,F%CREF!F%LIST)
	NM (NOCROSS-REFERENCE,S%TOFF!S%FRH,F%CREF!F%LIST)
	NM (NODEBUG,S%TOFF!S%FRH,F%DEB)
;	NM (NOERROR-LIMIT,S%TOFF!S%FRH,F%ERR)
	NM (NOFLAG-NON-STANDARD,S%TOFF!S%FRH,F%FLAG)
	NM (NOLIBRARY,S%TOFF!S%FRH,F%LIB)
	NM (NOLIST,S%TOFF!S%FRH,F%CREF!F%LIST)
	NM (NOMACHINE-CODE,S%TOFF!S%FRH,F%MACH)
	NM (NOOPTIMIZE,S%TOFF!S%FRH,F%OPT)
	NM (NOSEARCH,S%TOFF!S%FRH,F%LIB)
;**;[930]Change 1 line at DBTAB: +41L	RWW	5-Nov-82
	NM (NOSYMBOLS,S%FRH,F%LSYM)
;**;[947]	Modify next line	YKT	8-FEB-83
	NM (NOWARNINGS,S%FRH,F%NWAR)	;[947]
	NM (OPTIMIZE,S%FRH,F%OPT)
	NM (PASCAL,S%LTYP,LT.PAS)
	NM (RELOCATABLE,S%LTYP,LT.REL)
	NM (SAIL,S%LTYP,LT.SAI)
	NM (SEARCH,S%FRH,F%LIB)
	NM (SIMULA,S%LTYP,LT.SIM)
	NM (SNOBOL,S%LTYP,LT.SNO)
	NM (STAY,S%DSP,DOSTAY,[RET])
;**;[930]Change 1 line at DBTAB: +51L	RWW	5-Nov-82
	NM (SYMBOLS,S%TOFF!S%FRH,F%LSYM)
;**;[947]	Modify next line	YKT	8-FEB-83
	NM (WARNINGS,S%TOFF!S%FRH,F%NWAR)	;[947]
>

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

SWTAB:	SWLEN,,SWLEN
	NAMES
SWLEN==.-SWTAB-1
BRINI.				;START WITH ALL 0'S

BRKCH. " "			;BREAK ON THESE CHARACTERS
BRKCH. "/"
BRKCH. ":"
BRKCH. "+"
BRKCH. "%"
BRKCH. ","
BRKCH. (QUOTE)			;QUOTE MARK
BRKCH. (0)			;NULL (END OF COMMAND)

BMSK:	EXP W0.,W1.,W2.,W3.

;**;[954]	Add new break mask	YKT	28-MAR-83

BRINI.				;[954] START WITH ALL 0'S

BRKCH. (40,77)   		;[954] BREAK ON ALMOST EVERY THING
BRKCH. (100,137)		;[954]
BRKCH. (140,176)		;[954]

BMSKSW:	EXP W0.,W1.,W2.,W3.	;[954]
;CTAB - CHARACTER TYPE TABLE
;EACH 4-BIT ENTRY CONTAINS THE CHARACTER TYPE FOR CHARACTER N

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

;PTAB - BYTE POINTER TABLE FOR CTAB

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

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

;USER TYPED NON-DIRECTORY.  MAYBE IT'S A PPN.

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

;THE FOLLOWING VERBOSE ERROR MESSAGE WAS PUT IN BECAUSE AT TIME
;OF THIS COMMAND, DOCUMENTATION DEPARTMENT DIDN'T HAVE TIME TO UPDATE
;ALL THE DOCUMENTATION TO DESCRIBE IT, AS MANY PLACES HAD TO BE EDITED.

BADPPN:	ERROR <To translate between PPN's and directories, type one of:
	TRANSLATE str:<directory>
	TRANSLATE str:[n,m]
>
	END