Trailing-Edge
-
PDP-10 Archives
-
BB-GS97A-SM
-
exec-sources/execcs.mac
There are 47 other files named execcs.mac in the archive. Click here to see a list.
; UPD ID= 223, SNARK:<6.1.EXEC>EXECCS.MAC.7, 10-Jun-85 08:43:09 by DMCDANIEL
; UPD ID= 196, SNARK:<6.1.EXEC>EXECCS.MAC.6, 13-May-85 15:19:09 by PRATT
;TCO 6.1.1383 - Update CMPSIZ in CMPER. Fixes nested indirect files.
; UPD ID= 166, SNARK:<6.1.EXEC>EXECCS.MAC.5, 3-May-85 08:29:56 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 129, SNARK:<6.1.EXEC>EXECCS.MAC.4, 8-Feb-85 15:10:53 by PRATT
;TCO 6.1.1182 - Fix CREF problem when jsys trapping is on.
; UPD ID= 79, SNARK:<6.1.EXEC>EXECCS.MAC.2, 12-Nov-84 04:40:38 by MERRILL
; TCO 6.1.1042 - Change a CALL FIELD to CALL FIELDX
; UPD ID= 437, SNARK:<6.EXEC>EXECCS.MAC.50, 21-Aug-84 15:01:05 by SANTIAGO
;TCO 6.2188 - Make COMPILE command abort if illegal value is given to switch.
; UPD ID= 413, SNARK:<6.EXEC>EXECCS.MAC.49, 14-Jun-84 15:17:38 by MCCOLLUM
;TCO 6.2099 - Change HDDs to use directory number instead of PPNs.
; UPD ID= 402, SNARK:<6.EXEC>EXECCS.MAC.48, 1-May-84 15:10:02 by MCCOLLUM
; TCO 6.2054 - Add /NOSTAY switch to load class commands.
; UPD ID= 397, SNARK:<6.EXEC>EXECCS.MAC.47, 23-Mar-84 17:26:41 by MCCOLLUM
;More of TCO 6.1995 - Fix a couple of loose problems.
; UPD ID= 394, SNARK:<6.EXEC>EXECCS.MAC.46, 12-Mar-84 16:08:13 by MCCOLLUM
;TCO 6.1995 - Rewrite routine CMPER to properly replace '%' with ',%'
; UPD ID= 385, SNARK:<6.EXEC>EXECCS.MAC.45, 3-Feb-84 17:04:01 by MCCOLLUM
;TCO 6.1965 - .BLI and .B10 files are compiled by BLIS10. .B36 files are
; compiled by BLISS (through XBLISS). Also, add /10-BLISS and
; /36-BLISS switches.
; UPD ID= 365, SNARK:<6.EXEC>EXECCS.MAC.44, 27-Dec-83 10:45:47 by TSANG
;TCO 6.1914 - An unrecognized file type will be defaulted to FORTRAN
; UPD ID= 362, SNARK:<6.EXEC>EXECCS.MAC.42, 19-Dec-83 11:43:28 by TSANG
;TCO 6.1858 - Give a meaningful error message for @COMP FOO/L
; UPD ID= 308, SNARK:<6.EXEC>EXECCS.MAC.40, 26-Aug-83 13:28:22 by TSANG
;TCO 6.1778 - Pass the correct arguments to compilers for /NOBINARY,/NOCREF,/NODEBUG,/NOFLAG-NON-STANDARD,/NOLIST,/NOMACHINE-CODE,/NOOPTIMIZE and /NOWARNINGS.
;TCO 6.1653 - Make /RELOCATABLE switch work properly.
; UPD ID= 266, SNARK:<6.EXEC>EXECCS.MAC.37, 8-Apr-83 14:24:36 by TSANG
;TCO 6.1597 - Give a meanful error message for file generation number problem.
; UPD ID= 265, SNARK:<6.EXEC>EXECCS.MAC.36, 8-Apr-83 13:54:31 by TSANG
;TCO 6.1564 - Make /SWITCH:TEXT work.
; UPD ID= 260, SNARK:<6.EXEC>EXECCS.MAC.35, 4-Apr-83 10:10:30 by CHALL
;TCO 6.1456 - Set up AC C for $GET0 and $GET2
; UPD ID= 258, SNARK:<6.EXEC>EXECCS.MAC.34, 11-Feb-83 14:17:07 by TSANG
; UPD ID= 252, SNARK:<6.EXEC>EXECCS.MAC.33, 18-Jan-83 16:00:55 by WEETON
;TCO 6.1349 - Make @LOAD/NOSYMBOL Work
; UPD ID= 251, SNARK:<6.EXEC>EXECCS.MAC.32, 18-Jan-83 09:24:21 by TSANG
; UPD ID= 239, SNARK:<6.EXEC>EXECCS.MAC.31, 15-Jan-83 19:24:20 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 211, SNARK:<6.EXEC>EXECCS.MAC.34, 21-Dec-82 10:27:26 by TSANG
;TCO 6.1424 - MAKE /NOBINARY SWITCH WORK.
; UPD ID= 209, SNARK:<6.EXEC>EXECCS.MAC.33, 15-Dec-82 10:37:53 by TSANG
;TCO 6.1400 - MAKE THE QUOTATION MARK IN A QUOTE STRING WORK PROPERLY.
; UPD ID= 208, SNARK:<6.EXEC>EXECCS.MAC.32, 13-Dec-82 12:06:54 by TSANG
;TCO 6.1388 - MAKE /NOWARNINGS WORK PROPERLY FOR FORTRAN LANGUAGE.
; UPD ID= 207, SNARK:<6.EXEC>EXECCS.MAC.31, 13-Dec-82 11:31:15 by TSANG
;TCO 6.1389 - MAKE THE "%" OPERATOR WORK PROPERLY.
; UPD ID= 200, SNARK:<6.EXEC>EXECCS.MAC.30, 24-Nov-82 16:28:37 by TSANG
;TCO 6.1187 - STRIP THE LINE-CONTINUATION CHARACTER "-" IF SEE IN SOURCE.
;TCO 6.1158 - USE DDT SW INSTEAD OF BLISS SW WHEN USE DEBUG COMMAND ON A
; BLISS FILE.
; UPD ID= 197, SNARK:<6.EXEC>EXECCS.MAC.29, 22-Nov-82 13:56:55 by TSANG
;TCO 6.1382 - LET THE /NOCOMP LOCAL SWITCH TO OVERRIDE /COMP GLOBAL SW
; UPD ID= 187, SNARK:<6.EXEC>EXECCS.MAC.27, 25-Oct-82 11:38:18 by TSANG
;TCO 6.1319 - RECOMPILE THE SOURCE FILE IF .REL FILE IS OFFLINE.
; UPD ID= 180, SNARK:<6.EXEC>EXECCS.MAC.26, 8-Oct-82 18:42:53 by MURPHY
;TCO 5.1.1088 - Force compile if source in connected dir but REL not.
; UPD ID= 161, SNARK:<6.EXEC>EXECCS.MAC.25, 21-Sep-82 16:29:47 by TSANG
;TCO 6.1269 - SET CORRECT FORMAT FOR PASCAL FILE IN TMPCOR FILE.
; UPD ID= 155, SNARK:<6.EXEC>EXECCS.MAC.24, 30-Aug-82 11:20:15 by TSANG
;TCO 6.1234 - MAKE GLOBAL LANGUAGE SWITCHES OVERRIDE THE DEFAULT ONE
; UPD ID= 144, SNARK:<6.EXEC>EXECCS.MAC.23, 5-Aug-82 09:23:33 by CHALL
;TCO 6.1211 MOVE FORTRAN TO 2ND POSITION OF LANGUAGES MACRO
; UPD ID= 136, SNARK:<6.EXEC>EXECCS.MAC.22, 4-Aug-82 17:15:41 by LEACHE
;TCO 6.1209 Fix invocations of ETYPE
; UPD ID= 116, SNARK:<6.EXEC>EXECCS.MAC.20, 20-Apr-82 07:53:44 by CHALL
;MORE TCO 5.1717 - MAKE MINOR ALTERATIONS FOUND BY JOHN GROUT
;TCO 6.1063 ALLOW UP TO 32 LANGUAGES (ADJUST F%LANG AND F.LMSK)
; UPD ID= 107, SNARK:<6.EXEC>EXECCS.MAC.17, 7-Feb-82 14:31:10 by CHALL
;TCO 5.1719 ADD NATIVE FORTRAN (NFO) TO LANGUAGES MARCO
;TCO 5.1717 BILDIT- FOR NATIVE, PUT SWITCHES AFTER FILESPECS
; UPD ID= 90, SNARK:<6.EXEC>EXECCS.MAC.16, 8-Jan-82 15:48:57 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 76, SNARK:<6.EXEC>EXECCS.MAC.14, 22-Oct-81 15:04:33 by CHALL
;TCO 5.1582 .SNDCS- ALLOW "." TO BE A LEGAL EXTENSION NAME
;TCO 5.1577 Fix TPLUS and TCOMM to skip COMIN CRLF check
;TCO 5.1572 Fix INFO DEFAULT COMPILE-SWITCHES typeout
;TCO 5.1571 Fix /LANGUAGE-SWITCHES to work with SET DEFAULT COMPILE-SWITCHES
;TCO 5.1569 Fix SET DEFAULT COMPILE-SWITCHES
;TCO 5.1568 Make global language switches override file types for translator
;TCO 5.1567 Make /LANGUAGE-SWITCHES work as last thing on line
; UPD ID= 71, SNARK:<6.EXEC>EXECCS.MAC.13, 10-Oct-81 20:24:29 by CHALL
;TCO 5.1560 ADDED CBL68 (.C68) AND CBL74 (.C74) TO LANGUAGES TABLE
; ALSO, ADDED CBL68 (.68C) TO BE PARALLEL TO THE EXISTING CBL74 (.74C)
; UPD ID= 61, SNARK:<6.EXEC>EXECCS.MAC.12, 2-Oct-81 10:41:06 by CHALL
;TCO 5.1539 P1SRC1- CHANGE "%" TO "?" IN "?SOURCE FILE MISSING"
; ALSO, PASS2- CHANGE "%" TO "?" IN "?OBJECT FILE MISSING"
; UPD ID= 58, SNARK:<6.EXEC>EXECCS.MAC.11, 21-Sep-81 09:36:28 by CHALL
;TCO 5.1520 GTASC- 7-CHAR FILE NAMES WERE ALLOWED (TYPO), BUT NOT NO MO
; UPD ID= 51, SNARK:<6.EXEC>EXECCS.MAC.10, 9-Sep-81 10:09:36 by CHALL
;TCO 6.1025 SWTAB- ADD /NOCREF SWITCH (SAME AS /NOLIST)
; UPD ID= 17, SNARK:<6.EXEC>EXECCS.MAC.9, 17-Aug-81 10:09:32 by CHALL
;TCO 5.1454 CHANGE NAMES FROM CSCAN TO EXECCS AND XDEF TO EXECDE
; UPD ID= 2151, SNARK:<6.EXEC>EXECCS.MAC.8, 8-Jun-81 16:51:14 by OSMAN
; UPD ID= 2148, SNARK:<6.EXEC>EXECCS.MAC.7, 8-Jun-81 15:16:06 by OSMAN
; UPD ID= 2143, SNARK:<6.EXEC>EXECCS.MAC.6, 8-Jun-81 10:02:53 by OSMAN
; UPD ID= 2142, SNARK:<6.EXEC>EXECCS.MAC.5, 8-Jun-81 09:28:49 by OSMAN
; UPD ID= 2141, SNARK:<6.EXEC>EXECCS.MAC.4, 8-Jun-81 08:28:43 by OSMAN
; UPD ID= 2132, SNARK:<6.EXEC>EXECCS.MAC.3, 7-Jun-81 16:59:12 by OSMAN
;tco 6.1020 - Recognize .REQ files as bliss library files
;tco 6.1019 - Add /BLISS switch and don't say /obj: for native-mode compilers
;unless explicit .rel given
; UPD ID= 2119, SNARK:<6.EXEC>EXECCS.MAC.2, 3-Jun-81 16:10:25 by OSMAN
;tco 6.1017 - run XBLISS for bliss programs
;<4.EXEC>EXECCS.MAC.1, 26-Mar-80 18:55:00, Edit by DK32
;Programmable Command Language
; UPD ID= 1388, SNARK:<5.EXEC>EXECCS.MAC.13, 30-Dec-80 14:53:00 by DONAHUE
;tco 5.1221 - Make HANSWI check for S%QUO+S%VAL instead of S%DSP
; UPD ID= 1385, SNARK:<5.EXEC>EXECCS.MAC.12, 24-Dec-80 16:11:36 by OSMAN
;More 5.1220 - Allow compiler to have non-TOPS10 entry vector
; UPD ID= 1381, SNARK:<5.EXEC>EXECCS.MAC.11, 24-Dec-80 14:42:07 by OSMAN
;More 5.1220 - NTVCOM was superfluous
; UPD ID= 1380, SNARK:<5.EXEC>EXECCS.MAC.10, 24-Dec-80 14:38:55 by OSMAN
;tco 5.1220 - Talk to native-mode compilers
; UPD ID= 1238, SNARK:<5.EXEC>EXECCS.MAC.9, 6-Nov-80 15:20:36 by OSMAN
;tco 5.1189 - Use $GET0 instead of $GET2
; UPD ID= 1163, SNARK:<5.EXEC>EXECCS.MAC.8, 14-Oct-80 10:45:09 by DONAHUE
;TCO 5.1172 - MAKE TCR PUT A NULL AT END OF COMMAND STRING
; UPD ID= 985, SNARK:<5.EXEC>EXECCS.MAC.7, 3-Sep-80 14:57:49 by OSMAN
;tco 5.1140 - Make /LANGUAGE-SWITCHES: work!
; UPD ID= 869, SNARK:<5.EXEC>EXECCS.MAC.6, 11-Aug-80 11:21:29 by OSMAN
;tco 5.1129 - Make CFIELD global
; UPD ID= 850, SNARK:<5.EXEC>EXECCS.MAC.5, 7-Aug-80 16:48:30 by OSMAN
;More 5.1122 - Make sure CREF isn't run in "stay" mode
; UPD ID= 822, SNARK:<5.EXEC>EXECCS.MAC.4, 4-Aug-80 09:46:54 by OSMAN
;tco 5.1122 - Add /STAY
; UPD ID= 548, SNARK:<5.EXEC>EXECCS.MAC.3, 21-May-80 17:05:00 by MURPHY
;PREVENT FOLLOWING SEARCH LIST FOR REL FILE IN CERTAIN CASES
; UPD ID= 419, SNARK:<4.1.EXEC>EXECCS.MAC.4, 8-Apr-80 13:44:01 by OSMAN
;tco 4.1.1139 - Make "?Can't find process" a better message
; UPD ID= 395, SNARK:<4.1.EXEC>EXECCS.MAC.3, 1-Apr-80 16:40:43 by TOMCZAK
;TCO#4.1.1133 - Have EXEC look for CBL74, not 74-COBOL
;<4.1.EXEC>EXECCS.MAC.2, 26-Nov-79 09:59:06, EDIT BY OSMAN
SUBTTL T.HESS/TAH 1-SEP-75
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 1980,1985
;ALL RIGHTS RESERVED.
SEARCH EXECDE
TTITLE EXECCS - COMMAND SCANNER FOR TOPS-20
SALL
ESC==ALTM ;BETTER SYMBOL
QUOTE=="""" ;QUOTING CHARACTER
B.BP==70000,,0 ;CONSTANT TO BACKUP BYTE POINTER
;INTERNAL AC USAGE
;P1 - FLAGS
;P2 - DESC BLOCK POINTER
;P3 - COUNT OF CHARS IN STRING
;P4 - POINTER TO STRING (PARSE)
; LANGUAGE TYPE (LSCAN)
;P5 - FLAGS DURING LSCAN
;P6 - INTENTIONALLY NOT TOUCHED, SINCE TRVAR USES IT
;CHARACTER TYPE DEFINITIONS
C.SPAC==1 ;SPACE
C.COMA==6 ;COMMA
C.EOL==7 ;END-OF-LINE
C.COLN==12 ;COLON (SWITCH DELIM)
;FLAGS IN LH OF P1 (PARSE AND GLOBAL)
F%LAHD==1B0 ;LOOK AHEAD FLAG
F%SLSH==1B1 ;SLASH SEEN
F%FILE==1B2 ;POSSIBLE FILESPEC
F%OBJ==1B3 ;OBJECT SPEC IS NEXT
F%DDT==1B4 ;LOAD DDT
F%TOPN==1B5 ;TEMP FILE OPEN
F%GO==1B6 ;START EXECUTION
F%SDDT==1B7 ;GO TO DDT
F%NLOD==1B8 ;DON'T LOAD
F%NCMA==1B9 ;NEED COMMA FLAG
F%CMOK==1B9 ;(PARSE) COMMA OK FOR NULL SPEC
F%SPEC==1B10 ;FIRST FILESPEC SEEN (SWITCH HACK)
F%SUPP==1B11 ;LOADING SUPPRESSED
F%DSYM==1B12 ;DOING LOCAL SYMBOLS
F%AGN==1B13 ;DO OLD COMMAND AGAIN
F%NLOB==1B14 ;GTLANG MAY NOT LOOK FOR OBJECT FILE
F%XPXT==1B15 ;GTLANG HAS SEEN AN EXPLICIT EXTENSION TYPED
F%FWKE==1B16 ;GTLANG HAS FOUND A FILE WITH A KNOWN EXTENSION
F%STOJ==1B17 ;GTLANG HAS A STACKED OUTPUT JFN
;FLAGS IN RH OF P1 (LOCAL FOR FILESPEC BLOCKS)
F%LIST==1B18 ;MAKE LISTING
F%CREF==1B19 ;CREF
F%CMPL==1B20 ;FORCE COMPILATION
F%NBIN==1B21 ;NOBINARY FOR THIS FILE
F%OPT==1B22 ;PRODUCE OPTIMIZED OUTPUT
F%DEB==1B23 ;DEBUG CODE FOR THIS FILE
F%LIB==1B24 ;LIBRARY SEARCH OF THIS FILE
F%LSYM==1B25 ;Don't load local symbols
F%ABT==1B26 ;ABORT-ON-ERROR
F%MACH==1B27 ;MACHINE-CODE
F%FLAG==1B28 ;FLAG-NON-STANDARD
F%NWAR==1B29 ;NO WARNINGS
;F%CHK==1B30 ;CHECK
;F%ERR==1B31 ;MAXIMUM ERRORS ALLOWED
F%LANG==1B30 ;GLOBAL LANGUAGE SWITCH SEEN
;BITS 31-35 ARE LANG TYPE
F.LMSK==37B35 ;MASK FOR LANG TYPE
F.ALL==776000 ;MASK FOR ALL FILE RELEVENT SWS
;OFFSETS IN FILE DESCRIPTOR BLOCK
LNK==0 ;LINK TO NEXT BLOCK
SRC==0 ;POINTER TO SOURCE DESC OR 0
NAM==1 ;BYTE POINTER TO FILESPEC
FLG==2 ;FLAG WORD
SVER==3 ;SOURCE VERSION D/T
OVER==4 ;OBJECT VERSION D/T
HDD==5 ;HACKED DEVICE DESIGNATOR (DD OR PROG #,,RH OF DISK DD)
HDDO==6 ;HACKED DEVICE DESIGNATOR FOR OLD OBJECT FILE
HDDNO==7 ;HACKED DEVICE DESIGNATOR FOR NEW OBJECT FILE
SWP==8 ;POINTER TO LANGUAGE SWITCHES
B.SIZE==9 ;SIZE OF BLOCK
L.SIZE==3 ;SIZE OF LINK-20 SWITCH BLOCK
CMPWDS==FRESIZ/3 ;MAX WORDS TO ALLOW IN COMMAND. BE CAREFUL RAISING
;THIS, SINCE A "LOAD" AFTER "LOAD FOO" CAUSES TWO
;PASSES, AND FREE SPACE IS FRAGMENTED DURING THE SECOND
;PASS
CMPMSZ==CMPWDS*5 ;MAXIMUM CHARACTERS IN COMMAND INCLUDING ALL INDIRECT FILES
;FLAGS IN LH OF FILE DESC BLOCK FLAG WORD
D%LINK==1B1 ;LINK-20 SWITCH SPEC
D%EXTN==1B2 ;EXPLICIT EXTENSION TYPED
D%FNF==1B3 ;FILE DOES NOT EXIST
;SWITCH TABLE DEFINITIONS (BITS IN LHS OF VALUE)
S%DSP==1B0 ;DISPATCH ADDRS
S%TOFF==1B1 ;TURN OFF BITS
S%FRH==1B2 ;FLAGS IN RHS OF P1
S%FLH==1B3 ;FLAGS IN LHS OF P1
S%LTYP==1B4 ;LANGUAGE TYPE
S%LINK==1B6 ;LINK-20 SWITCH TEXT
S%VAL==1B7 ;VALUE ALLOWED
S%QUO==1B8 ;SWITCH TAKES QUOTED STRING AFTER IT
;ARGUMENT BLOCK DEFINITIONS FOR SENDING DATA TO COMPATABILITY PACKAGE
TMPCOR==BUF0 ;TMPCOR AREA BEGINS AT BUF0
NFILES==TMPCOR ;WORD 0, HOLDS NUMBER OF FILES BEING SENT
ADDTAB==TMPCOR+1 ;WORD 1, BEGINNING OF TABLE OF FILE S/A'S
ADDTLN==%LT+1 ;ONE FILE FOR EACH SOURCE TRANSLATOR + ONE FOR LINK
TMPBUF==ADDTAB+ADDTLN ;ADDRESSES FOLLOWED BY FILES THEMSELVES
;LANGUAGE PROCESSOR DEFINITIONS
;ARGS: A - DEBUG SWITCH NAME
; B - EXTENSION
; C - PROCESSOR NAME
; D - TEMP FILE NAME
; E - TEMP FILE NAME FOR NATIVE COMPILER
DEFINE LANGUAGE <
L (BINARY,REL,LINK,LNK)
L (FORTRAN,FOR,FORTRA,FOR,NFO)
L (SAIL,SAI,SAIL,SAI)
L (FAIL,FAI,FAIL,FAI)
L (SNOBOL,SNO,SNOBOL,SNO)
L (PASCAL,PAS,PASCAL,PAS,NPO)
L (SIMULA,SIM,SIMULA,SIM)
L (BLISS,REQ,XBLISS,,BLB) ;HANDLE BLISS LIBRARY FILES (REQUIRE /LIB TO
;BLISS)
L (BLISS,R36,XBLISS,,BLB)
L (DDT,B36,XBLISS,,BLI)
;Until someone teaches the BLISS compiler how to
;read the temp file, we'll run XBLISS which force feeds
;the command string to BLISS
L (DDT,BLI,BLIS10,BLI)
L (DDT,B10,BLIS10,BLI)
L (ALGOL,ALG,ALGOL,ALG)
L (COBOL,68C,CBL68,COB,NCO)
L (COBOL,74C,CBL74,COB,NCO)
L (COBOL,C68,CBL68,COB,NCO)
L (COBOL,C74,CBL74,COB,NCO)
L (COBOL,CBL,COBOL,COB,NCO)
L (MACRO,MAC,MACRO,MAC)
L (,L36) ;NEEDED TO RECOGNIZE .REQ FILES THAT DON'T NEED
;NEW COMPILATION BECAUSE THEIR .L36 IS CURRENT
;*** this entry must be last ***
>
;CSCAN - ENTRY FROM COMMAND DECODER
;PRIMARY COMMAND ALREADY IN CBUF
;READ REMAINDER OF COMMAND
.COMPI::CALL CNSE ;NOISE STUFF
TXO P1,F%NLOD ;SET NO LOAD
JRST CSCAN ;CALL SCANNER
.DEBUG::CALL CNSE ;GUIDE WORD
TXOA P1,F%SDDT ;SET DEBUG
.EXECU::CALL CNSE ;NOISE STUFF
TXOA P1,F%GO ;GO FLAG
.LOAD:: CALL CNSE ;NOISE HACK
JRST CSCAN
CNSE: MOVEI B,[FLDDB. .CMNOI,,<-1,,[ASCIZ /FROM/]>]
CALL CFIELD ;TYPE NOISE BUT DON'T ALLOW "@"!
MOVEI P1,0 ;CLEAR FLAGS
RET
;ENTRY FROM CREF COMMAND
.CREF:: LINEX <Data line for CREF program>
CMERRX <Invalid data line for CREF program>
CALL CRSCAN ;MAKE RESCAN BUFFER
HRROI B,[GETSAVE (<SYS:CREF.>)]
SETZM STAYF ;WAIT FOR CREF TO FINISH
SETZM NFILES ;CLEAR OUT OLD "BUF0" FOR DPRARG
JRST RUNGO ;INVOKE CREF FOR NOW
CMAGN:: MOVX P1,F%AGN ;SAY WE'RE DOING OLD COMMAND AGAIN
JRST CSCAN ;GO ALLOCATE LOCAL VARIABLES
CMAGN1: CALL CSCANR ;RESET PARSER
CALL TIRST ;RESET TEXTI/GTJFN BLOCKS
MOVE P1,CSVCC ;GET COMMAND INFO
JRST CSCAN2 ;PARSE OLD ARGS IF ANY
;ROUTINE TO INIT SCANNER POINTERS, VALUES, ETC...
CSCANR: GJINF ;GET JOB RELATED INFO
MOVEM C,CSJOB ;JOB #
MOVE D,B ;SAVE DIRECTORY NUMBER
MOVX A,RC%EMO ;MATCH EXACTLY
SETZ C, ;CLEAR C
RCDIR ;CONVERT TO DIRECTORY NUMBER
HRLZM C,CHDD ;SAVE RH OF PPN INTO LH OF CHDD (LH ALWAYS 4)
MOVE B,D ;PUT DIRECTORY NUMBER BACK INTO B
HRROI A,FSPEC ;WRITE STRING TO FSPEC
DIRST
ERCAL CJERRE ;IN CASE ERROR
HRROI A,FSPEC ;TRANSLATE STRING TO DEVICE DESIGNATOR
STDEV
ERCAL CJERRE ;IN CASE ERROR
HRRM B,CHDD ;SAVE RH OF DD INTO RH OF CHDD
SETZM LHED ;INITIALIZE VARIABLES
SETZM CRFHED
SETZM SAVPNT
SETZM LSWPTR ;NO GLOBAL /LANG: YET
SETZM MAPPNT ;NO /MAP YET
MOVEI Q1,LT.FOR ;INITIAL LANGUAGE TYPE
DPB Q1,[POINTR (P1,F.LMSK)]
MOVEI P2,LHED ;BEGINNING OF FILE LIST
MOVEI A,STRSIZ*5
CALL GETBUF ;ALLOCATE FREE SPACE FOR TEXTI DESTINATION BUFFER
HRLI A,440700 ;MAKE A BYTE POINTER
MOVEM A,TXTPR ;REMEMBER POINTER
RET ;RETURN
NATWDS==1000 ;NUMBER OF WORDS FOR NATIVE COMMAND STRING
CSCAN: TRVAR <NEWPT0,NEWJFN,OLDJFN,NATIVF,SAVQS,CSPTR,CDPTR,CMPPT0,BAKPTR,TXTPR,NFIAR,NFILS,<SWIBUF,SWISIZ>,BMSKA,LSWPTR,LHED,CRFHED,SAVPNT,<FSPEC,FILWDS>,<CWBUF,LCWBUF>,<CSTXTB,10>,SRCSAV,CSJOB,CHDD,SAVBRK,EXTP,COMPBP,LPROC,DEBAID,TMPJFN,INDJFN,INDSIZ,CJEPTR,CMPBUF,ADDSIZ,CMPSIZ,LNGJFN,GJNSF,OUTJFN,LNGTYP,RELDAT,NXPROC,MAPPNT,BSTDAT,SAILF,FSPEXT,QQQFLG,DEFSW,RELOSW,BINYSW,WARNSW,NOCRSW,NODBSW,NOFGSW,NOLISW,NOMASW,NOOPSW>
SETZM BINYSW
SETZM WARNSW
SETZM NOCRSW
SETZM NODBSW
SETZM NOFGSW
SETZM NOLISW
SETZM NOMASW
SETZM NOOPSW
SETZM STAYF ;DON'T STAY AT COMMAND LEVEL UNLESS /STAY
MOVE A,CMPTR ;GET POINTER TO FOLLOWING "COMPILE (FROM)"
MOVEM A,.RDIOJ+CSTXTB ;POINT TEXTI BLOCK AT ORIGINAL COMMAND STRING
MOVEM A,COMPBP ;REMEMBER POINTER FOR CREATING DEFAULT STRING LATER
TXNE P1,F%AGN ;DOING OLD COMMAND AGAIN?
JRST CMAGN1 ;YES, GO DO IT
CALL TI ;READ A LINE
CALL CSCANR ;SCAN RESET
MOVEM P1,CSVCC ;SAVE COMMAND INFO FOR EDIT
CSCAN1: MOVEI A,7 ;ALLOCATE ROOM IN TEXTI BLOCK
MOVEM A,CSTXTB
SETZM .RDRTY+CSTXTB ;SAY NO ^R POINTER
SETZM .RDBFP+CSTXTB ;NO SPECIAL BACKUP POINTER
MOVE A,[TMPCOR,,TMPCOR+1] ;GET READY
SETZM TMPCOR ;TO CLEAR THE TEMPORARY FILE AREA
BLT A,TMPCOR+777 ;DO IT
MOVEI A,BMSK ;SET UP STANDARD BREAK MASK
MOVEM A,BMSKA
SETZM LNGJFN ;SAY NO LANGUAGE JFN YET
SETZM SAILF ;ASSUME NOT SAIL
SETZM INDJFN ;NO INDIRECT YET
SETZM SRCSAV ;NO PARTIAL SOURCE LIST
SETZM DEBAID ;NO DEBUGGING AID
SETOM LPROC ;UNKNOWN LANG PROCESSOR
SETZM DEFSW ;SET DEFAULT
SETZM RELOSW ;RELOCATABLE SW
MOVEI A,NATWDS ;NUMBER OF WORDS FOR NATIVE STRING
CALL GETBUF ;GET BUFFER FOR NATIVE COMMAND STRING
HRLI A,440700 ;MAKE BYTE POINTER TO AREA
MOVEM A,NEWPT0 ;REMEMBER POINTER TO AREA FOR NATIVE STRING
CALL CMPRES ;GET RID OF UNEEDED SPACES
CALL PARSE ;CALL PARSER
CALL RLJFNS ;RELEASE JFNS
TXNN P1,F%SPEC ;SEEN FILE SPEC?
CSCAN2: JRST [SKIPN A,CSVC ;NO, USE SAVED COPY
ERROR <No saved arguments>
MOVEM A,.RDIOJ+CSTXTB ;REMEMBER POINTER TO COPY
MOVEM A,COMPBP ;REMEMBER THAT WE'RE USING SAVED ONE
JRST CSCAN1] ;AND REPARSE
MOVE A,COMPBP ;BUFFER THE NEW ONE
CAMN A,CSVC ;IF STRING ALREADY SAVED,
JRST CSCANO ;DON'T DO IT AGAIN
CALL XBUFFS ;IN PERMANENT SPACE
EXCH A,CSVC ;REMEMBER POINTER TO SAVED STRING
CAIE A,0 ;MAKE SURE THERE WAS A PREVIOUS STRING
CALL STREM ;RELEASE SPACE IT TOOK UP
MOVEI A,.CHLFD ;PCL Fix buffer
DPB A,CMPTR ;PCL So .CMINI works again
CSCANO: HLRO A,PRTAB+LT.REL ;GET NAME OF LINK-20
TXNE P1,F%NLOD ;ARE WE GOING TO LOAD?
MOVEI A,0 ;NO - THEN NO FILESPEC
MOVEM A,NXPROC ;SAVE AS NEXT PROCESSOR
;;;; FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE
MOVEI P4,%LT ;GET HIGHEST LANG TYPE
P1LUP: MOVE A,NEWPT0 ;GET POINTER TO AREA FOR CREATING NATIVE STRING
MOVEM A,NEWJFN ;INITIALIZE POINTER TO END OF NATIVE STRING
CALL LSCAN ;SCAN LIST
JRST PASS1 ;CO-ROUTINE ADDRS
TXNN P1,F%TOPN ;FILE OPEN?
JRST P1LPA ;NO - SKIP CLOSE STUFF
SETZM NATIVF ;SAY WE'RE DOING OLD-STYLE LINE
MOVE A,OLDJFN ;GET JFN
CALL PUTLNK ;GO PUT LINK TO NEXT PROCESSOR IN TEXT
CALL CLSTMP ;CLOSE TMP FILE FOR OLD-STYLE LINE
P1LPA: MOVE A,NEWJFN ;GET POINTER TO NATIVE STRING
CAMN A,NEWPT0 ;IS THERE ANY NATIVE STRING?
JRST P1LPB ;NO
SETOM NATIVF ;YES, SAY WE'RE DOING NATIVE-STYLE LINE
CALL PUTLNK ;PUT IN LINK INFORMATION FOR NATIVE LINE
CALL OPNTMP ;CREATE TMP FILE FOR NATIVE COMMAND STRING
MOVE B,NEWPT0 ;GET POINTER TO BEGINNING OF NATIVE STRING
CALL TSOUT0 ;WRITE COMMAND STRING INTO TEMP FILE
CALL CLSTMP ;CLOSE TEMP FILE FOR NEW STYLE COMMAND STRING
P1LPB: MOVE A,NEWJFN
HLRO B,PRTAB(P4) ;LINK TO OURSELVES
TXZN P1,F%TOPN
CAME A,NEWPT0
MOVEM B,NXPROC ;SAVE NEXT PROCESSOR ONLY IF THIS COMPILER WILL BE RUN
SOS P4 ;DECREMENT LANG
CAIE P4,LT.REL ;DONE IF LANG TYPE = RELOC
JRST P1LUP ;CONTINUE
JRST P2ST ;START PASS2
PUTLNK: SKIPN B,NXPROC ;WHERE TO GO WHEN DONE
JRST P1LPN ;NONE
SKIPE NATIVF ;NATIVE STYLE LINE?
JRST [ HRROI B,[ASCIZ "/RUN:"]
CALL TSOUT0 ;YES, PUT /RUN:PROG/OFFSET:1
MOVE B,NXPROC
CALL TSOUT0 ;PUT PROGRAM NAME
HRROI B,[ASCIZ "/OFFSET:1"]
CALL TSOUT0
JRST P1LPC1] ;JOIN COMMON CODE
CAIN P4,LT.FOR ;FORTRAN?
JRST P1LFOR ;SPECIAL FORTRAN HACK
CAIE P4,LT.C68 ;68 COBOL,
CAIN P4,LT.C74 ; OR 74 COBOL?
JRST P1LBLI ;YES
CAIE P4,LT.CBL ;YES - COBOL SPECIAL HACK
CAIN P4,LT.BLI ;BLISS?
JRST P1LBLI ;YES - SPECIAL BLISS HACK
CAIN P4,LT.PAS ;PASCAL?
JRST P1LFOR ;YES - SPECIAL PASCAL HACK
CALL TSOUT0 ;DUMP FILESPEC
P1LPC: MOVEI B,"!"
CALL TBOUT
P1LPC1: HRROI B,[BYTE (7)15,12]
CALL TSOUT0 ;TERMINATE
P1LPN: MOVEI B,.CHNUL ;ASSUME LINK TO PROCESSOR IS END OF STRING
IDPB B,A ;GUARANTEE NULL AT END OF STRING
RET
;SPECIAL LANGUAGE HACKS
P1LFOR: HRROI B,[ASCIZ "/RUN:"] ;FORTRAN USES SCAN
CALL TSOUT0 ;PUT IN FILE
MOVE B,NXPROC ;GET NEXT PROCESSOR NAME
CALL TSOUT0 ;DUMP IT
CALL EOLOUT ;TERMINATE
JRST P1LPN ;JOIN COMMON CODE
P1LBLI: MOVE Q1,NXPROC ;POINT TO STRING
HRLI Q1,(<POINT 7,,>)
CALL PUTDF0 ;OUTPUT DEVICE AND FILENAME
NOP ;IGNORE EXTENSION
JRST P1LPC ;CONTINUE
P2ST: SETZM NATIVF ;LINK ISN'T NATIVE
TXNE P1,F%NLOD ;WANT TO LOAD?
JRST P2XIT ;NO - EXIT THIS SECTION
TXNE P1,F%SUPP ;LOSAGE?
ERROR <Loading suppressed>
MOVEI P4,LT.REL ;USE RELOC TYPE
CALL OPNTMP ;OPEN TMP FILE
MOVEM A,TMPJFN ;SAVE JFN
TXZ P1,F%NCMA ;NO COMMA NEEDED YET
SKIPN MAPPNT ;SEE IF WE NEED /MAP
SKIPE SAVPNT ; OR /SAVE SWITCH PROCESSING
CALL MAPSAV ;YES - OUTPUT MAP/SAVE INFO
SKIPE SAILF ;IF SAIL INVOLVED
CALL [ HRROI B,[ASCIZ /SYS:LOWTSA/]
CALL TSOUT0 ;PUT OUT REQUEST FOR LOWTSA
CALLRET EOLOUT]
TXNE P1,F%SDDT ;WANT TO DEBUG?
CALL SETDEB ;YES - SET DEBUGGER
CALL LSCAN ;LOOP THROUGH LIST
JRST PASS2 ;INSERT SPEC IN FILE
HRROI B,[ASCIZ "/EXE"] ;ASSUME EXECUTE
TXNE P1,F%GO ;IS IT?
CALL TSOUT0 ;YES - DUMP SWITCH
HRROI B,[ASCIZ "/GO"] ;NO - JUST LOAD
CALL TSOUT0 ;DUMP SWITCH
CALL EOLOUT ;AND EOL
CALL CLSTMP ;CLOSE TEMPORARY FILE
TXNE P1,F%SUPP ;AOK?
ERROR <Loading suppressed>
P2XIT: CALL FINCRF ;FINISH UP CREF FILE
SKIPE B,NXPROC ;SEE IF SOMEWHERE TO GO
JRST RUNGO ;YES, GO START COMPILER OR LINK
CALL UNMAP ;UNMAP FREE SPACE USED
CALLRET RLJFNS ;RELEASE JFNS & RETURN IF DONE
;PERFORM RUN AND CCL START ON THE PROCESS
RUNGO: STKVAR <BPTR,CCLJFN,ENT0>
MOVEM B,BPTR ;REMEMBER POINTER TO STRING
CALL TRYGTJ ;TRY TO GET JFN
JRST [ MOVE A,BPTR ;FAILED, GET POINTER TO STRING
ERROR <Can't find %1M - %?>]
MOVEM A,CCLJFN ;REMEMBER JFN OF PROGRAM
CALL ERESET ;RESET
MOVE A,CCLJFN ;SAY WHICH PROGRAM TO LOAD
SETO C, ;FORCE OVERLAY
CALL $GET0 ;DO GET ETC...
CALL DPRARG ;SEND TMP FILES
CALL UNMAP ;UNMAP FREE SPACE USED
CALL SETGO ;SET UP FOR PROGRAM RUNNING
MOVX B,<XWD 1,0> ;INCREMENT 1 INTO VECTOR LOCATION 0
SFRKV ; IS CCL START ADDRESS, START PROCESS
ERJMP RUNGO1 ;FAILED-- TRY TO DO OLD STYLE
JRST WAITF ;WAIT FOR PROCESS TO TERMINATE
;**** Old style CCL start ***** Remove this code sometime ****
;(such as when SFRKV allows XWD 1,0 in AC2 regardless of whether program
;is TOPS10-style)
;
;The following code handles both the case where the "entry vector address" as
;returned by GEVEC is the location of the first instruction of the program,
;and the case where the address is actually that containing a JRST to the
;first instruction.
RUNGO1: CALL GETENT ;GET ENTRY VECTOR
MOVE A,C ;NO, GET ADDRESS OF ENTRY VECTOR
MOVEM A,ENT0 ;REMEMER WHERE ENTRY VECTOR IS
CALL LOADF ;READ WHAT MIGHT BE FIRST INSTRUCTION
CALL CJERRE ;IF CAN'T, SAY WHY AND DIE
HLRZ B,A ;GET LEFT HALF OF WHAT MIGHT BE FIRST REAL INSTRUCTION
CAIE B,(JRST) ;IS IT REALLY FIRST INSTRUCTION?
HRRZ A,ENT0 ;NO, FIRST INSTRUCTION IS THE ENTRY VECTOR!
MOVEI B,1(A) ;INCREMENT TO CREATE CCL ENTRY POINT
CALLRET GOTO2 ;GO START COMPILER
;ROUTINE TO DUMP /MAP AND/OR /SAVE INFO AND SWITCHES
MAPSAV: SKIPN B,MAPPNT ;NEED MAP?
JRST MAPSV1 ;NO - MUST BE SAVE
TLNE B,-1 ;CHECK FOR ARG
CALL TSOUT0 ;OUTPUT ARG
HRROI B,[ASCIZ "/MAP"]
CALL TSOUT0 ;DUMP SWITCH NAME
SKIPN SAVPNT ;/SAVE ALSO?
JRST MAPSVX ;NO - JUST EXIT
CALL CMOUT ;YES - NEED COMMA
MAPSV1: MOVE B,SAVPNT ;NO - MUST BE SAVE FILE
TLNE B,-1 ;NO ARG IF LHS := 0
CALL TSOUT0 ;DUMP IF NECESSARY
HRROI B,[ASCIZ "/SAVE"]
CALL TSOUT0 ;DUMP SWITCH NAME
MAPSVX: MOVEI B,"," ;TERMINATE WITH A COMMA
CALLRET TBOUT ;...
;ROUTINE TO SETUP DEBUG AID IF ANY
SETDEB: HRROI B,[ASCIZ "/DEBUG"]
CALL TSOUT0 ;DUMP LINK SWITCH
TXNN P1,F%LANG ;WAS A LANGUAGE SWITCH SEEN?
JRST TRYDDT ;NO, HOW ABOUT /DDT ?
LDB B,[POINTR(P1,F.LMSK)] ;GET DEFAULT LANG COMPILER NAME
CAIE B,0 ;IF NONE, MOVE ON...
MOVEM B,DEBAID ;OTHERWISE, USE IT TO SELECT DEBUGGER
TRYDDT: MOVEI B,LT.MAC ;BUT FIRST,
TXNE P1,F%DDT ;CHECK FOR /DDT IN COMMAND
MOVEM B,DEBAID ;YES, SO USE REAL DDT INSTEAD!
SKIPN B,DEBAID ;ANYTHING ELSE?
CALLRET SPOUT ;NO
HRRO B,DBTAB(B) ;YES - GET AID NAME
CALL TSOUT0 ;DUMP IT
CALLRET SPOUT ;AND SPACE
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;CALL: CALL LSCAN
; <COROUTINE ADDRS>
; RETURN ON EMPTY LIST
LSCAN: MOVEI P2,LHED ;GET LIST HEAD
LSCAN0: HRRZ P2,LNK(P2) ;LOOK AT NEXT ENTRY
JUMPE P2,RSKP ;SKIP RETURN WHEN DONE
SKIPGE P5,FLG(P2) ;LOAD FLAGS
JRST LSCAN0 ;YES - SKIP IT
HLL P2,SRC(P2) ;LOAD SOURCE POINTER IF ANY
CALL @0(P) ;INVOKE COROUTINE
JRST LSCAN0 ;TRY NEXT
;SRCSCN - ROUTINE TO SCAN ALL SOURCES AND CALL SOURCE COROUTINE
SRCSCN: TLNN P2,-1 ;SINGLE SOURCE?
JRST SRCSC2 ;YES - INVOKE ROUTINE AND RETURN
PUSH P,P2 ;SAVE POINTER
PUSH P,P5 ;AND FLAGS
HLRZ P2,P2 ;GET STARTING POINT
SRCSC1: MOVE P5,FLG(P2) ;LOAD FLAGS
CALL @-2(P) ;CALL COROUTINE
HRRZ P2,LNK(P2) ;LINK TO NEXT
JUMPN P2,SRCSC1 ;PROCEED IF EXISTS
POP P,P5 ;RESTORE FLAGS
POP P,P2 ;AND POINTER
RETSKP ;RETURN, SKIPPING COROUTINE ADDRESS
SRCSC2: CALL @0(P) ;INVOKE COROUTINE
RETSKP ;RETURN, SKIPPING COROUTINE ADDRESS
;PASS1 - DETERMINE WHAT TO COMPILE AND CONSTRUCT COMMAND
PASS1: TXNE P5,D%LINK ;LINK-20 SWITCH?
RET ;YES - IGNORE
MOVNI Q2,1 ;INIT TO -1
CALL SRCSCN ;SCAN SOURCES
JRST P1SRC ;ROUTINE FOR SOURCE ON PASS1
JUMPE Q2,R ;RETURN IF NO SOURCE
SKIPN A,OVER(P2) ;IS THERE A VALID OBJECT FILE?
JRST [TXO P1,F%SUPP ;LOSAGE NOTED
TYPE <?Invalid object file: >
MOVE B,NAM(P2) ;TELL HIM WHAT
CALL DSOUTR ;PRINT SPEC
RET] ;RETURN
TXNN P5,F%CMPL ;FORCED COMPILE?
CAML Q2,A ;COMPARE SOURCE & REL TIMES
CALLRE BLDCOM ;BUILD COMMAND STRING
RET ;DON'T COMPILE
P1SRC: LDB A,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
CAIE A,(P4) ;MATCH?
JRST P1SRCX ;NO - SKIP OVER
JUMPE Q2,P1SRC1 ;IF Q2 IS ZERO WE HAVE ALREADY LOST
CAMG Q2,SVER(P2) ;SAVE LARGEST TO DATE
MOVE Q2,SVER(P2) ;LOAD D/T OR 0
P1SRC1: TXNN P5,D%FNF ;FILE PRESENT?
RET ;YES - RETURN
TXO P1,F%SUPP ;SET SUPPRESSED
TYPE <?Source file missing: >
MOVE B,NAM(P2)
CALL DSOUTR ;FILE NAME & CRLF
P1SRCX: MOVEI Q2,0 ;SAY WE LOST
RET ;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE
PASS2: TXNE P5,D%LINK ;LINK SWITCH
JRST PASS2S ;YES - HANDLE SPECIAL
LDB Q2,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
CAIN Q2,LT.REQ ;DOING BLISS LIBRARY FILE?
RET ;YES, DON'T ATTEMPT TO LOAD IT
SKIPN OVER(P2) ;HAVE REL SOMEWHERE?
JRST [TXO P1,F%SUPP ;LOSAGE NOTED
PUSH P,A ;SAVE JFN
TYPE <?Object file missing: >
MOVE B,NAM(P2) ;TELL HIM WHAT
CALL DSOUTR ;PRINT SPEC
POP P,A ;RESTORE JFN
RET] ;RETURN
TXZE P1,F%NCMA ;NEED COMMA?
CALL CMOUT ;YES - PUT ONE IN
CALL P2SYMS ;DO SYMBOL CODE
CALL PUTDFO ;OUTPUT DEVICE AND FILENAME
JRST PASS2A ;END-OF-SPEC USE REL EXTENSION
LDB Q2,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
CAIN Q2,LT.REL ;LANG TYPE = REL?
TXNN P5,D%EXTN ;EXPLICIT EXTENSION TYPED?
JRST PASS2A ;NO - USE DEFAULT
CALL PROUT ;YES - DUMP PERIOD
CALL PUTDF0 ;REMAINDER OF TYPED EXTENSION
NOP ;IGNORE END-OF-SPEC
JRST PASS2B ;DONE WITH SPEC
PASS2A: HRROI B,[ASCIZ ".REL"] ;DEFAULT EXTENSION
CALL TSOUT0 ;DUMP INTO FILE
PASS2B: TXO P1,F%NCMA ;SAY WE NEED A COMMA
MOVE B,HDDO(P2) ;MOVE IN HDDO
CALL PUTPPN ;DUMP PPN IF NECESSARY
TXNN P5,F%LIB ;WANT LIB FOR THIS?
JRST PASOUT ;DONE
HRROI B,[ASCIZ "/SEARCH"]
CALL TSOUT0 ;YES - DUMP SWITCH
JRST PASOUT ;DONE, SAVE JFN AND RETURN
;PASS2S CALLED TO DUMP LINK SWITCH
PASS2S: MOVEI B,"/" ;OUTPUT SLASH
MOVE Q1,NAM(P2) ;GET STRING POINTER
ILDB Q1,Q1 ;PEEK AT FIRST CHAR
CAIE Q1,"/" ;IS IT A SLASH?
CALL TBOUT ;NO - DUMP ONE
MOVE B,NAM(P2) ;GET STRING
CALL TSOUT0 ;DUMP IT
TXO P1,F%NCMA ;NO COMMA YET
PASOUT: MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET
;ROUTINE TO OUTPUT /LOCAL OR /NOLOCAL ETC...
P2SYMS: TXNE P5,F%LSYM ;Test if /NOSYMBOL given as local switch
JRST P2SYM1 ;yes, force /NOLOCAL switch
TXNN P1,F%LSYM ;local /NOSYMBOL not given, text if global
RET ;no, return with no switches set
TXNN P5,F%LSYM ;was global /NOSYMBOL turned off with local
; /SYMBOL switch?
RET ;yes, return with no special switches set
P2SYM1: HRROI B,[ASCIZ "/NOLOCAL "] ;here when /NOSYMBOL switch given
CALLRET TSOUT0 ;dump switch to link.
;BLDCOM - ROUTINE TO BUILD A COMMAND STRING
;CHECK FOR FILE OPEN FOR THIS LANGUAGE
BLDCOM: SKIPE A,HDDNO(P2) ;GET HDDNO WORD FROM BLOCK
MOVEM A,HDDO(P2) ;IF NON-ZERO, IT SHOULD REPLACE HDDO
; MOVEM P5,FLG(P2) ;UPDATE FLAG WORD
SETOM OVER(P2) ;MARK REL EXISTANCE
SKIPN SIXTAB(P4) ;DOES OLD-STYLE COMPILER EXIST FOR THIS LANGUAGE?
JRST BLDCMN ;NO, SKIP OLD-STYLE
SETZM NATIVF ;SAY WE'RE DOING OLD-STYLE LINE
MOVE A,OLDJFN ;OLDJFN => TMPJFN IN CASE OPNTMP ISN'T CALLED
MOVEM A,TMPJFN
TXNE P1,F%TOPN ;TEMP FILE OPEN?
JRST BLDCM1 ;YES - GO ON
CALL OPNTMP ;OPEN TEMP FILE
MOVEM A,TMPJFN ;SAVE JFN
TXO P1,F%TOPN ;FLAG FILE OPEN
BLDCM1: CALL BILDIT ;DO OLD-STYLE COMMAND LINE
MOVEM A,OLDJFN ;REMEMBER LATEST OLD POINTER
BLDCMN: SKIPN NSXTAB(P4) ;IS THERE A NATIVE VERSION FOR THIS COMPILER?
RET ;NO - DONE
SETOM NATIVF ;MARK THAT WE'RE DOING NEW STYLE
MOVE A,NEWJFN ;SET UP WHICH BYTE POINTER TO USE
MOVEM A,TMPJFN
CALL BILDNC ;BUILD NEW-STYLE COMMAND STRING
MOVEM A,NEWJFN ;REMEMBER POINTER TO NATIVE-STYLE STRING
RET
;SUBROUTINE TO BUILD THE COMMAND LINE FOR A NATIVE COMPILER
BILDNC: MOVE A,TMPJFN ;GET JFN TO OUTPUT TO
TXZ P1,F%NCMA ;SAY NO COMMA HAS BEEN SEEN YET
CALL SRCSCN ;LOOP THROUGH SOURCES
JRST BLDSRN ;(ADDRESS OF COROUTINE FOR SOURCE FILES)
TXNN P5,F%NBIN ;WANT AN OBJECT FILE?
JRST [CALL BILOBN ;YES - OUTPUT IT (AS A SWITCH)
JRST .+3] ;CHECK NEXT SW
HRROI B,[ASCIZ "/NOBINARY"] ;NO, SWITCH FOR NOBINARY
CALL TSOUT0 ;DUMP IT
HRROI B,[ASCIZ "/ABORT"] ;SWITCH FOR ABORT
TXNE P5,F%ABT ;WANT IT?
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ "/MACH"] ;SWITCH FOR MACHINE-CODE
TXNN P5,F%MACH ;WANT IT?
JRST [SKIPN NOMASW ;NO, IS NOMACH SW EXPLICITLY TYPED?
JRST .+2 ;NO, DON'T WRITE
HRROI B,[ASCIZ "/NOMACH"] ;YES, WRITE IT
JRST .+1]
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ "/FLAG"] ;SWITCH FOR FLAG-NON-STANDARD
TXNN P5,F%FLAG ;WANT IT?
JRST [SKIPN NOFGSW ;NO, IS NOFLAG SW EXPLICITLY TYPED?
JRST .+2 ;NO, DON'T WRITE
HRROI B,[ASCIZ "/NOFLAG"] ;YES, WRITE IT
JRST .+1]
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ "/NOWARN"] ;SWITCH FOR NO WARNINGS
TXNN P5,F%NWAR ;YES, WANT IT?
JRST [SKIPN WARNSW ;NO, IS WARN SW EXPLICITLY TYPED?
JRST .+2 ;NO, DON'T WRITE
HRROI B,[ASCIZ "/WARN"] ;YES, WRITE IT
JRST .+1]
CALL TSOUT0 ;YES - DUMP IT
TXNN P5,F%LIST ;WANT LISTING?
JRST [CALL NOCRLI ;NO, SKIP OVER LIST STUFF
JRST BLDNC1]
TXNN P5,F%CREF ;YES - WANT CREF, TOO?
JRST [HRROI B,[ASCIZ "/LIST:LPT:"] ;YES - OUTPUT SWITCH
CAIN P4,LT.PAS ;IS PASCAL PROGRAM?
HRROI B,[ASCIZ "/LIST:"] ;YES,
CALL TSOUT0
CALL PUTDF1 ;DUMP NAME
NOP ;IGNORE EXTENSION
JRST BLDNC1] ;CONTINUE
HRROI B,[ASCIZ "/CREF"]
CALL TSOUT0 ;ELSE JUST PUT IN CREF SWITCH WITH NO FILENAME
BLDNC1: SKIPE B,LSWPTR ;GOT GLOBAL LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
SKIPE B,SWP(P2) ;GOT LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
CALL EOLOUT ;END THE SPECS
MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET ;RETURN
NOCRLI: HRROI B,[ASCIZ "/NOLIST"]
SKIPE NOLISW ;IS NOLIST SW EXPLICITLY TYPED?
CALL TSOUT0 ;YES, WRITE IT
HRROI B,[ASCIZ "/NOCREF"] ;NO,
SKIPE NOCRSW ;IS NOCREF SW EXPLICITLY TYPED?
CALL TSOUT0 ;YES, WRITE IT
RET ;NO, SKIP OVER
;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN NATIVE FORMAT
BLDSRN: MOVEI B,"+" ;FOR NATIVE MODE, PLUS BETWEEN SOURCE SPECS
TXZE P1,F%NCMA ;NEED SEPARATOR?
CALL TBOUT ;YES, PUT IT IN
CALL PUTDF ;OUTPUT DEVICE AND FILE NAME
JRST BLDN1 ;SPEC OVER, NO PERIOD
CALL PROUT ;PUT IN PERIOD
CALL PUTDF0 ;CONTINUE SPEC
NOP ;SHOULD BE OVER BY NOW
BLDN1: TXO P1,F%NCMA ;MAKE SURE SEPARATOR PUT IN IF MORE SPECS
RET ;DONE WITH THIS SPEC
;SUBROUTINE TO BUILD THE COMMAND LINE FOR AN OLD-STYLE COMPILER
BILDIT: MOVE A,TMPJFN ;GET JFN TO OUTPUT TO
TXNE P5,F%NBIN ;WANT OBJECT?
CALL CKCOB ;NO - OUTPUT A HYPHEN IF COBOL
TXNN P5,F%NBIN ;WANT OBJECT?
CALL BILOBO ;YES - OUTPUT OBJECT SPECS
MOVEI B,"," ;SEPARATE WITH A COMMA
CALL TBOUT
TXNN P5,F%LIST ;WANT LISTING?
JRST [CALL CKCOB ;NO - CHECK COBOL
JRST BLDIT1] ;SKIP OVER LIST STUFF
TXNN P5,F%CREF ;YES - WAS A CREF REQUESTED TOO?
JRST [HRROI B,[ASCIZ "LPT:"]
CALL TSOUT0 ;NO - DUMP DEVICE (FOR LIST FILE)
CALL PUTDF1 ;DUMP NAME
NOP ;IGNORE EXTENSION
JRST BLDIT1] ;CONTINUE
MOVE B,CHDD ;OUTPUT CREF FILE TO CONNECTED DIRECTORY
CALL PUTDEV
CALL PUTDF1 ;OUTPUT FILENAME
NOP ;IGNORE
MOVEI D,"C" ;OUTPUT SW
CALL SWOUT ;...
CAIE P4,LT.C68 ;68 COBOL,
CAIN P4,LT.C74 ; OR 74 COBOL?
JRST BLDIT1 ;YES, SO DON'T CREF
CAIE P4,LT.CBL ;IF COBOL
CAIN P4,LT.BLI ; OR BLISS
JRST BLDIT1 ; THEN DON'T CREF
CALL ENTCRF ;ENTER NAME IN CREF FILE
BLDIT1: MOVEI B,"=" ;DELIMIT
CALL TBOUT
TXZ P1,F%NCMA ;SAY NO COMMA SEEN YET
CALL SRCSCN ;LOOP THROUGH SOURCES
JRST BLDSRC ;(ADDRESS OF COROUTINE FOR SOURCE FILES)
SKIPE B,LSWPTR ;GOT GLOBAL LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
SKIPE B,SWP(P2) ;GOT LANGUAGE SWITCHES?
CALL TSOUT0 ;YES - DUMP THEM
CALL EOLOUT ;END OF SPECS
MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET ;RETURN
;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN OLD FORMAT
BLDSRC: TXZE P1,F%NCMA ;NEED COMMA?
CALL CMOUT ;YES - DUMP ONE
CALL PUTDF ;OUTPUT DEVICE & FILE
JRST BSRC1 ;END OF SPEC
CALL PROUT ;DUMP PERIOD
CALL PUTDF0 ;CONTINE SPEC
NOP ;IGNORE
BSRC1: TXO P1,F%NCMA ;SET NEED-COMMA FLAG
MOVE B,HDD(P2) ;GET HACKED DEVICE DESIGNATOR
CALLRET PUTPPN ;DUMP ONE AND RETURN
;SUBROUTINE TO OUTPUT THE OBJECT FILE
;BILOBO: ENTRY FOR OLD-STYLE
;BILOBN: ENTRY FOR NATIVE MODE
BILOBN: HRROI B,[ASCIZ "/OBJECT:"]
CALL TSOUT0 ;NATIVE MODE: OUTPUT OBJECT FILE AS A SWITCH
BILOBO: CALL PUTDFO ;OUTPUT DEVICE AND FILENAME
JRST BLDOB1 ;END OF SPEC
LDB Q2,[POINTR (P5,F.LMSK)] ;GET LANGUAGE TYPE
CAIN Q2,LT.REL ;IS IT "RELOC"?
TXNN P5,D%EXTN ;YES - EXPLICIT EXTENSION?
JRST BLDOB1 ;NO - PROCEED
CALL PROUT ;DUMP PERIOD
CALL PUTDF0 ;Q1 STILL HAS POINTER
NOP ;IGNORE END-OF-SPEC RETURN
BLDOB1: MOVE B,HDDO(P2)
SKIPE NATIVF ;NATIVE COMPILER?
JRST BLDOB2 ;YES - SKIP PPN, BUT DO SWITCHES
CALL PUTPPN ;NO - DUMP PPN
CAIE P4,LT.FOR ;FORTRAN?
RET ;NO - DONE
BLDOB2: HRROI B,[ASCIZ "/OPTIM"] ;SWITCH FOR OPTIMIZE
TXNN P5,F%OPT ;WANT IT
JRST [SKIPN NOOPSW ;NO, IS NOOP SW EXPLICITLY TYPED?
JRST .+2 ;NO, DON'T WRITE
HRROI B,[ASCIZ "/NOOPTIM"] ;YES,
JRST .+1]
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ "/DEBUG"] ;SWITCH FOR DEBUG
TXNN P5,F%DEB ;WANT DEBUG CODE?
JRST [SKIPN NODBSW ;NO, IS NODEB SW EXPLICITLY TYPED?
JRST .+2 ;NO, DON'T WRITE IT
HRROI B,[ASCIZ "/NODEBUG"] ;YES,
JRST .+1]
CALLRET TSOUT0 ;YES - DUMP IT AND RETURN
RET ;NO - JUST RETURN
;ROUTINE TO CHECK FOR COBOL AND OUTPUT A "-" TO THE COMMAND FILE
CKCOB: CAIE P4,LT.C68 ;COBOL 68,
CAIN P4,LT.C74 ; OR COBOL 74?
JRST CKCOB1 ;YES
CAIE P4,LT.CBL ;IS IT COBOL?
RET ;NO - RETURN
CKCOB1: MOVEI B,"-"
CALLRET TBOUT ;YES - DUMP MINUS
;ROUTINE TO PUT PPN IN OUTPUT STREAM
PUTPPN: TLNN B,600000 ;IS THIS A NON-DIRECTORY DEVICE?
TLNN B,777777 ;OR IS THIS THE CONNECTED DIRECTORY?
RET ;YES TO ONE, LEAVE
PUSH P,B ;SAVE ARG
HRROI B,[ASCIZ "[4,"] ;MOVE IN PROJECT NUMBER (ALWAYS 4)
CALL TSOUT0 ;DUMP IT
POP P,B ;GET PPN BACK
HLRZS B ;PUT PROGRAMMER NUMBER IN RHS
LDF C,1B0+10 ;...
NOUT ;MAJIK
CALL CJERR
MOVEI B,"]" ;CLOSE BRACKET
CALLRET TBOUT ;DUMP AND RETURN
;ROUTINE TO ADD NEW FILESPEC TO THINGS THAT NEED CREFING
ENTCRF: PUSH P,A ;SAVE POSIBLE JFN
MOVE A,CSBUFP ;CURRENT POINTER
MOVE B,CHDD ;OUTPUT DEVICE FOR CONNECTED STRUCTURE
CALL PUTDEV ;OUTPUT CURRENT STRUCTURE
MOVE C,A ;MOVE UPDATED POINTER TO C
MOVE Q1,NAM(P2) ;POINTER TO NAME
CALL CPYDF ;COPY FILE NAME
NOP ;IGNORE THIS RETURN
MOVEI B,0 ;TERMINATE STRING
IDPB B,C ;...
CALL CHKCRF ;CHECK AND ENTER IF UNIQUE
POP P,A ;RESTORE ACCUM
RET ;RETURN
;CHECK FOR ALREADY EXISTING FILESPEC
CHKCRF: MOVEI Q1,CRFHED ;POINTER TO HEAD OF LIST
CKCRF1: SKIPN Q2,0(Q1) ;CHECK FOR END OF LIST
JRST CKCRF2 ;END - ENTER NEW STRING
MOVE A,CSBUFP ;POINTER TO STRING TO BE CONSIDERED
MOVE B,1(Q2) ;POINTER TO OLD STRING
STCMP ;COMPARE STRINGS
JUMPE A,R ;MATCH IF ZERO CODE (RETURN)
MOVE Q1,Q2 ;ADVANCE POINTER
JRST CKCRF1 ;TRY NEXT
CKCRF2: MOVEI A,2 ;ALLOCATE CELL
CALL BALLOC ;...
HRRM A,0(Q1) ;LINK TO OLD
MOVE A,CSBUFP ;POINTER TO NEW STRING
CALL BUFFS ;ISOLATE THE STRING
HRRZ B,0(Q1) ;GET ADDRESS OF NEW BLOCK
MOVEM A,1(B) ;STORE POINTER TO STRING IN SECOND WORD OF BLOCK
RET ;RETURN
;ROUTINE TO MERGE EXISTING CREF FILE WITH CORE INFO
FINCRF: SKIPN CRFHED ;ANYTHING NEW?
RET ;NO - THEN DONE
CALL TJNUM ;GO MAKE A FILENAME
MOVEI A,"CR"
DPB A,[POINT 14,FSPEC,34]
MOVE A,[ASCII "E.TMP"]
MOVEM A,1+FSPEC ;COMPLETE NAME
SETZM 2+FSPEC ;MAKE ASCIZ
LDF A,GJ%SHT!GJ%PHY!GJ%OLD
HRROI B,FSPEC ;ARGS FOR GTJFN
CALL GTJFS ;SEE IF FILE EXISTS
JRST DONCRF ;NO - JUST DUMP CORE
LDF B,7B5+1B19 ;BITS FOR READ
OPENF ;OPEN FILE
CALL CJERR ;LOSAGE
PUSH P,A ;SAVE JFN ON STACK
PUSH P,EOFDSP ;SAVE EOF TRAP
MOVEI A,CRFEOF ;NEW ADDRS FOR TRAP
MOVEM A,EOFDSP ;...
;;;; FALL INTO FNCRFN
;HERE TO SCAN FILE FOR SPEC
FNCRFN: MOVE A,-1(P) ;FETCH JFN
FNCRF1: BIN ;READ A CHAR
CAIE B,"=" ;SEARCH FOR BEGINNING OF SPEC
JRST FNCRF1 ;LOOP TILL FOUND
MOVE C,CSBUFP ; " POINTER
FNCRF2: BIN ;GOBBLE CHAR
CAIN B,LF ;LOOK FOR EOL
JRST FNCRF3 ;FOUND - CHECK FOR MERGE
IDPB B,C ;COPY TO STRING SPACE
JRST FNCRF2
FNCRF3: MOVEI B,0 ;REPLACE CR WITH NULL
DPB B,C ;...
CALL CHKCRF ;CALL COMMON CODE
JRST FNCRFN ;LOOK FOR MORE
;HERE ON EOF INTERUPT FROM READING CREF FILE
CRFEOF: POP P,EOFDSP ;RESTORE THIS
MOVE A,0(P) ;GET JFN
TLO A,(1B0) ;RETAIN IT
CLOSF ;CLOSE FILE
CALL CJERR ;NEVER HAPPEN
LDF B,7B5+1B20 ;OPEN FOR WRITE
TLZ A,(1B0) ;CLEAR FLAG
OPENF ;...
CALL CJERR ;SOMETHING WENT WRONG
JRST DNCRF1 ;JOIN WRITE
;ROUTINE TO WRITE OUT NEW CREF FILE
DONCRF: CALL TOPNF ;OPEN TMP FILE IN FSPEC
PUSH P,A ;STACK JFN
DNCRF1: MOVE Q1,CRFHED ;GET LIST HEAD
MOVE A,0(P) ;GET JFN
DNCRF2: MOVEI B,"=" ;EQUAL SIGN
CALL TBOUT ;DUMP IT
MOVE B,1(Q1) ;POINTER TO FILESPEC
CALL TSOUT0 ;DUMP IT NEXT
CALL EOLOUT ; AND CRLF
SKIPE Q1,0(Q1) ;SEE IF MORE
JRST DNCRF2 ;YES - LOOP BACK
POP P,A ;NO - CLOSE OUT FILE
CLOSF ;...
CALL CJERR ;WHOOPS
RET ;ALL DONE - RETURN
;PUTDF - ROUTINE TO OUTPUT FILESPEC AS FOLLOWS:
;OUTPUT DEVICE IF ANY , DUMP FILENAME
; TERMINATE ON FIRST PERIOD OR ; OR NULL.
;NON-SKIP IF FILESPEC TERMINATED (; OR NULL).
;SKIP IF PERIOD FIRST.
;PUTDF0 - IF Q1 ALREADY SET UP
PUTDFO: SKIPA B,HDDO(P2) ;GET HDD FROM HDDO
PUTDF: MOVE B,HDD(P2) ;GET HDD FROM HDD
SKIPE NATIVF ;IN COMPATIBILITY MODE?
TLNE B,600000 ;OR NON-DIRECTORY DEVICE?
JRST [CALL PUTDEV ;YES TO ONE, JUST OUTPUT DEVICE
JRST PUTDF1] ;AND GO OUTPUT FILENAME
TLNN B,-1 ;GOT THE CONNECTED DIRECTORY?
JRST PUTDF1 ;YES - DON'T OUTPUT DEVICE AND DIRECTORY AT ALL
PUSH P,A ;SAVE JFN
PUSH P,B ;AND HDD
HRLI B,600000 ;CHANGE TO DEVICE DESIGNATOR
MOVE A,CSBUFP ;PUT IN CSBUF
DEVST ;GET STRUCTURE STRING
ERCAL CJERRE ;IN CASE ERROR
POP P,B ;RESTORE PPN
HLRZS B ;PUT PROGRAMMER NUM IN RH
HRLI B,4 ;PUT PROJECT 4 IN LH
MOVE C,CSBUFP ;PUT POINTER TO STRUCTURE IN C
POP P,A ;GET BACK JFN
PPNST ;TRANSLATE TO STRING
ERCAL CJERRE ;IN CASE ERROR
PUTDF1: MOVE Q1,NAM(P2) ;USE FILENAME POINTER
PUTDF0: PUSH P,[TBOUT] ;ROUTINE TO USE
PUTDFC: ILDB B,Q1 ;GET CHAR
SKIPE B ;LOOK FOR NULL
CAIN B,";" ; OR SEMICOLON
JRST PTDFR ;GIVE RETURN (END-OF-SPEC)
CAIN B,"." ;PERIOD?
JRST PTDFR1 ;YES - RETURN NOW
CALL @0(P) ;NO - DUMP CHAR
JRST PUTDFC ;CONTINUE
PTDFR1: AOS -1(P) ;SET FOR SKIP RETURN
PTDFR: POP P,0(P) ;PRUNE PDL
RET ;AND RETURN
;ROUTINE LIKE PUTDF0 ONLY COPIES TO CORE
CPYDF: PUSH P,[CPYDF1] ;ROUTINE TO USE
JRST PUTDFC ;JOIN COMMON CODE
CPYDF1: IDPB B,C ;POINTER IN C
RET
;ROUTINE TO OUTPUT DEVICE FROM HDD TO DEVICE DESIGNATOR IN A
PUTDEV: TLC B,600000 ;CHANGE PROJECT NUMBER LH TO 600000+.DVDSK
TLCE B,600000
HRLI B,600000 ;NOTE: .DVDSK = 0
DEVST ;COPY THE DEVICE NAME
ERCAL JERRE ;HORRIBLE ERROR
MOVEI B,":" ;OUTPUT A COLON
CALLRET TBOUT ;AND RETURN
;OPEN TMP CORE FILE
OPNTMP: AOS A,NFILES ;INCREASE NUMBER OF TMP FILES BY ONE
CAIN A,1 ;FIRST ONE?
JRST OPNT2 ;YES
MOVE B,ADDTAB-2(A) ;NO, IT STARTS RIGHT AFTER LAST ONE
ADD B,TMPCOR(B) ;GET ADDRESS OF NEXT FILE
AOJ B, ;LENGTH DOESN'T INCLUDE HEADER
OPNT1: HRRZM B,ADDTAB-1(A) ;REMEMBER STARTING ADDRESS OF TMP FILE
HLLZ C,SIXTAB(P4) ;GET NAME OF TMP FILE, MAC, FOR, LNK ETC.
SKIPE NATIVF ;DOING NATIVE-STYLE?
HLLZ C,NSXTAB(P4) ;YES, GET CORRECT NAME FOR NATIVE COMPILER
MOVEM C,TMPCOR(B) ;STORE NAME IN LEFT HALF OF FIRST WORD
MOVEI A,TMPCOR+1(B) ;MAKE BYTE POINTER TO SECOND WORD OF
HRLI A,440700 ;FILE
RET ;GIVE CALLER THE BYTE POINTER ("JFN")
OPNT2: SETZM ADDTAB ;CLEAR BUFFER
MOVE B,[ADDTAB,,ADDTAB+1]
BLT B,BUF1-1
MOVEI B,TMPBUF-TMPCOR ;ASSUME FIRST ONE
JRST OPNT1
;CLOSE TEMP FILE
CLSTMP: MOVE B,NFILES
MOVE C,ADDTAB-1(B) ;GET BEGINNING OF FILE ADDRESS
MOVEI D,0 ;END WITH A NULL
CLSTM1: IDPB D,A ;FILL REST OF WORD WITH NULLS
TLNE A,(76B5) ;AT END OF WORD?
JRST CLSTM1 ;NO, LOOP BACK TIL DONE
SUBI A,TMPCOR(C) ;CALCULATE LENGTH OF FILE
HRRM A,TMPCOR(C) ;REMEMBER LENGTH
RET
;ROUTINE TO ATTEMPT TO OPEN FILE IN FSPEC
TOPNF: LDF A,GJ%SHT!GJ%FOU!GJ%PHY!GJ%TMP
HRROI B,FSPEC ;POINT TO FILESPEC
CALL GTJFS ;GET A JFN
CALL CJERR ;TEMP FILE LOSAGE
LDF B,7B5+1B20 ;BYTE SIZE + WRITE
OPENF ;OPEN FILE
CALL CJERR ;TEMP FILE LOSAGE
RET ;RETURN
TJNUM: MOVEI Q1,3 ;NEED TO MAKE TMP FILE
MOVE A,CSJOB ;GET JOB #
TJNM1: IDIVI A,^D10 ;DIVIDE INTO DIGITS
ADDI B,"0" ;CONVERT TO ASCII
LSHC B,-7 ;SHIFT OVER
SOJG Q1,TJNM1 ;LOOP
MOVEM C,FSPEC ;PUT IN BLOCK
RET ;RETURN
SUBTTL PARSE
;The CMPRES routine tidies up command strings for the COMPILE-class
;commands. Lots of these petty chores are normally handled by the monitor
;via the COMND jsys. However, since the PARSE routine doesn't use COMND,
;this CMPRES routine is needed.
;CMPRES does the following:
;
; o Carriage returns are ignored. Linefeeds are changed to
; commas. This is so that multiple-line indirect files work.
;
; o All multiple spaces are compressed to at most one space
;
; o Any spaces following end of line are
; deleted. Neglecting to remove spaces at end of line causes
; "COMP FOO.MAC " to force a compilation.
;
; o Spaces preceding percent signs are deleted.
; If spaces aren't removed in front of percent, the command
; LOAD FOO %"text" fails to call the compiler!
; o Comments enclosed in exclams (!) are removed
;
; o Comments starting with semicolon (;) last through the next
; linefeed or end of command
;
; o All spaces other than those sandwiched between filespecs
; are removed.
;Accepts: AC1/ Pointer to command string
C%PLUS==1B0 ;LAST NON-SPACE WAS NOT A FILESPEC CONSTITUENT
CMPRES: MOVEI A,CMPWDS ;INITIALLY ALLOCATE ENTIRE BUFFER FOR COMMAND
CALL GETBUF
MOVEM A,CMPBUF ;REMEMBER ADDRESS OF BLOCK
ADDI A,CMPWDS-1 ;GET LAST ADDRESS IN BLOCK
SETZM (A) ;GUARANTEE NULL AT END OF STRING
HRLI A,100700 ;GET STARTING POINTER IF STRING WERE 0 BYTES
MOVEM A,CMPPT0 ;REMEMBER POINTER TO NULL COMMAND
MOVE A,.RDIOJ+CSTXTB ;GET POINTER TO COMMAND STRING
CALL BCOUNT ;SEE HOW MANY CHARACTERS ARE IN IT
MOVEI C,1(B) ;LEAVE ROOM FOR NULL
CAILE C,CMPMSZ ;MAKE SURE THERE'S ROOM FOR COMMAND STRING
ERROR <COMPIL-class command string is too long>
MOVEM C,CMPSIZ ;REMEMBER INITIAL SIZE OF STRING
MOVN A,B ;GET NEGATIVE NUMBER OF CHARACTERS
MOVE C,A ;REMEMBER NEGATIVE COUNT FOR SOUT JSYS
ADJBP A,CMPPT0 ;GET ACTUAL STARTING BYTE POINTER FOR COMMAND
MOVEM A,CMPPT0 ;REMEMBER STARTING POINTER
MOVEM A,CSPTR ;INITIALIZE SOURCE POINTER
MOVEM A,CDPTR ;INITIALIZE DESTINATION POINTER
MOVE B,.RDIOJ+CSTXTB ;GET POINTER TO COMMAND STRING
SOUT ;CREATE INITIAL COMMAND (BEFORE EXPANDING INDIRECT FILES!)
MOVX Z,C%PLUS ;FORCE LEADING SPACES TO BE FILTERED OUT
CALL REMNUL ;REMOVE NULLS FROM COMMAND
CMP2: CALL GCMC ;GET CHARACTER, STRIP COMMENT IF SEEN
CAIE A,.CHTAB ;TABS ARE THE SAME AS SPACES
CAIN A," " ;A SPACE?
JRST CMP1 ;YES, GO HACK IT
CMP4: IDPB A,CDPTR ;NOT A SPACE, STORE IT IN NEW STRING
JUMPE A,CMPDON ;DONE IF NULL
TXZ Z,C%PLUS ;FIRST ASSUME FILEPSEC CHARACTER
CALL SKPFCH ;IS CHARACTER A FILESPEC CHARACTER?
TXO Z,C%PLUS ;NO, REMEMBER
JRST CMP2 ;GO BACK FOR REST OF CHARACTERS
CMPDON: MOVE A,CMPPT0 ;GET RESULTANT STARTING POINTER
MOVEM A,.RDIOJ+CSTXTB ;PLACE IN TEXTI BLOCK
HRRZ A,A ;KEEP FIRST ADDRESS USED
SUB A,CMPBUF ;CALCULATE NUMBER OF WORDS UNUSED
MOVE B,CMPBUF ;TELL RETBUF WHERE THE BLOCK IS
CALLRET RETBUF ;RETURN THE UNUSED WORDS AND EXIT
CMP1: CALL GCMC ;GET CHARACTER AFTER SPACE
CAIE A,.CHTAB ;TABS ARE THE SAME AS SPACES
CAIN A," " ;MULTIPLE SPACES?
JRST CMP1 ;YES, SEARCH FOR FIRST NON-SPACE
TXNE Z,C%PLUS ;WAS CHARACTER BEFORE SPACES A NON-FILE CHARACTER?
JRST CMP4 ;YES, SO LEAVE OUT THE SPACES
JUMPE A,CMP4 ;THROW AWAY TRAILING SPACES
CALL SKPFCH ;SKIP IF CHARACTER IS A FILE CHARACTER
JRST CMP7 ;NOT A FILE CHARACTER, SO THROW AWAY SPACES
MOVEI A," " ;SPACE SANDWICHED BETWEEN FILESPECS, LEAVE IT IN
IDPB A,CDPTR
CMP7: LDB A,CSPTR ;GET THE FILE CHARACTER BACK
JRST CMP4
;SKPFCH SKIPS IF CHARACTER IS A FILE CONSTITUENT FOR COMPIL-CLASS COMMANDS.
;
;ACCEPTS: A/ CHARACTER
;
;RETURNS: +1: CHARACTER IS NOT PART OF A FILESPEC
; +2: CHARACTER IS PART OF A FILESPEC
SKPFCH: IDIVI A,4*8 ;GET INDEX AND OFFSET
MOVE B,BITS(B) ;GET BIT POSITION
TDNE B,NFLBTS(A) ;SKIP IF BIT NOT ON
RET ;BIT ON, CHARACTER IS NOT PART OF FILESPEC
RETSKP ;CHARACTER IS PART OF FILESPEC, SKIP.
;TABLE OF CHARACTERS NOT INCLUDED IN COMPIL-CLASS FILESPECS. THERE ARE
;FOUR WORDS, EACH OF WHICH CONTAINING 32 LEFT-JUSTIFIED BITS, YIELDING A TOTAL
;OF 128 BITS, ONE FOR EACH POSSIBLE CHARACTER. THE BIT IS ON IF THE CHARACTER
;IS NOT PART OF A FILESPEC
NFLBTS: BRMSK. FILB0.,FILB1.,FILB2.,FILB3.,,<%> ;PERCENT IS PART OF A LINK SWITCH
;GET CHARACTER, STRIP COMMENT OR CARRIAGE RETURN IF SEEN
GCMC: ILDB A,CSPTR ;LOOK AT CHARACTER FROM OLD STRING
CAIN A,"-" ;CHECK THE LINE-CONTINUATION "-"
JRST [MOVE D,A ;YES, MAY BE, SO SAVE THE CHARACTER
ILDB A,CSPTR ;LOAD NEXT BYTE
CAIE A,.CHCRT ;IS CR ?
JRST ADJBP1 ;NO, IT IS NOT A LINE-CONTINUATION "-"
ILDB A,CSPTR ;YES, LOAD THE NEXT BYTE
CAIE A,.CHLFD ;IS LF ?
JRST ADJBP2 ;NO, IT IS NOT A LINE-CONTINUATION "-"
JRST GCMC] ;YES, STRIP THE LINE-CONTINUATION
JRST CMIND ;NO, IT IS NOT A LINE-CONTINUATION
ADJBP1: MOVEM D,A ;RESTORE THE BYTE "-"
MOVNI C,1 ;
IBP C,CSPTR ;ADJUST THE SOURCE POINTER BACKWARD BY 1
MOVEM C,CSPTR ;
JRST CMIND ;
ADJBP2: MOVEM D,A ;RESTORE THE BYTE "-"
MOVNI C,2 ;
IBP C,CSPTR ;ADJUST THE SOURCE POINTER BACKWARD BY 2
MOVEM C,CSPTR ;
JRST CMIND ;
CMIND: CAIN A,"@" ;INDIRECT FILE?
JRST GCMIND ;YES, GO STUFF IT INTO THE STRING
CAIN A,.CHCRT ;CARRIAGE RETURN
JRST GCMC ;YES, IGNORE IT
CAIN A,"""" ;QUOTED STRING?
JRST GCMQT ;YES, FIND THE END OF IT
CAIE A,"," ;COMMA IS SAME AS LINEFEED!
CAIN A,.CHLFD ;END OF LINE?
JRST GCMLF ;YES
CAIN A,";" ;IS REST OF LINE A COMMENT?
JRST CMP6 ;YES, GO FIND END OF LINE
CAIN A,"!" ;INTERNAL COMMENT IN LINE?
JRST CMP5 ;YES,
CAIN A,"%" ;NO, IS IT A % SIGN?
JRST CMPER ;YES,
RET ;NO
CMP5: ILDB A,CSPTR ;YES, FIND END OF IT
JUMPE A,R ;IF COMMAND ENDS BEFORE COMMENT, CATCH IT.
CAIN A,.CHLFD ;END OF LINE SEEN?
JRST GCMLF ;YES, ENDS COMMENT AND ACTS AS END OF LINE
CAIE A,"!" ;END OF COMMENT YET?
JRST CMP5 ;NO, KEEP LOOKING
JRST GCMC ;COMMENT OVER, READ NEXT CHARACTER
CMP6: ILDB A,CSPTR ;REST OF LINE IS COMMENT, FIND END OF LINE
JUMPE A,R ;NULL MEANS END OF LINE
CAIN A,.CHLFD ;END OF LINE SEEN?
JRST GCMLF ;YES, ENDS COMMENT AND ACTS AS END OF LINE
JRST CMP6 ;KEEP LOOKING FOR END OF LINE
;GET HERE WHEN ATSIGN (@) SEEN IN COMMAND STRING. SHOVE EVERYTHING TO
;THE LEFT OF IT MORE TO THE LEFT, SO THE INDIRECT FILE'S CONTENTS MAY BE
;STUFFED IN INSTEAD OF THE ATSIGN AND THE FILESPEC
GCMIND: HRROI A,[ASCIZ "CMD"] ;DEFAULT EXTENSION
MOVEM A,CJFNBK+.GJEXT ;GOOD PLACE
MOVE A,[377777,,377777]
MOVEM A,CJFNBK+.GJSRC ;NO EXTRA INPUT
LDF A,GJ%OLD ;PREPARE FOR GTJFN
MOVEM A,CJFNBK ;STORE
MOVEI A,CJFNBK ;POINT TO BLOCK
MOVE B,CSPTR ;POINTER TO STRING
CALL GTJFS ;GET A JFN
CALL [ MOVE B,CSPTR ;FAILED, TRY TO GET PARSE-ONLY JFN
MOVE Q1,A ;REMEMBER ERROR CODE
MOVX A,GJ%OFG ;SAY WE WANT NAME ONLY
MOVEM A,.GJGEN+CJFNBK
MOVEI A,CJFNBK
CALL GTJFS ;ATTEMPT PARSE-ONLY
CALL [ MOVE A,Q1 ;FAILED, GET ORIGINAL ERROR
ERROR <Can't access indirect file - %1?>]
MOVE B,Q1 ;GOT A JFN, GET THE ERROR CODE
ERROR <Can't access indirect file %1S - %2?>]
MOVNI C,1
ADJBP C,B ;KEEP CHARACTER AFTER FILESPEC
MOVEM C,CJEPTR ;REMEMBER POINTER TO END OF FILESPEC
LDF B,7B5+OF%RD ;BITS FOR OPENF
MOVEM A,INDJFN ;REMEMBER INDIRECT JFN
OPENF ;OPEN FILE
CALL CJERR ;WHOOPS
MOVE B,[2,,.FBBYV] ;WE WANT BYTE SIZE AND NUMBER OF BYTES
MOVEI C,C ;READ INFO INTO C AND D
GTFDB
ERCAL [ERROR <Can't determine size of indirect file %1S>]
LOAD C,FB%BSZ,C ;ISOLATE THE BYTE SIZE
MOVE A,[440000,,1] ;GET BYTE POINTER TO 0TH BYTE IF BYTE SIZE WAS 0
DPB C,[300600,,A] ;NOW A HAS BYTE POINTER TO 0TH BYTE
ADJBP D,A ;GET POINTER TO LAST BYTE IN D
HRRZ A,D ;REMEMBER NUMBER OF WORDS
LDB C,[360600,,D] ;GET NUMBER OF UNUSED BITS IN LAST WORD
SOJ C, ;BIT 35 IS UNUSED FOR ASCII
IDIVI C,7 ;SEE HOW MANY ASCII BYTES ARE UNUSED IN LAST WORD
IMULI A,5 ;GET MAXIMUM NUMBER OF ASCII CHARACTERS
SUB A,C ;GET RID OF UNUSED CHARACTERS
MOVEM A,INDSIZ ;REMEMBER TOTAL NUMBER OF ASCII CHARACTERS
MOVNI A,1
ADJBP A,CSPTR ;BACKUP ONE FROM CURRENT TO FLUSH THE ATSIGN
MOVEM A,CSPTR ;STORE SO THAT FIRST CHARACTER OF INDIRECT FILE GETS SEEN
MOVE B,CJEPTR ;GET POINTER TO END OF FILESPEC
CALL SUBBP ;GET NEGATIVE CHARACTERS FILESPEC AND ATSIGN TAKES
ADD A,INDSIZ ;ADD TO SPACE NEEDED BY INDIRECT FILE TO GET DISTANCE STUFF HAS TO BE SHUFFLED
MOVEM A,ADDSIZ ;REMEMBER ADDITIONAL SIZE OF COMMAND
MOVE B,CMPPT0 ;GET POINTER TO BEGINNING OF STRING
MOVE A,CSPTR ;GET POINTER TO BEFORE ATSIGN
CALL SUBBP ;CALCULATE LENGTH OF STRING TO MOVE
MOVN C,A ;TELL SOUT TO MOVE EXACTLY THAT NUMBER OF CHARACTERS
MOVE A,ADDSIZ ;GET ADDITIONAL SIZE (MIGHT BE NEGATIVE!)
ADDB A,CMPSIZ ;GET TOTAL NEW SIZE OF COMMAND STRING
SKIPGE ADDSIZ ;IS COMMAND STRING SHRINKING?
JRST GSHRNK ;YES, CONTENTS IS SHORTER THAN FILEPSEC!
CAILE A,CMPMSZ ;STILL LESS THAN MAXIMUM ALLOWED?
ERROR <Indirect file too large or too many indirect files>
MOVN A,ADDSIZ ;GET NEGATIVE AMOUNT WE HAVE TO MOVE THE COMMAND
ADJBP A,CMPPT0 ;BACKUP POINTER TO GET NEW BEGINNING
MOVE B,CMPPT0 ;MOVE FROM OLD BEGINNING
MOVEM A,CMPPT0 ;REMEMBER NEW BEGINNING
CAIE C,0 ;DON'T GIVE SOUT 0, SINCE IT DOESN'T MEAN 0 BYTES
SOUT ;SHOVE FIRST PORTION TO THE LEFT
MOVE B,A ;B NOW HAS PLACE WHERE INDIRECT FILE GOES
MOVE A,INDJFN ;SAY WHAT CHANNEL INDIRECT FILE IS ON
MOVN C,INDSIZ ;PREPARE TO READ EXACT NUMBER OF CHARACTERS
CALL GEOFQ ;DO SIN AND CHECK FOR EOF
JUMPN C,[MOVE A,CJEPTR ;SIN STOPPED SHORT. GET POINTER TO COMMAND BEYOND THE INDIRECT SPEC
MOVEI C,0 ;STOP ON NULL
SIN ;SLIDE STUFF LEFT TO FILL GAP AFTER INDIRECT FILE CONTENTS
JRST .+1]
MOVN A,ADDSIZ ;GET NEGATIVE AMOUNT WE MOVED STRING
ADJBP A,CDPTR ;FIX DESTINATION POINTER TO ACCOUNT FOR MOVED STRING
MOVEM A,CDPTR ;REMEMBER FIXED POINTER
MOVN A,ADDSIZ ;FIX SOURCE POINTER
ADJBP A,CSPTR
MOVEM A,CSPTR ;STORE FIXED SOURCE POINTER
GCOMMN: CALL RJFN ;CLOSE INDIRECT FILE SO THAT HAVING MANY LEVELS DOESN'T RUN OUT OF JFNS
CALL REMNUL ;REMOVE ANY NULLS THAT WERE IN INDIRECT FILE
JRST GCMC ;CONTINUE PARSING WITH CONTENTS OF INDIRECT FILE
GCMQT: IDPB A,CDPTR ;SAVE QUOTED STRING
GCQ1: ILDB A,CSPTR ;QUOTED STRING, FIND ITS END
CAIE A,"""" ;FIND THE END YET?
JRST GCMQT ;NO, KEEP LOOKING
RET
;REMNUL USES CSPTR AS POINTER TO "REST" OF UNCOMPRESSED STRING AND REMOVES
;ANY NULLS EXCEPT THE ONE TERMINATING THE STRING. THE REASON WE DON'T MERELY
;STRIP NULLS AS WE SCAN THE STRING, IS THAT WHEN ATSIGN IS SEEN, GTJFN IS
;SCANNING, SO WE MUST MAKE SURE WE STRIP AT LEAST THOSE NULLS THAT MAY FALL
;WITHIN A FILESPEC.
REMNUL: MOVE A,CSPTR ;START SCANNING HERE
MOVE B,CSPTR ;STORE NON-NULLS WITH B POINTER
REMN1: ILDB C,A ;PICK UP NEXT CHARACTER FROM COMMAND STRING
IDPB C,B ;STORE IT, NULL OR NOT.
JUMPN C,REMN1 ;JUST CONTINUE IF NON-NULL
MOVE C,CMPSIZ ;NULL FOUND, CALCULATE POINTER TO END OF STRING
ADJBP C,CMPPT0
CAMN B,C ;IS THIS NULL AT END OF STRING?
RET ;YES, WE'RE DONE
MOVNI C,1 ;STRING DIDN'T END, BACK UP DESTINATION POINTER
ADJBP C,B
MOVE B,C ;CAUSE INTERNAL NULL TO BE OVERWRITTEN
SOS CMPSIZ ;REMEMBER REDUCED SIZE TOO
JRST REMN1 ;LOOP FOR CHARACTERS AFTER INTERNAL NULL
;HERE DURING INDIRECT PROCESSING IF INDIRECT FILE CONTENTS IS SHORTER THAN
;ITS NAME. HANDLE THIS BY COPYING THE INDIRECT FILE CONTENTS OVER THE FILESPEC
;AND THEN SLIDING THE REMAINDER OF THE COMMAND STRING TO THE LEFT
GSHRNK: MOVE A,INDJFN ;GET HANDLE OF INDIRECT FILE
MOVE B,CSPTR ;COPY OVER THE ATSIGN AND FILESPEC
MOVN C,INDSIZ ;INPUT EXACT NUMBER OF CHARACTERS
CALL GEOFQ ;DO SIN AND CHECK FOR EOF
MOVE A,CJEPTR ;NOW INPUT CHARACTERS STARTING AFTER FILESPEC
MOVEI C,0 ;READ UNTIL NULL FOUND
SIN ;SLIDE STUFF LEFT THAT WAS AFTER INDIRECT SPEC
JRST GCOMMN ;JOIN COMMON CODE
;GEOFQ DOES SIN AND VERIFIES THAT THE FAILING SIN JSYS READING THE INDIRECT FILE WAS DUE
;TO EOF. THIS IS EXPECTED IF THE INDIRECT FILE HAS LINE NUMBERS.
;
;RETURNS +1 EOF WAS THE CAUSE OF THE ERROR. ALL AC'S PRESERVED.
; NEVER IF SOME STRANGE ERROR OCCURRED
GEOFQ: SIN ;READ ENTIRE FILE
ERJMP .+2 ;FAILED, GO INVESTIAGE
RET ;SUCCEEDED, RETURN
ADDM C,CMPSIZ ;FIX COMMAND SIZE. C WILL BE NEGATIVE IF LINE NUMBERS IN INDIRECT FILE
SAVEAC <A,B,C,D> ;SAVE WHAT THE SIN JSYS RETURNED
CALL DGETER ;GET THE ERROR CODE
CAIE A,IOX4 ;END OF FILE REACHED?
CALL CJERRE ;NO, SO BOMB OUT
RET ;YES, SO RETURN GOOD
;COME HERE IF COMMA OR LF. WE MUST FILTER OUT MULTIPLE COMMAS, SINCE CRLF AT THE
;END OF INDIRECT FILES GENERATES ONE COMMA, AND THEN THE COMMA IN THE COMMAND
;FOLLOWING THE INDIRECT SPEC WOULD CAUSE A MULTIPLE ONE.
GCMLF: MOVE B,CDPTR
CAMN B,CMPPT0 ;IS LINEFEED AT BEGINNING OF COMMAND?
JRST GCMC ;YES, SO IGNORE IT
LDB A,CDPTR ;LINEFEED IS USUALLY COMMA, BUT SEE IF COMMA ALREADY
CAIN A,"," ;DO WE ALREADY HAVE A COMMA?
JRST GCMC ;YES, IGNORE THIS LINEFEED
MOVEI A,"," ;TREAT END OF LINE AS COMMA
DPB A,CSPTR ;STORE IN SOURCE STRING IN FOR LDB INSTRUCTION
RET ;ACCOUNT FOR COMMA
;COME HERE IF "%" SIGN SEEN. WE HAVE TO OUTPUT A COMMA PRECEEDING THE "%" SIGN.
;BUT IF THERE IS AN INDIRECT FILE BEFORE THE "%" SIGN, DON'T WORY ABOUT IT.
CMPER: LDB Q1,CDPTR ;LOAD THE LAST OUTPUT CHARACTER
CAIN Q1,"," ;IS IT A COMMA?
RET ;YES, FORGET ABOUT IT
SETO B, ;GET -1
ADJBP B,CMPPT0 ;ADJUST POINTER TO STRING BACK ONE CHAR
MOVEM B,CMPPT0 ;SAVE THIS AS ORIGINAL BYTE POINTER
MOVE A,CDPTR ;GET POINTER TO DESTINATION BYTE
CALL SUBBP ;GET NUMBER OF BYTES TO MOVE
SOJ A, ;ADJUST BY ONE
MOVN C,A ;TELL SOUT EXACT NUMBER OF BYTES TO MOVE
MOVE A,CMPPT0 ;WHERE TO MOVE STRING TO
MOVE B,CMPPT0 ;GET NEW START OF STRING
IBP B ;MAKE OLD START OF STRING
SKIPGE C ;DON'T DO SOUT IF ZERO!
SOUT% ;MOVE THE STRING BACKWARDS
MOVEI B,"," ;GET A COMMA
IDPB B,A ;STORE IT BEFORE "%"
MOVEI A,"%" ;GET BACK '%'
AOS CMPSIZ ;ACCOUNT FOR THE NEW COMMA
RET ;DONE. CONTINUE PROCESSING
;MAIN PARSER
PARSE: CALL RDFLD ;HERE TO READ A FIELD
PARSE2: JRST XTAB(A) ;TRANSFER ON BREAK TYPE
;TRANSFER TABLE FOR CHARACTER TYPE DISPATCH
XTAB: ERROR <Illegal character in command> ;0 - ILLEGAL
JRST RDSPAC ;1 - SPACE SEEN
JRST RDPLUS ;2 - PLUS SEEN
JRST RDSLSH ;3 - SLASH SEEN
ERROR <Illegal character in command> ;4 - ILLEGAL
ERROR <Illegal character in command> ;5 - ILLEGAL
JRST RDCOMA ;6 - COMMA SEEN
RET ;NULL IS END OF COMMAND
ERROR <Illegal character in command> ;10 - ILLEGAL
JRST RDPERC ;11 - PERCENT SEEN
JRST RDCOLN ;12 - COLON SEEN
JRST RDQS ;13 - QUOTED STRING STARTING
ERROR <Illegal character in command> ;14 - ILLEGAL
ERROR <Illegal character in command> ;15 - ILLEGAL
ERROR <Illegal character in command> ;16 - ILLEGAL
;HERE TO HANDLE QUOTED STRING
RDQS: MOVE A,P4 ;GET POINTER TO SWITCH
CALL SWMOV ;SAVE SWITCH STRING IN FSPEC
CALL RDQOT1 ;READ QUOTED STRING (OPEN QUOTE ALREADY SEEN)
MOVEM A,SAVQS ;REMEMBER POINTER TO QUOTED STRING
HRROI A,FSPEC ;POINT TO THE SAVED SWITCH
CALL DOSWI0 ;HANDLE THE PARTICULAR SWITCH
TXZ P1,F%SLSH ;SAY WE ARE DONE PROCESSING THE SWITCH
TXO P1,F%CMOK ;SAY NULL SPEC IS OK
JRST PARSE ;GO READ THE NEXT ITEM IN THE COMMAND
;HERE TO PROCESS COLON (MAY BE SWITCH DELIM OR DEVICE)
RDCOLN: CAIG P3,1 ;ANYTHING?
ERROR <Null spec before colon>
CALL CAPND ;APPEND COLON TO BUFFER
CAIE A,0 ;SPECIAL CHARACTER?
JRST XTAB(A) ;YES, DISPATCH
JRST [TXO P1,F%LAHD ;NO, MAY BE A FILESPEC
JRST RDSPAC]
CAPND: MOVEI Q1,":" ;REPLACE DELIMITER
CAPND1: DPB Q1,3+CSTXTB ;IN BUFFER
PUSH P,P3 ;SAVE COUNT
CALL RDFLDN ;SPECIAL READ
ADDM P3,0(P) ;UPDATE COUNT
POP P,P3 ;PRUNE PDL
RET ;RETURN
;HERE TO PROCESS LINK SWITCH SPEC
RDPERC: CAILE P3,1 ;BETTER STAND ALONE
JRST RDSLH1 ;ELSE MAY BE LOCAL SW
MOVEI A,L.SIZE ;SIZE FOR L20 SWITCH
CALL BALLOC ;ALLOCATE BLOCK
HRRM A,LNK(P2) ;LINK TO NEW BLOCK
MOVE P2,A ;UPDATE AC P2
CALL RDQUOT ;READ QUOTED STRING
MOVEM A,NAM(P2) ;STORE STRING POINTER
LDF Q2,D%LINK ;SAY LINK SWITCH
IORM Q2,FLG(P2) ;...
TXO P1,F%CMOK ;SAY NULL SPEC OK
JRST PARSE ;CONTINUE
;HERE TO PROCESS COMMA (MUST HAVE COMPLETE FILESPEC NOW)
RDCOMA: TXZE P1,F%SLSH ;SWITCH FIELD?
JRST RDCMA3 ;YES - PROCESS
CAILE P3,1 ;DO WE HAVE AN ATOM?
JRST [CALL FILBLK ;YES - GEN BLOCK
TXZ P1,F%FILE ;DONE WITH THIS SPEC
JRST RDCMA1] ;PROCEDE
TXNN P1,F%CMOK ;NULL ATOM - IS IT OK?
JRST PARSE ;NO, MUST BE END OF INDIRECT FILE
RDCMA1: SETZM GJNSF ;CLEAR GJ%NS FLAG (ONLY HERE MUST ATOM BE DONE)
TXZ P1,F%CMOK ;CLEAR FLAG FOR NULL SPEC
SKIPN Q1,SRCSAV ;DID WE HAVE SEPARATE SOURCES
JRST [MOVE A,FLG(P2) ;NO, CHECK TO SEE IF LINK SWITCH
TXNN A,D%LINK ;IF LINK SWITCH, DON'T STORE
SKIPGE A,RELDAT;IF NOT LINK SWITCH, STORE IF GE 0
JRST RDCMA2 ;DON'T STORE, GO SET UP LANG TYPE
MOVEM A,OVER(P2) ;STORE
JRST RDCMA2] ;GO SET UP LANG TYPE
MOVE B,BAKPTR ;GET PREVIOUS BLOCK POINTER
TXNE P1,F%OBJ ;HAVE OBJECT?
SETZM LNK(B) ;YES - CLEAR OLD SRC LINK
TXZN P1,F%OBJ ;CHECK FOR OBJ GIVEN
CALL MAKOBJ ;MAKE OBJECT BLOCK
HRLM Q1,SRC(P2) ;POINTER TO SOURCE LIST
HLRZ Q1,SRCSAV ;POINTER TO LAST OBJ BLOCK
HRRM P2,LNK(Q1) ;POINT TO NEW ONE
MOVEI Q2,LT.REL ;MARK AS RELOC
DPB Q2,[POINTR (<FLG(P2)>,F.LMSK)]
SETZM SRCSAV ;CLEAR POINTER
RDCMA2: SKIPGE B,LPROC ;HAVE A PROCESSOR?
LDB B,[POINTR (P1,F.LMSK)] ;USE DEFAULT
SETOM LPROC ;CLEAR THIS NOW
MOVE Q1,B ;COPY TYPE
CAIE Q1,LT.REL ;NO DEBUG AID FOR REL FILES
CAIN Q1,LT.MAC ; OR MACRO
MOVEI Q1,0 ;YES - NO AID FOR YOU
CAIN B,LT.SAI ;IF SAIL
SETOM SAILF ;SAY WE HAVE SEEN SAIL
CAMLE Q1,DEBAID ;CHECK BEST SEEN SO FAR
MOVEM Q1,DEBAID ;SAVE BETTER
PUSH P,P2 ;SAVE THIS POINTER
HLL P2,SRC(P2) ;POINTER TO SOURCE LIST
MOVE P5,FLG(P2) ;GET FLAGS
MOVEI Q2,0 ;INIT REG
CALL SRCSCN ;LOOP THROUGH SOURCES
JRST [DPB B,[POINTR (<FLG(P2)>,F.LMSK)] ;STORE TYPE
ANDI P5,F.ALL ;MASK FLAGS WE WANT
IOR Q2,P5 ;ACCUMULATE RESULT
RET] ; AND EXIT
POP P,P2 ;RESTORE ORIG POINTER
IORM Q2,FLG(P2) ;SET AGGREGATE FLAGS
JRST PARSE ;CONTINUE SCAN
;HERE TO PROCESS SWITCH
RDCMA3: TXZE P1,F%FILE ;FILE SPEC SEEN?
JRST [CALL DOSWIT ;PROCESS SWITCH
JRST RDCMA1] ;CHECK FOR 2ND PART
CALL DOSWIT ;DO SWITCH
TXNE P1,F%SPEC ;ANYTHING YET?
SKIPGE LPROC ;YES - LANG SWITCH?
JRST PARSE ;NO - CONTINUE
JRST RDCMA2 ;YES - HANDLE SOURCE UPDATE
;ROUTINE TO MAKE OBJ BLOCK FROM LAST SRC BLOCK (P2)
MAKOBJ: MOVEI A,B.SIZE ;GET SOME SPACE
CALL BALLOC ;...
EXCH A,P2 ;P2 POINTS TO NEW BLK
MOVEI Q2,NAM(P2) ;SET UP BLT POINTER
HRLI Q2,NAM(A) ;...
BLT Q2,B.SIZE-1(P2) ;MOVE VALUES
SKIPL A,RELDAT ;DO WE WANT TO STORE?
MOVEM A,OVER(P2) ;YES, DO SO
LDF A,D%EXTN ;CLEAR EXPLICIT EXTENSION
ANDCAM A,FLG(P2) ; FLAG IN IMPLICIT NAME
RET ;RETURN
;HERE TO PROCESS SLASH
RDSLSH: CAILE P3,1 ;ANYTHING BEFORE SLASH?
JRST RDSLH1 ;HANDLE FILESPEC
TXOE P1,F%SLSH ;SET SLASH SEEN
ERROR <Illegal slash>
JRST PARSE ;CONTINUE SCAN
;HERE TO HANDLE SPEC BEFORE SLASH IS PROCESSED
RDSLH1: TXO P1,F%LAHD ;WANT TO SEE IT AGAIN
TXZE P1,F%SLSH ;PREVIOUS SWITCH?
JRST RDSPC2 ;YES - PROCESS
CALL FILBLK ;STORE FILE SPEC
TXNE P1,F%OBJ ;IN OBJECT SPEC?
JRST [TXZ P1,F%FILE ;YES - SAY DONE WITH SPEC
JRST RDCMA1] ; AND STORE
HRL P2,B ;SAVE BACK POINTER
JRST PARSE ;AND CONTINUE SCAN
;HERE TO PROCESS SPACE (DELIMITS OBJECT MODULE)
RDSPAC: TXZ P1,F%CMOK ;CLR THIS HERE
TXZN P1,F%FILE ;ANY SPEC SEEN YET?
JRST RDSPC1 ;NO - CHECK SWITCH
TXZE P1,F%SLSH ;SW SEEN?
JRST [SKIPN SRCSAV ;SAVED SOURCE POINTER YET?
MOVEM P2,SRCSAV ;NO - SAVE ONE
TXO P1,F%OBJ ;AND MOVE TO OBJECT FIELD
JRST RDSPC2] ;PROCESS SWITCH
RDSPC0: CAIG P3,1 ;DO WE HAVE A SPEC?
CALL SCREWUP ;NEVER COME HERE
CALL RDFILB ;SAVE FILE
TXO P1,F%OBJ ; AND SET FLAG FOR OBJECT
JRST PARSE ;PROCEDE
RDSPC1: TXZN P1,F%SLSH ;SWITCH?
JRST RDSPC0 ;NO - FILE ALONE
RDSPC2: CALL DOSWIT ;PROCESS SWITCH
JRST PARSE ;PROCEED
;HERE TO PROCESS PLUS SIGN (MULTIPLE SOURCES)
RDPLUS: CAILE P3,1 ;BETTER HAVE SPEC
TXNE P1,F%OBJ ;AND BE IN SOURCE FIELD
ERROR <Illegal plus sign>
CALL RDFILB ;STASH SPEC AND CHECK SRCSAV
JRST PARSE ;GET NEXT SPEC
RDFILB: CALL FILBK1 ;STASH SPEC ETC.
HRL P2,B ;BACK POINTER TO BE SAVED
SKIPN SRCSAV ;FIRST TIME?
MOVEM P2,SRCSAV ;YES - SAVE POINTER TO THIS BLK
RET ;RETURN
SUBTTL PARSE SUBROUTINES
;ROUTINE TO ALLOCATE AND FILL A FILE DESCR BLOCK
;RETURNS POINTER TO PREVIOUS BLOCK IN B, NEW BLOCK IN P2.
FILBLK: TXZA P1,F%NLOB ;SAY OK TO LOOK FOR OBJECT
FILBK1: TXO P1,F%NLOB ;SAY NOT TO LOOK FOR OBJCECT
MOVE B,[POINT 7,FSPEC] ;COPY STRING TO FSPEC
FILBK2: ILDB A,P4 ;...
IDPB A,B
JUMPN A,FILBK2
MOVEI A,B.SIZE ;SIZE OF BLOCK
CALL BALLOC ;ALLOCATE IT
HRRM A,LNK(P2) ;STORE POINTER TO NEW BLOCK
PUSH P,P2 ;SAVE OLD POINTER
MOVE P2,A ;SET UP NEW POINTER
HRRM P1,FLG(P2) ;SET DEFAULTS
SETZM NAM(P2) ;NONE YET
TXO P1,F%FILE!F%SPEC ;SAY FILE SEEN
CALL GTLANG ;FILL IN LANG TYPE INFO
JRST [LDF A,D%FNF ;SET FILE NOT FOUND
IORM A,FLG(P2) ;IN FLAGS OF SPEC
JRST NODEF] ;KEEP GOING
MOVE A,EXTP ;GET POINTER TO EXTENSION
TXNN P1,F%OBJ ;ON OBJECT OR FILE NOT FOUND?
CALL PARDEF ;NO, GOBBLE THE DEFAULT SWITCHES
NODEF: POP P,B ;RETURN BACK POINTER
MOVEM B,BAKPTR ;STORE IN BAKPTR TOO
RET ;...
;ROUTINE TO ALLOCATE SOME SPACE IN STRING SPACE
;CALL: MOVEI A,<SIZE-IN-WORDS>
; CALL BALLOC
; <RETURN> C(A) := ADDRS OF BLOCK, BLOCK ZEROED
BALLOC: STKVAR <BSZ>
MOVEM A,BSZ ;REMEMBER HOW MUCH IS WANTED
CALL GETBUF ;GET THE MEMORY
SETZM (A) ;CLEAR OUT THE BLOCK
SOSGE B,BSZ ;GET ONE LESS THAN SIZE
RET ;NO MORE TO CLEAR, BLOCK IS ONE ONE WORD
ADD B,A ;GET LAS WORD TO CLEAR
HRRI C,1(A) ;MAKE BLT POINTER FOR 0ING BLOCK
HRL C,A
BLT C,(B) ;0 THE BLOCK
RET
;GTLANG - ROUTINE TO DETERMINE LANGUAGE TYPE AND CHECK FOR
;EXISTING OBJECT FILE.
GTLANG: CALL GTLNGX ;CALL SUBROUTINE
JRST GTLNGA ;NO SUCH FILE RETURN
AOS 0(P) ;SKIP RETURN
GTLNGB: MOVE A,LNGJFN ;GET JFN USED
JUMPE A,R ;NONE - RETURN
CALL RJFN ;RELEASE LNGJFN
SETZM LNGJFN ;SAY RELEASED
RET ;GIVE DESIRED RETURN
GTLNGA: TXNN P1,F%OBJ ;IS IN OBJECT FILE?
CALL CJERR ;NO, IT IS SOURCE FILE?
HRROI A,FSPEC ;POINT TO SPEC
CALL BUFFS ;ISOLATE IT
MOVEM A,NAM(P2) ;REMEMBER POINTER
JRST GTLNGB ;JOIN COMMON CODE
GTLNGX: DMOVE A,[POINT 7,[ASCII "*"]
GJ%OLD+GJ%IFG+GJ%FLG] ;LOAD DEFAULTS FOR NON-OBJECT FIELD
TXNE P1,F%OBJ ;IN OBJECT FIELD?
DMOVE A,[POINT 7,[ASCII "REL"]
GJ%FOU+GJ%FLG] ;YES, THEN USE THESE DEFAULTS INSTEAD
MOVEM A,CJFNBK+.GJEXT ;SAVE DEFAULTS
MOVEM B,CJFNBK
MOVE A,[377777,,377777] ;DON'T USE ANY OTHER INPUT
MOVEM A,CJFNBK+.GJSRC
MOVEI A,CJFNBK ;BLOCK ADDRS
HRROI B,FSPEC ;POINT TO STRING
CALL GTJFS ;LOOK UP FILE
JRST [CAIN A,GJFX24 ;FILE NOT FOUND RETURN
RET ;RETURN ERROR
CAIL A,GJFX16 ;VARIOUS OTHER FNF RETURNS
CAILE A,GJFX21 ;...
CALL CJERR ;SYNTAX ERROR
RET] ;ERROR RETURN
HRRZM A,LNGJFN ;SAVE JFN
LDB B,B ;CHECK TERMINATOR
JUMPN B,[HRROI A,FSPEC
ERROR <Illegal character in filespec: %1M>]
TXNE A,GJ%EXT ;WAS AN EXPLICIT EXTENSION TYPED?
TXZA P1,F%XPXT ;NO, CLEAR F%XPXT
TXO P1,F%XPXT ;YES, SET F%XPXT
TXNN P1,F%OBJ ;ARE WE IN OBJECT FIELD?
JRST GTLNX0 ;NO, GO HANDLE
MOVX A,GJ%OLD+GJ%FLG ;IN OBJECT FIELD, TRY TO DO INPUT GTJFN
SKIPE GJNSF ;DO WE WANT TO SET GJ%NS?
TXO A,GJ%NS ;YES, SET IT
MOVEM A,CJFNBK ;STORE FLAGS
MOVEI A,CJFNBK ;BLOCK ADDRS
HRROI B,FSPEC ;POINT TO STRING
CALL GTJFS ;LOOK UP .REL FILE
JRST GTLNX0 ;FAILS, NO STACKED OUTPUT JFN
TXO P1,F%STOJ ;THERE IS STACKED OUTPUT JFN
HRRZS A ;TAKE THE FLAGS OFF THE JFN FOR DVCHR
EXCH A,LNGJFN ;INPUT JFN BECOMES LNGJFN
MOVEM A,OUTJFN ;OUTPUT JFN IS SAVED AS OUTJFN
CALL GTHDD ;GET THE HDD
MOVEM C,HDDNO(P2) ;STORE IT IN HDDNO
JRST GTLNX1 ;PROCEED
GTLNX0: TXZ P1,F%STOJ ;NO STACKED OUTPUT JFN
SETZM HDDO(P2) ;INDICATE NOT DIFFERENT DIRECTORY FOR OBJECT
GTLNX1: LDF A,GJ%OFG!GJ%XTN
MOVEM A,CJFNBK ;STORE FLAGS
LDF A,G1%SLN ;SUPRESS LOGICAL NAME EXPANSION
MOVEM A,CJFNBK+.GJF2
SETZM CJFNBK+.GJEXT ;NO MORE DEFAULT EXTENSION
MOVEI A,CJFNBK ;POINT TO BLOCK
HRROI B,FSPEC ;POINT TO STRING
CALL GTJFS ;LOOK UP FILE
CALL JERRE ;SHOULD NEVER FAIL
MOVE B,A ;WRITE DEVICE AND DIRECTORY FIELDS
HRROI A,FSPEC ;INTO FSPEC
MOVX C,1B2+1B5+JS%PAF
JFNS
MOVEM A,NAM(P2) ;SAVE BYTE POINTER TO BEGINNING OF FILE NAME
MOVE B,LNGJFN ;WRITE FILENAME FIELD
MOVX C,1B8 ;FROM OTHER JFN INTO FSPEC
JFNS
MOVEM A,FSPEXT ;SAVE EXTENSION POINTER HERE
CALL RJFN ;RELEASE PARSE-ONLY JFN
MOVE A,LNGJFN ;JFN
DVCHR ;GET DEVICE CHARACTERISTICS
TXNN B,DV%IN ;IS DEVICE OUTPUT ONLY
TXNE P1,F%NLOD ;AND ARE WE LOADING?
TRNA ;NO, SKIP
RET ;YES, LEAVE
TXNE B,DV%DIR ;DIRECTORY DEVICE?
TDZA C,C ;YES, CLEAR
HRLOI C,377777 ;NO, FUNNY LARGE DATE
TXNE P1,F%OBJ ;ARE WE IN OBJECT FIELD?
TXNE P1,F%STOJ ;IF SO, DO WE HAVE STACKED OUTPUT JFN
TRNA ;NOT IN OBJECT FIELD OR THIS IS INPUT JFN, SKIP
SETO C, ;FORCE COMPILE (NO INPUT FILE TO CHECK)
MOVEM C,BSTDAT ;SAVE IN BSTDAT
TXNN B,DV%DIR ;IS IT A DIRECTORY DEVICE?
SKIPA C,A ;NO, SAVE REAL DEVICE DESIGNATOR
SETZ C, ;YES, SAVE ZERO (FILL IN LATER WITH GTHDDF)
MOVEM C,HDD(P2)
JUMPE C,GTLNX2 ;DON'T SAVE IN HDDNO IF NOT FORCED COMP
TXNE P1,F%OBJ ;ARE WE IN OBJECT FIELD?
MOVEM C,HDDNO(P2) ;YES, SAVE FORCED COMP IN HDDNO
GTLNX2: MOVEI A,LT.REL ;DEFAULT SOURCE LANGUAGE TYPE SEEN IS REL
MOVEM A,LNGTYP
TXZ P1,F%FWKE ;CLEAR "FILE WITH KNOWN EXTENSION" BIT
LDF A,GJ%OLD ;FILES WE'RE LOOKING FOR ARE OLD
MOVEM A,CJFNBK ;SAVE FLAGS IN GTJFN BLOCK
SKIPN BSTDAT ;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT
TXNE P1,F%XPXT ;OR WAS AN EXPLICIT EXTENSION TYPED?
TRNA ;YES TO ONE, SKIP
JRST GTLNG2 ;NO, START LOOKING AT STANDARD EXTENSIONS
TXNE P1,F%OBJ ;IN OBJECT SPEC?
SKIPN BSTDAT ;NON-TWO-WAY SPEC (NON-DIR OR INPUT FAILED)?
TRNA ;NO TO ONE, SKIP
JRST [MOVX B,LT.REL ;YES TO BOTH, EXTENSION MIGHT NOT BE THERE,
JRST GTLNX3] ;SO IT'S ARBITRARILY TYPE .REL
MOVE A,LNGJFN ;GET BACK LNGJFN
CALL DJFNSE ;PUT EXTENSION IN CWBUF
MOVE B,CWBUF ;PUT EXTENSION INTO B
CALL LOOKE ;LOOK UP EXTENSION IN LTAB
SETZ B, ;FAILED, MAKE LANGUAGE TYPE ZERO
GTLNX3: MOVEM B,LNGTYP ;STORE LNGTYP
MOVE A,LNGJFN ;GET BACK LNGJFN AGAIN
MOVEM A,TMPJFN ;PUT IT WHERE GTLN1S WILL FIND IT
SKIPE BSTDAT ;IS NON-DIRECTORY DEVICE OR FORCED COMP OBJECT?
JRST GTLNG4 ;YES, SKIP CHECKING FOR BETTER THINGS
MOVE Q1,B ;GET IN LANGUAGE TYPE FOR GTLN1S
CALL GTLN1S ;MAKE SHORT CALL TO LOOK AT THIS FILE
MOVE B,LNGTYP ;SEE IF WE JUST LOOKED AT .REL FILE
CAIN B,LT.REL ;DID WE?
JRST GTLNG4 ;YES, SKIP CHECKING IT AGAIN
GTLNG2: MOVE Q1,[1-LTABL,,1] ;GET LANGUAGE TABLE INDEX (SKIP NULL EXTENSION)
SETOM RELDAT ;SET REL FILE DATE-TIME TO -1 (FORCE COMPILE)
TXNN P1,F%NLOB ;CAN WE USE AN OBJECT FILE?
GTLNG3: CALL GTLNG1 ;CHECK THIS FILE TYPE
;WE CAN'T USE AN OBJECT FILE, SKIP .REL ENTRY
;NOTE THAT .REL MUST ALWAYS BE
;THE FIRST ENTRY IN THE LANGUAGE TABLE
TXNN P1,F%XPXT ;STOP HERE IF EXPLICIT EXTENSION WAS TYPED
AOBJN Q1,GTLNG3 ;SEE IF ANY OTHERS
TXZN P1,F%FWKE ;DID WE SEE A FILE WITH A KNOWN EXT?
RET ;NO, FAIL
GTLNG4: LDF A,D%EXTN ;EXPLICIT EXTENSION GIVEN
IORM A,FLG(P2)
SKIPE RELOSW ;IS RELOCAT SW ON?
JRST [TXNN P1,F%XPXT ;YES, IS FILE TYPE EXPLICITLY EXISTING?
ANDCAM A,FLG(P2) ;NO,
JRST .+1] ;YES,
MOVE A,LNGJFN ;RESTORE LANGUAGE JFN
CALL DJFNSE ;GET EXTENSION
CALL COPEXT ;COPY EXTENSION
SKIPE B,LNGTYP ;DO WE HAVE LANGUAGE TYPE FROM BEFORE?
CALL SETLTP ;YES, SET IT
PUSH P,B ;SAVE LANG TYPE TEMPORARILY
MOVE A,LNGJFN ;GET BACK LNGJFN
SKIPN C,HDD(P2) ;IS IT A NON-DIRECTORY DEVICE?
CALL GTHDDF ;NO, GET HDD FOR FILE
MOVEM C,HDD(P2) ;STORE IT
TLNE C,-1 ;CONNECTED DIRECTORY?
JRST GTLG4A ;NO - SKIP THIS
SETOM GJNSF ;YES, FOLLOWING OBJECT SPEC USES GJ%NS
MOVE B,HDDO(P2) ;CHECK OBJECT HDD
TLNE B,-1 ;CONNECTED DIR TOO?
SETOM RELDAT ;NO, CAN'T USE IT
GTLG4A: POP P,B ;RESTORE LANG TYPE
CAIN B,LT.REL ;IS IT A .REL FILE?
MOVEM C,HDDO(P2) ;YES, STORE HDD IN HDDO ALSO
MOVE A,BSTDAT ;GET BEST D/T FOUND EARLIER
CAIN B,LT.REL ;IS IT A .REL FILE?
MOVE A,RELDAT ;YES, GET D/T FROM HERE INSTEAD
CALL STODT ;STORE D/T ACCORDING TO TYPE
CAIE B,LT.REL ;IS OBJECT TYPE ALREADY
TXNE P1,F%NLOB ;OR CAN'T WE LOOK FOR OBJECT?
CALLRET STEXNA ;YES, UPDATE FSPEC, STORE NAME, LEAVE
TXNE P1,F%STOJ ;IS THERE A STACKED OUTPUT JFN?
JRST [MOVE A,OUTJFN ;YES, GET IT BACK
JRST GTLNG5] ;AND SKIP OVER GETTING A NEW JFN
SETZM CJFNBK+2 ;CLEAR DEFAULTS
MOVE Q1,[CJFNBK+2,,CJFNBK+3]
BLT Q1,XTNCNT-1 ;...
HRROI A,[ASCIZ /REL/] ;STORE DEFAULT FOR FILE EXTENSION
MOVEM A,CJFNBK+.GJEXT
LDF A,GJ%FOU ;FIND OUT WHERE .REL FILE WILL GO
MOVEM A,CJFNBK ;...
MOVEI A,CJFNBK ;GET GTJFN BLOCK ADDRESS
MOVE B,NAM(P2) ;ENTER .REL FILE ON CONNECTED DIR
CALL GTJFS ;(OR ON DSK:)
CALLRET STEXNA ;FAILED, UPDATE FSPEC AND STORE NAME, AND LEAVE
GTLNG5: SETOM OVER(P2) ;SAY WE HAVE CREATED A NEW .REL FILE
TXO P1,F%STOJ ;WE HAVE A STACKED OUTPUT JFN
MOVEM A,OUTJFN ;SAVE FOR AFTER DVCHR
CALL GTHDD ;GET HDD FOR THE FILE
MOVEM C,HDDNO(P2) ;SAVE FOR LATER
CALLRET STEXNA ;UPDATE FSPEC, STORE FILE NAME, AND LEAVE
GTLNG1: HRROI B,LTAB(Q1) ;GET A LANGUAGE TYPE FOR DEFAULT
MOVEI A,CJFNBK ;GET ADDRESS OF GTJFN BLOCK
MOVEM B,.GJEXT(A) ;SAVE DEFAULT LANG EXT
TRNN Q1,777776 ;IS THIS TYPE .REL?
TXNN P1,F%XPXT ;AND WAS THERE AN EXPLICIT EXTENSION TYPED?
SKIPA B,[POINT 7,FSPEC] ;NOT BOTH - USE DIRECTORY SPECIFIED
MOVE B,NAM(P2) ;YES, IMPLICIT OBJECT ONLY LOOKED FOR ON DSK:
CALL GTJFS ;SEE IF THIS LANGUAGE TYPE IS THERE
RET ;THIS TYPE IS NOT THERE, RETURN
MOVE B,[1,,.FBCTL]
MOVEI C,C
GTFDB
TXNE C,FB%OFF ;IS .REL FILE OFFLINE?
JRST [SETOM RELDAT ;YES, FORCE TO RECOMPILE
ETYPE <%% %1S - is offline file %_> ;GIVE WARNING MESSAGE
RET] ;AND RETURN
MOVEM A,TMPJFN ;FOUND A JFN, SAVE IT FOR NOW
GTLN1S: CALL GTDT ;GET THE D & T OF LAST WRITE TO FILE
CAMG A,BSTDAT ;IS IT LATER THAN PREVIOUSLY FOUND TYPE
CALLRET RJFN ;NO, THROW IT AWAY AND RETURN
HRRZ B,Q1 ;GET LANGUAGE TYPE INTO B
CAIE B,LT.REL ;IS THIS A .REL FILE?
JRST [MOVEM A,BSTDAT ;NOT .REL FILE, PUT IN BSTDAT
JRST GTLN1F] ;REJOIN TO CHECK FLAGS
MOVEM A,RELDAT ;YES, SAVE D&T FOR MAKOBJ
TXNE P1,F%OBJ ;IS THIS OBJECT SPEC?
JRST GTLN1F ;YES, DON'T FIND HDD AGAIN
MOVE A,TMPJFN ;JFN
CALL GTHDDF ;GET HDD OF .REL FILE
MOVEM C,HDDO(P2) ;SAVE IT FOR LATER
GTLN1F: TXON P1,F%FWKE ;SAY WE'VE SEEN A FILE WITH KNOWN EXT
TXNN P1,F%XPXT ;FIRST TIME, IS THIS SHORT CALL AT GTLN1S?
TRNA ;NOT FIRST TIME OR ISN'T LNGJFN, SKIP
RET ;THIS IS A SHORT CALL, DON'T SWAP TO SELF
HRRZ B,Q1 ;GET LANGUAGE TYPE INTO B
CAIN B,LT.REL ;IS THIS A .REL FILE?
TXNN P1,F%XPXT ;IF SO, IS THIS THE FIRST FILE WE'RE DOING?
TRNA ;NOT .REL FILE OR IT'S THE FIRST FILE, SKIP
CALLRET RJFN ;DON'T SWAP WITH VALID SOURCE JFN, LEAVE NOW
MOVE A,TMPJFN ;GET BACK THE JFN OF THIS FILE
MOVE B,LNGJFN ;GET JFN OF CURRENT BEST FILE
SWJFN ;SWAP THE TWO JFN'S
HRRZ B,Q1 ;GET LANGUAGE TYPE INTO B
CAIN B,LT.REL ;IS THIS A .REL FILE?
CALLRET RJFN ;YES, LEAVE NOW
TXNE P1,F%LANG ;IS THERE A GLOBAL LANGUAGE SWITCH?
LDB B,[POINTR (P1,F.LMSK)] ;YES, SUBSTITUTE THAT LANGUAGE TYPE
MOVEM B,LNGTYP ;SAVE THE LANGUAGE TYPE WE FOUND
CALLRET RJFN ;THROW AWAY JFN WE DON'T WANT, AND RETURN
SETLTP: SKIPGE LPROC ;HAVE PROCESSOR SET YET?
JRST [MOVEM B,LPROC ;NO -SET IT
RET] ; AND RETURN
TXNE P1,F%OBJ ;OK IF OBJECT FIELD
CAIE B,LT.REL ;OK IF RELOC
CAMN B,LPROC ;OR SAME AS BEFORE
RET ;...
ERROR <Language processor conflict>
;ROUTINE TO COPY EXTENSION FROM CWBUF . THE COPY IS
;USED AS THE FILE-TYPE USED FOR LOOKING UP DEFAULTS IF IT ISN'T IN THE
;OBJECT FIELD.
;POINTER TO THE COPY IS STORED IN EXTP
COPEXT: HRROI A,CWBUF ;POINT TO EXTENSION
CALL BUFFS ;MAKE A COPY
MOVEM A,EXTP ;REMEMBER POINTER TO COPY
RET
;CHK10 - CHECK FILE NAME TO BE OUTPUT FOR TOPS10 COMPAT.
;TAKES JFN IN B
CHK10: MOVE A,CSBUFP ;BEGINNING OF STRING SPACE
MOVE D,A ;POINTER TO FILESPEC'S END SO FAR
LDF C,1B2+1B35 ;GET DEVICE
JFNS
CALL GTASIZ ;GET STRING SIZE
CAILE C,7 ;MAX LEGAL (INCLUDES ":")
JRST [ HRROI A,FSPEC
ERROR <Device name exceeds 6 characters: %1M>]
MOVE B,LNGJFN ;JFN
LDF C,1B8+1B35 ;FILE NAME
JFNS
CALL GTASIZ ;GET SIZE
CAILE C,6 ;MAX LEGAL
JRST [ HRROI A,FSPEC
ERROR <File name exceeds 6 characters: %1M>]
MOVE B,LNGJFN ;JFN
LDF C,1B11+1B35 ;GET EXTENSION
JFNS
CALL GTASIZ
CAILE C,4 ;MAX LEGAL (INCLUDES ".")
JRST [ HRROI A,FSPEC
ERROR <File type exceeds 3 characters: %1M>]
RET
GTASIZ: MOVEI C,0 ;INIT COUNT
GTASZ1: CAMN A,D ;COMPARE
RET ;MATCH RETURN
ILDB B,D ;PROCEED - GET CHAR
CAIE B,"-" ;CHECK LEGAL
CAIN B,"_"
JRST ILCHR ;INFORM LOSER
CAIN B,"$"
JRST ILCHR
AOJA C,GTASZ1 ;LOOP TILL MATCH
ILCHR: HRROI A,FSPEC ;GET FILESPEC THAT'S WRONG
ERROR <Illegal character %2\ in file: %1M">
;DOSWIT - DECODE SWITCH AND TAKE ACTION
DOSWIT: MOVE A,P4 ;STR POINTER TO A
CALL SWMOV ;MOVE STR TO FSPEC
MOVE B,A ;REMEMBER POINTER TO LAST CHARACTER
HRROI A,FSPEC ;POINTER TO SW NAME
; CALLRET DOSWI0 ;DO THE SWITCH
;ROUTINE TO PARSE A SWITCH. GIVE IT POINTER TO SWITCH IN A.
;GIVE IT POINTER TO END OF SWITCH IN B.
DOSWI0: STKVAR <SUFFIX>
MOVE B,A ;PUT POINTER IN B
TLC B,-1
TLCN B,-1
HRLI B,440700 ;MAKE REAL BYTE POINTER
SETZM SUFFIX ;NO SUFFIX YET
DOSWI1: ILDB D,B ;SCAN SWITCH STRING
JUMPE D,DOSWI2 ;IF NULL CHARACTER, NO SUFFIX TO WORRY ABOUT
CAIE D,":" ;FIND A COLON?
JRST DOSWI1 ;NO, KEEP LOOKING
MOVEM B,SUFFIX ;REMEMBER POINTER TO SUFFIX
MOVEI C,0 ;MAKE STRING END IN NULL
DPB C,B
DOSWI2: MOVE B,A ;GET POINTER TO SWITCH AGAIN
MOVEI A,SWTAB ;THE SWITCH TABLE
TBLUK ;LOOK UP THE SWITCH
TXNE B,TL%NOM ;NO MATCH AT ALL?
JRST NOMAT ;CORRECT
TXNE B,TL%AMB ;AMBIGUOUS?
JRST AMBIG ;YUP
MOVE C,(A) ;PUT VALUE INTO C
HLR D,C
CAIN D,[ASCIZ "BINARY"] ;IS IT /BINARY?
SETOM BINYSW ;YES, SET THE FLAG
CAIN D,[ASCIZ "WARNINGS"] ;IS IT /WARNINGS?
SETOM WARNSW ;YES, SET THE FLAG
CAIN D,[ASCIZ "NOCREF"] ;IS IT /NOCREF?
SETOM NOCRSW ;YES, SET THE FLAG
CAIN D,[ASCIZ "NODEBUG"] ;IS IT /NODEBUG?
SETOM NODBSW ;YES, SET THE FLAG
CAIN D,[ASCIZ "NOFLAG-NON-STANDARD"]
SETOM NOFGSW ;YES, SET THE FLAG
CAIN D,[ASCIZ "NOLIST"] ;IS IT /NOLIST?
SETOM NOLISW ;YES, SET THE FLAG
CAIN D,[ASCIZ "NOMACHINE-CODE"]
SETOM NOMASW ;YES, SET THE FLAG
CAIN D,[ASCIZ "NOOPTIMIZE"]
SETOM NOOPSW ;YES, SET THE FLAG
HRRZ B,(C) ;GET RHS OF TABLE
HLL C,(C) ;GET FLAGS FROM LHS
MOVE A,SUFFIX ;GIVE SUPPORT ROUTINES POINTER TO SWITCH ARG
TXNE C,S%DSP ;CHECK FOR ROUTINE ADDRS
JRST 0(B) ;EXIT THROUGH ROUTINE
TXNE C,S%VAL!S%LINK ;VALUE ALLOWED OR L20 SWITCH?
JRST SWVAL ;YES - FURTHER WORK REQ'D
CAIN P5,":" ;CHECK FOR COLON
JRST [ HRROI A,FSPEC
ERROR <Value illegal for switch: %1M>]
TXNE C,S%LTYP ;LANGUAGE TYPE DESIGNATOR?
JRST SWLTYP ;YES - CHECK PERM/TEMP
MOVE D,[IORM B,FLG(P2)] ;INTSTR TO SET FLAGS
TXNE C,S%TOFF ;CLEAR FLAGS?
TLC D,(<IORM>-<ANDCAM>) ;YES - CHANGE INSTR
TXNE C,S%FLH ;FLAGS IN LH?
MOVSS B ;YES - SWAP HALVES
TXNN C,S%FLH ;PERM FLAGS?
TXNN P1,F%SPEC ;OR FILE SPEC SEEN YET
JRST [TLZ D,17 ;CLEAR INDEX REG
HRRI D,P1 ;SET FLAG ADDRS
JRST DOSWIX] ;DO FLAGS & RETURN
TXNE C,S%FRH ;TEMP FLAGS?
DOSWIX: XCT D ;YES - SET/CLR IN DESC BLOCK
RET ;RETURN
;HERE TO HANDLE ADDITIONAL VALUES AND LINK-20 SWITCHES
SWVAL: RET ;RETURN FOR NOW
;/STAY CAUSES EXEC TO STAY AT COMMAND LEVEL DURING COMPILATION/LOADING.
DOSTAY: SETOM STAYF ;REMEMBER TO STAY
RET
;/NOSTAY CAUSES THE EXEC TO SLEEP DURING COMPILATION/LOADING. USED TO
;OVERRIDE A DEFAULT OF /STAY.
NOSTAY: SETZM STAYF ;REMEMBER NOT TO STAY
RET
;HANDLE /LANGUAGE-SWITCHES:
DOLSW: TXNE P1,F%SPEC ;GLOBAL?
JRST DOL1 ;NO, ON PARTICULAR PROGRAM
SKIPE LSWPTR ;YES, ALREADY GIVEN?
ERROR <Only one global /LANGUAGE-SWITCHES: allowed>
MOVE A,SAVQS ;GET POINTER TO SAVED QUOTED STRING
MOVEM A,LSWPTR ;REMEMBER POINTER TO STRING
RET
DOL1: SKIPE SWP(P2) ;SWITCH GIVEN FOR THIS FILE YET?
ERROR <Only one /LANGUAGE-SWITCHES: switch allowed per source module>
MOVE A,SAVQS ;GET POINTER TO SAVED QUOTED STRING
MOVEM A,SWP(P2) ;REMEMBER POINTER TO STRING
RET
;HERE TO HANDLE LANGUAGE TYPE SWITCHES
SWLTYP: CAIN B,LT.SAI ;IF SAIL
SETOM SAILF ;SAY WE HAVE SEEN SAIL
CAIN B,LT.REL ;IS RELOCATABLE SW?
JRST [SETOM RELOSW ;YES, SET THE FLAG
TXNE P1,F%XPXT ;IS FILE TYPE SEEN?
JRST .+1 ;YES,
LDF Q3,D%EXTN ;NO, LET THE .REL FILE BEEN USED
ANDCAM Q3,FLG(P2) ;MAKE SURE AN EXPLICIT EXTEN ISN'T USED
JRST .+1]
TXNN P1,F%SPEC ;SPEC SEEN YET?
JRST SWLTP2 ;NO, GO HANDLE GLOBAL SWITCH
MOVE C,LPROC ;MOVE IN LANGUAGE TYPE WE ARE REPLACING
CAIN C,LT.REL ;IS IT .REL?
RET ;YES, DON'T CHANGE, LEAVE
SKIPN DEFSW ;DEFAULT SW SEEN?
JRST .+3 ;NO,
SETZM DEFSW ;YES,SET FLAG ON
TRNN P1,F%LANG ;DOES THE GLOBAL LANGUAGE SW EXIST?
MOVEM B,LPROC ;SET PROCESSOR TYPE
CAIE B,LT.REL ;IS THIS /REL WE'RE SETTING?
RET ;NO, WE ARE DONE
JUMPE C,SWLTP1 ;IF WAS NULL TYPE, MOVE SOURCE TO OBJECT
SKIPN HDDO(P2) ;IF WAS NON-NULL, IS OBJECT FILE SET UP?
JRST SWLTP1 ;NO, MOVE SOURCE TO OBJECT
RET ; EXPLICIT EXTENSION ISN'T USED
SWLTP1: MOVE B,SVER(P2) ;MOVE SOURCE TIME/DATE
MOVEM B,OVER(P2) ;TO OBJECT TIME/DATE
MOVE B,HDD(P2) ;ALSO SET UP HDD
MOVEM B,HDDO(P2) ;FOR OBJECT FILE
RET ;LEAVE
SWLTP2: DPB B,[POINTR (P1,F.LMSK)] ;SET LANGUAGE TYPE
TRON P1,F%LANG ;SET GLOBAL LANG SWITCH SEEN - HAS IT ALREADY?
RET ;NO - RETURN;
;YES - FALL INTO AMBIGUOUS ERROR ROUTINE
;ERROR RETURNS
AMBIG: HRROI A,FSPEC
ERROR <Switch name ambiguous: %1M>
NOMAT: HRROI A,FSPEC
ERROR <No such switch: %1M>
;ROUTINE TO PARSE THE DEFAULT SWITCHES FOR A FILE TYPE
;PASS IT POINTER TO THE FILE TYPE IN A.
PARDEF: STKVAR <QUOF,PAREND,SWIPTR,<ABSAV,2>>
CALL GETDL ;GET DEFAULT SWITCHES FOR FILE TYPE
SKIPE A ;IS DEFAULT SW EXISTING?
SETOM DEFSW ;YES, SET THE FLAG ON
MOVEM A,SWIPTR ;INITIALIZE POINTER TO SWITCH LIST
PARD0: MOVE A,[440700,,SWIBUF] ;POINTER TO SWITCH BUFFER
MOVE B,SWIPTR ;POINTER TO NEXT SWITCH
MOVEI C,SWISIZ*5 ;MAXIMUM CHARACTERS TO READ
ILDB D,B ;READ THE SLASH
JUMPE D,R ;IF NULL, LAST ONE WAS LAST SWITCH
SETZM QUOF ;NOT IN QUOTED STRING YET
PARD3: ILDB D,B ;READ CHARACTER OF SWITCH
JUMPE D,PARD4 ;IF NULL, SWITCH OVER
SKIPE QUOF ;IN QUOTED STRING?
JRST PARD5 ;YES, SO "/" DOESN'T START NEXT SWITCH
CAIN D,"/" ;OR IF SLASH OF NEXT SWITCH, SWITCH OVER
JRST PARD4 ;YES, SWITCH OVER
PARD5: IDPB D,A ;SWITCH NOT OVER, ACCUMULATE NAME
CAIE D,QUOTE ;A QUOTE?
JRST PARD6 ;NO, GO DECREMENT COUNT
SKIPN QUOF ;IS OPEN QUOTE?
JRST PARD2 ;YES,
MOVE Q3,B ;NO, SAVE PTR
SOSG C ;DECREASE COUNT
JRST .+6 ;NO MORE SPACES FOR SWITCH
ILDB D,B ;READ CHARACTER OF SWITCH
CAIE D,0 ;END OF QUOTE STRING?
JRST PARD5 ;NO, KEEP ON
MOVEM Q3,B ;YES, RESTORE PREVIOUS PTR
SKIPE QUOF ;START OR END OF A QUOTED STRING?
JRST [DMOVEM A,ABSAV ;END, SAVE A AND B
MOVEM C,PAREND ;AND C TOO
MOVEI B,0 ;PUT ZERO BYTE AT END OF STRING
DPB B,A
MOVE A,QUOF ;GET QUOTED STRING POINTER
CALL BUFFS ;BUFFER THE QUOTED STRING
MOVEM A,SAVQS ;AND SAVE THE POINTER
SETZM QUOF ;NOT IN QUOTED STRING ANY MORE
DMOVE A,ABSAV ;RESTORE A AND B
MOVE C,PAREND ;AND C
MOVEI D,QUOTE ;AND D
DPB D,A ;RESTORE QUOTE AT END OF STRING
JRST PARD6] ;GO DECREMENT COUNT
PARD2: MOVEM A,QUOF ;BEGINNING OF QUOTED STRING, SAVE PTR
PARD6: SOJG C,PARD3 ;READ REST OF NAME
ERROR <Default switch too long>
PARD4: MOVEM A,PAREND ;REMEMBER POINTER TO END OF SWITCH
MOVEI C,0 ;PUT NULL AFTER NAME
IDPB C,A
MOVNI A,1
ADJBP A,B ;BACK SOURCE POINTER BACK TO BEGINNING OF NEXT SWITCH
MOVEM A,SWIPTR ;REMEMBER POINTER FOR NEXT SWITCH
HRROI A,SWIBUF ;POINT AT THE DEFAULT SWITCH
MOVE B,PAREND ;PASS POINTER TO END OF SWITCH
CALL DOSWI0 ;PARSE THE SWITCH
JRST PARD0 ;LOOP FOR REST OF SWITCHES
;ROUTINES TO PROCESS /MAP AND /SAVE SWITCHES
SWMAP: PUSH P,[MAPPNT] ;SAVE ADDRS ON STACK
SKIPE @0(P) ;ALREADY SEE THIS SWITCH?
ERROR <MAP or SAVE switch seen twice>
CAIE P5,":" ;MORE COMING?
JRST [MOVEI P4,-1 ;NO - SET FLAG
JRST SWSAV2] ;AND EXIT
CALL RDFLD ;YES - READ NEXT FIELD
CAIN P5,":" ;CHECK FOR DEVICE
CALL CAPND ;AND APPEND TO COLON
SWSAV2: EXCH P4,0(P) ;REVERSE ARGS
POP P,@P4 ;AND SAVE VALUE
RET ;RETURN
;GTHDD - ROUTINE TO GET HDD FOR JFN IN A AND OUTJFN
GTHDD: PUSH P,A
DVCHR
TXNE B,DV%TYP ;IS IT DISK?
JRST [MOVE C,A ;YES, SKIP GETTING HDD
POP P,(P) ;ADJUST STACK
RET] ;AND RETURN
CALLRE GTHDD1 ;GET HDD TO STORE FILE IN, AND RETURN
;GTHDDF - ROUTINE TO GET HDD FOR FILE
GTHDDF: PUSH P,A ;SAVE JFN FOR LATER
DVCHR% ;GET BACK DEVICE DESIGNATOR
ERCAL CJERRE ;HORRIBLE ERROR
TXNE B,DV%TYP ;IS IT A DISK?
ERROR <Non-disk directory devices are not supported>
GTHDD1: EXCH A,(P) ;SWITCH JFN AND DEVICE DESIGNATOR
MOVE B,A ;GET JFN IN B
MOVX A,RC%EMO ;MATCH EXACTLY
SETZ C, ;ZERO C
RCDIR% ;GET BACK PPN FOR DEVICE
ERCAL CJERRE ;HORRIBLE ERROR
MOVE B,C ;GET DIRECTORY NUMBER IN B
POP P,C ;CONSTRUCT HDD IN AC C
HRL C,B
CAMN C,CHDD ;IS FILE IN CONNECTED DIRECTORY?
TLZ C,777777 ;IF SO, CLEAR LH OF HDD (NO PPN NECESSARY)
RET ;RETURN
;DJFNSE - OBTAIN EXTENSION OF FILE SPECIFIED BY JFN IN A
;RETURNS ASCIZ IN CWBUF
DJFNSE: LDF C,1B11 ;EXTENSION ONLY ENTRY
SETZM CWBUF ;CLEAR DESTINATION
HRRZ B,A ;JFN TO B
HRROI A,CWBUF ;POINTER TO DEST
JFNS ;GET EXTENSION
RET ;RETURN
;DOJFNS - OBTAIN DESIRED TEXT FOR JFN IN A
;FORMAT DESIRED IN C
;RETURNS ASCIZ IN CSBUF
DOJFNS: HRRZ B,A ;JFN TO B
MOVE A,CSBUFP ;POINTER TO DEST
JFNS ;GET IT
RET ;RETURN
;ROUTINE TO LOOK UP EXTENSION FOUND IN B AND RETURN
;LANG TYPE IN B
LOOKE: MOVSI C,-LTABL ;LTAB LENGTH
CAME B,LTAB(C) ;MATCH?
AOBJN C,.-1 ;NO - TRY NEXT
JUMPGE C,R ;FAIL RETURN
HRRZ B,C ;TABLE INDEX IS TYPE
TXNE P1,F%LANG ;IS THERE A GLOBAL LANGUAGE SWITCH?
CAIN B,LT.REL ;IF SO, IS FILE REL?
JUMPN B,RSKP ;NO, SKIP, ELSE IF NOT GLOBAL, IS NULL?
LDB B,[POINTR (P1,F.LMSK)] ;GLOBAL AND NOT REL OR NULL, REPLACE
RETSKP ;RETURN
;ROUTINE TO WRITE EXTENSION OF LNGJFN AT FSPEXT, ISOLATE THE FILENAME AND
;EXTENSION, AND STORE POINTER IN NAM OF FDB
STEXNA: MOVE A,FSPEXT ;PLACE TO WRITE FILE EXTENSION
LDB B,A ;BUT CHECK TO SEE IF THERE'S A FILENAME FIRST
CAIN B,":"
JRST [ MOVEI A,1 ;NO THERE ISN'T
CALL GETBUF ;GET A WORD
SETZM (A) ;ZERO IT
HRLI A,440700 ;POINT TO IT
JRST STEXN1] ;AND SAVE THE POINTER
MOVEI B,"." ;(BUT PUT IN DOT FIRST)
IDPB B,A
MOVE B,LNGJFN
LDF C,1B11
JFNS
MOVE A,NAM(P2) ;ONLY COPY OVER THE PORTION WE WANT
CALL BUFFS
STEXN1: MOVEM A,NAM(P2) ;SAVE NEW FILENAME BYTE POINTER
MOVE B,LNGJFN ;CHECK JFN TO BE OUTPUT
CALL CHK10 ;FOR TOPS-10 LEGALITY
TXZN P1,F%STOJ ;IS THERE AN EXTRA JFN TO RELEASE?
RETSKP ;NO, LEAVE, GIVING GOOD RETURN
MOVE B,OUTJFN ;CHECK THIS JFN TOO
CALL CHK10 ;FOR TOPS-10 LEGALITY
CALL RJFN ;RELEASE EXTRA JFN
RETSKP ;LEAVE, GIVING GOOD RETURN
;ROUTINE TO SEND TMP FILE TO COMPATABILITY PACKAGE
DPRARG: MOVE A,NFILES ;POINT TO WORD CONTAINING LAST FILE ADDRESS
MOVE C,ADDTAB-1(A) ;GET STARTING ADDRESS OF LAST FILE
ADD C,TMPCOR(C) ;GET FINAL ADDRESS
HRRZI C,1(C) ;KEEP ONLY THE LENGTH
MOVEI B,NFILES ;SPECIFY S/A OF ARG BLOCK
MOVE A,FORK ;SEND BLOCK TO CURRENT FORK
HRLI A,.PRAST ;FUNCTION IS "ARG BLOCK BEING SPECIFIED"
PRARG ;SEND THE BLOCK
ERJMP .+2 ;FAILED, SEE WHY
RET
;THE PRARG FAILED, PROBABLY BECAUSE WE TRIED TO SEND TOO MUCH.
;WRITE FILES TO DISK.
MOVE Q1,NFILES ;GET NUMBER OF FILES
TMP1: SOJL Q1,TMP2 ;JUMP TO TMP2 IF NO MORE TMP FILES
MOVEI P1,0 ;NO HIGH ORDER BITS
MOVE P2,CSJOB ;BINARY JOB NUMBER
MOVEI P3,0 ;UNUSED WORD
MOVE P4,[400000,,3] ;WE WANT FILLING, THREE DIGITS
MOVE P5,CSBUFP ;POINTER TO AREA INTO WHICH TO WRITE NUMBER
EXTEND P1,[CVTBDO "0"
"0"] ;THREE DIGITS TO ASCII(FILL WITH "0" AT BEGINNING)
ERCAL CJERRE ;FAILED, SAY WHY
MOVE D,ADDTAB(Q1) ;GET ADDRESS OF FILE
MOVEI P2,TMPCOR(D) ;GET SIXBIT NAME OF FILE(ADDRESS THEREOF)
HRLI P2,440600 ;MAKE BYTE POINTER
MOVEI P1,3 ;WE WANT TO CONVERT 3 CHARACTERS
MOVEI P4,3
EXTEND P1,[MOVSO "A"-'A'];SIXBIT TO ASCII CONVERSION
ERCAL CJERRE
MOVE A,P5 ;RETAIN UPDATED BYTE POINTER
HRROI B,[ASCIZ /.TMP;T/];REST OF FILESPEC
MOVEI C,0
SOUT
MOVX A,GJ%FOU+GJ%SHT ;OUTPUT USE, SHORT FORM
MOVE B,CSBUFP ;POINT TO FILESPEC
CALL GTJFS ;GET HANDLE
CALL CJERRE ;FAILED
MOVE B,[70000,,OF%WR] ;OPEN FOR WRITING
OPENF
ERCAL CJERRE ;FAILED
MOVE D,ADDTAB(Q1) ;GET ADDRESS OF FILE
HRROI B,TMPCOR+1(D) ;GET POINTER TO DATA
MOVEI C,0 ;END ON NULL
SOUT ;WRITE THE DATA TO FILE
CLOSF ;CLOSE FILE
ERCAL CJERRE ;COULDN'T
JRST TMP1 ;DO NEXT FILE
TMP2: RET ;ALL DONE
;GTDT - GET DATE/TIME OF FILE JFN IN A
;RETURNS VERSION D/T IN A
GTDT: PUSH P,[0] ;PLACE TO READ D/T
PUSH P,B ;SAVE ACS
PUSH P,C
MOVEI C,-2(P) ;POINT TO SPECIAL CELL
MOVE B,[1,,.FBWRT] ;GET TIME LAST WRITTEN
GTFDB
POP P,C ;RESTORE STUFF
POP P,B
POP P,A ;SHOULD HAVE D/T
RET ;RETURN
;ROUTINE TO STORE DATE/TIME IN SPEC BLOCK ACCORDING TO
;LANGUAGE TYPE (I.E. REL OR NOT)
STODT: CAIE B,LT.L36 ;FOR BLISS LIBRARY, OBJECT TYPE IS "L36"
CAIN B,LT.REL ;RELOC TYPE?
MOVEM A,OVER(P2) ;YES - STORE IN OBJECT
MOVEM A,SVER(P2) ;STORE IN SOURCE ALWAYS, IN CASE OF /BINARY
RET ;RETURN
;SUBROUTINE TO OUTPUT THE STRING POINTED TO BY AC B, PLUS A CRLF
DSOUTR: MOVE A,COJFN ;OUTPUT JFN
SETZ C,
SOUT ;PRINT STRING
ETYPE <%_> ;AND CRLF
RET ;RETURN
;PUNCTUATION ROUTINES
PROUT: SKIPA B,["."] ;PERIOD
CMOUT: MOVEI B,"," ;COMMA
CALLRET TBOUT ;DUMP IT
SWOUT: MOVEI B,"/" ;SLASHIFY IT
CALL TBOUT ;...
MOVE B,D ;SW VALUE
CALLRET TBOUT ;DUMP IT
EOLOUT: MOVEI B,15
CALL TBOUT
SKIPA B,[12] ;END-OF-LINEF
SPOUT: MOVEI B," " ;SPACE
CALLRET TBOUT ;DUMP AND RETURN
SUBTTL RDSKP AND RDFLD
;RDFLD - READS NEXT FIELD USING TEXTI
;RETURNS: P5 := BREAK CHAR
; A := BREAK TYPE
; P3 := CHAR COUNT
; P4 := POINTER TO STRING
RDFLD: MOVE Q1,.RDIOJ+CSTXTB ;CURRENT POINTER
TXZE P1,F%LAHD ;CHECK IF NEED BACKUP
ADD Q1,[B.BP] ;YES - ADD CONST
MOVEM Q1,.RDIOJ+CSTXTB ;NOW HAVE CORRECT POSITION
MOVE P4,TXTPR ;POINTER TO STRING SPACE
MOVEM P4,3+CSTXTB ;OUTPUT STRING HERE
RDFLD0: MOVEI P3,STRSIZ ;ENOUGH LENGTH FOR ANY REASNABLE FIELD
MOVEM P3,4+CSTXTB ; IN STRING SPACE
LDF Q1,RD%RIE ;RETURN ON EMPTY STRING
MOVE A,BMSKA ;GET SPECIAL BREAK MASK ADDRESS
MOVEM A,7+CSTXTB
MOVEM Q1,1+CSTXTB ;...
MOVEI A,CSTXTB ;POINT AT ARGS
TEXTI ;SNARF FIELD
CALL EOFJER ;CHECK FOR END OF FILE
MOVE Q1,1+CSTXTB ;GET FLAGS
TXNN Q1,RD%BTM ;BREAK ON TERM?
ERROR <Command string space exhausted>
LDB P5,3+CSTXTB ;GET BREAK CHAR
CALL GTYP ;GET CHAR TYPE
MOVEI Q1,0 ;NULL OUT DELIM
DPB Q1,3+CSTXTB ;...
SUB P3,4+CSTXTB ;SIZE = ORIG - NEW COUNT
RET ;AND RETURN
;FOLLOW THE ":" IN A SWITCH
RDFLDN: MOVE Q1,.RDIOJ+CSTXTB ;CURRENT POINTER
TXZE P1,F%LAHD ;CHECK IF NEED BACKUP
ADD Q1,[B.BP] ;YES - ADD CONST
MOVEM Q1,.RDIOJ+CSTXTB ;NOW HAVE CORRECT POSITION
MOVEI P3,STRSIZ ;ENOUGH LENGTH FOR ANY REASNABLE FIELD
MOVEM P3,4+CSTXTB ; IN STRING SPACE
TXNN P1,F%SLSH ;SLASH SEEN?
JRST RDFLDX ;NO
MOVE A,QQQFLG ;YES, IT IS A SWITCH
TXNE A,S%QUO+S%VAL ;IS IT A LANGUAGE-SW?
JRST RDFLDX ;YES
MOVEI A,BMSKSW ;NO, USE NEW SET OF BREAK MASK
CAIA
RDFLDX: MOVE A,BMSKA ;GET SPECIAL BREAK MASK ADDRESS
MOVEM A,7+CSTXTB
LDF Q1,RD%RIE ;RETURN ON EMPTY STRING
MOVEM Q1,1+CSTXTB ;...
MOVEI A,CSTXTB ;POINT AT ARGS
TEXTI ;SNARF FIELD
CALL EOFJER ;CHECK FOR END OF FILE
MOVE Q1,1+CSTXTB ;GET FLAGS
TXNN Q1,RD%BTM ;BREAK ON TERM?
ERROR <Command string space exhausted>
LDB P5,3+CSTXTB ;GET BREAK CHAR
CALL GTYP ;GET CHAR TYPE
MOVEI Q1,0 ;NULL OUT DELIM
DPB Q1,3+CSTXTB ;...
SUB P3,4+CSTXTB ;SIZE = ORIG - NEW COUNT
RET ;AND RETURN
;ROUTINE TO READ A QUOTED STRING. RETURNS POINTER TO IT IN A.
RDQUOT: CALL LDCHR ;GET A CHAR
CAIE P5,QUOTE ;GRNTEE QUOTED
ERROR <String must be quoted>
RDQOT1: MOVE P4,CSBUFP ;PICK UP STRING POINTER
RDPRC1: CALL LDCHR ;GET CHAR
CAIN A,C.EOL ;CHECK END
ERROR <Unterminated quoted string>
CAIN P5,QUOTE ;END OF SWITCH?
JRST [MOVE A,.RDIOJ+CSTXTB ;SAVE PTR
ILDB P5,.RDIOJ+CSTXTB ;LOAD & INCRE PTR
CAIN P5,QUOTE ;IS QUOTE?
JRST RDPRC1+5 ;YES,
MOVEM A,.RDIOJ+CSTXTB ;NO, RESTORE PREVIOUS PTR
JRST RDPRC2] ;YES - SET UP BLOCK
IDPB P5,P4 ;STUFF CHAR
JRST RDPRC1
RDPRC2: MOVEI P5,0 ;TERMINATE WITH NULL
IDPB P5,P4 ;...
MOVE A,CSBUFP
CALLRET BUFFS ;BUFFER THE STRING AND RETURN POINTER TO CALLER
;LDCHR - ROUTINE TO GET NEXT CHARACTER
;RETURNS: P5: = CHARACTER
; A := CHAR TYPE
LDCHR: TXZN P1,F%LAHD ;CHECK FLAG
IBP .RDIOJ+CSTXTB ;INCR BYTE POINTER
LDB P5,.RDIOJ+CSTXTB ;GET CHAR
; CALLRET GTYP ;GET TYPE INFO AND EXIT
;GTYP - GET CHAR TYPE IN A
GTYP: MOVE Q1,P5 ;COPY IT
IDIVI Q1,^D9 ;LOOK IT UP IN TABLE
LDB A,PTAB(Q2) ;...
RET ;RETURN
;THE FOLLOWING ROUTINE GETS A POINTER TO THE STRING OF DEFAULT
;SWITCHES FOR A PARTICULAR EXTENSION. THE ROUTINE RETURNS WITH 0
;OR A POINTER IN A.
;PASS THE ROUTINE IN A A POINTER TO THE DESIRED EXTENSION
GETDL: MOVE C,A ;POINTER IN C
BIN ;READ FIRST CHARACTER
CAIN B,0 ;NULL EXTENSION?
SKIPA B,[440700,,[ASCIZ /./]] ;YES, SO LOOK UP DOT
MOVE B,C ;RETRIEVE POINTER
MOVEI A,DEXTBL ;ADDRESS OF DEFAULT TABLE
TBLUK ;LOOK FOR THE EXTENSION
TXNN B,TL%EXM ;EXACT MATCH?
JRST GETDL0 ;NO
HRR A,(A) ;YES, GET POINTER TO STRING
HRLI A,440700 ;MAKE BYTE POINTER
RET ;GIVE IT TO CALLER
GETDL0: MOVEI A,0 ;NO DEFAULTS SET, RETURN 0
RET
;INFO DEFAULT COMPILE-SWITCHES
.IDCS:: STKVAR <NWHICH,NS>
HLRZ A,DEXTBL ;GET NUMBER OF FILE TYPES
MOVEM A,NS ;REMEMBER HOW MANY TO DO
SETZM NWHICH ;INITIALIZE WHICH ONE WE'RE ON
IDC0: AOS C,NWHICH ;STEP TO NEXT FILE TYPE
CAMLE C,NS ;DONE THEM ALL YET?
RET ;YES
HLRO A,DEXTBL(C) ;GET POINTER TO FILE TYPE
HRRO B,DEXTBL(C) ;GET POINTER TO LIST OF SWITCHES
ETYPE < SET DEFAULT COMPILE-SWITCHES %1M %2M%%_>
JRST IDC0 ;LOOP FOR REST
;SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)
.SNDCS::STKVAR <<WHAT,2>,TBDLSA>
NOISE (FILE TYPE)
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,<"*" for all>,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /./]>,,,[
FLDDB. .CMKEY,,DEXTBL,<File type,>,,[
FLDDB. .CMFLD,CM%SDH]]]] ;.CMFLD MERELY FOR NONX ENTRIES
CALL FLDSKP ;GET SOME INPUT
CMERRX
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
DMOVEM B,WHAT ;REMEMBER COMND DATA
CONFIRM ;CONFIRM THE COMMAND
DMOVE B,WHAT ;GET WHAT WAS TYPED
CAIN C,.CMFLD ;NONEXISTENT ENTRY?
JRST SNDERR ;YES - GIVE ERROR
CAIN C,.CMTOK ;STAR OR DOT?
JRST SNDALL ;YES, DELETE ALL DEFAULTS OR "."
MOVE A,(B) ;SAVE TABLE ENTRY FOR LATER
SNDCS1: MOVEM A,TBDLSA
MOVEI A,DEXTBL ;POINT AT TABLE
TBDEL ;REMOVE REQUESTED ENTRY
HLRO A,TBDLSA ;DEALLOCATE STRINGS IN EACH HALF
CALL STREM
HRRO A,TBDLSA
CALLRET STREM ;AND RETURN
;HERE IF A TOKEN WAS TYPED. IF "*" DELETE ALL DEFAULTS. IF "." DELETE "."
SNDALL: LDB A,[350700,,ATMBUF] ;GET THE TOKEN THAT WAS TYPED
CAIE A,"*" ;STAR?
JRST SNDALD ;NO - MUST BE A DOT
HLLZ D,DEXTBL ;YES - FIGURE OUT HOW MANY DEXTBL ENTRIES
HRRZS DEXTBL ;CLEAR ALL ENTRIES
JUMPE D,R ;IF NO ENTRIES, DONE
MOVNS D ;CONSTRUCT AOBJN POINTER
HRRI D,DEXTBL+1
SNDAL1: HLRO A,(D) ;DEALLOCATE STRINGS IN EACH HALF
CALL STREM
HRRO A,(D)
CALL STREM
AOBJN D,SNDAL1 ;GO BACK IF MORE
RET
SNDALD: HRROI B,ATMBUF ;FIND THE "." ENTRY
MOVEI A,DEXTBL ; IN THE DEFAULT EXTENSION TABLE
TBLUK
TXNN B,TL%EXM ;FOUND IT?
JRST SNDERR ;NO - ERROR
MOVE B,A ;YES - SET UP ADDRESS TO DELETE
MOVE A,(A) ;GET ADDRESS OF EXTENSION ENTRY
JRST SNDCS1 ;GO FINISH OFF
SNDERR: HRROI A,ATMBUF ;POINTER TO NONEXISTENT FILE TYPE
LDB B,[350700,,ATMBUF] ;SEE IF ANYTHING TYPED
CAIN B,.CHNUL ;ANYTHING TYPED?
ERROR <File type or "*" expected>
ETYPE <%%No defaults were set for file type %1M%%_>
RET
;SET DEFAULT COMPILE-SWITCHES (FILE TYPE) TYP (SWITCHES) /SW/SW/SW...
.SDCS:: STKVAR <STE,SAVOP,SAVSCT,SAVFGS,EXTPTR,ENTPTR,ANYYET,<LST,DCSSIZ>,SWPT,LSTPT,LSTRM>
NOISE (FILE TYPE)
DOTX <File type (without the dot), or just dot (.) for null type>
CAIA ;NOT DOT, MUST BE REAL FILE TYPE
JRST SDC0 ;USER TYPED DOT
WORDX <File type (without the dot)>
CMERRX <File type or dot (.) required>
SDC0: CALL BUFFF ;ISOLATE THE EXTENSION
MOVEM A,EXTPTR ;REMEMBER IT
MOVEI A,DCSSIZ*5 ;INITIALIZE AMOUNT OF ROOM LEFT
MOVEM A,LSTRM
HRROI A,LST ;INITIALIZE POINTER TO LIST OF SWITCHES
MOVEM A,LSTPT ;REMEMBER POINTER
SETZM ANYYET ;NOTE THAT NO SWITCHES INPUT YET
SDC1: MOVEI B,[FLDDB. .CMCFM,,,,,[FLDDB. .CMSWI,,SWTAB]]
SKIPN ANYYET ;GOT ANY SWITCHES YET?
MOVE B,(B) ;NO, SO NO CR ALLOWED
CALL FLDSKP ;READ FIELD, SKIP IF SUCCESSFUL
CMERRX <Invalid switch>
LDB C,[331100,,(C)] ;SEE WHAT WAS TYPED
SETOM ANYYET ;MARK THAT WE'VE GOT AT LEAST ONE SWITCH
CAIN C,.CMCFM ;END OF LINE?
JRST SDC3 ;YES, GO STORE SWITCHES
MOVEM B,STE ;REMEMBER TABLE ENTRY
MOVE B,(B) ;GET TABLE ENTRY
HLRO B,B ;MAKE POINTER TO SWITCH STRING
MOVEM B,SWPT ;REMEMBER POINTER TO SWITCH
SETZB C,D ;STOP ON NULL (D USED FOR SECOND SOUT)
HRROI B,[ASCIZ ./.] ;PUT SLASH IN FOR SWITCH
MOVE A,LSTPT ;GET POINTER TO LIST
SOUT ;WRITE THE SLASH
SOS C,LSTRM ;GET ROOM LEFT, ACCOUNT FOR SLASH
MOVE B,SWPT ;GET POINTER TO SWITCH
CALL SOUTN ;SOUT BUT DON'T KEEP NULL
MOVEM A,SAVOP ;SAVE OUTPUT POINTER
MOVEM C,SAVSCT ;SAVE SWITCH CHARACTER COUNT
MOVE A,STE ;GET SWITCH TABLE ENTRY
CALL HANSWI ;DO SPECIAL PARSING
JRST [ MOVE A,SAVOP
MOVE C,SAVSCT ;NO, RESTORE SOUT STUFF
JRST SDC4]
MOVEM A,SAVFGS ;SAVE SPECIAL FLAGS
MOVE A,SAVOP ;GET BACK DATA TO CONTINUE SOUT
MOVE C,SAVSCT
MOVX D,S%QUO
TDNE D,SAVFGS ;IS SWITCH QUOTED?
CALL SDCQ ;YES - OUTPUT A QUOTE
MOVEI D,0 ;END ON NULL
HRROI B,ATMBUF ;GET SPECIAL DATA
CALL SOUTN ;SOUT BUT DON'T KEEP NULL
MOVX D,S%QUO
TDNE D,SAVFGS ;QUOTED?
CALL SDCQ ;YES - OUTPUT A QUOTE
SDC4: CAIG C,1 ;MAKE SURE ROOM FOR AT LEAST ONE MORE CHAR (NEXT "/" !)
ERROR <Too many switches in command>
MOVEM C,LSTRM ;REMEMBER HOW MUCH ROOM IS LEFT NOW
MOVEM A,LSTPT ;REMEMBER UPDATED POINTER
JRST SDC1 ;KEEP READING
SDC3: MOVEI A,DEXTBL ;GET ADDRESS OF TABLE
MOVE B,EXTPTR ;GET POINTER TO EXTENSION
TBLUK ;FIND EXTENSION IN TABLE
TXNE B,TL%EXM ;ALREADY IN TABLE?
JRST SDC2 ;YES
MOVE A,EXTPTR ;NO, SET IT UP IN PERMANENT FREE SPACE
CALL XBUFFS
HRRZM A,EXTPTR ;REMEMBER WHERE WE PUT IT
HRLZ B,A ;GET TABLE ENTRY TO BE ADDED
MOVEI A,DEXTBL ;ADDRESS OF TABLE
TBADD ;ADD NEW ENTRY
ERJMP [HRRO A,EXTPTR ;REMOVE EXTENSION STRING
CALL STREM ;FROM PERMANENT FREE SPACE
ERROR <No room for another file type>]
SDC2: HRRZM A,ENTPTR ;SAVE ENTRY POINTER FOR LATER
HRRO A,(A) ;MAKE BYTE POINTER TO DEFAULT STRING SO FAR
TRNN A,777777 ;IS THERE ANY STRING TO APPEND TO?
JRST [HRROI A,LST ;NO, PUT IN PERMANENT FREE SPACE
CALL XBUFFS
HRRM A,@ENTPTR ;PUT STRING POINTER INTO TABLE ENTRY
RET]
CALL BCOUNT ;YES, FIND HOW BIG IT IS
ADDI B,DCSSIZ*5+1 ;COMPUTE SIZE OF JOINED STRINGS
SUB B,LSTRM ;(PLUS 1 FOR NULL)
IDIVI B,5
CAIE C,0
AOJ B,
MOVE A,B
CALL GTBUFX ;GET THE MEMORY
HRROS A ;FIX UP OUTPUT ADDRESS AS BYTE POINTER
MOVE C,ENTPTR
HRRO B,(C) ;COPY FROM PRESENT DEFAULT STRING FIRST
HRRZM B,SAVOP ;SAVE TO DELETE LATER
HRRM A,(C) ;UPDATE STRING POINTED TO
SETZ C,
SOUT
MOVEI C,377777 ;COPY A NULL TOO
HRROI B,LST ;GET POINTER TO DEFAULT LIST GIVEN IN COMMAND
MOVEI D,0 ;STOP COPYING ON NULL
SOUT ;ADD IT TO REST
HRRO A,SAVOP ;RETURN OLD STRING TO PERMANENT FREE SPACE
CALLRET STREM
SDCQ: SETZ D, ;SUBROUTINE TO OUTPUT A QUOTE
HRROI B,[ASCIZ /"/]
; CALLRET SOUTN ;SOUT BUT DON'T KEEP NULL; FALL INTO SOUTN
;ROUTINE USED ABOVE TO DO SOUT ASSUMING POSITIVE COUNT IN C. BACKS
;UP COUNT AND DESTINATION POINTER SO AS NOT TO KEEP NULL CHARACTER IN
;STRING
SOUTN: SOUT ;WRITE THE DATA
BKJFN ;BACK UP THE POINTER
CALL JERR ;SHOULDN'T FAIL
AOJA C,R ;UNCOUNT THE FINAL NULL AND RETURN
SUBTTL TI - TEXT INPUT ROUTINE
;TEXTI/GTJFN BLOCK INIT ROUTINE
TIRST: LDF Q1,GJ%XTN!GJ%OLD ;EXTENDED GTJFN
MOVEM Q1,CJFNBK
SETZM CJFNBK+2 ;CLEAR DEFAULTS
MOVE Q1,[CJFNBK+2,,CJFNBK+3]
BLT Q1,XTNCNT-1 ;...
LDF Q1,G1%RBF!G1%RND!G1%NLN+3 ;RETURN ON NULL NAME
MOVEM Q1,XTNCNT
RET ;RETURN
;ROUTINE FOR DOING COMND JSYS FOR COMPILE-CLASS COMMANDS. PREVENTS
;"@" FROM HAVING STANDARD EFFECT, AS COMPILE-CLASS COMMANDS WANT TO
;PROCESS "@" THEMSELVES.
CFIELD::MOVX A,CM%XIF ;WE WANT TO DO INDIRECT FILESPEC OURSELF
IORM A,CMFLG
CALLRET FIELDX ;READ INPUT AND RETURN
;MAIN ROUTINE
;INPUT ROUTINE, MERELY INPUTS ENTIRE LINE, DOING RECOGNITION ON
;FILESPECS AND SWITCHES
TI: SETZM NFIAR ;NO FILES IN A ROW YET
SETZM NFILS ;NO FILES AT ALL
MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL
FLDDB. .CMSWI,,SWTAB,,,[ ;SWITCH
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
CAIA ;FAILED
JRST @D ;DISPATCH ON FIELD FLAVOR
CALL SKCROK ;DIFFERENT ERROR DEPENDING ON WHETHER CR ALLOWED
CMERRX <Switch, filespec, "@", or "%" required>
CMERRX <Carriage return, switch, filespec, "@", or "%" required>
;CR GOT TYPED
TCR: MOVE A,CMPTR ;GET POINTER TO END OF STRING
SETZM B
IDPB B,A ;PUT NULL AT END OF STRING
RET ;RETURN TO CALLER
;AT SIGN TYPED
TAT: DEXTX <CMD> ;DEFAULT COMMAND FILE EXTENSION IS "CMD"
MOVX A,GJ%OLD ;COMMAND FILE MUST EXIST
MOVEM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMFIL,,,<Name of indirect file>,,]
CALL CFIELD ;READ INDIRECT FILESPEC
TXNE A,CM%NOP
CMERRX <Invalid indirect file specification>
AOS NFILS ;WE MUST ASSUME THERE IS A FILESPEC IN THE INDIRECT FILE
JRST TALL ;AFTER INDIRECT FILE, ANYTHING CAN BE INPUT
;FILE SPEC SEEN. MAY BE FOLLOWED BY ANYTHING.
TFILE: AOS NFILS ;REMEMBER HOW MANY FILES
AOS A,NFIAR ;COUNT HOW MANY FILESPECS IN A ROW
CAIGE A,2 ;DON'T ALLOW MORE THAN TWO FILESPECS IN A ROW (WITHOUT THIS CHECK, "COMP /L" CAUSES "?TOO MANY JFNS IN COMMAND")
JRST TALL
MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL
FLDDB. .CMSWI,,SWTAB,,,[ ;SWITCH
FLDDB. .CMCMA,,,,,[ ;COMMA
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]] ;PERCENT SIGN
CALL COMIN ;TRY TO PARSE A FIELD
CMERRX ;FAILED, USE SYSTEM'S REASON
JRST @D ;SUCCEEDED, DISPATCH ON FLAVOR
;PLUS SIGN SEEN
TPLUS: MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Source file specification>,,] ;FILESPEC
CALL COMIN1 ;INPUT FILESPEC
CMERRX <Invalid source file specification>
JRST TALL ;ANYTHING CAN BE TYPED AFTER A SOURCE
;GET HERE WHEN ANYTHING MAY BE TYPED
TALL: MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL
FLDDB. .CMSWI,,SWTAB,,,[ ;SWITCH
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMCMA,,,,,[ ;COMMA
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
CAIA ;FAILED
JRST @D ;DISPATCH ON FIELD FLAVOR
CALL SKCROK ;SEE IF CARRIAGE RETURN ALLOWED
CMERRX <Switch, filespec, comma, "@", "+", or "%" required>
CMERRX <Carriage return, switch, filespec, comma, "@", "+", or "%" required>
;SKCROK SKIPS IF CARRIAGE RETURN VALID NOW. CLOBBERS NOTHING.
SKCROK: SKIPN CSVC ;IF DEFAULT STRING, THEN CR IS O.K.
SKIPE NFILS ;IF NO DEFAULT STRING BUT FILE SEEN, THEN CR O.K.
RETSKP ;SKIP, CR O.K.
RET ;DON'T SKIP, CR NOT O.K.
;ROUTINE TO DO INPUT FOR COMPILE-CLASS COMMAND. TAKES NON-SKIP
;RETURN IF FIELD DOESN'T MATCH SOMETHING IN THE REQUESTED CHAIN (FED
;BY AC2 ON THE CALL). SKIP RETURNS WITH ADDRESS OF SUPPORT ROUTINE
;IN D IF SUCCESSFUL PARSE.
COMIN: CALL SKCROK ;SEE IF CARRIAGE RETURN LEGAL
MOVE B,(B) ;NO, SO CR INVALID ON EMPTY LINE
COMIN1: PUSH P,B ;SAVE FUNCTION CHAIN
DEXTX ;NO DEFAULT EXTENSION ON FILESPEC
MOVX A,GJ%XTN ;WE HAVE AN EXTENDED FLAG, SO WE NEED THIS BIT
MOVEM A,CJFNBK+.GJGEN
MOVX A,G1%NLN ;EXTENDED FLAG SAYS ONLY ALLOW TOPS-10 STYLE NAMES (SHORT NAMES AND NO GENERATION FIELDS AND ATTRIBUTES ALLOWED)
MOVEM A,CJFNBK+.GJF2 ;STORE EXTENDED FLAGS
POP P,B ;RESTORE FUNCTION CHAIN
CALL CFIELD ;DO COMND JSYS
; TXNE A,CM%NOP ;MAKE SURE A LEGAL POSSIBILITY WAS TYPED
; JRST COM1 ;GO TRY PARSE ONLY
TXNN A,CM%NOP
IFSKP.
CAIE B,NPXAMB
IFSKP.
CMERRX
ENDIF.
CAIE B,NPXNOM
IFSKP.
CMERRX
ENDIF.
CAIE B,NPXNUL
IFSKP.
CMERRX
ENDIF.
CAIE B,NPXNC
IFSKP.
CMERRX
ENDIF.
JRST COM1
ENDIF.
CALL IDEN ;FIND OUT WHAT GOT TYPED
RETSKP ;SKIP ON SUCCESS
;REGULAR GTJFN FAILED, SO TRY OLD-FILE ONLY. NOTE THAT IT ISN'T
;GOOD TO TRY OLD-FILE-ONLY FIRST, BECAUSE SIMPLE COMMON CASE OF
;"COMPILE FOO" WOULD FAIL, AS FILE ISN'T CALLED "FOO", BUT "FOO.FOR"
;OR SOMETHING LIKE THAT. HOWEVER, THE ORIGINAL GTJFN WE DID WITH
;NO BITS ON WILL FAIL ON "COMP X:FOO" WHERE X: IS DEFINED WITH
;"DEFINE X: (AS) <A>,<B>", AND DIRECTORY <A> IS NOT WRITABLE BY THE
;USER. OLD-FILE-ONLY WILL CAUSE THE LOGICAL NAME TO BE STEPPED
;WHEN LOOKING FOR "FOO" IF NOT FOUND IN <A>.
;ACTUALLY, OLD-FILE-ONLY WILL ALSO FAIL FOR "COMP X:FOO"! HOWEVER,
;IF FOO.MAC IS UNIQUE IN X:, "COMP X:FOO$" WILL RECOGNIZE IT WITH
;OLD-FILE-ONLY. BUT IF NO RECOGNITION IS ATTEMPTED, "COMP X:FOO" WILL
;FAIL, SINCE THERE'S NO OLD FILE CALLED "FOO" IN X:. HENCE, IF OLD-FILE-ONLY
;FAILS, WE HAVE TO TRY PARSE-ONLY GTJFN!! NOTE THAT PARSE-ONLY
;MUST BE TRIED LAST TO ALLOW RECOGNITION TO WORK.
COM1: MOVE A,NFIAR ;SEE HOW MANY FILES IN A ROW SO FAR
CAIL A,2 ;TWO?
RET ;YES, DON'T ALLOW ANY MORE
MOVX A,GJ%OLD ;TRY OLD-FILE-ONLY
IORM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMFIL]
CALL CFIELD
TXNN A,CM%NOP ;SKIP IF FAILED
JRST COM2 ;SUCCEEDED
MOVE A,CJFNBK+.GJGEN ;GET FLAGS
TXZ A,GJ%OLD ;TURN OFF OLD-FILE-ONLY
TXO A,GJ%OFG ;TRY PARSE-ONLY
IORM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMFIL]
CALL CFIELD
TXNN A,CM%NOP ;FAIL?
JRST COM2 ;NO,
CAIE B,600060 ;YES, BECAUSE OF GENERATION # OR ATTRI?
RET ;NO,
MOVE D,[440700,,ATMBUF] ;YES, GET FILE NAME
ERROR <No generation field or attributes allowed, or invalid character in file name - %4M>
COM2: MOVE A,CSBUFP ;GET POINTER TO TEMPORARY STORAGE
MOVSI C,(1B8) ;ALWAYS OUTPUT THE FILE NAME ONLY
JFNS ;GET THE FILE NAME THAT WAS ENTERED
ILDB A,CSBUFP ;TAKE A LOOK AT THE FIRST CHARACTER
JUMPE A,R ;ERROR IF FILE NAME IS NULL
MOVEI D,TFILE ;SAY THAT FILESPEC TYPED
RETSKP
;ROUTINE TO CALL AFTER COMND TO FIGURE OUT WHAT GOT TYPED. RETURNS ADDRESS
;IN D OF ROUTINE TO JUMP TO TO HANDLE THAT FIELD.
IDEN: MOVE A,B ;IF FILE TYPED, JFN NOW IN A!
LDB D,[331100,,.CMFNP(C)] ;FIND OUT WHAT WAS TYPED
CAIE D,.CMFIL ;FILESPEC?
SETZM NFIAR ;NO, SO TALLY ZERO FILESPECS IN A ROW
EXCH C,D ;FUNCTION CODE IN C, POINTER IN D
CAIN C,.CMTOK ;TOKEN?
JRST IDTOK ;YES, GO INVESTIGATE FURTHER
CAIN C,.CMCMA ;COMMA?
MOVEI D,TCOMM ;YES
CAIN C,.CMCFM ;CARRIAGE RETURN?
MOVEI D,TCR ;YES
CAIN C,.CMFIL ;FILESPEC?
MOVEI D,TFILE ;YES
CAIN C,.CMSWI ;SWITCH?
MOVEI D,TSWI ;YES
RET
IDTOK: MOVE A,.CMDAT(D) ;TOKEN TYPED, GET POINTER TO WHICH KIND
BIN ;GET THE TOKEN
CAIN B,"%" ;LINK SWITCH DELIMITER?
MOVEI D,TPER ;YES
CAIN B,"@" ;INDIRECT FILE DELIMITER?
MOVEI D,TAT ;YES
CAIN B,"+" ;PLUS SIGN?
MOVEI D,TPLUS ;YES
RET
;% TYPED. READ THE LINK SWITCH
TPER: QUOTEX <LINK switch, in quotes>
CMERRX <Invalid LINK switch>
JRST TALL ;AFTER LINK SWITCH, ANYTHING MAY BE TYPED
;SWITCH TYPED. ANYTHING MAY FOLLOW
TSWI: MOVE A,B ;PUT TABLE ADDRESS IN A
CALL HANSWI ;HANDLE DETAILS ABOUT PARSING THE SWITCH
JRST TALL ;WE DON'T CARE IF SPECIAL VALUE WAS REQUIRED
JRST TALL
;ROUTINE TO DO SWITCH-SPECIFIC PARSING
;GIVE IT TABLE ADDRESS IN A. IT SKIPS WITH ARG PARSED, IFF A SPECIAL
;ARG IS REQUIRED
;RETURNS VALID SETTING OF S%QUO IN A.
HANSWI: STKVAR <QQQ>
HRRZ A,(A) ;GET ADDRESS OF SWITCH DATA
MOVEI B,1(A) ;GET ADDRESS CONTAINING SPECIAL DISPATCH ADDRESS
MOVE A,(A) ;GET SWITCH DATA
MOVEM A,QQQ ;REMEMBER FLAGS
MOVEM A,QQQFLG
TXNE A,S%QUO+S%VAL ;QUOTED STRING OR VALUE TO FOLLOW?
IFSKP. ; NO, BUT CHECK IF ONE WAS TYPED ANYWAY
MOVE D,SBLOCK+.CMFLG ;SET UP COMND% FLAGS
TXNE D,CM%SWT ;WAS ILLEGAL COLON TYPED IN SWITCH?
ERROR <Invalid use of colon in switch> ; YES, COMPLAIN ABOUT IT.
RET ;NO PROBLEM FOUND
ENDIF.
CALL @(B) ;GO GET VALUE TYPED IN TO SWITCH
MOVE A,QQQ ;RETURN FLAGS IN A
RETSKP ;SKIP TO SAY SOMETHING MORE WAS READ
;READ VALUE FOR /LANGUAGE-SWITCHES
RDLSW: QUOTEX <Switch(es) for compiler, in quotes>
CMERRX <Invalid value for /LANGUAGE-SWITCHES:>
RET
;COMMA TYPED. DON'T ALLOW END OF LINE AFTER COMMA, OR ANOTHER COMMA,
;OR A PLUS SIGN.
TCOMM: MOVEI B,[
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]] ;PERCENT SIGN
CALL COMIN1 ;INPUT FIELD
CMERRX <Filespec, "@", or "%" required after comma>
JRST @D ;DISPATCH
;SWMOV - ROUTINE TO PLACE SWITCH NAME IN BUFFER IN PROPER
;FORMAT FOR FSYM
;CALL: MOVE A,<POINTER-TO-STRING>
; CALL SWMOV
; RETURN HERE (STRING IN FSPEC), POINTER TO LAST CHAR IN A
SWMOV: MOVE B,A ;SOURCE POINTER IN B
HRROI A,FSPEC ;COPY TO FSPEC
MOVEI C,0 ;STOP ON NULL
SOUT
RET
;LANGUAGE EXTENSION TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
LT.'EXT==<%LT==%LT+1>
ASCII "EXT"
>
%LT==0 ;INITIAL VALUE
;Note that LT.REL, which must be the first entry, for GTLNG1, must be 1,
;because language type 0 is reserved for the null extension
LTAB: 0 ;NULL EXTENSION (ILLEGAL AS ACTUAL LANGUAGE TYPE)
LANGUAGE ;EXPAND MACRO
LTABL==.-LTAB ;LENGTH OF TABLE
LT.68C==LT.C68
LT.74C==LT.C74
;TABLE OF SIXBIT TMP FILE NAMES
SIXTAB: 0 ;TYPE 0 UNUSED
DEFINE L(A,B,C,D)
<IFNB <D>, SIXBIT /D/ ;;SIXBIT IF OLD-STYLE LINE EXISTS
IFB <D>, 0 ;;0 IF NO OLD-STYLE LINE EXISTS
>
LANGUAGE
;TABLE OF SIXBIT TMP FILE NAMES FOR NATIVE-COMPILERS
NSXTAB: 0
DEFINE L(A,B,C,D,E)
<IFB <E>, 0 ;;0 IF NO NATIVE COMPILER FOR THIS LANGUAGE
IFNB <E>, SIXBIT /E/ ;;SIXBIT FOR NATIVE COMPILER TEMP FILE NAME
>
LANGUAGE
;LANGUAGE TMP FILE NAME TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
[GETSAVE (<SYS:'PROC'.>)],,[ASCIZ \TNAME'.TMP\]
>
PRTAB: ;PROCESS NAME TABLE(LH)
0 ;TEMP NAME (RH)
LANGUAGE ;EXPAND
;DEBUG AID TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
0,,[ASCIZ \:'LANG\]
>
DBTAB: 0 ;LOSAGE ENTRY
LANGUAGE ;EXPAND
DEFINE NAMES <
NM (10-BLISS,S%LTYP,LT.B10)
NM (36-BLISS,S%LTYP,LT.B36)
NM (68-COBOL,S%LTYP,LT.C68)
NM (74-COBOL,S%LTYP,LT.C74)
NM (ABORT,S%FRH,F%ABT)
NM (ALGOL,S%LTYP,LT.ALG)
NM (BINARY,S%TOFF!S%FRH,F%NBIN)
; NM (CHECK,S%FRH,F%CHK)
NM (COBOL,S%LTYP,LT.CBL)
NM (COMPILE,S%FRH,F%CMPL)
NM (CREF,S%FRH,F%CREF!F%LIST)
NM (CROSS-REFERENCE,S%FRH,F%CREF!F%LIST)
NM (DDT,S%FLH,F%DDT)
NM (DEBUG,S%FRH,F%DEB)
; NM (ERROR-LIMIT,S%FRH,F%ERR)
NM (FAIL,S%LTYP,LT.FAI)
NM (FLAG-NON-STANDARD,S%FRH,F%FLAG)
NM (FORTRAN,S%LTYP,LT.FOR)
NM (LANGUAGE-SWITCHES:,S%QUO!S%DSP,DOLSW,RDLSW)
NM (LIBRARY,S%FRH,F%LIB)
NM (LIST,S%FRH,F%LIST)
NM (MAC,S%LTYP,LT.MAC)
NM (MACHINE-CODE,S%FRH,F%MACH)
NM (MACRO,S%LTYP,LT.MAC)
NM (MAP,S%DSP,SWMAP,[RET])
NM (NOBINARY,S%FRH,F%NBIN)
; NM (NOCHECK,S%TOFF!S%FRH,F%CHK)
NM (NOCOMPILE,S%TOFF!S%FRH,F%CMPL)
NM (NOCREF,S%TOFF!S%FRH,F%CREF!F%LIST)
NM (NOCROSS-REFERENCE,S%TOFF!S%FRH,F%CREF!F%LIST)
NM (NODEBUG,S%TOFF!S%FRH,F%DEB)
; NM (NOERROR-LIMIT,S%TOFF!S%FRH,F%ERR)
NM (NOFLAG-NON-STANDARD,S%TOFF!S%FRH,F%FLAG)
NM (NOLIBRARY,S%TOFF!S%FRH,F%LIB)
NM (NOLIST,S%TOFF!S%FRH,F%CREF!F%LIST)
NM (NOMACHINE-CODE,S%TOFF!S%FRH,F%MACH)
NM (NOOPTIMIZE,S%TOFF!S%FRH,F%OPT)
NM (NOSEARCH,S%TOFF!S%FRH,F%LIB)
NM (NOSTAY,S%DSP,NOSTAY,[RET])
NM (NOSYMBOLS,S%FRH,F%LSYM)
NM (NOWARNINGS,S%FRH,F%NWAR)
NM (OPTIMIZE,S%FRH,F%OPT)
NM (PASCAL,S%LTYP,LT.PAS)
NM (RELOCATABLE,S%LTYP,LT.REL)
NM (SAIL,S%LTYP,LT.SAI)
NM (SEARCH,S%FRH,F%LIB)
NM (SIMULA,S%LTYP,LT.SIM)
NM (SNOBOL,S%LTYP,LT.SNO)
NM (STAY,S%DSP,DOSTAY,[RET])
NM (SYMBOLS,S%TOFF!S%FRH,F%LSYM)
NM (WARNINGS,S%TOFF!S%FRH,F%NWAR)
>
DEFINE NM (NAME,FLAGS<0>,VALUE<0>,VAL2) <
%V==VALUE ;TEMP EQUATE
IF2 ,<IFN <%V&^O777777B17>,<%V==<Z (%V)>>>
IFB <VAL2>,<[ASCIZ "NAME"],,[<Z (FLAGS)>,,%V]>
IFNB <VAL2>,<[ASCIZ "NAME"],,[ <Z (FLAGS)>,,%V
VAL2]>
>
SWTAB: SWLEN,,SWLEN
NAMES
SWLEN==.-SWTAB-1
BRINI. ;START WITH ALL 0'S
BRKCH. " " ;BREAK ON THESE CHARACTERS
BRKCH. "/"
BRKCH. ":"
BRKCH. "+"
BRKCH. "%"
BRKCH. ","
BRKCH. (QUOTE) ;QUOTE MARK
BRKCH. (0) ;NULL (END OF COMMAND)
BMSK: EXP W0.,W1.,W2.,W3.
;NEW SET OF BREAK MASK FOR /SWITCH:TEXT
BRINI. ;START WITH ALL 0'S
BRKCH. (40,77) ;BREAK ON ALMOST EVERY THINGS
BRKCH. (100,137)
BRKCH. (140,176)
BMSKSW: EXP W0.,W1.,W2.,W3.
;CTAB - CHARACTER TYPE TABLE
;EACH 4-BIT ENTRY CONTAINS THE CHARACTER TYPE FOR CHARACTER N
CTAB: BYTE (4) 7,0,0,0,0,0,0,0,0 ; NULL THRU ^H(NULL MARKS END OF COMMAND)
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ^I THRU ^Q
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ^R THRU ^Z
BYTE (4) 0,0,0,0,0,1,0,13,0 ; ESC,PS,CS,RS,^_,SP,!,",#
BYTE (4) 0,11,0,0,0,0,0,2,6 ; $,%,&,',(,),*,+,,
BYTE (4) 0,0,3,0,0,0,0,0,0 ; -,.,/,0,1,2,3,4,5
BYTE (4) 0,0,0,0,12,0,0,0,0 ; 6,7,8,9,:,;,<,=,>
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ?,@,A,B,C,D,E,F,G
BYTE (4) 0,0,0,0,0,0,0,0,0 ; H,I,J,K,L,M,N,O,P
BYTE (4) 0,0,0,0,0,0,0,0,0 ; Q,R,S,T,U,V,W,X,Y
BYTE (4) 0,0,0,0,0,0,0,0,0 ; Z,[,\,],^,_,@,a,b
BYTE (4) 0,0,0,0,0,0,0,0,0 ; c,d,e,f,g,h,i,j,k
BYTE (4) 0,0,0,0,0,0,0,0,0 ; l,m,n,o,p,q,r,s,t
BYTE (4) 0,0,0,0,0,0,0,0,0 ; u,v,w,x,y,z,[,\,]
BYTE (4) 0,0 ; 176,177
;PTAB - BYTE POINTER TABLE FOR CTAB
PTAB: POINT 4,CTAB(Q1),3
POINT 4,CTAB(Q1),7
POINT 4,CTAB(Q1),11
POINT 4,CTAB(Q1),15
POINT 4,CTAB(Q1),19
POINT 4,CTAB(Q1),23
POINT 4,CTAB(Q1),27
POINT 4,CTAB(Q1),31
POINT 4,CTAB(Q1),35
;TRANSLATE (DIRECTORY) COMMAND
;ALLOWS EITHER PPN OR DIRECTORY NAME TO BE INPUT AND TRANSLATES TO THE
;OTHER
.TRANS::NOISE (DIRECTORY)
DIRX <Directory name or project-programmer-number>
JRST PPNQ ;USER DIDN'T TYPE DIRECTORY NAME.
CONFIRM ;GET CONFIRMATION OF COMMAND
MOVE C,B ;REMEMBER DIRECTORY NUMBER IN C
MOVE A,CSBUFP
DIRST ;GET DIRECTORY STRING
ERCAL CJERRE
MOVE A,CSBUFP
STDEV ;GET DEVICE ASSOCIATED WITH DIRECTORY
ERCAL CJERRE
MOVE A,CSBUFP
PUSH P,A ;REMEMBER POINTER TO DEVICE NAME
DEVST ;GET NAME OF DEVICE
ERCAL CJERRE
MOVE A,C ;PUT DIRECTORY NUMBER IN A
STPPN ;GET IT'S PPN
HLRZ C,B ;LEFT HALF IN C
HRRZ B,B ;LEAVE RIGHT HALF IN B
POP P,D ;GET POINTER TO DEVICE NAME
ETYPE <%1R (IS) %4M:[%3O,%2O]
>
RET
;USER TYPED NON-DIRECTORY. MAYBE IT'S A PPN.
PPNQ: CALL CONST ;GET DEVICE DESIGNATOR FOR CONNECTED STRUCTURE
MOVEM A,FBLOCK+.CMDEF ;FILL IN DEFAULT INFO
MOVE D,A ;REMEMBER POINTER IN CASE USER DOESN'T TYPE STRUCTURE NAME
DEVX <Structure name or/and "[" to start PPN>
SKIPA A,D ;NO DEVICE TYPED, USE CONNECTED STRUCTURE
CALL BUFFF ;ISOLATE THE DEVICE NAME
PUSH P,A ;REMEMBER POINTER TO DEVICE NAME
MOVEI A,"["
CHARX <"[" to start PPN>
JRST BADPPN ;BAD SYNTAX FOR PPN
OCTX <Octal programmer number>
JRST BADPPN
PUSH P,B ;SAVE PROJECT NUMBER
COMMAX <Comma to separate programmer number from project number>
JRST BADPPN
OCTX <Octal project number>
JRST BADPPN
PUSH P,B ;PROGRAMMER NUMBER
MOVEI A,"]"
CHARX <"]" to end PPN>
JRST BADPPN
CONFIRM
POP P,B ;GET PROGRAMMER NUMBER
POP P,D ;AND PROJECT NUMBER
HRL B,D ;PUT THEM TOGETHER
MOVE C,(P) ;GET POINTER TO STRUCTURE NAME
MOVE A,CSBUFP ;GET SOME SPACE FOR WRITING DIRECTORY NAME INTO
PPNST ;GET THE DIRECTORY NAME
ERCAL CJERRE ;ASSUME FAILURE WILL HAVE REASONABLE MESSAGE
HRRZ B,B ;KEEP ONLY THE PROGRAMMER NUMBER IN B
MOVE A,CSBUFP ;GET POINTER TO STRUCTURE NAME
POP P,C ;GET POINTER TO STRUCTURE NAME
ETYPE <%3M:[%4O,%2O] (IS) %1M
>
RET
;THE FOLLOWING VERBOSE ERROR MESSAGE WAS PUT IN BECAUSE AT TIME
;OF THIS COMMAND, DOCUMENTATION DEPARTMENT DIDN'T HAVE TIME TO UPDATE
;ALL THE DOCUMENTATION TO DESCRIBE IT, AS MANY PLACES HAD TO BE EDITED.
BADPPN: ERROR <To translate between PPN's and directories, type one of:
TRANSLATE str:<directory>
TRANSLATE str:[n,m]
>
END