Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/exec/execcs.mac
There are 47 other files named execcs.mac in the archive. Click here to see a list.
;713 add literals label
;712 DEC release version
; UPD ID= 140, SNARK:<5.EXEC>EXECCS.MAC.18, 7-Feb-82 14:00:09 by CHALL
;TCO 5.1719 ADD NATIVE FORTRAN (NFO) TO LANGUAGES MARCO
;TCO 5.1717 BILDIT- FOR NATIVE, PUT SWITCHES AFTER FILESPECS
; UPD ID= 116, SNARK:<5.EXEC>EXECCS.MAC.15, 28-Dec-81 11:12:13 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 103, SNARK:<5.EXEC>EXECCS.MAC.14, 22-Oct-81 14:39:14 by CHALL
;TCO 5.1582 .SNDCS- ALLOW "." TO BE A LEGAL EXTENSION NAME
; UPD ID= 95, SNARK:<5.EXEC>EXECCS.MAC.13, 21-Oct-81 11:27:34 by GROUT
;TCO 5.1577 Fix TPLUS and TCOMM to skip COMIN CRLF check
; UPD ID= 94, SNARK:<5.EXEC>EXECCS.MAC.12, 21-Oct-81 11:23:37 by GROUT
;TCO 5.1572 Fix INFO DEFAULT COMPILE-SWITCHES typeout
; UPD ID= 91, SNARK:<5.EXEC>EXECCS.MAC.11, 21-Oct-81 11:14:22 by GROUT
;TCO 5.1571 Fix /LANGUAGE-SWITCHES to work with SET DEFAULT COMPILE-SWITCHES
; UPD ID= 90, SNARK:<5.EXEC>EXECCS.MAC.10, 21-Oct-81 11:08:08 by GROUT
;TCO 5.1569 Fix SET DEFAULT COMPILE-SWITCHES
; UPD ID= 89, SNARK:<5.EXEC>EXECCS.MAC.9, 21-Oct-81 10:47:05 by GROUT
;TCO 5.1568 Make global language switches override file types for translator
; UPD ID= 88, SNARK:<5.EXEC>EXECCS.MAC.8, 21-Oct-81 10:43:17 by GROUT
;TCO 5.1567 Make /LANGUAGE-SWITCHES work as last thing on line
; UPD ID= 87, SNARK:<5.EXEC>EXECCS.MAC.7, 10-Oct-81 19:46:53 by CHALL
;TCO 5.1560 ADDED CBL68 (.C68) AND CBL74 (.C74) TO LANGUAGES TABLE
; ALSO, ADDED CBL68 (.68C) TO BE PARALLEL TO THE EXISTING CBL74 (.74C)
; UPD ID= 77, SNARK:<5.EXEC>EXECCS.MAC.5, 2-Oct-81 10:34:35 by CHALL
;TCO 5.1539 P1SRC1- CHANGE "%" TO "?" IN "?SOURCE FILE MISSING"
; ALSO, PASS2- CHANGE "%" TO "?" IN "?OBJECT FILE MISSING"
; UPD ID= 74, SNARK:<5.EXEC>EXECCS.MAC.4, 21-Sep-81 09:10:13 by CHALL
;TCO 5.1520 GTASC- 7-CHAR FILE NAMES WERE ALLOWED (TYPO), BUT NOT NO MO
; UPD ID= 24, SNARK:<5.EXEC>EXECCS.MAC.3, 14-Aug-81 18:33:42 by CHALL
;TCO 5.1454 CHANGE NAMES FROM CSCAN TO EXECCS AND XDEF TO EXECDE
; UPD ID= 1798, SNARK:<5.EXEC>EXECCS.MAC.2, 7-Apr-81 17:14:54 by TILLSON
;tco 5.1278 - Use "COBOL" as debugger name, not "74-COBOL"
;<4.EXEC>EXECCS.MAC.1, 26-Mar-80 18:55:00, Edit by DK32
;Programmable Command Language
; UPD ID= 1388, SNARK:<5.EXEC>EXECCS.MAC.13, 30-Dec-80 14:53:00 by DONAHUE
;tco 5.1221 - Make HANSWI check for S%QUO+S%VAL instead of S%DSP
; UPD ID= 1385, SNARK:<5.EXEC>EXECCS.MAC.12, 24-Dec-80 16:11:36 by OSMAN
;More 5.1220 - Allow compiler to have non-TOPS10 entry vector
; UPD ID= 1381, SNARK:<5.EXEC>EXECCS.MAC.11, 24-Dec-80 14:42:07 by OSMAN
;More 5.1220 - NTVCOM was superfluous
; UPD ID= 1380, SNARK:<5.EXEC>EXECCS.MAC.10, 24-Dec-80 14:38:55 by OSMAN
;tco 5.1220 - Talk to native-mode compilers
; UPD ID= 1238, SNARK:<5.EXEC>EXECCS.MAC.9, 6-Nov-80 15:20:36 by OSMAN
;tco 5.1189 - Use $GET0 instead of $GET2
; UPD ID= 1163, SNARK:<5.EXEC>EXECCS.MAC.8, 14-Oct-80 10:45:09 by DONAHUE
;TCO 5.1172 - MAKE TCR PUT A NULL AT END OF COMMAND STRING
; UPD ID= 985, SNARK:<5.EXEC>EXECCS.MAC.7, 3-Sep-80 14:57:49 by OSMAN
;tco 5.1140 - Make /LANGUAGE-SWITCHES: work!
; UPD ID= 869, SNARK:<5.EXEC>EXECCS.MAC.6, 11-Aug-80 11:21:29 by OSMAN
;tco 5.1129 - Make CFIELD global
; UPD ID= 850, SNARK:<5.EXEC>EXECCS.MAC.5, 7-Aug-80 16:48:30 by OSMAN
;More 5.1122 - Make sure CREF isn't run in "stay" mode
; UPD ID= 822, SNARK:<5.EXEC>EXECCS.MAC.4, 4-Aug-80 09:46:54 by OSMAN
;tco 5.1122 - Add /STAY
; UPD ID= 548, SNARK:<5.EXEC>EXECCS.MAC.3, 21-May-80 17:05:00 by MURPHY
;PREVENT FOLLOWING SEARCH LIST FOR REL FILE IN CERTAIN CASES
; UPD ID= 419, SNARK:<4.1.EXEC>EXECCS.MAC.4, 8-Apr-80 13:44:01 by OSMAN
;tco 4.1.1139 - Make "?Can't find process" a better message
; UPD ID= 395, SNARK:<4.1.EXEC>EXECCS.MAC.3, 1-Apr-80 16:40:43 by TOMCZAK
;TCO#4.1.1133 - Have EXEC look for CBL74, not 74-COBOL
;<4.1.EXEC>EXECCS.MAC.2, 26-Nov-79 09:59:06, EDIT BY OSMAN
;tco 4.2577 - Put in PASCAL and SIMULA support
;<4.EXEC>EXECCS.MAC.201, 19-Oct-79 15:29:02, EDIT BY OSMAN
;MORE 4.2436 - STRIP NULLS FROM INDIRECT FILE CONTENTS
;<4.EXEC>EXECCS.MAC.196, 3-Oct-79 19:59:21, EDIT BY OSMAN
;tco 4.2509 - Don't allow cr in LOAD-class command unless filespec seen
;<4.EXEC>EXECCS.MAC.190, 3-Oct-79 15:23:41, EDIT BY OSMAN
;USE PERMANENT FREE SPACE FOR REMEMBERED STRING
;<4.EXEC>EXECCS.MAC.181, 1-Oct-79 09:35:25, EDIT BY OSMAN
;PUT INDIRECT FILES IN-LINE!
;remove special guide-word scanner (not needed)
;MORE 4.2436 - Make CMPRES remember character from previous indirect level
;More 4.2436 - Make CMPRES ignores all spaces except those sandwiched
;between filespecs
;<4.EXEC>EXECCS.MAC.177, 14-Sep-79 15:51:52, EDIT BY OSMAN
;MORE 4.2436 - Make CMPRES delete spaces after quoted string
;<4.EXEC>EXECCS.MAC.176, 14-Sep-79 11:02:23, EDIT BY OSMAN
;MORE 4.2436 - ignore comma comma at RDCOMA
;<4.EXEC>EXECCS.MAC.175, 14-Sep-79 10:12:35, EDIT BY OSMAN
;MORE 4.2436 - Get rid of RDSKP; Make CMPRES flush spaces following comma
;Don't set F%LAHD after gobbling indirect file
;<4.EXEC>EXECCS.MAC.174, 10-Sep-79 16:13:07, EDIT BY OSMAN
;tco 4.2466 - Do better than "?File not found" when indirect file in
;indirect file is not found
;<4.EXEC>EXECCS.MAC.173, 13-Sep-79 15:21:44, EDIT BY OSMAN
;MORE 4.2436 - Store words for PARSE recursion
;<4.EXEC>EXECCS.MAC.171, 13-Sep-79 6:24:13, EDIT BY OSMAN
;MORE 4.2436 - HANDLE NON-7-BIT indirect files correctly
;<4.EXEC>EXECCS.MAC.170, 7-Sep-79 11:19:36, EDIT BY OSMAN
;DON'T CALL JFNSTK AT TAT, COM2, OR IDEN; IT'S ALREADY CALLED AT CFN2
;<4.EXEC>EXECCS.MAC.169, 11-Sep-79 14:56:13, EDIT BY OSMAN
;more 4.2436 - Leave room for null in indirect buffer
;<4.EXEC>EXECCS.MAC.168, 11-Sep-79 10:28:27, EDIT BY OSMAN
;MORE 4.2436 - CALL RETBUF with correct args
;<4.EXEC>EXECCS.MAC.166, 4-Sep-79 15:41:26, EDIT BY OSMAN
;tco 4.2436 - Allow comments in indirect files
;<EKLUND>EXECCS.MAC.5, 28-Aug-79 13:56:39, EDIT BY EKLUND
;TCO 4.2426 - Load LOWTSA.REL first if SAIL program is loaded
;<4.EXEC>EXECCS.MAC.161, 16-Aug-79 09:39:05, EDIT BY OSMAN
;tco 4.2403 - Give better error on SET NO DEFAULT COMPILE
;<4.EXEC>EXECCS.MAC.159, 27-Jul-79 16:33:56, EDIT BY EKLUND
;tco 4.2354 - Prohibit file specific switches after comma in commands
;<4.EXEC>EXECCS.MAC.158, 26-Jul-79 17:08:29, EDIT BY OSMAN
;tco 4.2351 - Prevent ?Invalid CMBFP pointer adnauseum
;<4.EXEC>EXECCS.MAC.156, 18-Jul-79 10:16:54, EDIT BY OSMAN
;tco 4.2334 - Don't recompile if .REL is current and trailing spaces
;<4.EXEC>EXECCS.MAC.151, 17-Jul-79 09:48:18, EDIT BY OSMAN
;tco 4.2331 - Allow comments in COMPIL-class commands.
;<4.EXEC>EXECCS.MAC.150, 21-Jun-79 11:32:23, EDIT BY OSMAN
;tco 4.2303 - Look for .REL in both connected and source directory
;<4.EXEC>EXECCS.MAC.149, 21-Jun-79 11:10:45, EDIT BY OSMAN
;tco 4.2302 - fix LOAD A:FOO1+A:FOO2 when .REL in A:
;DON'T CLEAR PPN AT MAKOBJ IN CASE REL FILE IS IN SOURCE AREA
;<HELLIWELL.EXEC.4>EXECCS.MAC.3, 6-Jun-79 11:50:35, EDIT BY HELLIWELL
;ADD TEMP VARS SRCPTR AND DSKPTR FOR USE IN GTLANG
;<HELLIWELL.EXEC.4>EXECCS.MAC.2, 5-Jun-79 12:28:46, EDIT BY HELLIWELL
;FIX ERRORS IN WHERE TO LOOK FOR .REL FILES AND WHEN
;CLEAR TEMP CORE FILE AREA BEFORE ENTERING FIRST FILE
;<4.EXEC>EXECCS.MAC.147, 2-May-79 10:22:31, EDIT BY OSMAN
;SET UP JFN IN A FOR $GET2
;<4.EXEC>EXECCS.MAC.146, 1-May-79 11:22:05, EDIT BY OSMAN
;GTJFN => CALL GTJFS (SO ^C CAN'T LEAVE JFN AROUND)
;<4.EXEC>EXECCS.MAC.142, 20-Apr-79 15:36:17, EDIT BY OSMAN
;tco 4.2238 - Fix "?SCNCDR COMA REQUIRED IN DIRECTORY 0" (tmpcor blocks too
; long)
;<4.EXEC>EXECCS.MAC.138, 30-Mar-79 10:57:11, EDIT BY OSMAN
;COPY COMMAND SO THAT WE DON'T CLOBBER ORIGINAL BUFFER (SO CTRL/H DOESN'T GET
; CONFUSED)
;<4.EXEC>EXECCS.MAC.137, 12-Mar-79 17:53:14, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECCS.MAC.132, 4-Jan-79 19:46:40, EDIT BY OSMAN
;tco 4.2149 - make link switches (%) work better
;<4.EXEC>EXECCS.MAC.122, 3-Jan-79 15:41:08, EDIT BY OSMAN
;GET RID OF STRP, STRC
;<4.EXEC>EXECCS.MAC.120, 21-Dec-78 14:09:56, EDIT BY OSMAN
;tco 4.2130 - Don't say "?Not confirmed" on "LOAD @FOO"
;<4.EXEC>EXECCS.MAC.119, 20-Dec-78 11:01:58, EDIT BY OSMAN
;tco 4.2125 - fix "comp foo + zot"
;<4.EXEC>EXECCS.MAC.116, 8-Oct-78 17:06:41, EDIT BY OSMAN
;REMOVE REFS TO CERET BY REMOVING GTASCE
;<4.EXEC>EXECCS.MAC.112, 14-Sep-78 14:11:33, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;TCO 4.1978 - FIX "COMP /L" AND "COMP A=B" TO MAKE THEM NOT LOOP
;AND THEN TYPE "?TOO MANY JFNS IN COMMAND".
;CHANGE COLON PARSING TO NOT BREAK ON COLON, EVEN IF COLON PART OF SWITCH
;<4.EXEC>EXECCS.MAC.79, 7-Aug-78 14:52:52, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.78, 7-Aug-78 11:32:02, EDIT BY OSMAN
;PUT IN /LANGUAGE-SWITCHES:
;<4.EXEC>EXECCS.MAC.77, 7-Aug-78 10:36:59, EDIT BY OSMAN
;FIX G COMMAND (FROM "EDIT" PROGRAM)
;<EKLUND>EXECCS.MAC.14, 27-Jul-78 15:17:56, Edit by EKLUND
; TCO 1959
;MAKE /REL SWITCH WORK (AVOID %OBJECT FILE MISSING MESSAGE)
;<EKLUND>EXECCS.MAC.13, 27-Jul-78 15:16:24, Edit by EKLUND
; TCO 1958
;DO NOT PASS /LOCALS TO LINK UNLESS EXPLICITLY REQUESTED BY USER
;<EKLUND>EXECCS.MAC.12, 27-Jul-78 15:11:59, Edit by EKLUND
; TCO 1957
;MAKE THE /FOR AND /DDT SWITCHES SELECT THE RIGHT DEBUGGER (USED WITH @DEBUG)
;<4.EXEC>EXECCS.MAC.75, 27-Jul-78 16:38:20, EDIT BY OSMAN
;fix swmov
;<4.EXEC>EXECCS.MAC.74, 27-Jul-78 15:01:10, Edit by DBELL
;FIX TCO 1955
;<4.MONITOR>EXECCS.MAC.1, 27-Jul-78 13:35:42, EDIT BY OSMAN
;FIX A BUG
;<4.EXEC>EXECCS.MAC.72, 26-Jul-78 17:31:06, Edit by DBELL
;TCO 1955. CLEAR PRARG AREA SO EXECUTE COMMANDS DON'T MAKE LINK FAIL
;<4.EXEC>EXECCS.MAC.71, 25-Jul-78 10:15:00, EDIT BY OSMAN
;UNSTACK LNGJFN WHEN DONE WITH IT
;<4.EXEC>EXECCS.MAC.70, 24-Jul-78 11:06:59, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.69, 21-Jul-78 08:26:11, EDIT BY OSMAN
;CHANGE BMSK TO NOT BREAK ON CR (BUT STILL BREAK ON LF)
;<4.EXEC>EXECCS.MAC.67, 14-Jul-78 13:11:15, EDIT BY OSMAN
;CHANGE LINK STRING FROM "/DEBUG:FORTRAN" TO "/DEBUG:(DDT,FORTRAN)"
;<4.EXEC>EXECCS.MAC.66, 13-Jul-78 15:41:15, EDIT BY OSMAN
;MAKE LHED, CRFHED, SAVPNT LOCAL
;<4.EXEC>EXECCS.MAC.65, 13-Jul-78 15:17:17, EDIT BY OSMAN
;MAKE CWBUF LOCAL
;<4.EXEC>EXECCS.MAC.61, 10-Jul-78 20:47:56, EDIT BY OSMAN
;MAKE TEXTIB BE LOCAL (AND RENAME IT TO CSTXTB)
;<4.EXEC>EXECCS.MAC.58, 27-Jun-78 15:13:27, EDIT BY OSMAN
;MAKE LOCAL VARIABLES BE DECLARED IN TRVAR (INSTEAD OF EXECPR AND EXECGL)
;<4.EXEC>EXECCS.MAC.57, 27-Jun-78 10:55:33, EDIT BY OSMAN
;STACK LNGJFN, SO IT NEEDN'T BE TREATED SPECIALLY IN RLJFNS
;<4.EXEC>EXECCS.MAC.56, 23-Jun-78 18:32:12, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: C.ILEG-IND-LPRN-PERC-PLUS-RPRN-SLSH,
;CMP3, D%IGN, P1LCOB, P1ST, PARD1, PPN1, PSWP, RDCMA4, RDFLD1, RDFLD2, S%PTYP,
;SPACE, SWSAV, SWSAV1, TCTAB
;<4.EXEC>EXECCS.MAC.52, 15-Jun-78 14:14:09, EDIT BY OSMAN
;ADD SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)
;ADD /68-COBOL /74-COBOL
;<4.EXEC>EXECCS.MAC.47, 14-Jun-78 14:45:05, EDIT BY OSMAN
;ADD "INFORMATION (ABOUT) DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;SET NO DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;<4.EXEC>EXECCS.MAC.37, 13-Jun-78 14:22:32, EDIT BY OSMAN
;CHANGE COMPILER-SWITCHES TO COMPILE-SWITCHES
;<4.EXEC>EXECCS.MAC.22, 11-Jun-78 21:15:47, EDIT BY OSMAN
;FREE UP USAGE OF P6, SO THAT TRVAR CAN BE USED FOR SRCEXT (AND ANY FUTURE
; NEEDS!)
;<4.EXEC>EXECCS.MAC.7, 8-Jun-78 16:34:16, EDIT BY OSMAN
;CAUSE DEFAULT SWITCHES TO COME AFTER EACH PROGRAM SPEC
;<3A.EXEC>EXECCS.MAC.2, 8-Jun-78 10:46:50, EDIT BY OSMAN
;ALLOW CRLF AS ALTERNATIVE TO LF AT END OF COMMAND LINE
;<4.EXEC>EXECCS.MAC.4, 3-May-78 11:01:15, Edit by DBELL
;MAKE /MAP AND /SAVE PRECEED /DEBUG IN LINK COMMAND
;<4.EXEC>EXECCS.MAC.3, 2-Mar-78 09:07:06, Edit by PORCHER
;<4.EXEC>EXECCS.MAC.2, 2-Mar-78 08:41:04, Edit by PORCHER
;Make CCL start use SFRKV rather than touching .JBSA
;<4.EXEC>EXECCS.MAC.1, 31-Jan-78 17:03:20, Edit by PORCHER
;Add stuff for execute-only
;TOPS20 'EXECUTIVE' COMMAND LANGUGAE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE
TTITLE EXECCS
SUBTTL T.HESS/TAH 1-SEP-75
;THIS FILE CONTAINS THE COMMAND SCANNER FOR TOPS-20
SALL
ESC==ALTM ;BETTER SYMBOL
QUOTE=="""" ;QUOTING CHARACTER
B.BP==7B5 ;CONSTANT TO BACKUP BYTE POINTER
; ACS: P1/ FLAGS
; 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%LOBJ==1B14 ;GTLANG MAY LOOK FOR OBJECT FILE
F%SLI==1B15 ;7 use SLINK to load
; 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 ;LOAD LOCAL SYMBOLS
F%ABT==1B26 ;ABORT-ON-ERROR
F%MACH==1B27 ;MACHINE-CODE
F%FLAG==1B28 ;FLAG-NON-STANDARD
F%WARN==1B29 ;WARNINGS
F%CHK==1B30 ;CHECK
; F%ERR==1B31 ;ERROR LIMIT
F%LANG==1B31 ;GLOBAL LANGUAGE SWITCH SEEN
;BITS 32-35 ARE LANG TYPE
F.LMSK==17B35 ;MASK FOR LANG TYPE
F.ALL==776000 ;MASK FOR ALL FILE RELEVENT SWS
; 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)
;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==4 ;SOURCE VERSION D/T
OVER==5 ;OBJECT VERSION D/T
PPN==6 ;DIRECTORY NUMBER (RH)
SWP==7 ;POINTER TO LANGUAGE SWITCHES
DYRNO==10 ;DIRECTORY NUMBER
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
D%OSRC==1B4 ;OBJECT IN SOURCE DIRECTORY
;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 - LANGUAGE NAME
; B - EXTENSION
; C - PROCESSOR NAME
; D - TEMP FILE NAME
; E - TEMP FILE NAME FOR NATIVE COMPILER
DEFINE LANGUAGE
< L (ALGOL,ALG,ALGOL,ALG)
MIT,< L (BCPL,BCP,BCPL,BCP)> ;7 BCPL language
L (BINARY,REL,LINK,LNK)
L (BLISS,BLI,BLIS10,BLI)
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 (FAIL,FAI,FAIL,FAI)
L (FORTRAN,FOR,FORTRA,FOR,NFO)
L (MACRO,MAC,MACRO,MAC)
L (PASCAL,PAS,PASCAL,PAS,NPO)
L (SAIL,SAI,SAIL,SAI)
L (SIMULA,SIM,SIMULA,SIM)
MIT,< L (SLINK,SLI,SLINK,LNK)> ;7 special loader
L (SNOBOL,SNO,SNOBOL,SNO)>
;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,,TXTPTR <from>]
CALL CFIELD ;TYPE NOISE BUT DON'T ALLOW "@"!
SETZ P1, ;CLEAR FLAGS
RET
;ENTRY FROM CREF COMMAND
.CREF:: LINEX <Data line for CREF program>
CMERRX <Invalid data line for CREF program>
CALL CRSCAN ;MAKE RESCAN BUFFER
HRROI B,[GETSAVE <SYS:CREF.>]
SETZM STAYF ;WAIT FOR CREF TO FINISH
JRST RUNGO ;INVOKE CREF FOR NOW
CMAGN:: MOVX P1,F%AGN ;SAY WE'RE DOING OLD COMMAND AGAIN
JRST CSCAN ;GO ALLOCATE LOCAL VARIABLES
CMAGN1: CALL CSCANR ;RESET PARSER
CALL TIRST ;RESET TEXTI/GTJFN BLOCKS
MOVE P1,CSVCC ;GET COMMAND INFO
JRST CSCAN2 ;PARSE OLD ARGS IF ANY
;ROUTINE TO INIT SCANNER POINTERS, VALUES, ETC...
CSCANR: GJINF ;GET JOB RELATED INFO
MOVEM C,CSJOB ;JOB #
MOVE A,B ;CONNECTED DIRECTORY NUMBER
STPPN ;CONVERT TO PPN
MOVEM B,CSPPN ;FOR THOSE WHO NEED
SETZM LHED ;INITIALIZE VARIABLES
SETZM CRFHED
SETZM SAVPNT
SETZM LSWPTR ;NO GLOBAL /LANG: YET
SETZM MAPPNT ;NO /MAP YET
MOVX 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,(ASCPTR) ;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,SAVLNG,LHED,CRFHED,SAVPNT,
<FSPEC,FILWDS>,<CWBUF,LCWBUF>,<CSTXTB,10>,SRCSAV,CSJOB,CSPPN,SAVBRK,EXTP,
COMPBP,LPROC,DEBAID,TMPJFN,INDJFN,INDSIZ,CJEPTR,CMPBUF,ADDSIZ,CMPSIZ,LNGJFN,
NXPROC,MAPPNT,SRCPTR,DSKPTR,SAILF>
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: MOVX A,7 ;ALLOCATE ROOM IN TEXTI BLOCK
MOVEM A,.RDCWB+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
MOVEI A,NATWDS ;NUMBER OF WORDS FOR NATIVE STRING
CALL GETBUF ;GET BUFFER FOR NATIVE COMMAND STRING
HRLI A,(ASCPTR) ;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
MOVX 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%SLI ;7 use SLINK?
HLRO A,PRTAB+LT.SLI ;7 yes, get name of SLINK-20
TXNE P1,F%NLOD ;ARE WE GOING TO LOAD?
SETZ A, ;NO - THEN NO FILESPEC
MOVEM A,NXPROC ;SAVE AS NEXT PROCESSOR
;FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE
MOVX 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
SUBI P4,1 ;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
CAIE P4,LT.PAS ;7 SPR #:20-17931 PASCAL?
CAIN P4,LT.FOR ;FORTRAN?
JRST P1LFOR ;SPECIAL FORTRAN HACK
CAIE P4,LT.C68 ;68 COBOL,
CAIN P4,LT.C74 ; OR 74 COBOL?
JRST P1LBLI ;YES
CAIE P4,LT.CBL ;COBOL SPECIAL HACK
CAIN P4,LT.BLI ;BLISS?
JRST P1LBLI ;SPECIAL BLISS HACK
CALL TSOUT0 ;DUMP FILESPEC
P1LPC: MOVX B,"!"
BOUT ;7 that's all TBOUT does!
;7 CALL TBOUT
P1LPC1: HRROI B,[BYTE (7).CHCRT,.CHLFD]
CALLRET TSOUT0 ;TERMINATE
P1LPN: 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,(ASCPTR)
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>
MOVX P4,LT.REL ;USE RELOC TYPE
CALL OPNTMP ;OPEN TMP FILE
MOVEM A,TMPJFN ;SAVE JFN
TXZ P1,F%NCMA ;NO COMMA NEEDED YET
SKIPN MAPPNT ;SEE IF WE NEED /MAP
SKIPE SAVPNT ; OR /SAVE SWITCH PROCESSING
CALL MAPSAV ;YES - OUTPUT MAP/SAVE INFO
SKIPE SAILF ;IF SAIL INVOLVED
CALL [HRROI B,[ASCIZ/SYS:LOWTSA/]
CALL TSOUT0 ;PUT OUT REQUEST FOR LOWTSA
CALLRET EOLOUT]
TXNE P1,F%SDDT ;WANT TO DEBUG?
CALL SETDEB ;YES - SET DEBUGGER
CALL LSCAN ;LOOP THROUGH LIST
JRST PASS2 ;INSERT SPEC IN FILE
HRROI B,[ASCIZ"/EXE"] ;ASSUME EXECUTE
TXNE P1,F%GO ;IS IT?
CALL TSOUT0 ;YES - DUMP SWITCH
HRROI B,[ASCIZ"/GO"] ;NO - JUST LOAD
CALL TSOUT0 ;DUMP SWITCH
CALL EOLOUT ;AND EOL
CALL CLSTMP ;CLOSE TEMPORARY FILE
TXNE P1,F%SUPP ;AOK?
ERROR <Loading suppressed>
P2XIT: CALL FINCRF ;FINISH UP CREF FILE
SKIPE B,NXPROC ;SEE IF SOMEWHERE TO GO
JRST RUNGO ;YES, GO START COMPILER OR LINK
CALL UNMAP ;UNMAP FREE SPACE USED
CALLRET RLJFNS ;RELEASE JFNS & RETURN IF DONE
;PERFORM RUN AND CCL START ON THE PROCESS
RUNGO: STKVAR <BPTR,CCLJFN,ENT0>
MOVEM B,BPTR ;REMEMBER POINTER TO STRING
CALL TRYGTJ ;TRY TO GET JFN
JRST [MOVE A,BPTR ;FAILED, GET POINTER TO STRING
ERROR <Can't find %1M - %?>]
MOVEM A,CCLJFN ;REMEMBER JFN OF PROGRAM
CALL ERESET ;RESET
MOVE A,CCLJFN ;SAY WHICH PROGRAM TO LOAD
CALL $GET0 ;DO GET ETC...
CALL DPRARG ;SEND TMP FILES
CALL UNMAP ;UNMAP FREE SPACE USED
CALL SETGO ;SET UP FOR PROGRAM RUNNING
MOVX B,<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 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: MOVX B,"," ;TERMINATE WITH A COMMA
CALLRET TBOUT ;...
;ROUTINE TO SETUP DEBUG AID IF ANY
SETDEB: MOVX B,LT.PAS ;7 RUTGER's PASCAL support
CAMN B,DEBAID ;7
JRST PASDEB ;7
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
PASDEB: HRROI B,[ASCIZ/SYS:PASDDT/] ;7 just load PASDDT
CALL TSOUT0 ;7
TXZ P1,F%SDDT ;7 and run program normally
CALLRET EOLOUT ;7
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;
; RETURNS: 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 @(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 @(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
SETO Q2, ;INIT TO -1
CALL SRCSCN ;SCAN SOURCES
JRST P1SRC ;ROUTINE FOR SOURCE ON PASS1
JUMPE Q2,R ;RETURN IF NO SOURCE
TXNN P5,F%CMPL ;FORCED COMPILE?
CAML Q2,OVER(P2) ;COMPARE SOURCE & REL TIMES
CALL 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: SETZ Q2, ;SAY WE LOST
RET ;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE
PASS2: TXNE P5,D%LINK ;LINK SWITCH
JRST PASS2S ;YES - HANDLE SPECIAL
SKIPN OVER(P2) ;HAVE REL SOMEWHERE?
JRST [TXO P1,F%SUPP ;LOSAGE NOTED
PUSH P,A ;SAVE JFN
TYPE <?Object file missing: >
MOVE B,NAM(P2) ;TELL HIM WHAT
CALL DSOUTR ;PRINT SPEC
POP P,A ;RESTORE JFN
RET] ;RETURN
TXZE P1,F%NCMA ;NEED COMMA?
CALL CMOUT ;YES - PUT ONE IN
CALL P2SYMS ;DO SYMBOL CODE
MOVE Q1,NAM(P2) ;GET POINTER TO FILE NAME STRING
SKIPE PPN(P2) ;STRANGE DIRECTORY INVOLVED? (SKIP IF NO)
TXNN P5,D%OSRC ;OBJECT IN SOURCE DIRECTORY?
CALL SKPDEV ;WITHOUT THIS CHECK, "LOAD SNARK:FOO" TRIES TO
; LOAD SNARK:FOO.REL EVEN THOUGH MACRO
; GENERATED PS:SNARK.REL
CALL PUTDF0 ;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 ;LSAY WE NEED A COMMA
SKIPE B,PPN(P2) ;ANY PPN?
TXNN P5,D%OSRC ;YES - USE IT?
ABSKP ;NO
CALL PUTPPN ;YES - DUMP IT
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: MOVX B,"/" ;OUTPUT SLASH
MOVE Q1,NAM(P2) ;GET STRING POINTER
ILDB Q1,Q1 ;PEEK AT FIRST CHAR
CAIE Q1,"/" ;IS IT A SLASH?
BOUT ;7 that's all TBOUT does!
;7 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: TXNN P5,F%LSYM ;LOAD LOCALS?
JRST P2SYM1 ;NO - CHECK IF OFF
TXOE P1,F%DSYM ;YES - ALREADY?
RET ;YES - RETURN
HRROI B,[ASCIZ"/LOCALS "]
CALLRET TSOUT0 ;DUMP SWITCH
P2SYM1: TXZN P1,F%DSYM ;GRNTEE SW OFF
RET ;RETURN IF NO FURTHER ACTION
HRROI B,[ASCIZ"/NOLOCA "]
CALLRET TSOUT0 ;ELSE DUMP SWITCH
;BLDCOM - ROUTINE TO BUILD A COMMAND STRING
; CHECK FOR FILE OPEN FOR THIS LANGUAGE
BLDCOM: TXZ P5,D%OSRC ;CLEAR THIS IF COMPILING
MOVEM P5,FLG(P2)
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?
CALL BILOBN ;YES - OUTPUT IT (AS A SWITCH)
ABSKP ;7 SPR #:20-18623
JRST [HRROI B,[ASCIZ"/NOBINARY"] ;7 make /NOBINARY work
CALL TSOUT0 ;7
JRST .+1] ;7
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
TXNE P5,F%MACH ;WANT IT?
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ"/FLAG"] ;SWITCH FOR FLAG-NON-STANDARD
TXNE P5,F%FLAG ;WANT IT?
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ"/WARN"] ;SWITCH FOR WARNINGS
TXNE P5,F%WARN ;WANT IT?
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ"/CHECK"] ;SWITCH FOR CHECK
TXNE P5,F%CHK ;WANT IT?
CALL TSOUT0 ;YES - DUMP IT
TXNN P5,F%LIST ;WANT LISTING?
JRST BLDNC1 ;NO - SKIP OVER LIST STUFF
TXNN P5,F%CREF ;YES - WANT CREF, TOO?
JRST [HRROI B,[ASCIZ"/LIST:LPT:"] ;YES - OUTPUT SWITCH
CALL TSOUT0
MOVE Q1,NAM(P2) ;POINTER TO FILESPEC
CALL SKPDEV ;SKIP OVER DEVICE FIELD
CALL PUTDF0 ;DUMP NAME (Q1 RETURNED BY SKPDEV)
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
;COROUTINE CALLED BY SRCSCN TO OUTPUT SOURCE SPECS IN NATIVE FORMAT
BLDSRN: MOVX B,"+" ;FOR NATIVE MODE, PLUS BETWEEN SOURCE SPECS
TXZE P1,F%NCMA ;NEED SEPARATOR?
BOUT ;7 that's all TBOUT does!
;7 CALL TBOUT ;YES, PUT IT IN
SKIPE B,PPN(P2) ;SPECIAL DIRECTORY?
CALL PUTPPN ;YES, PUT IT IN
MOVE Q1,NAM(P2) ;GET POINTER TO NAME
CALL SKPDEV ;SKIP DEVICE SINCE IT'S INCLUDED IN DIRECTORY
CALL PUTDF0 ;PUT REST OF SPEC
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
MOVX B,"," ;SEPARATE WITH A COMMA
BOUT ;7 that's all TBOUT does!
;7 CALL TBOUT
TXNN P5,F%LIST ;WANT LISTING?
JRST [CALL CKCOB ;NO - CHECK COBOL
JRST BLDIT1] ;SKIP OVER LIST STUFF
TXNN P5,F%CREF ;YES - WAS A CREF REQUESTED TOO?
JRST [HRROI B,[ASCIZ/LPT:/]
CALL TSOUT0 ;NO - DUMP DEVICE (FOR LIST FILE)
MOVE Q1,NAM(P2) ;GET POINTER TO FILESPEC
CALL SKPDEV ;SKIP OVER DEVICE FIELD
CALL PUTDF0 ;DUMP NAME (Q1 RETURNED BY SKPDEV)
NOP ;IGNORE EXTENSION
JRST BLDIT1] ;CONTINUE
MOVE Q1,NAM(P2) ;GET POINTER TO FILENAME AGAIN
CALL SKPDEV ;ONLY OUTPUT LISTING TO CONNECTED DIRECTORY
;WARNING: IF YOU MERELY TRY TO OMIT THE "CALL
; SKPDEV", THE COMMAND "COMP FOO:[A]ZOT/CREF"
; WILL TRY TO WRITE THE .CRF FILE TO
; "FOO:[B]" WHERE "BAR:[B]" IS YOUR CURRENTLY
; CONNECTED DIRECTORY. THE "CALL SKPDEV"
; PREVENTS THAT, ALTHOUGH IT MAKES
; RESTRICTION THAT .CRF FILES ONLY GO TO
; CONNECTED DIRECTORY.
CALL PUTDF0 ;OUTPUT FILENAME
NOP ;IGNORE
SKIPE B,PPN(P2) ;WANT PPN
CALL PUTPPX ;YES - DUMP IT
MOVX 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: MOVX B,"=" ;DELIMIT
BOUT ;7 that's all TBOUT does!
;7 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
SKIPE B,PPN(P2) ;CHECK FOR PPN
CALLRET PUTPPN ;DUMP ONE AND RETURN
RET ;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
SKIPE B,PPN(P2) ;SPECIAL DIRECTORY?
CALL PUTPPX ;YES - PUT IT IN STRING
BILOBO: MOVE Q1,NAM(P2) ;GET POINTER TO NAME STRING
CALL SKPDEV ;PREVENT DEVICE FROM GOING INTO COMMAND FILE
; THIS MAY LOOK WRONG. WELL IT IS. HOWEVER,
; WITHOUT IT, THE FOLLOWING CASE CAUSES MACRO
; TO CREATE SNARK:[OSMAN]FOO.REL:
; @DEFINE DSK: DSK:,SNARK:[3-EXEC]
; @CONNECT PS:[OSMAN]
; @COMP FOO FOO
; THIS SHOULD CREATE PS:[OSMAN]FOO.REL, BUT
; IN FACT TRIES TO CREATE
; SNARK:[OSMAN]FOO.REL, IF IT WEREN'T FOR THE
; "CALL SKPDEV" HERE.
;NOTE: THAT WITH THE "CALL SKPDEV", THERE IS
; NOW A RESTRICTION THAT ONLY ONE'S CONNECTED
; DIRECTORY MAY BE USED FOR THE .REL
; CREATION, BUT THAT'S PRETTY MUCH O.K., AS
; THAT'S WHAT PEOPLE TEND TO DO. ASSUME THAT
; BEFORE THE COMP COMMAND, THE ONLY FOO'S IN
; THE WORLD WERE PS:[OSMAN]FOO.MAC AND
; SNARK:[3-EXEC]FOO.REL, WHERE THE .REL IS
; OLDER THAN THE .MAC. NOTE THAT THIS BUG
; WILL DO ANYONE IN THAT TRIES TO USE LOGICAL
; NAMES FOR THE PURPOSE OF FOOLING THE SYSTEM
; INTO USING A FEW PRIVATE MODULES FROM A
; PRIVATE DIRECTORY TOGETHER WITH MOST OF THE
; STANDARD MODULES IN A STANDARD DIRECTORY.
CALL PUTDF0 ;OUTPUT 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: SKIPE NATIVF ;NATIVE COMPILER?
JRST BLDOB2 ;YES - ALREADY HAVE DIRECTORY
SKIPE B,PPN(P2) ;NEED PPN?
CALL PUTPPX ;YES - DUMP IT
CAIE P4,LT.FOR ;FORTRAN?
RET ;YES - DONE
BLDOB2: HRROI B,[ASCIZ"/OPT"] ;SWITCH FOR OPTIMIZE
TXNE P5,F%OPT ;WANT IT
CALL TSOUT0 ;YES - DUMP IT
HRROI B,[ASCIZ"/DEBUG"] ;SWITCH FOR DEBUG
TXNE P5,F%DEB ;WANT DEBUG CODE?
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: MOVX B,"-"
CALLRET TBOUT ;YES - DUMP MINUS
;ROUTINE TO PUT PPN IN OUTPUT STREAM
PUTPPX: TLNE P2,-1 ;HAVE SOURCE LIST?
TXNN P5,D%OSRC ;YES - WANT OBJ IN SOURCE DIR?
RET ;NO - IGNORE PPN
PUTPPN: SKIPE NATIVF ;DOING NATIVE-STYLE LINE?
JRST [MOVE B,DYRNO(P2) ;YES, USE DIRECTORY STRING
DIRST
ERCAL CJERRE ;IF CAN'T, DIE.
RET]
PUSH P,B ;SAVE ARG
MOVX B,"[" ;OPEN BRACKET
BOUT ;7 that's all TBOUT does
;7 CALL TBOUT ;DUMP IT
HLRZ B,(P) ;LHS
LDF C,NO%MAG!FLD(10,NO%RDX) ;MAG & RADIX
NOUT ;CONVENIENT
CALL CJERR ;WHOOPS
CALL CMOUT ;COMMA
POP P,B ;GET PPN BACK
ANDI B,-1 ;RHS ONLY
LDF C,NO%MAG!FLD(10,NO%RDX) ;...
NOUT ;MAJIK
CALL CJERR
MOVX 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 C,CSBUFP ;CURRENT POINTER
MOVE Q1,NAM(P2) ;POINTER TO NAME
CALL SKPDEV ;DON'T PUT ERRONEOUS DEVICE NAME IN STRING
CALL CPYDF ;COPY FILE NAME
NOP ;IGNORE THIS RETURN
SETZ B, ;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,(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: MOVX A,2 ;ALLOCATE CELL
CALL BALLOC ;...
HRRM A,(Q1) ;LINK TO OLD
MOVE A,CSBUFP ;POINTER TO NEW STRING
CALL BUFFS ;ISOLATE THE STRING
HRRZ B,(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,FLD(7,OF%BSZ)!OF%RD ;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: SETZ B, ;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,(P) ;GET JFN
TXO A,CO%NRJ ;RETAIN IT
CLOSF ;CLOSE FILE
CALL CJERR ;NEVER HAPPEN
LDF B,FLD(7,OF%BSZ)!OF%WR ;OPEN FOR WRITE
TXZ A,CO%NRJ ;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,(P) ;GET JFN
DNCRF2: MOVEI B,"=" ;EQUAL SIGN
BOUT ;7 that's all TBOUT does!
;7 CALL TBOUT ;DUMP IT
MOVE B,1(Q1) ;POINTER TO FILESPEC
CALL TSOUT0 ;DUMP IT NEXT
CALL EOLOUT ; AND CRLF
SKIPE Q1,(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.
;PUTDF0 - IF Q1 ALREADY SET UP
;
; RETURNS: +1 FILESPEC TERMINATED (; OR NULL)
; +2 IF PERIOD FIRST
PUTDF: MOVE Q1,NAM(P2) ;USE FILESPEC POINTER
PUTDF0: PUSH P,[TBOUT] ;ROUTINE TO USE
PUTDFC: ILDB B,Q1 ;GET CHAR
CAIE B,0 ;LOOK FOR NULL
CAIN B,";" ; OR SEMICOLON
JRST PTDFR ;GIVE RETURN (END-OF-SPEC)
CAIN B,"." ;PERIOD?
JRST PTDFR1 ;YES - RETURN NOW
CALL @(P) ;NO - DUMP CHAR
JRST PUTDFC ;CONTINUE
PTDFR1: AOS -1(P) ;SET FOR SKIP RETURN
PTDFR: POP P,(P) ;PRUNE PDL
RET ;AND RETURN
;ROUTINE LIKE PUTDF 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 SKIP OVER DEVICE FIELD (Q1 HAS TEXT POINTER)
SKPDEV: PUSH P,Q1 ;SAVE ORIG POINTER IF NO DEVICE
SKPDV1: ILDB B,Q1 ;GET A CHAR
CAIE B,0 ;SEARCH FOR NULL
CAIN B,";" ; OR ; AS END OF SPEC
JRST SKPDV2 ;NO DEVICE - EXIT
CAIE B,":" ;DEVICE DELIM?
JRST SKPDV1 ;NO - TRY NEXT CHAR
MOVEM Q1,(P) ;USE THIS POINTER
SKPDV2: POP P,Q1 ;RETURN UPDATED POINTER
RET ;...
;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
ADDI B,1 ;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,(ASCPTR) ;FILE
RET ;GIVE CALLER THE BYTE POINTER ("JFN")
OPNT2: SETZM ADDTAB ;CLEAR BUFFER
MOVE B,[ADDTAB,,ADDTAB+1]
BLT B,BUF1-1
MOVX 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
SETZ D, ;END WITH A NULL
CLSTM1: IDPB D,A ;FILL REST OF WORD WITH NULLS
TXNE 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,FLD(7,OF%BSZ)!OF%WR ;BYTE SIZE + WRITE
OPENF ;OPEN FILE
CALL CJERR ;TEMP FILE LOSAGE
RET ;RETURN
TJNUM: MOVX 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:
;
; 1) CARRIAGE RETURNS ARE IGNORED. LINEFEEDS ARE CHANGED TO COMMAS. THIS IS
; SO THAT MULTIPLE-LINE INDIRECT FILES WORK.
; 2) ALL MULTIPLE SPACES ARE COMPRESSED TO AT MOST ONE SPACE
; 3) ANY SPACES FOLLOWING END OF LINE ARE DELETED. NEGLECTING TO REMOVE
; SPACES AT END OF LINE CAUSES "COMP FOO.MAC " TO FORCE A COMPILATION.
; 4) 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!
; 5) COMMENTS ENCLOSED IN EXCLAMS (!) ARE REMOVED
; 6) COMMENTS STARTING WITH SEMICOLON (;) LAST THROUGH THE NEXT LINEFEED OR
; END OF COMMAND
; 7) ALL SPACES OTHER THAN THOSE SANDWICHED BETWEEN FILESPECS ARE REMOVED.
;
; ACCEPTS: A/ POINTER TO COMMAND STRING
C%PLUS==1B0 ;LAST NON-SPACE WAS NOT A FILESPEC CONSTITUENT
CMPRES: MOVX 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,(<POINT 7,0,27>) ;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,^D32 ;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,"@" ;INDIRECT FILE?
JRST GCMIND ;YES, GO STUFF IT INTO THE STRING
CAIN A,.CHCRT ;CARRIAGE RETURN
JRST GCMC ;YES, IGNORE IT
CAIN A,QUOTE ;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
CAIE A,"!" ;INTERNAL COMMENT IN LINE?
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,[.NULIO,,.NULIO]
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?>]
SETO C,
ADJBP C,B ;KEEP CHARACTER AFTER FILESPEC
MOVEM C,CJEPTR ;REMEMBER POINTER TO END OF FILESPEC
LDF B,FLD(7,OF%BSZ)!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,[POINT 0,A] ;GET BYTE POINTER TO 0TH BYTE IF BYTE SIZE WAS
; 0
DPB C,[POINT 6,A,11] ;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,[POINT 6,D,5] ;GET NUMBER OF UNUSED BITS IN LAST WORD
SUBI C,1 ;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
SETO A,
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
SETZ C, ;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,QUOTE ;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
SETO C, ;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
SETZ C, ;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
ERSKP ;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
MOVX A,"," ;TREAT END OF LINE AS COMMA
DPB A,CSPTR ;STORE IN SOURCE STRING IN FOR LDB INSTRUCTION
RET ;ACCOUNT FOR COMMA
;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
JRST XTAB(A) ;DISPATCH
CAPND: MOVX Q1,":" ;REPLACE DELIMITER
CAPND1: DPB Q1,.RDDBP+CSTXTB ;IN BUFFER
PUSH P,P3 ;SAVE COUNT
CALL RDFLD0 ;SPECIAL READ
ADDM P3,(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
MOVX 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: TXZ P1,F%CMOK ;CLEAR FLAG FOR NULL SPEC
SKIPN Q1,SRCSAV ;DID WE HAVE SEPARATE SOURCES
JRST RDCMA2 ;DONE - 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
MOVX 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
SETZ Q1, ;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
SETZ Q2, ;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
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: B/ POINTER TO PREVIOUS BLOCK
; P2/ POINTER TO NEW BLOCK
FILBLK: TXOA P1,F%LOBJ ;SAY OK TO LOOK FOR OBJECT
FILBK1: TXZ P1,F%LOBJ ;SAY NOT TO LOOK FOR OBJCECT
MOVE B,[ASCPTR FSPEC] ;COPY STRING TO FSPEC
FILBK2: ILDB A,P4 ;...
IDPB A,B
JUMPN A,FILBK2
MOVX 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
;
; ACCEPTS: A/ SIZE OF REQUIRED SPACE
; RETURNS: A/ ADDR OF BLOCK (BLOCK IS 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 (P) ;SKIP RETURN
GTLNGB: HRRZ A,LNGJFN ;GET JFN USED
JUMPE A,R ;NONE - RETURN
CALL RJFN ;RELEASE LNGJFN
SETZM LNGJFN ;SAY RELEASED
RET ;GIVE DESIRED RETURN
GTLNGA: HRROI A,FSPEC ;POINT TO SPEC
CALL BUFFS ;ISOLATE IT
MOVEM A,NAM(P2) ;REMEMBER POINTER
JRST GTLNGB ;JOIN COMMON CODE
GTLNGX: HRROI A,[ASCII/*/] ;DEFAULT EXTENSION
; TXNE P1,F%OBJ ;IN OBJECT FIELD?
; HRROI A,[ASCII/REL/] ;YES - USE THIS DEFAULT
MOVEM A,CJFNBK+.GJEXT
MOVE A,[.NULIO,,.NULIO] ;DON'T USE ANY OTHER INPUT
MOVEM A,CJFNBK+.GJSRC
LDF A,GJ%OLD!GJ%IFG!GJ%FLG
MOVEM A,CJFNBK ;STORE FLAGS
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
MOVEM A,LNGJFN ;SAVE JFN
LDB B,B ;CHECK TERMINATOR
JUMPN B,[HRROI A,FSPEC
ERROR <Illegal character in filespec: %1m>]
TXNE A,GJ%EXT ;* FOR EXTENSION
JRST [TXNN P1,F%OBJ ;YES, IN OBJ FIELD?
JRST GTLNG1 ;NO, LOOK FOR STANDARD EXT
JRST GTOBF1] ;YES, LOOK FOR REL
GTOBF2: MOVE A,LNGJFN ;GET JFN
CALL DJFNSE ;GET EXTENSION
CALL COPEXT ;COPY EXTENSION
CALL GTASC ;GET ACTUAL ASCII STRING
HRRZ A,LNGJFN ;JFN
DVCHR ;GET DEVICE CHARACTERISTICS
TXNN B,DV%DIR ;DIRECTORY DEVICE?
JRST [HRLOI A,377777 ;FUNNY LARGE DATE
MOVEM A,SVER(P2)
RETSKP] ;GIVE GOOD RETURN
LDF A,D%EXTN ;EXPLICIT EXT GIVEN
IORM A,FLG(P2)
MOVE A,LNGJFN ;JFN
CALL GTPPN ;GET PPN
HRRZ A,LNGJFN ;RESTORE JFN
CALL GTDT ;GET SOURCE DATE/TIME
PUSH P,A ;SAVE D/T
CALL LOOKE ;LOOK UP EXTENSION IN CSBUF
ABSKP ;IGNORE IF NOT FOUND
CALL SETLTP ;SET LANG TYPE
POP P,A ;RESTORE D/T
CALL STODT ;STORE D/T ACCORDING TO TYPE
;FALL INTO NEXT PAGE
CAIN B,LT.REL ;OBJECT TYPE ALREADY
JRST [LDF A,D%OSRC ;YES - SET FLG WHERE OBJ IS
IORM A,FLG(P2)
RETSKP] ; AND EXIT
TXNN P1,F%LOBJ ;CAN WE LOOK FOR OBJECT?
RETSKP ;NO
MOVE A,CSBUFP ;GET POINTER TO STRING SPACE
MOVEM A,SRCPTR ;THIS WILL BE POINTER TO SOURCE SPEC
MOVE B,LNGJFN ;GET JFN
LDF C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF
JFNS ;GET DEV:<DIR>
GTLNGZ: MOVEM A,DSKPTR ;THIS BEGINS CONNECTED FILESPEC
MOVE B,LNGJFN ;GET JFN
LDF C,FLD(.JSAOF,JS%NAM)!JS%PAF
JFNS ;GET NAME
HRROI B,[ASCIZ/REL/]
LDF C,FLD(.JSAOF,JS%TYP)!JS%PTR!JS%PAF
JFNS ;TACK ON .REL
CALL GTLNGB ;RELEASE JFN
SETZM .GJDEV+CJFNBK ;CLEAR DEFAULTS
MOVE Q1,[.GJDEV+CJFNBK,,.GJDIR+CJFNBK]
BLT Q1,XTNCNT-1 ;...
LDF A,GJ%OLD ;OLD FILE ONLY
LDF B,D%OSRC
TDNN B,FLG(P2) ;HAVE SEEN REL IN SAME DIR AS SOURCE?
TXO A,GJ%NS ;NO, PREVENT FOLLOWING SEARCH LIST
MOVEM A,CJFNBK ;...
GTLNGY: MOVEI A,CJFNBK ;POINT TO BLOCK
SKIPN B,SRCPTR ;TRY SOURCE AREA?
MOVE B,DSKPTR ;NO, DSK:
CALL GTJFS ;LOOK UP
JRST [SKIPN SRCPTR ;TRIED DSK: YET?
RETSKP ;YES, ALL DONE
SETZM SRCPTR ;NO, TRY IT NOW
JRST GTLNGY]
MOVEM A,LNGJFN ;STORE JFN
CALL GTDT ;GET DATE/TIME
MOVEM A,OVER(P2) ;REMEMBER IT.
LDF A,D%OSRC ;FOUND IN SOURCE AREA FLAG
SKIPN SRCPTR ;WAS THIS SOURCE AREA?
JRST [ANDCAM A,FLG(P2) ;SAY .REL FOUND IN DSK:
RETSKP]
IORM A,FLG(P2) ;SET FLAG
SETZM SRCPTR ;NOW TRY DSK:
JRST GTLNGY
;GTLANG...
;HERE IF IN OBJ FIELD. HAVE LOOKED UP FILNAM.*, SEE IF REL IS ONE OF THE VALUES
; OF *
GTOBF1: MOVE A,LNGJFN
CALL DJFNSE ;GET EXT STRING
MOVE B,CWBUF
CAMN B,[ASCIZ/REL/] ;A REL?
JRST GTOBF2 ;YES, PROCESS IT
MOVE A,LNGJFN
GNJFN ;STEP
RET ;NORMAL NOT FOUND RETURN
JRST GTOBF1 ;TRY AGAIN
;HERE IF NO EXT SPECIFIED - FIND A STANDARD ONE TO USE
GTLNG1: SETO Q3, ;INITIAL VALUE
GTLNG2: MOVE A,LNGJFN ;GTJFN FLAGS ETC...
CALL DJFNSE ;GET EXTENSION
CALL LOOKE ;SEE IF STANDARD
SETO B, ;DON'T CHANGE CURRENT VALUE
CAMGE Q3,B ;CHECK BEST SO FAR
JRST [MOVE Q3,B ;SAVE LARGEST VALUE
PUSH P,B ;SAVE IT
CALL GTLNGS ;GET STRING FOR SPEC
CALL COPEXT ;COPY EXTENSION
POP P,B
JRST .+1]
JUMPL B,GTLNG3 ;LOSAGE IF NO FILE
MOVE A,LNGJFN ;JFN
CALL GTPPN ;GET PPN
HRRZ A,LNGJFN ;GET JFN
CALL GTDT ;GET DATE/TIME INFO
CALL STODT ;STORE ACCORDING TO TYPE
GTLNG3: MOVE A,LNGJFN ;RESTORE GTJFN INFO
GNJFN ;GET NEXT
ABSKP ;NO MORE FILES
JRST GTLNG2 ;CHECK EXTENSION
SKIPGE B,Q3 ;FIND ANYTHING INTERESTING?
RET ;NO - FNF RETURN
LDB A,[POINTR P1,F.LMSK] ;GET CURRENT LANG TYPE
CAIN A,LT.REL ;IS IT RELOC?
MOVX B,LT.REL ;YES - THEN ASSUME THATS WHAT WE WANT
AOS (P) ;SET FOR SKIP RETURN
LDF A,D%OSRC ;YES - SAY OBJ IN SOURCE DIR
SKIPE OVER(P2) ;SAW A REL?
IORM A,FLG(P2) ;SAW .REL IN SOURCE AREA
TXNN P1,F%LOBJ ;OK TO LOOK FOR OBJECT
JRST SETLTP ;NO
MOVEM B,SAVLNG ;DON'T LOSE EXTENSION
CALL GTLNGB ;WE MUST DO THIS THE HARD WAY (RLS JFN)
LDF A,GJ%OLD ;OLD FILE ONLY (ALREADY SEEN)
MOVEM A,CJFNBK
MOVE B,SAVLNG ;RESTORE LANGUAGE
HRROI A,LTAB(B) ;GET EXTENSION FROM TABLE
MOVEM A,CJFNBK+.GJEXT
MOVEI A,CJFNBK ;POINT TO BLOCK
PUSH P,B ;SAVE THIS
HRROI B,FSPEC ;WHAT HE TYPED
CALL GTJFS ;GET JFN
CALL CJERR
MOVEM A,LNGJFN ;SAVE IN CASE LOSAGE
SETZM SRCPTR ;DON'T TRY SOURCE AREA (ALREADY LOOKED)
MOVE A,CSBUFP ;GET STRING SPACE POINTER
CALL GTLNGZ ;LOOK FOR OBJECT
NOP ;CAN'T HAPPEN
POP P,B ;RESTORE B
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.
;
; RETURNS: EXTP/ POINTER TO THE COPY
COPEXT: HRROI A,CWBUF ;POINT TO EXTENSION
CALL BUFFS ;MAKE A COPY
MOVEM A,EXTP ;REMEMBER POINTER TO COPY
RET
;ROUTINE TO DETERMINE CORRECT FILE NAME WHEN NO EXT WAS TYPED
GTLNGS: CAIE B,LT.REL ;THIS OBJECT TYPE?
JRST GTASC ;NO, GO GET ONE
SKIPE NAM(P2) ;HAVE A NAME YET?
RET ;YES - RETURN
; CALLRET GTASC ;NO - GET ONE AND RETURN
;GTASC - GET REAL ASCII FILESPEC FROM JFN AND CHECK LEGAL SIZES FOR TOPS10
; COMPAT.
GTASC: HRRZ B,LNGJFN ;JFN
MOVE A,CSBUFP ;BEGINNING OF STRING SPACE
MOVEM A,NAM(P2) ;REMEMBER BEGINNING OF NAME
MOVE D,A ;POINTER TO FILESPEC'S END SO FAR
LDF C,FLD(.JSAOF,JS%DEV)!JS%PAF ;GET DEVICE
JFNS
CALL GTASIZ ;GET STRING SIZE
CAILE C,7 ;MAX LEGAL (INCLUDES ":")
JRST [HRROI A,FSPEC
ERROR <Device name exceeds 6 characters: %1M>]
HRRZ B,LNGJFN ;JFN
LDF C,FLD(.JSAOF,JS%NAM)!JS%PAF ;FILE NAME
JFNS
CALL GTASIZ ;GET SIZE
CAILE C,6 ;MAX LEGAL
JRST [HRROI A,FSPEC
ERROR <File name exceeds 6 characters: %1M>]
HRRZ B,LNGJFN ;JFN
LDF C,FLD(.JSAOF,JS%TYP)!JS%PAF;GET EXTENSION
JFNS
CALL GTASIZ
CAILE C,4 ;MAX LEGAL (INCLUDES ".")
JRST [HRROI A,FSPEC
ERROR <File type exceeds 3 characters: %1M>]
SETZ B, ;TERMINATE SPEC
IDPB B,D ;...
MOVE A,NAM(P2) ;GET POINTER TO BEGINNING OF NAME
CALL BUFFS ;ISOLATE THE ENTIRE STRING
MOVEM A,NAM(P2) ;REMEMBER POINTER TO NAME
RET
GTASIZ: SETZ C, ;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.
;
; ACCEPTS: A/ POINTER TO SWITCH
; B/ POINTER TO END OF SWITCH
DOSWI0: STKVAR <SUFFIX>
MOVE B,A ;PUT POINTER IN B
TLC B,-1
TLCN B,-1
HRLI B,(ASCPTR) ;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
SETZ C, ;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
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 (B) ;EXIT THROUGH ROUTINE
TXNE C,S%VAL!S%LINK ;VALUE ALLOWED OR L20 SWITCH?
JRST SWVAL ;YES - FURTHER WORK REQ'D
CAIN P5,":" ;CHECK FOR COLON
JRST [HRROI A,FSPEC
ERROR <Value illegal for switch: %1M>]
TXNE C,S%LTYP ;LANGUAGE TYPE DESIGNATOR?
JRST SWLTYP ;YES - CHECK PERM/TEMP
MOVE D,[IORM B,FLG(P2)] ;INTSTR TO SET FLAGS
TXNE C,S%TOFF ;CLEAR FLAGS?
TLC D,(<IORM>-<ANDCAM>) ;YES - CHANGE INSTR
TXNE C,S%FLH ;FLAGS IN LH?
MOVSS B ;YES - SWAP HALVES
TXNN C,S%FLH ;PERM FLAGS?
TXNN P1,F%SPEC ;OR FILE SPEC SEEN YET
JRST [TLZ D,17 ;CLEAR INDEX REG
HRRI D,P1 ;SET FLAG ADDRS
JRST DOSWIX] ;DO FLAGS & RETURN
TXNE C,S%FRH ;TEMP FLAGS?
DOSWIX: XCT D ;YES - SET/CLR IN DESC BLOCK
RET ;RETURN
;HERE TO HANDLE ADDITIONAL VALUES AND LINK-20 SWITCHES
SWVAL: RET ;RETURN FOR NOW
;/STAY CAUSES EXEC TO STAY AT COMMAND LEVEL DURING COMPILATION/LOADING.
DOSTAY: SETOM STAYF ;REMEMBER TO STAY
RET
;HANDLE /LANGUAGE-SWITCHES:
DOLSW: TXNE P1,F%SPEC ;GLOBAL?
JRST DOL1 ;NO, ON PARTICULAR PROGRAM
SKIPE LSWPTR ;YES, ALREADY GIVEN?
ERROR <Only one global /LANGUAGE-SWITCHES: allowed>
MOVE A,SAVQS ;GET POINTER TO SAVED QUOTED STRING
MOVEM A,LSWPTR ;REMEMBER POINTER TO STRING
RET
DOL1: SKIPE SWP(P2) ;SWITCH GIVEN FOR THIS FILE YET?
ERROR <Only one /LANGUAGE-SWITCHES: switch allowed per source module>
MOVE A,SAVQS ;GET POINTER TO SAVED QUOTED STRING
MOVEM A,SWP(P2) ;REMEMBER POINTER TO STRING
RET
;HERE TO HANDLE LANGUAGE TYPE SWITCHES
SWLTYP: CAIN B,LT.SAI ;IF SAIL
SETOM SAILF ;SAY WE HAVE SEEN SAIL
TXNE P1,F%SPEC ;SPEC SEEN YET?
JRST [MOVEM B,LPROC ;SET PROCESSOR TYPE
CAIE B,LT.REL ;IS THIS /REL?
RET ;NO, WE ARE DONE
MOVE B,SVER(P2) ;YES, THEN SET UP
MOVEM B,OVER(P2) ;TIME/DATE FOR OBJECT FILE
RET]
DPB B,[POINTR P1,F.LMSK] ;SET PERM TYPE
TRON P1,F%LANG ;SET GLOBAL LANG SWITCH SEEN
RET ;RETURN
;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
;
; ACCEPTS: A/ POINTER TO FILE TYPE
PARDEF: STKVAR <QUOF,PAREND,SWIPTR,<ABSAV,2>>
CALL GETDL ;GET DEFAULT SWITCHES FOR FILE TYPE
MOVEM A,SWIPTR ;INITIALIZE POINTER TO SWITCH LIST
PARD0: MOVE A,[ASCPTR 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
SKIPE QUOF ;START OR END OF A QUOTED STRING?
JRST [DMOVEM A,ABSAV ;END, SAVE A AND B
MOVEM C,PAREND ;AND C TOO
SETZ B, ;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
MOVX D,QUOTE ;AND D
DPB D,A ;RESTORE QUOTE AT END OF STRING
JRST PARD6] ;GO DECREMENT COUNT
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
SETZ C, ;PUT NULL AFTER NAME
IDPB C,A
SETO A,
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 @(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,(P) ;REVERSE ARGS
POP P,@P4 ;AND SAVE VALUE
RET ;RETURN
;GTPPN - ROUTINE TO GET TOPS10 STYLE PPN AND STORE IN DESC BLOCK IF DIFFERENT
; THAT CONNECTED PPN
GTPPN: PUSH P,B ;SAVE B
PUSH P,A ;SAVE JFN
HRRZ B,A ;PUT JFN IN B
MOVX A,RC%EMO ;WE WANT EXACT MATCH
RCDIR ;GET DIRECTORY ON WHICH THIS FILE RESIDES
ERCAL CJERRE ;SHOULD NEVER FAIL
PUSH P,C ;SAVE DIRECTORY NUMBER
GJINF ;GET CONNECTED DIRECTORY NUMBER INTO B
POP P,C ;NOW CONN DIR IN B, FILE DIR IN C
POP P,A ;RESTORE THE JFN (ONLY B LEFT TO "POP")
CAMN B,C ;FILE DIR SAME AS CONN DIR?
JRST STPPN0 ;YES, SO DON'T BOTHER TRYING TO GET PPN
MOVEM C,DYRNO(P2) ;REMEMBER DIRECTORY NUMBER
LDF C,FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!JS%PAF ;SPECIFY STR:<DIR>
CALL DOJFNS ;GET STRING
MOVE A,CSBUFP ;GET POINTER TO DIRECTORY NAME
STPPN ;CHANGE TO PPN
ERCAL CJERRE ;SHOULDN'T FAIL
MOVEM B,PPN(P2) ; SAVE IT
STPPN0: POP P,B ;RESTORE
RET ;RETURN
;DJFNSE - OBTAIN EXTENSION OF FILE SPECIFIED
;
; ACCEPTS: A/ JFN
; RETURNS: CWBUF/ ASCIZ FILE EXTENSION
DJFNSE: LDF C,FLD(.JSAOF,JS%TYP) ;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
;
; ACCEPTS: A/ JFN
; C/ FORMAT DESIRED
; RETURNS: CSBUF/ ASCIZ OF FORMAT DESIRED
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 CWBUF
;
; RETURNS: B/ LANGUAGE TYPE
LOOKE: MOVE B,CWBUF ;GET EXTENSION IN B
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 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
ERSKP ;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
SETZ P1, ;NO HIGH ORDER BITS
MOVE P2,CSJOB ;BINARY JOB NUMBER
SETZ P3, ;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,(<POINT 6,0>) ;MAKE BYTE POINTER
MOVX P1,3 ;WE WANT TO CONVERT 3 CHARACTERS
MOVX 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
SETZ C,
SOUT
MOVX A,GJ%FOU!GJ%SHT ;OUTPUT USE, SHORT FORM
MOVE B,CSBUFP ;POINT TO FILESPEC
CALL GTJFS ;GET HANDLE
CALL CJERRE ;FAILED
MOVX B,FLD(7,OF%BSZ)!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
SETZ C, ;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
;
; ACCEPTS: A/ JFN
; RETURNS: VERSION D/T IN A
GTDT: PUSH P,[0] ;PLACE TO READ D/T
PUSH P,B ;SAVE ACS
PUSH P,C
MOVEI C,-2(P) ;POINT TO SPECIAL CELL
MOVE B,[1,,.FBWRT] ;GET TIME LAST WRITTEN
GTFDB
POP P,C ;RESTORE STUFF
POP P,B
POP P,A ;SHOULD HAVE D/T
RET ;RETURN
;ROUTINE TO STORE DATE/TIME IN SPEC BLOCK ACCORDING TO LANGUAGE TYPE (I.E. REL
; OR NOT)
STODT: CAIN B,LT.REL ;RELOC TYPE?
CALLRET STOREL ;YES - STORE DATE
MOVEM A,SVER(P2) ;YES - MUST BE SOURCE
RET ;RETURN
STOREL: MOVEM A,OVER(P2) ;USE IT
RET ;RETURN
;OUTPUT SUBROUTINES DSOUT & DSOUTR
DSOUTR: CALL DSOUT ;DUMP STRING IN B
ETYPE<%_> ;AND CRLF
RET
DSOUT: MOVE A,COJFN ;OUTPUT JFN
SETZ C,
SOUT ;PRINT STRING
RET ;RETURN
;PUNCTUATION ROUTINES
PROUT: SKIPA B,["."] ;PERIOD
CMOUT: MOVX B,"," ;COMMA
CALLRET TBOUT ;DUMP IT
SWOUT: MOVX B,"/" ;SLASHIFY IT
BOUT ;7 that's all TBOUT does
;7 CALL TBOUT ;...
MOVE B,D ;SW VALUE
CALLRET TBOUT ;DUMP IT
EOLOUT: MOVEI B,.CHCRT
BOUT ;7 that's all TBOUT does
;7 CALL TBOUT
SKIPA B,[.CHLFD] ;END-OF-LINEF
SPOUT: MOVEI B," " ;SPACE
CALLRET TBOUT ;DUMP AND RETURN
SUBTTL RDSKP AND RDFLD
;RDFLD - READS NEXT FIELD USING TEXTI
;
; RETURNS: A/ BREAK TYPE
; P3/ CHAR COUNT
; P4/ POINTER TO STRING
; P5/ BREAK CHAR
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,.RDDBP+CSTXTB ;OUTPUT STRING HERE
RDFLD0: MOVX P3,STRSIZ ;ENOUGH LENGTH FOR ANY REASNABLE FIELD
MOVEM P3,.RDDBC+CSTXTB ; IN STRING SPACE
LDF Q1,RD%RIE ;RETURN ON EMPTY STRING
MOVE A,BMSKA ;GET SPECIAL BREAK MASK ADDRESS
MOVEM A,.RDBRK+CSTXTB
MOVEM Q1,.RDFLG+CSTXTB ;...
MOVEI A,CSTXTB ;POINT AT ARGS
TEXTI ;SNARF FIELD
CALL EOFJER ;CHECK FOR END OF FILE
MOVE Q1,.RDFLG+CSTXTB ;GET FLAGS
TXNN Q1,RD%BTM ;BREAK ON TERM?
ERROR <Command string space exhausted>
LDB P5,.RDDBP+CSTXTB ;GET BREAK CHAR
CALL GTYP ;GET CHAR TYPE
SETZ Q1, ;NULL OUT DELIM
DPB Q1,.RDDBP+CSTXTB ;...
SUB P3,.RDDBC+CSTXTB ;SIZE = ORIG - NEW COUNT
RET ;AND RETURN
;ROUTINE TO READ A QUOTED STRING.
;
; RETURNS: A/ POINTER TO STRING
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 RDPRC2 ;YES - SET UP BLOCK
IDPB P5,P4 ;STUFF CHAR
JRST RDPRC1
RDPRC2: SETZ P5, ;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: A/ CHARACTER TYPE
; P5/ CHARACTER
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
;
; ACCEPTS: A/ CHARACTER
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.
;
; ACCEPTS: A/ POINTER TO EXTENSION
; RETURNS: A/ POINTER OR 0
GETDL: MOVE C,A ;POINTER IN C
BIN ;READ FIRST CHARACTER
CAIN B,0 ;NULL EXTENSION?
SKIPA B,[TXTPTR <.>] ;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,(ASCPTR) ;MAKE BYTE POINTER
RET ;GIVE IT TO CALLER
GETDL0: SETZ A, ;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,TXTPTR <*>,<"*" for all>,,[
FLDDB. .CMTOK,CM%SDH,TXTPTR <.>,,,[
FLDDB. .CMKEY,,DEXTBL,<a file type,>,,[
FLDDB. .CMFLD,CM%SDH]]]] ;.CMFLD MERELY FOR NONX ENTRIES
CALL FLDSKP ;GET SOME INPUT
CMERRX
GTFLDT 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,[FIRCHR 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,[FIRCHR 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>
ABSKP ;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
MOVX 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>
GTFLDT 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
SETZ D, ;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
ADDI B,1
MOVE A,B
CALL GTBUFX ;GET THE MEMORY
HRRO A,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
MOVX C,377777 ;COPY A NULL TOO
HRROI B,LST ;GET POINTER TO DEFAULT LIST GIVEN IN COMMAND
SETZ D, ;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 .GJDEV+CJFNBK ;CLEAR DEFAULTS
MOVE Q1,[.GJDEV+CJFNBK,,.GJDIR+CJFNBK]
BLT Q1,XTNCNT-1 ;...
LDF Q1,G1%RBF!G1%RND!G1%NLN!3 ;RETURN ON NULL NAME
MOVEM Q1,XTNCNT
RET ;RETURN
;ROUTINE FOR DOING COMND JSYS FOR COMPILE-CLASS COMMANDS. PREVENTS "@" FROM
; HAVING STANDARD EFFECT, AS COMPILE-CLASS COMMANDS WANT TO PROCESS "@"
; THEMSELVES.
CFIELD::MOVX A,CM%XIF ;WE WANT TO DO INDIRECT FILESPEC OURSELF
IORM A,CMFLG
CALLRET FIELD ;READ INPUT AND RETURN
;MAIN ROUTINE
; INPUT ROUTINE, MERELY INPUTS ENTIRE LINE, DOING RECOGNITION ON FILESPECS
; AND SWITCHES
TI: SETZM NFIAR ;NO FILES IN A ROW YET
SETZM NFILS ;NO FILES AT ALL
MOVEI B,[FLDDB. .CMCFM,,,,,[ ;CR IS LEGAL
FLDDB. .CMSWI,,SWTAB,,,[ ;SWITCH
FLDDB. .CMFIL,CM%SDH,,<a file name>,,[ ;FILESPEC
FLDDB. .CMTOK,,TXTPTR <@>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,TXTPTR <%>]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
ABSKP ;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,,,<a 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,,TXTPTR <@>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,TXTPTR <+>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,TXTPTR <%>]]]]]] ;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,,<a 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,,<a file name>,,[ ;FILESPEC
FLDDB. .CMCMA,,,,,[ ;COMMA
FLDDB. .CMTOK,,TXTPTR <@>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,TXTPTR <+>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,TXTPTR <%>]]]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
ABSKP ;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.
;
; ACCEPTS: B/ FUNCTION CHAIN
; RETURNS: +1 FIELD NOT PARSED
; +2 D/ SUCESSFUL PARSE, ADDRESS OF SUPPORT ROUTINE
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
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
TXNE A,CM%NOP
RET ;SINGLE RETURN ON FAILURE
COM2: MOVE A,CSBUFP ;GET POINTER TO TEMPORARY STORAGE
MOVX C,FLD(.JSAOF,JS%NAM) ;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
TLNE B,(GJ%NAM!GJ%EXT) ;7 SPR #:20-17432 begin
ERROR <No wildcards allowed in this file specification> ;7
;7 SPR #:20-17432 end
MOVEI D,TFILE ;SAY THAT FILESPEC TYPED
RETSKP
;ROUTINE TO CALL AFTER COMND TO FIGURE OUT WHAT GOT TYPED.
;
; RETURNS: D/ ADDR OF ROUTINE TO HANDLE PARSED FIELD
IDEN: MOVE A,B ;IF FILE TYPED, JFN NOW IN A!
GTFLDT D ;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
;
; ACCEPTS: A/ TABLE ADDRESS
; RETURNS: +1 NO QUOTED STRING OR VALUE TO FOLLOW
; +2 A/ SPECIAL ARG REQUIRED AND PARSED, VALID S%QUO SETTING
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
TXNN A,S%QUO+S%VAL ;QUOTED STRING OR VALUE TO FOLLOW?
RET ;NO
CALL @(B) ;YES, DO IT
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,,<a file name>,,[ ;FILESPEC
FLDDB. .CMTOK,,TXTPTR <@>,,,[ ;INDIRECT FILE
FLDDB. .CMTOK,,TXTPTR <%>]]] ;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
;
; ACCEPTS: A/ POINTER TO STRING
; RETURNS: A/ POINTER TO LAST CHAR
; FSPEC/ STRING
SWMOV: MOVE B,A ;SOURCE POINTER IN B
HRROI A,FSPEC ;COPY TO FSPEC
SETZ C, ;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
LTAB: 0 ;ILLEGAL ENTRY (NULL EXTENSION)
LANGUAGE ;EXPAND MACRO
LTABL==.-LTAB ;LENGTH OF TABLE
LT.68C==LT.C68
LT.74C==LT.C74
;TABLE OF SIXBIT TMP FILE NAMES
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
SIXTAB: 0 ;TYPE 0 UNUSED
LANGUAGE
;TABLE OF SIXBIT TMP FILE NAMES FOR NATIVE-COMPILERS
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
NSXTAB: 0
LANGUAGE
;LANGUAGE TMP FILE NAME TABLE
DEFINE L(LANG,EXT,PROC,TNAME)
< [GETSAVE (<SYS:'PROC'.>)],,[ASCIZ\TNAME'.TMP\]>
PRTAB: 0 ;PROCESS NAME TABLE,,TEMP NAME
LANGUAGE ;EXPAND
;DEBUG AID TABLE
DEFINE L(LANG,EXT,PROC,TNAME)
< 0,,[ASCIZ\:'LANG\]>
DBTAB: 0 ;LOSAGE ENTRY
LANGUAGE ;EXPAND
DEFINE NAMES
< NM (68-cobol,S%LTYP,LT.C68)
NM (74-cobol,S%LTYP,LT.C74)
NM (abort,S%FRH,F%ABT) ;7 SPR #:20-18717 wrong alphabetical order
NM (algol,S%LTYP,LT.ALG)
;7 NM (abort,S%FRH,F%ABT)
MIT,< NM (bcpl,S%LTYP,LT.BCP)> ;7
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 (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 (nosymbols,S%TOFF!S%FRH,F%LSYM)
NM (nowarnings,S%TOFF!S%FRH,F%WARN)
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)
MIT,< NM (slink,S%FLH,F%SLI)> ;7
NM (snobol,S%LTYP,LT.SNO)
NM (stay,S%DSP,DOSTAY,[RET])
NM (symbols,S%FRH,F%LSYM)
NM (warnings,S%FRH,F%WARN)>
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.
;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
MOVX 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
MOVX 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]%_>
LITSCS: ;713 debugging aid: literals label
END