Trailing-Edge
-
PDP-10 Archives
-
AP-4178E-RM
-
swskit-sources/execcs.mac
There are 47 other files named execcs.mac in the archive. Click here to see a list.
;<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
;<3-EXEC>EXECCS.MAC.80, 10-Nov-77 09:31:27, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-EXEC>EXECCS.MAC.79, 4-Oct-77 13:17:23, EDIT BY HURLEY
;FIX TMPCOR FILE TO END WORD WITH NULLS
;<3-EXEC>EXECCS.MAC.78, 8-Sep-77 12:28:42, EDIT BY OSMAN
;REMOVE CLZFF WHICH WAS ERRONEOUSLY CLOSING PARALLEL PROCESS'S JFNS. NOT NEEDED ANYWAY, SINCE KFORK AND RLJFNS/FLJFNS WILL KILL ANY JFN'S WHICH ARE SUPPOSED TO GO AWAY
;<3-EXEC>EXECCS.MAC.77, 28-Aug-77 18:04:21, EDIT BY OSMAN
;MAKE "COMP FOO+@BAR" WORK, RATHER THAN GIVING 4 ERROR MESSAGES!
;<3-EXEC>EXECCS.MAC.76, 16-Jun-77 17:17:24, EDIT BY OSMAN
;MAKE SURE "@" INTERPRETATION ALWAYS TURNED OFF WHEN CALLING COMND
;<3-EXEC>EXECCS.MAC.75, 7-Jun-77 17:04:00, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.74, 7-Jun-77 15:14:03, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.73, 7-Jun-77 14:49:47, EDIT BY OSMAN
;SELF-DOCUMENT TRANSLATE COMMAND
;<3-EXEC>EXECCS.MAC.72, 2-Jun-77 13:40:06, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.71, 25-May-77 14:05:07, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.70, 25-May-77 13:35:28, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.69, 24-May-77 13:58:09, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.68, 23-May-77 19:53:39, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.67, 23-May-77 17:04:28, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.66, 23-May-77 16:55:10, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.65, 23-May-77 16:25:24, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.64, 23-May-77 14:52:05, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.63, 23-May-77 14:41:53, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.62, 23-May-77 14:22:27, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.61, 23-May-77 11:51:14, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.60, 23-May-77 10:50:00, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.59, 20-May-77 11:17:23, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.58, 20-May-77 11:09:25, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.57, 20-May-77 10:57:46, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.56, 20-May-77 10:50:37, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.55, 20-May-77 10:35:57, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.54, 20-May-77 10:18:42, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.53, 20-May-77 10:17:01, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.52, 20-May-77 09:51:05, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.51, 20-May-77 09:11:22, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.50, 20-May-77 09:04:34, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.49, 19-May-77 17:01:54, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.48, 19-May-77 16:53:56, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.47, 19-May-77 16:20:33, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.46, 19-May-77 16:16:54, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.45, 19-May-77 16:07:31, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.44, 13-May-77 11:38:19, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.43, 13-May-77 11:27:54, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.42, 13-May-77 11:12:48, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.41, 13-May-77 11:02:09, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.40, 12-May-77 21:25:38, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.39, 12-May-77 21:00:31, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.37, 28-Apr-77 14:47:17, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.36, 28-Apr-77 14:30:16, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.35, 27-Apr-77 15:35:50, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.34, 26-Apr-77 13:53:00, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.33, 26-Apr-77 13:42:27, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.32, 22-Apr-77 11:31:15, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.31, 21-Apr-77 16:14:38, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.30, 21-Apr-77 15:28:25, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.29, 21-Apr-77 15:25:07, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.28, 21-Apr-77 15:21:33, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.27, 21-Apr-77 15:19:05, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.26, 21-Apr-77 15:03:02, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.25, 21-Apr-77 14:26:42, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.24, 7-Apr-77 15:40:53, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.23, 7-Apr-77 15:34:32, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.22, 6-Apr-77 14:16:51, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.20, 6-Apr-77 11:23:20, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.19, 4-Apr-77 15:36:39, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.18, 2-Mar-77 16:01:19, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.17, 16-Feb-77 14:22:55, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.16, 15-Feb-77 14:36:39, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.15, 15-Feb-77 10:48:50, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.14, 10-Feb-77 20:41:58, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.13, 10-Feb-77 15:34:06, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.12, 10-Feb-77 15:11:15, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.11, 10-Feb-77 14:58:40, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.10, 8-Feb-77 16:40:35, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.9, 7-Feb-77 13:52:20, EDIT BY OSMAN
;<3-EXEC>EXECSU.MAC.70, 7-Feb-77 13:00:23, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.7, 7-Feb-77 11:53:52, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.6, 7-Feb-77 10:56:21, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.5, 4-Feb-77 14:42:17, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.3, 4-Feb-77 14:36:24, EDIT BY OSMAN
;<3-EXEC>EXECCS.MAC.2, 4-Feb-77 14:32:22, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.115, 22-Dec-76 14:38:26, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.114, 22-Dec-76 13:52:39, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.113, 22-Dec-76 12:38:59, EDIT BY OSMAN
;<OSMAN>EXECCS.MAC.1, 22-Dec-76 12:17:16, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.112, 23-Nov-76 00:19:25, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.111, 23-Nov-76 00:10:14, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.110, 22-Nov-76 23:47:11, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.109, 22-Nov-76 22:55:10, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.108, 22-Nov-76 21:31:49, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.107, 22-Nov-76 21:11:41, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.106, 22-Nov-76 20:28:29, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.105, 22-Nov-76 19:37:24, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.104, 22-Nov-76 17:16:11, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.103, 22-Nov-76 14:42:07, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.102, 22-Nov-76 14:02:36, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.101, 4-Nov-76 17:15:00, EDIT BY HELLIWELL
;REMOVE OCCLF AND /SAVE
;<2-EXEC>EXECCS.MAC.100, 3-Nov-76 13:14:54, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.99, 27-Oct-76 00:24:42, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.98, 26-Oct-76 20:36:23, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.97, 26-Oct-76 17:11:22, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.96, 25-Oct-76 21:20:38, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.95, 15-Sep-76 15:50:04, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.94, 25-Aug-76 12:52:06, EDIT BY OSMAN
;<2-EXEC>EXECCS.MAC.93, 26-Jul-76 17:56:13, EDIT BY OSMAN
; TCO 1477 - RELEASE 2 36-BIT USER AND DIR NUMBERS
;<1B-EXEC>EXECCS.MAC.92, 16-Jun-76 17:11:45, Edit by HESS
; TCO 1431 - MAKE /LIST GO TO LPT:
;<1B-EXEC>EXECCS.MAC.91, 9-JUN-76 19:11:21, Edit by HESS
;<1B-EXEC>EXECCS.MAC.90, 8-JUN-76 21:39:11, Edit by HESS
; TCO 1368 AND <ESC> <CR> BUG
;<1B-EXEC>EXECCS.MAC.89, 7-JUN-76 15:29:14, Edit by HESS
;<1A-EXEC>EXECCS.MAC.88, 23-APR-76 16:56:25, Edit by HESS
; MORE TCO 1253
;<EXEC>EXECCS.MAC.87, 20-APR-76 16:43:42, Edit by HESS
; TCO 1253
;<EXEC>EXECCS.MAC.86, 15-MAR-76 14:07:49, Edit by HESS
;<EXEC>EXECCS.MAC.85, 9-MAR-76 05:36:30, Edit by HESS
; TCO 1164
;<EXEC>EXECCS.MAC.84, 8-MAR-76 06:27:52, Edit by HESS
; TCO 1160
;<EXEC>EXECCS.MAC.83, 8-MAR-76 03:42:58, Edit by HESS
; TCO 1155
;<EXEC>EXECCS.MAC.82, 27-FEB-76 17:30:55, Edit by HESS
; TCO 1126
;<EXEC>EXECCS.MAC.81, 19-FEB-76 00:57:04, Edit by HESS
; ADD TCO'S 1115,1116,1117
;<EXEC>EXECCS.MAC.80, 13-FEB-76 14:43:32, Edit by HESS
; FIX LANG TYPE CHECKING,EXTRA SPACES AFTER SWS,/DEB:BINARY BUG
;<EXEC>EXECCS.MAC.79, 13-JAN-76 15:40:04, Edit by HESS
SUBTTL T.HESS/TAH 1-SEP-75
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH MONSYM,XDEF,MACSYM
TTITLE CSCAN - COMMAND SCANNER FOR TOPS-20
SALL
ESC==ALTM ;BETTER SYMBOL
SPACE==40 ;A SPACE
B.BP==70000,,0 ;CONSTANT TO BACKUP BYTE PNTR
;INTERNAL AC USAGE
;P1 - FLAGS
;P2 - BREAK TYPE (USED IN PARSE)
;P3 - COUNT OF CHARS IN STRING
;P4 - POINTER TO STRING (PARSE)
; LANGUAGE TYPE (LSCAN)
;P5 - FLAGS DURING LSCAN
;P6 - DESC BLOCK POINTER
;CHARACTER TYPE DEFINITIONS
C.ILEG==0 ;ILLEGAL CHARACTER
C.SPAC==1 ;SPACE
C.PLUS==2 ;PLUS SIGN
C.SLSH==3 ;SLASH
C.LPRN==4 ;LEFT PARENTHESIS
C.RPRN==5 ;RIGHT PARNETHESIS
C.COMA==6 ;COMMA
C.EOL==7 ;END-OF-LINE
C.IND==10 ;@ SIGN SEEN (INDIRECT)
C.PERC==11 ;PERCENT SIGN (LINK SWITCH)
C.COLN==12 ;COLON (SWITCH DELIM)
;FLAGS IN LH OF P1 (PARSE AND GLOBAL)
F%LAHD==1B0 ;LOOK AHEAD FLAG
F%SLSH==1B1 ;SLASH SEEN
F%FILE==1B2 ;POSSIBLE FILESPEC
F%OBJ==1B3 ;OBJECT SPEC IS NEXT
F%DDT==1B4 ;LOAD DDT
F%TOPN==1B5 ;TEMP FILE OPEN
F%GO==1B6 ;START EXECUTION
F%SDDT==1B7 ;GO TO DDT
F%NLOD==1B8 ;DON'T LOAD
F%NCMA==1B9 ;NEED COMMA FLAG
F%CMOK==1B9 ;(PARSE) COMMA OK FOR NULL SPEC
F%SPEC==1B10 ;FIRST FILESPEC SEEN (SWITCH HACK)
F%SUPP==1B11 ;LOADING SUPPRESSED
F%DSYM==1B12 ;DOING LOCAL SYMBOLS
;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
;BITS 32-35 ARE LANG TYPE
F.LMSK==17B35 ;MASK FOR LANG TYPE
F.ALL==776000 ;MASK FOR ALL FILE RELEVENT SWS
;OFFSETS IN FILE DESCRIPTOR BLOCK
LNK==0 ;LINK TO NEXT BLOCK
SRC==0 ;PNTR TO SOURCE DESC OR 0
NAM==1 ;BYTE PNTR TO FILESPEC
FLG==2 ;FLAG WORD
PSWP==3 ;PROCESS SWITCH PNTR
SVER==4 ;SOURCE VERSION D/T
OVER==5 ;OBJECT VERSION D/T
PPN==6 ;DIRECTORY NUMBER (RH)
B.SIZE==7 ;SIZE OF BLOCK
L.SIZE==3 ;SIZE OF LINK-20 SWITCH BLOCK
;FLAGS IN LH OF FILE DESC BLOCK FLAG WORD
D%IGN==1B0 ;IGNORE THIS BLOCK
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%PTYP==1B5 ;PROCESSOR TYPE
S%LINK==1B6 ;LINK-20 SWITCH TEXT
S%VAL==1B7 ;VALUE ALLOWED
;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
DEFINE LANGUAGE <
L (BINARY,REL,LINK,LNK)
L (SAIL,SAI,SAIL,SAI)
L (FAIL,FAI,FAIL,FAI)
L (SNOBOL,SNO,SNOBOL,SNO)
L (BLISS,BLI,BLIS10,BLI)
L (ALGOL,ALG,ALGOL,ALG)
L (COBOL,CBL,COBOL,COB)
L (MACRO,MAC,MACRO,MAC)
L (FORTRAN,FOR,FORTRA,FOR)
>
;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
TXO P1,F%LSYM ;LOCAL SYMBOLS ALWAYS
JRST CSCAN
CNSE: NOISE <FROM>
MOVEI P1,0 ;CLEAR FLAGS
RET
;ENTRY FROM CREF COMMAND
.CREF:: LINEX <Data line for CREF program>
CMERRX <Invalid data line for CREF program>
CALL CRSCAN ;MAKE RESCAN BUFFER
HRROI B,[GETSAVE (<SYS:CREF.>)]
JRST RUNGO ;INVOKE CREF FOR NOW
CMAGN:: CALL CSCANR ;RESET PARSER
CALL TIRST ;RESET TEXTI/GTJFN BLOCKS
MOVE P1,CSVCC ;GET COMMAND INFO
MOVEI A,7 ;ALLOCATE ROOM IN TEXTI BLOCK
MOVEM A,TEXTIB
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
MOVE Q1,[CZBEG,,CZBEG+1]
SETZM CZBEG ;ZERO THIS AREA
BLT Q1,CZEND ;...
MOVE Q1,[POINT 7,STRS] ;POINTER TO START OF STRING SPACE
MOVEM Q1,STRP ;...
MOVEI Q1,NPSTR*1000*5 ;MAX SIZE OF STRING SPACE
MOVEM Q1,STRC ;...
MOVEI Q1,LT.FOR ;INITIAL LANGUAGE TYPE
DPB Q1,[POINTR (P1,F.LMSK)]
MOVEI P6,LHED ;BEGINNING OF FILE LIST
RET ;RETURN
;HE WHO ENTER HERE , BEWARE....
CSCAN:
MOVE A,CMPTR ;GET POINTER TO FOLLOWING "COMPILE (FROM)"
MOVEM A,COMPBP ;REMEMBER IT
MOVEM A,TEXTIB+2 ;TELL TEXTI WHERE TO READ FROM
MOVEI A,7 ;ALLOCATE ROOM IN TEXTI BLOCK
MOVEM A,TEXTIB
CALL TI ;READ A LINE
CALL CSCANR ;SCAN RESET
MOVEM P1,CSVCC ;SAVE COMMAND INFO FOR EDIT
CSCAN1: MOVE Q1,COMPBP ;PNTR TO TEXT INPUT
MOVEM Q1,TEXTIB+2 ;PLACE IN TEXTI BLOCK
SETZM NFILES ;NO TMP FILES YET
SETZM ADDTAB ;CLEAR ADDRESSES
MOVE A,[ADDTAB,,ADDTAB+1]
BLT A,ADDTAB+ADDTLN-1
SETZM INDJFN ;NO INDIRECT YET
SETZM SRCSAV ;NO PARTIAL SOURCE LIST
SETZM DEBAID ;NO DEBUGGING AID
SETOM LPROC ;UNKNOWN LANG PROCESSOR
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 CSVC ;SEE IF WE HAVE PREVIOUS
ERROR <No saved arguments>
MOVE A,COMPBP
HRROI B,CSVC ;MOVE FROM SAVED AREA TO REGUAR COMMAND STRING AREA
MOVEI C,0 ;END ON NULL
SOUT
JRST CSCAN1] ;AND REPARSE
HRROI A,CSVC
MOVE B,COMPBP
MOVEI C,0
SOUT ;SAVE COMMAND STRING IN CASE NO ARGS GIVEN NEXT TIME
HLRO A,PRTAB+LT.REL ;GET NAME OF LINK-20
TXNE P1,F%NLOD ;ARE WE GOING TO LOAD?
MOVEI A,0 ;NO - THEN NO FILESPEC
MOVEM A,NXPROC ;SAVE AS NEXT PROCESSOR
;;;; FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE
P1ST: MOVEI P4,%LT ;GET HIGHEST LANG TYPE
P1LUP: CALL LSCAN ;SCAN LIST
JRST PASS1 ;CO-ROUTINE ADDRS
TXZN P1,F%TOPN ;FILE OPEN?
JRST P1LPA ;NO - SKIP CLOSE STUFF
MOVE A,TMPJFN ;GET JFN
SKIPN B,NXPROC ;WHERE TO GO WHEN DONE
JRST P1LPN ;NONE
CAIN P4,LT.FOR ;FORTRAN?
JRST P1LFOR ;SPECIAL FORTRAN HACK
CAIE P4,LT.CBL ;COBOL SPECIAL HACK
CAIN P4,LT.BLI ;BLISS?
JRST P1LBLI ;SPECIAL BLISS HACK
CALL TSOUT0 ;DUMP FILESPEC
P1LPC: HRROI B,[BYTE (7)"!",15,12]
CALL TSOUT0 ;TERMINATE
P1LPN: MOVEM A,TMPJFN ;SAVE UPDATED JFN
HLRO B,PRTAB(P4) ;LINK TO OURSELVES
MOVEM B,NXPROC ;SAVE NEXT PROCESSOR
CALL CLSTMP ;CLOSE TEMPORARY FILE
P1LPA: SOS P4 ;DECREMENT LANG
CAIE P4,LT.REL ;DONE IF LANG TYPE = RELOC
JRST P1LUP ;CONTINUE
JRST P2ST ;START PASS2
;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
P1LCOB:
P1LBLI: MOVE Q1,NXPROC ;POINT TO STRING
HRLI Q1,(<POINT 7,,>)
CALL PUTDF0 ;OUTPUT DEVICE AND FILENAME
JFCL ;IGNORE EXTN
JRST P1LPC ;CONTINUE
P2ST: TXNE P1,F%NLOD ;WANT TO LOAD?
JRST P2XIT ;NO - EXIT THIS SECTION
TXNE P1,F%SUPP ;LOSAGE?
ERROR <Loading suppressed>
MOVEI P4,LT.REL ;USE RELOC TYPE
CALL OPNTMP ;OPEN TMP FILE
MOVEM A,TMPJFN ;SAVE JFN
TXZ P1,F%NCMA ;NO COMMA NEEDED YET
TXNE P1,F%SDDT ;WANT TO DEBUG?
CALL SETDEB ;YES - SET DEBUGGER
SKIPN MAPPNT ;SEE IF WE NEED /MAP
SKIPE SAVPNT ; OR /SAVE SWITCH PROCESSING
CALL MAPSAV ;YES - OUTPUT MAP/SAVE INFO
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
MOVEM A,TMPJFN ;SAVE UPDATED JFN
CALL CLSTMP ;CLOSE TEMPORARY FILE
TXNE P1,F%SUPP ;AOK?
ERROR <Loading suppressed>
P2XIT: CALL FINCRF ;FINISH UP CREF FILE
MOVNI A,1 ;RELEASE TEMP STG
MOVE B,[.FHSLF,,<STRS>B44]
LDF C,PM%CNT+NPSTR
PMAP ;PMAP IT OUT OF EXISTANCE
SKIPN B,NXPROC ;SEE IF SOMEWHERE TO GO
CALLRET RLJFNS ;RELEASE JFNS & RETURN IF DONE
RUNGO: CALL TRYGTJ ;TRY TO GET JFN
ERROR <Cannot find process>
CALL ERESET ;RESET
CALL $GET2 ;DO GET ETC...
CALL DPRARG ;SEND TMP FILES
MOVEI A,JOBSA ;NEED TO GET STARTING ADDRS
CALL LOADF ;READ WORD
AOS B,A ;INCREMENT
MOVEI A,JOBSA ;WRITE BACK ALTERED START ADDRS
CALL STOREF ;...
TLZ B,-1 ;CLEAR LHS
SETZM STAYF ;DON'T STAY AT COMMAND LEVEL
JRST GOTO2 ;EXIT THROUGH START CODE
;ROUTINE TO DUMP /MAP AND/OR /SAVE INFO AND SWITCHES
MAPSAV: SKIPN B,MAPPNT ;NEED MAP?
JRST MAPSV1 ;NO - MUST BE SAVE
TLNE B,-1 ;CHECK FOR ARG
CALL TSOUT0 ;OUTPUT ARG
HRROI B,[ASCIZ "/MAP"]
CALL TSOUT0 ;DUMP SWITCH NAME
SKIPN SAVPNT ;/SAVE ALSO?
JRST MAPSVX ;NO - JUST EXIT
CALL CMOUT ;YES - NEED COMMA
MAPSV1: MOVE B,SAVPNT ;NO - MUST BE SAVE FILE
TLNE B,-1 ;NO ARG IF LHS := 0
CALL TSOUT0 ;DUMP IF NECESSARY
HRROI B,[ASCIZ "/SAVE"]
CALL TSOUT0 ;DUMP SWITCH NAME
MAPSVX: MOVEI B,"=" ;TERMINATE WITH AN EQUAL
CALLRET TBOUT ;...
;ROUTINE TO SETUP DEBUG AID IF ANY
SETDEB: HRROI B,[ASCIZ "/DEBUG"]
CALL TSOUT0 ;DUMP LINK SWITCH
SKIPN B,DEBAID ;ANYTHING ELSE?
CALLRET SPOUT ;NO
HRRO B,DBTAB(B) ;YES - GET AID NAME
CALL TSOUT0 ;DUMP IT
CALLRET SPOUT ;AND SPACE
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;CALL: CALL LSCAN
; <COROUTINE ADDRS>
; RETURN ON EMPTY LIST
LSCAN: MOVEI P6,LHED ;GET LIST HEAD
LSCAN0: HRRZ P6,LNK(P6) ;LOOK AT NEXT ENTRY
JUMPE P6,RSKP ;SKIP RETURN WHEN DONE
SKIPGE P5,FLG(P6) ;LOAD FLAGS
JRST LSCAN0 ;YES - SKIP IT
HLL P6,SRC(P6) ;LOAD SOURCE PNTR IF ANY
CALL @0(P) ;INVOKE COROUTINE
JRST LSCAN0 ;TRY NEXT
;SRCSCN - ROUTINE TO SCAN ALL SOURCES AND CALL SOURCE COROUTINE
SRCSCN: TLNN P6,-1 ;SINGLE SOURCE?
JRST [CALL @0(P) ;INVOKE ROUTINE
RETSKP] ;AND RETURN
PUSH P,P6 ;SAVE POINTER
PUSH P,P5 ;AND FLAGS
HLRZ P6,P6 ;GET STARTING POINT
SRCSC1: MOVE P5,FLG(P6) ;LOAD FLAGS
CALL @-2(P) ;CALL ROUTINE
HRRZ P6,LNK(P6) ;LINK TO NEXT
JUMPN P6,SRCSC1 ;PROCEED IF EXISTS
POP P,P5 ;RESTORE FLAGS
POP P,P6 ;AND PNTR
RETSKP ;RETURN
;PASS1 - DETERMINE WHAT TO COMPILE AND CONSTRUCT COMMAND
PASS1: TXNE P5,D%LINK ;LINK-20 SWITCH?
RET ;YES - IGNORE
MOVNI Q2,1 ;INIT TO -1
CALL SRCSCN ;SCAN SOURCES
JRST P1SRC ;ROUTINE FOR SOURCE ON PASS1
JUMPE Q2,R ;RETURN IF NO SOURCE
TXNN P5,F%CMPL ;FORCED COMPILE?
CAML Q2,OVER(P6) ;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(P6) ;SAVE LARGEST TO DATE
MOVE Q2,SVER(P6) ;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(P6)
CALL DSOUTR ;FILE NAME & CRLF
P1SRCX: MOVEI Q2,0 ;SAY WE LOST
RET ;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE
PASS2: TXNE P5,D%LINK ;LINK SWITCH
JRST PASS2S ;YES - HANDLE SPECIAL
SKIPN OVER(P6) ;HAVE REL SOMEWHERE?
JRST [TXO P1,F%SUPP ;LOSAGE NOTED
PUSH P,A ;SAVE JFN
TYPE <%Object file missing: >
MOVE B,NAM(P6) ;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(P6) ;GET POINTER TO FILE NAME STRING
SKIPE PPN(P6) ;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 EXTN
LDB Q2,[POINTR (P5,F.LMSK)] ;GET LANG TYPE
CAIN Q2,LT.REL ;LANG TYPE = REL?
TXNN P5,D%EXTN ;EXPLICIT EXTN TYPED?
JRST PASS2A ;NO - USE DEFAULT
CALL PROUT ;YES - DUMP PERIOD
CALL PUTDF0 ;REMAINDER OF TYPED EXTN
JFCL ;IGNORE END-OF-SPEC
JRST PASS2B ;DONE WITH SPEC
PASS2A: HRROI B,[ASCIZ ".REL"] ;DEFAULT EXTN
CALL TSOUT0 ;DUMP INTO FILE
PASS2B: TXO P1,F%NCMA ;SAY WE NEED A COMMA
SKIPE B,PPN(P6) ;ANY PPN?
TXNN P5,D%OSRC ;YES - USE IT?
SKIPA ;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: MOVEI B,"/" ;OUTPUT SLASH
MOVE Q1,NAM(P6) ;GET STRING PNTR
ILDB Q1,Q1 ;PEEK AT FIRST CHAR
CAIE Q1,"/" ;IS IT A SLASH?
CALL TBOUT ;NO - DUMP ONE
MOVE B,NAM(P6) ;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(P6)
SETOM OVER(P6) ;MARK REL EXISTANCE
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: MOVE A,TMPJFN ;JFN
TXNE P5,F%NBIN ;WANT OBJECT?
JRST [CALL CKCOB ;CHECK ON COBOL
JRST BLDCM2] ;SKIP OBJECT CODE
MOVE Q1,NAM(P6) ;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 BLDC2A ;END OF SPEC
LDB Q2,[POINTR (P5,F.LMSK)] ;GET L/T
CAIN Q2,LT.REL ;IS IT "RELOC"?
TXNN P5,D%EXTN ;YES - EXPLICIT EXTN?
JRST BLDC2A ;NO - PROCEED
CALL PROUT ;DUMP PERIOD
CALL PUTDF0 ;Q1 STILL HAS PNTR
JFCL ;IGNORE END-OF-SPEC RETURN
BLDC2A: SKIPE B,PPN(P6) ;NEED PPN?
CALL PUTPPX ;YES - DUMP IT
CAIE P4,LT.FOR ;FORTRAN ONLY
JRST BLDCM2
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?
CALL TSOUT0 ;YES - DUMP IT
BLDCM2: CALL CMOUT ;OUTPUT COMMA
TXNN P5,F%LIST ;WANT LISTING?
JRST [CALL CKCOB ;CHECK COBOL
JRST BLDCM3] ;SKIP OVER LIST STUFF
TXNN P5,F%CREF ;CREF REQUESTED?
JRST [HRROI B,[ASCIZ "LPT:"]
CALL TSOUT0 ;DUMP DEVICE (FOR LIST FILE)
MOVE Q1,NAM(P6);PNTR TO FILESPEC
CALL SKPDEV ;SKIP OVER DEVICE FIELD
CALL PUTDF0 ;DUMP NAME (Q1 RETURNED BY SKPDEV)
JFCL ;IGNORE EXTN
JRST BLDCM3] ;CONTINUE
MOVE Q1,NAM(P6) ;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
JFCL ;IGNORE
SKIPE B,PPN(P6) ;WANT PPN
CALL PUTPPX ;YES - DUMP IT
MOVEI D,"C" ;OUTPUT SW
CALL SWOUT ;...
CAIE P4,LT.CBL ;IF COBOL
CAIN P4,LT.BLI ; OR BLISS
JRST BLDCM3 ; THEN DON'T CREF
CALL ENTCRF ;ENTER NAME IN CREF FILE
BLDCM3: MOVEI B,"=" ;DELIM
CALL TBOUT ;...
TXZ P1,F%NCMA ;NO COMMA YET
CALL SRCSCN ;LOOP THROUGH SRCS
JRST BLDSRC ;COROUTINE FOR SOURCE FILES
CALL EOLOUT ;END OF SPECS
MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET ;RETURN
;HERE FOR EACH SOURCE SPEC
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
JFCL ;IGNORE
BSRC1: TXO P1,F%NCMA ;SET NEED COMMA FLAG
SKIPE B,PPN(P6) ;CHECK FOR PPN
CALL PUTPPN ;DUMP ONE
RET ;RETURN
;ROUTINE TO CHECK FOR COBOL AND OUTPUT A "-" TO THE COMMAND FILE
CKCOB: CAIE P4,LT.CBL ;IS IT COBOL
RET ;NO RETURN
MOVEI B,"-"
CALLRET TBOUT ;YES - DUMP MINUS
;ROUTINE TO PUT PPN IN OUTPUT STREAM
PUTPPX: TLNE P6,-1 ;HAVE SOURCE LIST?
TXNN P5,D%OSRC ;YES - WANT OBJ IN SOURCE DIR?
RET ;NO - IGNORE PPN
PUTPPN: PUSH P,B ;SAVE ARG
MOVEI B,"[" ;OPEN BRACKET
CALL TBOUT ;DUMP IT
HLRZ B,0(P) ;LHS
LDF C,1B0+10 ;MAG & RADIX
NOUT ;CONVENIENT
CALL CJERR ;WHOOPS
CALL CMOUT ;COMMA
POP P,B ;GET PPN BACK
ANDI B,-1 ;RHS ONLY
LDF C,1B0+10 ;...
NOUT ;MAJIK
CALL CJERR
MOVEI B,"]" ;CLOSE BRACKET
CALLRET TBOUT ;DUMP AND RETURN
;ROUTINE TO ADD NEW FILESPEC TO THINGS THAT NEED CREFING
ENTCRF: PUSH P,A ;SAVE POSIBLE JFN
MOVE A,STRC ;COUNT OF CHARS LEFT
MOVE C,STRP ;CURRENT PNTR
MOVE Q1,NAM(P6) ;POINTER TO NAME
CALL SKPDEV ;DON'T PUT ERRONEOUS DEVICE NAME IN STRING
CALL CPYDF ;COPY FILE NAME
JFCL ;IGNORE THIS RETURN
MOVEI B,0 ;TERMINATE STRING
IDPB B,C ;...
MOVEI P2,-1(A) ;SAVE COUNT
MOVE P3,C ;AND PNTR
CALL CHKCRF ;CHECK AND ENTER IF UNIQUE
POP P,A ;RESTORE ACCUM
RET ;RETURN
;CHECK FOR ALREADY EXISTING FILESPEC
CHKCRF: MOVEI Q1,CRFHED ;PNTR TO HEAD OF LIST
CKCRF1: SKIPN Q2,0(Q1) ;CHECK FOR END OF LIST
JRST CKCRF2 ;END - ENTER NEW STRING
MOVE A,STRP ;PNTR TO STRING TO BE CONSIDERED
MOVE B,1(Q2) ;PNTR TO OLD STRING
STCMP ;COMPARE STRINGS
JUMPE A,R ;MATCH IF ZERO CODE (RETURN)
MOVE Q1,Q2 ;ADVANCE PNTR
JRST CKCRF1 ;TRY NEXT
CKCRF2: MOVEM P2,STRC ;UPDATE COUNT
EXCH P3,STRP ;AND PNTR & FETCH BEG.
MOVEI A,2 ;ALLOCATE CELL
CALL BALLOC ;...
HRRM A,0(Q1) ;LINK TO OLD
MOVEM P3,1(A) ;STASH PNTR
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,FSPEC+1 ;COMPLETE NAME
SETZM FSPEC+2 ;MAKE ASCIZ
LDF A,GJ%SHT!GJ%PHY!GJ%OLD
HRROI B,FSPEC ;ARGS FOR GTJFN
GTJFN ;SEE IF FILE EXISTS
JRST DONCRF ;NO - JUST DUMP CORE
CALL JFNSTK ;SAVE FOR LATER
LDF B,7B5+1B19 ;BITS FOR READ
OPENF ;OPEN FILE
CALL CJERR ;LOSAGE
PUSH P,A ;SAVE JFN ON STACK
PUSH P,EOFDSP ;SAVE EOF TRAP
MOVEI A,CRFEOF ;NEW ADDRS FOR TRAP
MOVEM A,EOFDSP ;...
;;;; FALL INTO FNCRFN
;HERE TO SCAN FILE FOR SPEC
FNCRFN: MOVE A,-1(P) ;FETCH JFN
FNCRF1: BIN ;READ A CHAR
CAIE B,"=" ;SEARCH FOR BEGINNING OF SPEC
JRST FNCRF1 ;LOOP TILL FOUND
MOVE P2,STRC ;FREE CNTR
MOVE P3,STRP ; " PNTR
FNCRF2: BIN ;GOBBLE CHAR
CAIN B,LF ;LOOK FOR EOL
JRST FNCRF3 ;FOUND - CHECK FOR MERGE
IDPB B,P3 ;COPY TO STRING SPACE
SOJG P2,FNCRF2 ;LOOP
ERROR <String space exhausted>
FNCRF3: MOVEI B,0 ;REPLACE CR WITH NULL
DPB B,P3 ;...
CALL CHKCRF ;CALL COMMON CODE
JRST FNCRFN ;LOOK FOR MORE
;HERE ON EOF INTERUPT FROM READING CREF FILE
CRFEOF: POP P,EOFDSP ;RESTORE THIS
MOVE A,0(P) ;GET JFN
TLO A,(1B0) ;RETAIN IT
CLOSF ;CLOSE FILE
CALL CJERR ;NEVER HAPPEN
LDF B,7B5+1B20 ;OPEN FOR WRITE
TLZ A,(1B0) ;CLEAR FLAG
OPENF ;...
CALL CJERR ;SOMETHING WENT WRONG
JRST DNCRF1 ;JOIN WRITE
;ROUTINE TO WRITE OUT NEW CREF FILE
DONCRF: CALL TOPNF ;OPEN TMP FILE IN FSPEC
PUSH P,A ;STACK JFN
DNCRF1: MOVE Q1,CRFHED ;GET LIST HEAD
MOVE A,0(P) ;GET JFN
DNCRF2: MOVEI B,"=" ;EQUAL SIGN
CALL TBOUT ;DUMP IT
MOVE B,1(Q1) ;PNTR TO FILESPEC
CALL TSOUT0 ;DUMP IT NEXT
CALL EOLOUT ; AND CRLF
SKIPE Q1,0(Q1) ;SEE IF MORE
JRST DNCRF2 ;YES - LOOP BACK
POP P,A ;NO - CLOSE OUT FILE
CLOSF ;...
CALL CJERR ;WHOOPS
RET ;ALL DONE - RETURN
;PUTDF - ROUTINE TO OUTPUT FILESPEC AS FOLLOWS:
;OUTPUT DEVICE IF ANY , DUMP FILENAME
; TERMINATE ON FIRST PERIOD OR ; OR NULL.
;NON-SKIP IF FILESPEC TERMINATED (; OR NULL).
;SKIP IF PERIOD FIRST.
;PUTDF0 - IF Q1 ALREADY SET UP
PUTDF: MOVE Q1,NAM(P6) ;USE FILESPEC PNTR
PUTDF0: PUSH P,[TBOUT] ;ROUTINE TO USE
PUTDFC: ILDB B,Q1 ;GET CHAR
SKIPE B ;LOOK FOR NULL
CAIN B,";" ; OR SEMICOLON
JRST PTDFR ;GIVE RETURN (END-OF-SPEC)
CAIN B,"." ;PERIOD?
JRST PTDFR1 ;YES - RETURN NOW
CALL @0(P) ;NO - DUMP CHAR
JRST PUTDFC ;CONTINUE
PTDFR1: AOS -1(P) ;SET FOR SKIP RETURN
PTDFR: POP P,0(P) ;PRUNE PDL
RET ;AND RETURN
;ROUTINE LIKE PUTDF ONLY COPIES TO CORE
CPYDF: PUSH P,[CPYDF1] ;ROUTINE TO USE
JRST PUTDFC ;JOIN COMMON CODE
CPYDF1: IDPB B,C ;PNTR IN C
SOJG A,R ;KEEP COUNT IN A
ERROR <String space exhausted>
;ROUTINE TO SKIP OVER DEVICE FIELD (Q1 HAS TEXT PNTR)
SKPDEV: PUSH P,Q1 ;SAVE ORIG PNTR IF NO DEVICE
SKPDV1: ILDB B,Q1 ;GET A CHAR
SKIPE B ;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,0(P) ;USE THIS PNTR
SKPDV2: POP P,Q1 ;RETURN UPDATED PNTR
RET ;...
;OPEN TMP CORE FILE
OPNTMP: AOS A,NFILES ;INCREASE NUMBER OF TMP FILES BY ONE
MOVEI B,TMPBUF-TMPCOR ;ASSUME FIRST ONE
CAIN A,1 ;FIRST ONE?
JRST OPNT1 ;YES
MOVE B,ADDTAB-2(A) ;NO, IT STARTS RIGHT AFTER LAST ONE
ADD B,TMPCOR(B) ;GET ADDRESS OF NEXT FILE
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.
MOVEM C,TMPCOR(B) ;STORE NAME IN LEFT HALF OF FIRST WORD
MOVEI A,TMPCOR+1(B) ;MAKE BYTE POINTER TO SECOND WORD OF
HRLI A,440700 ;FILE
RET ;GIVE CALLER THE BYTE POINTER ("JFN")
;CLOSE TEMP FILE
CLSTMP: MOVE B,NFILES
MOVE C,ADDTAB-1(B) ;GET BEGINNING OF FILE ADDRESS
MOVE A,TMPJFN ;GET POINTER INTO FILE
MOVEI D,0 ;END WITH A NULL
CLSTM1: IDPB D,A ;FILL REST OF WORD WITH NULS
TLNE A,(76B5) ;AT END OF WORD?
JRST CLSTM1 ;NO, LOOP BACK TIL DONE
SUBI A,TMPCOR-1(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
GTJFN ;GET A JFN
CALL CJERR ;TEMP FILE LOSAGE
CALL JFNSTK ;SAVE FOR ERROR RELEASE
LDF B,7B5+1B20 ;BYTE SIZE + WRITE
OPENF ;OPEN FILE
CALL CJERR ;TEMP FILE LOSAGE
RET ;RETURN
TJNUM: MOVEI Q1,3 ;NEED TO MAKE TMP FILE
MOVE A,CSJOB ;GET JOB #
TJNM1: IDIVI A,^D10 ;DIVIDE INTO DIGITS
ADDI B,"0" ;CONVERT TO ASCII
LSHC B,-7 ;SHIFT OVER
SOJG Q1,TJNM1 ;LOOP
MOVEM C,FSPEC ;PUT IN BLOCK
RET ;RETURN
SUBTTL PARSE
;ROUTINE THAT FILTERS OUT ALL MULTIPLE SPACES, AND SPACES BEFORE
;COMMAS AND PLUS SIGNS, AND SLASHES!.
CMPRES: MOVE A,COMPBP ;POINTER TO COMMAND STRING
MOVE B,COMPBP ;POINTER TO NEW VERSION OF COMMAND STRING
CMP2: ILDB C,A ;LOOK AT CHARACTER FROM OLD STRING
CAIN C," " ;A SPACE?
JRST CMP1 ;YES, GO HACK IT
CMP4: IDPB C,B ;NOT A SPACE, STORE IT IN NEW STRING
JUMPN C,CMP2 ;GO BACK FOR MORE UNLESS DONE
CMP3: RET ;HIT NULL, SO DONE
CMP1: ILDB C,A ;GET CHARACTER AFTER SPACE
CAIN C," " ;MULTIPLE SPACES?
JRST CMP1 ;YES, SEARCH FOR FIRST NON-SPACE
CAIN C,"," ;IS FIRST CHARACTER AFTER SPACES A COMMA?
JRST CMP4 ;YES, SO LEAVE OUT THE SPACES
CAIN C,"+" ;SAME FOR PLUS SIGN
JRST CMP4
CAIN C,"/" ;SPACE PRECEDING SLASH?
JRST CMP4 ;YES, LEAVE IT OUT
MOVEI D," " ;STRANGE CHARACTER AFTER SPACE SO LEAVE IT IN
IDPB D,B
JRST CMP4
;MAIN PARSER
PARSE: CALL RDSKP ;HERE TO SKIP OVER SPACES
PARSE1: CALL RDFLD ;HERE TO READ A FIELD
JRST XTAB(P2) ;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
JRST RDLPRN ;4 - BEGINNING OF NOISE WORDS
ERROR <Illegal character in command> ;5 - ILLEGAL
JRST RDCOMA ;6 - COMMA SEEN
JRST RDEOL ;7 - END OF COMMAND
JRST RDIND ;10 - INDIRECT (@) SEEN
JRST RDPERC ;11 - PERCENT SEEN
JRST RDCOLN ;12 - COLON SEEN
ERROR <Illegal character in command> ;13 - ILLEGAL
ERROR <Illegal character in command> ;14 - ILLEGAL
ERROR <Illegal character in command> ;15 - ILLEGAL
ERROR <Illegal character in command> ;16 - ILLEGAL
;HERE ON END OF LINE (MAY BE IN INDIRECT FILE)
RDEOL: SKIPLE INDJFN ;CHECK IF INDIRECT
RET ;RETURN IF SO (NOTHING SEEN)
CAILE P3,1 ;ANYTHING BEFORE EOL?
JRST [TXO P1,F%LAHD ;SET LOOK AGAIN
JRST RDCOMA] ;PRETEND ITS A COMMA
SKIPN SRCSAV ;CHECK TRAILING SPACE
RET ;NONE TO WORRY ABOUT
TXO P1,F%CMOK!F%LAHD ;LITE THESE
TXZ P1,F%OBJ ;DONT HAVE OBJECT
JRST RDCOMA ;PROCESS SPEC
;HERE TO SKIP OVER NOISE WORDS
RDLPRN: CALL LDCHR ;GET NEXT CHAR
CAIN P2,C.EOL ;END-OF-LINE?
JRST [TXO P1,F%LAHD ;YES - SET LOOK AHEAD
JRST PARSE] ;CONTINUE PROCESSING
CAIE P2,"]" ;TERMINATOR FOR NOISE
CAIN P2,")" ;...
JRST PARSE ;YES - PROCEDE
JRST RDLPRN ;LOOP TILL FOUND
;HERE TO START PROCESSING INDIRECT FILE
RDIND: CALL RDFLD ;GET NEXT FIELD
CAIG P3,1 ;NON-NULL
ERROR <Null field in indirect spec>
CAIN P2,C.COLN ;GOT A COLON?
CALL CAPND ;YES - APPEND NEXT FIELD
HRROI A,[ASCIZ "CMD"] ;DEFAULT EXTN
MOVEM A,CJFNBK+.GJEXT ;GOOD PLACE
MOVE A,[377777,,377777]
MOVEM A,CJFNBK+.GJSRC ;NO EXTRA INPUT
LDF A,GJ%OLD ;PREPARE FOR GTJFN
MOVEM A,CJFNBK ;STORE
MOVEI A,CJFNBK ;POINT TO BLOCK
MOVE B,P4 ;POINTER TO STRING
GTJFN ;GET A JFN
CALL CJERR ;NOT TODAY
CALL JFNSTK ;SAVE IT
PUSH P,A ;SAVE JFN
DVCHR ;GET CHARACTERISTICS
LDB B,[POINTR (B,DV%TYP)]
CAIE B,.DVDSK ;GRNTEE DISK
ERROR <Indirect device not a disk>
POP P,A ;RESTORE JFN
LDF B,7B5+OF%RD ;BITS FOR OPENF
OPENF ;OPEN FILE
CALL CJERR ;WHOOPS
PUSH P,INDBRK ;SAVE PREVIOUS BREAK CHAR
MOVEM P2,INDBRK ;SETUP NEW ONE
PUSH P,INDJFN ;SAVE OLD JFN IF ANY
PUSH P,TEXTIB+2 ;SAVE INPUT PNTR
PUSH P,EOFDSP ;SAVE DISPATCH
MOVEM A,INDJFN ;STORE NEW ONE
MOVEI A,RDEOF ;WHERE TO GO AT EOF
MOVEM A,EOFDSP ;...
CALL PARSE ;CONTINUE SCAN
MOVE A,INDJFN ;RELEASE JFN
CLOSF ;AND CLOSE FILE
CALL CJERR ;SHOULDN'T HAPPEN
POP P,EOFDSP ;RESTORE DISPATCH
POP P,TEXTIB+2 ;RESTORE PNTR
POP P,INDJFN ;RESTORE OLD VALUE
MOVE A,INDBRK ;BREAK CHAR TYPE
POP P,INDBRK ;RESTORE OLD VALUE
CAIE A,C.COMA ;IF COMMA THEN DON'T REPARSE
TXO P1,F%LAHD ;SET LOOK AHEAD
JRST PARSE ;CONTINUE SCAN
;HERE TO PROCESS COLON (MAY BE SWITCH DELIM OR DEVICE)
RDCOLN: CAIG P3,1 ;ANYTHING?
ERROR <Null spec before colon>
TXZE P1,F%SLSH ;SLASH (IN SWITCH?)
JRST RDCLN1 ;YES - HANDLE
CALL CAPND ;APPEND COLON TO BUFFER
JRST XTAB(P2) ;DISPATCH
RDCLN1: CALL DOSWIT ;HANDLE SWITCH
TXO P1,F%LAHD ;SET LOOK AHEAD
JRST PARSE ;BECAUSE DOSWIT READ NEXT ATOM
CAPND: MOVEI Q1,":" ;REPLACE DELIMITER
DPB Q1,TEXTIB+3 ;IN BUFFER
PUSH P,P3 ;SAVE COUNT
CALL RDFLD0 ;SPECIAL READ
ADDM P3,0(P) ;UPDATE COUNT
POP P,P3 ;PRUNE PDL
RET ;RETURN
;HERE TO PROCESS LINK SWITCH SPEC
RDPERC: CAILE P3,1 ;BETTER STAND ALONE
JRST RDSLH1 ;ELSE MAY BE LOCAL SW
CALL LDCHR ;GET A CHAR
CAIE P5,"""" ;GRNTEE QUOTED
ERROR <LINK switch must be quoted>
MOVE P4,STRP ;PICK UP STRING PNTR
MOVE P3,STRC ;AND COUNT
RDPRC1: CALL LDCHR ;GET CHAR
CAIN P2,C.EOL ;CHECK END
ERROR <Unterminated LINK switch>
CAIN P5,"""" ;END OF SWITCH?
JRST RDPRC2 ;YES - SET UP BLOCK
IDPB P5,P4 ;STUFF CHAR
SOJG P3,RDPRC1 ;LOOP IF ROOM
ERROR <LINK switch too large>
RDPRC2: MOVEI P5,0 ;TERMINATE WITH NULL
IDPB P5,P4 ;...
MOVEM P3,STRC ;NEW REMAINDER
EXCH P4,STRP ;GET PNTR TO START
MOVEI A,L.SIZE ;SIZE FOR L20 SWITCH
CALL BALLOC ;ALLOCATE BLOCK
HRRM A,LNK(P6) ;LINK TO NEW BLOCK
MOVE P6,A ;UPDATE AC P6
MOVEM P4,NAM(P6) ;STORE STRING PNTR
LDF Q2,D%LINK ;SAY LINK SWITCH
IORM Q2,FLG(P6) ;...
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?
ERROR <Null filespec in object field>
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
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(P6) ;POINTER TO SOURCE LIST
HLRZ Q1,SRCSAV ;PNTR TO LAST OBJ BLOCK
HRRM P6,LNK(Q1) ;POINT TO NEW ONE
MOVEI Q2,LT.REL ;MARK AS RELOC
DPB Q2,[POINTR (<FLG(P6)>,F.LMSK)]
SETZM SRCSAV ;CLEAR PNTR
RDCMA2: SKIPGE B,LPROC ;HAVE A PROCESSOR?
LDB B,[POINTR (P1,F.LMSK)] ;USE DEFAULT
SETOM LPROC ;CLEAR THIS NOW
MOVE Q1,B ;COPY TYPE
CAIE Q1,LT.REL ;NO DEBUG AID FOR REL FILES
CAIN Q1,LT.MAC ; OR MACRO
MOVEI Q1,0 ;YES - NO AID FOR YOU
CAMLE Q1,DEBAID ;CHECK BEST SEEN SO FAR
MOVEM Q1,DEBAID ;SAVE BETTER
PUSH P,P6 ;SAVE THIS PNTR
HLL P6,SRC(P6) ;POINTER TO SOURCE LIST
MOVE P5,FLG(P6) ;GET FLAGS
MOVEI Q2,0 ;INIT REG
CALL SRCSCN ;LOOP THROUGH SOURCES
JRST [DPB B,[POINTR (<FLG(P6)>,F.LMSK)] ;STORE TYPE
ANDI P5,F.ALL ;MASK FLAGS WE WANT
IOR Q2,P5 ;ACCUMULATE RESULT
RET] ; AND EXIT
POP P,P6 ;RESTORE ORIG PNTR
IORM Q2,FLG(P6) ;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
RDCMA4: 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 (P6)
MAKOBJ: MOVEI A,B.SIZE ;GET SOME SPACE
CALL BALLOC ;...
EXCH A,P6 ;P6 POINTS TO NEW BLK
MOVEI Q2,NAM(P6) ;SET UP BLT PNTR
HRLI Q2,NAM(A) ;...
BLT Q2,B.SIZE-1(P6);MOVE VALUES
LDF A,D%EXTN ;CLEAR EXPLICIT EXTN
ANDCAM A,FLG(P6) ; FLAG IN IMPLICIT NAME
SETZM PPN(P6) ;NO PPN FOR DEFAULT FILE
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 PARSE1 ;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 P6,B ;SAVE BACK PNTR
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 PNTR YET?
MOVEM P6,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 PARSE1 ;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 PARSE1 ;GET NEXT SPEC
RDFILB: CALL FILBLK ;STASH SPEC ETC.
HRL P6,B ;BACK PNTR TO BE SAVED
SKIPN SRCSAV ;FIRST TIME?
MOVEM P6,SRCSAV ;YES - SAVE PNTR TO THIS BLK
RET ;RETURN
SUBTTL PARSE SUBROUTINES
;ROUTINE TO ALLOCATE AND FILL A FILE DESCR BLOCK
;RETURNS POINTER TO PREVIOUS BLOCK IN B, NEW BLOCK IN P6.
FILBLK: MOVE B,[POINT 7,FSPEC] ;COPY STRING TO FSPEC
FILBK1: ILDB A,P4 ;...
IDPB A,B
JUMPN A,FILBK1
MOVEI A,B.SIZE ;SIZE OF BLOCK
CALL BALLOC ;ALLOCATE IT
HRRM A,LNK(P6) ;STORE PNTR TO NEW BLOCK
PUSH P,P6 ;SAVE OLD PNTR
MOVE P6,A ;SET UP NEW PNTR
HRRM P1,FLG(P6) ;SET DEFAULTS
SETZM NAM(P6) ;NONE YET
CALL GTLANG ;FILL IN LANG TYPE INFO
JRST [LDF A,D%FNF ;SET FILE NOT FOUND
IORM A,FLG(P6) ;IN FLAGS OF SPEC
JRST .+1] ;KEEP GOING
POP P,B ;RETURN BACK POINTER
TXO P1,F%FILE!F%SPEC ;SAY FILE SEEN
RET ;...
;ROUTINE TO SAVE CURRENT STRING POINTED TO BY P4
SAVSTR: MOVE A,TEXTIB+4 ;CURRENT COUNT
MOVEM A,STRC ;INTO STRC
MOVE A,TEXTIB+3 ;CURRENT PNTR
MOVEM A,STRP ;INTO STRP
RET ;RETURN
;ROUTINE TO ALLOCATE SOME SPACE IN STRING SPACE
;CALL: MOVEI A,<SIZE-IN-WORDS>
; CALL BALLOC
; <RETURN> C(A) := ADDRS OF BLOCK
BALLOC: MOVEI B,[BYTE (7) 0,4,3,2,1,5]
HLL B,STRP ;CONSTRUCT BYTE PNTR
MOVSI C,(<POINT 7,,>) ;NEW LHS OF POINTER
HLLM C,STRP ;...
ILDB C,B ;GET REMAINDER
SKIPE C ;NEED TO ADJUST PNTR IF NECESSARY
AOS STRP ;POINT TO NEXT WORD
HRRZ B,STRP ;BEGINNING OF BLOCK
CAIN C,5 ;SPECIAL CASE
MOVEI C,0 ;OF NO LOST BYTES
ADDM A,STRP ;MOVE PAST END OF BLOCK
EXCH A,B ;A := PNTR TO BE RETURNED
IMULI B,5 ;CHARACTER COUNT FROM WORDS
MOVE D,STRC ;GET CURRENT COUNT
SUB D,B ;MINUS NEW ALLOCATION
SUB D,C ; AND WASTE
SKIPG D ;ANYTHING LEFT?
ERROR <String space exhausted>
MOVEM D,STRC ;RESTORE NEW COUNT
SETZM 0(A) ;CLEAR NEW BLOCK
CAIG B,5 ;ONLY ONE WORD?
RET ;YES - RETURN NOW
MOVEI B,1(A) ;ELSE SET UP BLT
HRL B,A
HRRZ C,STRP ;END OF BLOCK
BLT B,-1(C) ;CLEAR IT
RET ;AND RETURN
;GTLANG - ROUTINE TO DETERMINE LANGUAGE TYPE AND CHECK FOR
;EXISTING OBJECT FILE.
GTLANG: CALL GTLNGX ;CALL SUBROUTINE
JRST GTLNGA ;NO SUCH FILE RETURN
AOS 0(P) ;SKIP RETURN
GTLNGB: HRRZ A,LNGJFN ;GET JFN USED
JUMPE A,R ;NONE - RETURN
RLJFN ;RELEASE IT
CALL CJERR ;LOSAGE
SETZM LNGJFN ;SAY RELEASED
RET ;GIVE DESIRED RETURN
GTLNGA: MOVE B,[POINT 7,FSPEC]
MOVE A,STRP ;WHERE STRING WILL BE
MOVEM A,NAM(P6) ;POINT TO IT
GTLNA1: ILDB A,B ;COPY STRING TO STRING SPACE
IDPB A,STRP ;FOR ERROR MSG
SOSG STRC ;OK SO FAR?
ERROR <Command string space exhausted>
JUMPN A,GTLNA1 ;LOOP TILL DONE
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,[377777,,377777] ;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
GTJFN ;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 B,[ASCIZ "?Illegal character in filespec: "]
JRST SWERR] ;JOIN COMMON CODE
TXNE A,GJ%EXT ;* FOR EXTENSION
JRST GTLNG1 ;YES - LOOK FOR STANDARD EXT
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(P6)
RETSKP] ;GIVE GOOD RETURN
LDF A,D%EXTN ;EXPLICIT EXT GIVEN
IORM A,FLG(P6)
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
MOVE A,LNGJFN ;GET JFN
CALL DJFNSE ;GET EXTENSION
CALL LOOKE ;LOOKUP EXTENSION IN CSBUF
SKIPA ;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(P6)
RETSKP] ; AND EXIT
MOVE A,LNGJFN ;RESTORE JFN
LDF C,1B8+1B35 ;BITS FOR JFNS
CALL DOJFNS ;GET DEV:FNAME
SETZM CWBUF ;CLEAR LOC
LDF C,2B5 ;GET DEFAULT VALUE FOR DIR
HRROI A,CWBUF ;PLACE TO PUT IT
JFNS
CALL GTLNGB ;RELEASE JFN NOW
HRROI A,[ASCIZ "REL"] ;DESIRED EXTN
MOVEM A,CJFNBK+.GJEXT ;STORE
SKIPE A,CWBUF ;HAVE DIR?
HRROI A,CWBUF ;YES - POINT TO IT
MOVEM A,CJFNBK+.GJDIR ;STORE PNTR OR 0
GTLNGY: LDF A,GJ%OLD ;OLD FILE ONLY
MOVEM A,CJFNBK ;...
MOVEI A,CJFNBK ;POINT TO BLOCK
MOVE B,CSBUFP ;POINT TO FILESPEC
GTJFN ;LOOKUP
JRST [SKIPN CJFNBK+.GJDIR ;TRIED ELSEWHERE?
RETSKP ;NO RETURN NOW
SETZM CJFNBK+.GJDIR ;YES - TRY CONNECTED DIR
JRST GTLNGY]
MOVEM A,LNGJFN ;STORE JFN
CALL GTDT ;GET DATE/TIME
CALL STOREL ;STORE BEST SO FAR
SKIPN CJFNBK+.GJDIR ;TRIED SOMEWHERE ELSE?
RETSKP ;NO - RETURN NOW
CALL GTLNGB ;YES - RELEASE JFN NOW
LDF A,D%OSRC ;FOUND ONE ELSEWHERE FLAG
IORM A,FLG(P6) ;SET FLAG
SETZM CJFNBK+.GJDIR ;TRY CONNECTED DIR ANYWAY
JRST GTLNGY ; IT MIGHT BE BETTER
;GTLANG...
;HERE IF NO EXT SPECIFIED - FIND A STANDARD ONE TO USE
GTLNG1: MOVNI Q3,1 ;INITIAL VALUE
GTLNG2: MOVE A,LNGJFN ;GTJFN FLAGS ETC...
CALL DJFNSE ;GET EXTENSION
CALL LOOKE ;SEE IF STANDARD
MOVNI B,1 ;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
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
SKIPA ;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?
MOVEI B,LT.REL ;YES - THEN ASSUME THATS WHAT WE WANT
AOS 0(P) ;SET FOR SKIP RETURN
SKIPE OVER(P6) ;SAW A REL?
JRST [LDF A,D%OSRC ;YES - SAY OBJ IN SOURCE DIR
IORM A,FLG(P6)
JRST SETLTP] ;CONTINUE
CAIE B,LT.REL ;ONLY REL?
SKIPN PPN(P6) ;WHERE DID WE