Trailing-Edge
-
PDP-10 Archives
-
BB-D348F-SM
-
exec/execcs.mac
There are 47 other files named execcs.mac in the archive. Click here to see a list.
;<4.EXEC>EXECCS.MAC.203, 3-Jan-80 16:06:54, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.EXEC>EXECCS.MAC.201, 19-Oct-79 15:29:02, EDIT BY OSMAN
;MORE 4.2436 - STRIP NULLS FROM INDIRECT FILE CONTENTS
;<4.EXEC>EXECCS.MAC.196, 3-Oct-79 19:59:21, EDIT BY OSMAN
;tco 4.2509 - Don't allow cr in LOAD-class command unless filespec seen
;<4.EXEC>EXECCS.MAC.190, 3-Oct-79 15:23:41, EDIT BY OSMAN
;USE PERMANENT FREE SPACE FOR REMEMBERED STRING
;<4.EXEC>EXECCS.MAC.181, 1-Oct-79 09:35:25, EDIT BY OSMAN
;PUT INDIRECT FILES IN-LINE!
;remove special guide-word scanner (not needed)
;MORE 4.2436 - Make CMPRES remember character from previous indirect level
;More 4.2436 - Make CMPRES ignores all spaces except those sandwiched
;between filespecs
;<4.EXEC>EXECCS.MAC.177, 14-Sep-79 15:51:52, EDIT BY OSMAN
;MORE 4.2436 - Make CMPRES delete spaces after quoted string
;<4.EXEC>EXECCS.MAC.176, 14-Sep-79 11:02:23, EDIT BY OSMAN
;MORE 4.2436 - ignore comma comma at RDCOMA
;<4.EXEC>EXECCS.MAC.175, 14-Sep-79 10:12:35, EDIT BY OSMAN
;MORE 4.2436 - Get rid of RDSKP; Make CMPRES flush spaces following comma
;Don't set F%LAHD after gobbling indirect file
;<4.EXEC>EXECCS.MAC.174, 10-Sep-79 16:13:07, EDIT BY OSMAN
;tco 4.2466 - Do better than "?File not found" when indirect file in
;indirect file is not found
;<4.EXEC>EXECCS.MAC.173, 13-Sep-79 15:21:44, EDIT BY OSMAN
;MORE 4.2436 - Store words for PARSE recursion
;<4.EXEC>EXECCS.MAC.171, 13-Sep-79 6:24:13, EDIT BY OSMAN
;MORE 4.2436 - HANDLE NON-7-BIT indirect files correctly
;<4.EXEC>EXECCS.MAC.170, 7-Sep-79 11:19:36, EDIT BY OSMAN
;DON'T CALL JFNSTK AT TAT, COM2, OR IDEN; IT'S ALREADY CALLED AT CFN2
;<4.EXEC>EXECCS.MAC.169, 11-Sep-79 14:56:13, EDIT BY OSMAN
;more 4.2436 - Leave room for null in indirect buffer
;<4.EXEC>EXECCS.MAC.168, 11-Sep-79 10:28:27, EDIT BY OSMAN
;MORE 4.2436 - CALL RETBUF with correct args
;<4.EXEC>EXECCS.MAC.166, 4-Sep-79 15:41:26, EDIT BY OSMAN
;tco 4.2436 - Allow comments in indirect files
;<EKLUND>EXECCS.MAC.5, 28-Aug-79 13:56:39, EDIT BY EKLUND
;TCO 4.2426 - Load LOWTSA.REL first if SAIL program is loaded
;<4.EXEC>EXECCS.MAC.161, 16-Aug-79 09:39:05, EDIT BY OSMAN
;tco 4.2403 - Give better error on SET NO DEFAULT COMPILE
;<4.EXEC>EXECCS.MAC.159, 27-Jul-79 16:33:56, EDIT BY EKLUND
;tco 4.2354 - Prohibit file specific switches after comma in commands
;<4.EXEC>EXECCS.MAC.158, 26-Jul-79 17:08:29, EDIT BY OSMAN
;tco 4.2351 - Prevent ?Invalid CMBFP pointer adnauseum
;<4.EXEC>EXECCS.MAC.156, 18-Jul-79 10:16:54, EDIT BY OSMAN
;tco 4.2334 - Don't recompile if .REL is current and trailing spaces
;<4.EXEC>EXECCS.MAC.151, 17-Jul-79 09:48:18, EDIT BY OSMAN
;tco 4.2331 - Allow comments in COMPIL-class commands.
;<4.EXEC>EXECCS.MAC.150, 21-Jun-79 11:32:23, EDIT BY OSMAN
;tco 4.2303 - Look for .REL in both connected and source directory
;<4.EXEC>EXECCS.MAC.149, 21-Jun-79 11:10:45, EDIT BY OSMAN
;tco 4.2302 - fix LOAD A:FOO1+A:FOO2 when .REL in A:
;DON'T CLEAR PPN AT MAKOBJ IN CASE REL FILE IS IN SOURCE AREA
;<HELLIWELL.EXEC.4>EXECCS.MAC.3, 6-Jun-79 11:50:35, EDIT BY HELLIWELL
;ADD TEMP VARS SRCPTR AND DSKPTR FOR USE IN GTLANG
;<HELLIWELL.EXEC.4>EXECCS.MAC.2, 5-Jun-79 12:28:46, EDIT BY HELLIWELL
;FIX ERRORS IN WHERE TO LOOK FOR .REL FILES AND WHEN
;CLEAR TEMP CORE FILE AREA BEFORE ENTERING FIRST FILE
;<4.EXEC>EXECCS.MAC.147, 2-May-79 10:22:31, EDIT BY OSMAN
;SET UP JFN IN A FOR $GET2
;<4.EXEC>EXECCS.MAC.146, 1-May-79 11:22:05, EDIT BY OSMAN
;GTJFN => CALL GTJFS (SO ^C CAN'T LEAVE JFN AROUND)
;<4.EXEC>EXECCS.MAC.142, 20-Apr-79 15:36:17, EDIT BY OSMAN
;tco 4.2238 - Fix "?SCNCDR COMA REQUIRED IN DIRECTORY 0" (tmpcor blocks too long)
;<4.EXEC>EXECCS.MAC.138, 30-Mar-79 10:57:11, EDIT BY OSMAN
;COPY COMMAND SO THAT WE DON'T CLOBBER ORIGINAL BUFFER (SO CTRL/H DOESN'T GET CONFUSED)
;<4.EXEC>EXECCS.MAC.137, 12-Mar-79 17:53:14, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECCS.MAC.132, 4-Jan-79 19:46:40, EDIT BY OSMAN
;tco 4.2149 - make link switches (%) work better
;<4.EXEC>EXECCS.MAC.122, 3-Jan-79 15:41:08, EDIT BY OSMAN
;GET RID OF STRP, STRC
;<4.EXEC>EXECCS.MAC.120, 21-Dec-78 14:09:56, EDIT BY OSMAN
;tco 4.2130 - Don't say "?Not confirmed" on "LOAD @FOO"
;<4.EXEC>EXECCS.MAC.119, 20-Dec-78 11:01:58, EDIT BY OSMAN
;tco 4.2125 - fix "comp foo + zot"
;<4.EXEC>EXECCS.MAC.116, 8-Oct-78 17:06:41, EDIT BY OSMAN
;REMOVE REFS TO CERET BY REMOVING GTASCE
;<4.EXEC>EXECCS.MAC.112, 14-Sep-78 14:11:33, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;TCO 4.1978 - FIX "COMP /L" AND "COMP A=B" TO MAKE THEM NOT LOOP
;AND THEN TYPE "?TOO MANY JFNS IN COMMAND".
;CHANGE COLON PARSING TO NOT BREAK ON COLON, EVEN IF COLON PART OF SWITCH
;<4.EXEC>EXECCS.MAC.79, 7-Aug-78 14:52:52, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.78, 7-Aug-78 11:32:02, EDIT BY OSMAN
;PUT IN /LANGUAGE-SWITCHES:
;<4.EXEC>EXECCS.MAC.77, 7-Aug-78 10:36:59, EDIT BY OSMAN
;FIX G COMMAND (FROM "EDIT" PROGRAM)
;<EKLUND>EXECCS.MAC.14, 27-Jul-78 15:17:56, Edit by EKLUND
; TCO 1959
;MAKE /REL SWITCH WORK (AVOID %OBJECT FILE MISSING MESSAGE)
;<EKLUND>EXECCS.MAC.13, 27-Jul-78 15:16:24, Edit by EKLUND
; TCO 1958
;DO NOT PASS /LOCALS TO LINK UNLESS EXPLICITLY REQUESTED BY USER
;<EKLUND>EXECCS.MAC.12, 27-Jul-78 15:11:59, Edit by EKLUND
; TCO 1957
;MAKE THE /FOR AND /DDT SWITCHES SELECT THE RIGHT DEBUGGER (USED WITH @DEBUG)
;<4.EXEC>EXECCS.MAC.75, 27-Jul-78 16:38:20, EDIT BY OSMAN
;fix swmov
;<4.EXEC>EXECCS.MAC.74, 27-Jul-78 15:01:10, Edit by DBELL
;FIX TCO 1955
;<4.MONITOR>EXECCS.MAC.1, 27-Jul-78 13:35:42, EDIT BY OSMAN
;FIX A BUG
;<4.EXEC>EXECCS.MAC.72, 26-Jul-78 17:31:06, Edit by DBELL
;TCO 1955. CLEAR PRARG AREA SO EXECUTE COMMANDS DON'T MAKE LINK FAIL
;<4.EXEC>EXECCS.MAC.71, 25-Jul-78 10:15:00, EDIT BY OSMAN
;UNSTACK LNGJFN WHEN DONE WITH IT
;<4.EXEC>EXECCS.MAC.70, 24-Jul-78 11:06:59, EDIT BY OSMAN
;<4.EXEC>EXECCS.MAC.69, 21-Jul-78 08:26:11, EDIT BY OSMAN
;CHANGE BMSK TO NOT BREAK ON CR (BUT STILL BREAK ON LF)
;<4.EXEC>EXECCS.MAC.67, 14-Jul-78 13:11:15, EDIT BY OSMAN
;CHANGE LINK STRING FROM "/DEBUG:FORTRAN" TO "/DEBUG:(DDT,FORTRAN)"
;<4.EXEC>EXECCS.MAC.66, 13-Jul-78 15:41:15, EDIT BY OSMAN
;MAKE LHED, CRFHED, SAVPNT LOCAL
;<4.EXEC>EXECCS.MAC.65, 13-Jul-78 15:17:17, EDIT BY OSMAN
;MAKE CWBUF LOCAL
;<4.EXEC>EXECCS.MAC.61, 10-Jul-78 20:47:56, EDIT BY OSMAN
;MAKE TEXTIB BE LOCAL (AND RENAME IT TO CSTXTB)
;<4.EXEC>EXECCS.MAC.58, 27-Jun-78 15:13:27, EDIT BY OSMAN
;MAKE LOCAL VARIABLES BE DECLARED IN TRVAR (INSTEAD OF EXECPR AND EXECGL)
;<4.EXEC>EXECCS.MAC.57, 27-Jun-78 10:55:33, EDIT BY OSMAN
;STACK LNGJFN, SO IT NEEDN'T BE TREATED SPECIALLY IN RLJFNS
;<4.EXEC>EXECCS.MAC.56, 23-Jun-78 18:32:12, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: C.ILEG-IND-LPRN-PERC-PLUS-RPRN-SLSH,
;CMP3, D%IGN, P1LCOB, P1ST, PARD1, PPN1, PSWP, RDCMA4, RDFLD1, RDFLD2, S%PTYP,
;SPACE, SWSAV, SWSAV1, TCTAB
;<4.EXEC>EXECCS.MAC.52, 15-Jun-78 14:14:09, EDIT BY OSMAN
;ADD SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)
;ADD /68-COBOL /74-COBOL
;<4.EXEC>EXECCS.MAC.47, 14-Jun-78 14:45:05, EDIT BY OSMAN
;ADD "INFORMATION (ABOUT) DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;SET NO DEFAULTS (FOR) COMPILE-SWITCHES (FILE-TYPE)"
;<4.EXEC>EXECCS.MAC.37, 13-Jun-78 14:22:32, EDIT BY OSMAN
;CHANGE COMPILER-SWITCHES TO COMPILE-SWITCHES
;<4.EXEC>EXECCS.MAC.22, 11-Jun-78 21:15:47, EDIT BY OSMAN
;FREE UP USAGE OF P6, SO THAT TRVAR CAN BE USED FOR SRCEXT (AND ANY FUTURE NEEDS!)
;<4.EXEC>EXECCS.MAC.7, 8-Jun-78 16:34:16, EDIT BY OSMAN
;CAUSE DEFAULT SWITCHES TO COME AFTER EACH PROGRAM SPEC
;<3A.EXEC>EXECCS.MAC.2, 8-Jun-78 10:46:50, EDIT BY OSMAN
;ALLOW CRLF AS ALTERNATIVE TO LF AT END OF COMMAND LINE
;<4.EXEC>EXECCS.MAC.4, 3-May-78 11:01:15, Edit by DBELL
;MAKE /MAP AND /SAVE PRECEED /DEBUG IN LINK COMMAND
;<4.EXEC>EXECCS.MAC.3, 2-Mar-78 09:07:06, Edit by PORCHER
;<4.EXEC>EXECCS.MAC.2, 2-Mar-78 08:41:04, Edit by PORCHER
;Make CCL start use SFRKV rather than touching .JBSA
;<4.EXEC>EXECCS.MAC.1, 31-Jan-78 17:03:20, Edit by PORCHER
;Add stuff for execute-only
SUBTTL T.HESS/TAH 1-SEP-75
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH XDEF
TTITLE CSCAN - COMMAND SCANNER FOR TOPS-20
SALL
ESC==ALTM ;BETTER SYMBOL
QUOTE=="""" ;QUOTING CHARACTER
B.BP==70000,,0 ;CONSTANT TO BACKUP BYTE PNTR
;INTERNAL AC USAGE
;P1 - FLAGS
;P2 - DESC BLOCK POINTER
;P3 - COUNT OF CHARS IN STRING
;P4 - POINTER TO STRING (PARSE)
; LANGUAGE TYPE (LSCAN)
;P5 - FLAGS DURING LSCAN
;P6 - INTENTIONALLY NOT TOUCHED, SINCE TRVAR USES IT
;CHARACTER TYPE DEFINITIONS
C.SPAC==1 ;SPACE
C.COMA==6 ;COMMA
C.EOL==7 ;END-OF-LINE
C.COLN==12 ;COLON (SWITCH DELIM)
;FLAGS IN LH OF P1 (PARSE AND GLOBAL)
F%LAHD==1B0 ;LOOK AHEAD FLAG
F%SLSH==1B1 ;SLASH SEEN
F%FILE==1B2 ;POSSIBLE FILESPEC
F%OBJ==1B3 ;OBJECT SPEC IS NEXT
F%DDT==1B4 ;LOAD DDT
F%TOPN==1B5 ;TEMP FILE OPEN
F%GO==1B6 ;START EXECUTION
F%SDDT==1B7 ;GO TO DDT
F%NLOD==1B8 ;DON'T LOAD
F%NCMA==1B9 ;NEED COMMA FLAG
F%CMOK==1B9 ;(PARSE) COMMA OK FOR NULL SPEC
F%SPEC==1B10 ;FIRST FILESPEC SEEN (SWITCH HACK)
F%SUPP==1B11 ;LOADING SUPPRESSED
F%DSYM==1B12 ;DOING LOCAL SYMBOLS
F%AGN==1B13 ;DO OLD COMMAND AGAIN
F%LOBJ==1B14 ;GTLANG MAY LOOK FOR OBJECT FILE
;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%LANG==1B31 ;GLOBAL LANGUAGE SWITCH SEEN
;BITS 32-35 ARE LANG TYPE
F.LMSK==17B35 ;MASK FOR LANG TYPE
F.ALL==776000 ;MASK FOR ALL FILE RELEVENT SWS
;OFFSETS IN FILE DESCRIPTOR BLOCK
LNK==0 ;LINK TO NEXT BLOCK
SRC==0 ;PNTR TO SOURCE DESC OR 0
NAM==1 ;BYTE PNTR 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
B.SIZE==8 ;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
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 (74-COBOL,74C,74-COBOL,COB)
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
JRST CSCAN
CNSE: MOVEI B,[FLDDB. .CMNOI,,<-1,,[ASCIZ /FROM/]>]
CALL CFIELD ;TYPE NOISE BUT DON'T ALLOW "@"!
MOVEI P1,0 ;CLEAR FLAGS
RET
;ENTRY FROM CREF COMMAND
.CREF:: LINEX <Data line for CREF program>
CMERRX <Invalid data line for CREF program>
CALL CRSCAN ;MAKE RESCAN BUFFER
HRROI B,[GETSAVE (<SYS:CREF.>)]
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
MOVEI Q1,LT.FOR ;INITIAL LANGUAGE TYPE
DPB Q1,[POINTR (P1,F.LMSK)]
MOVEI P2,LHED ;BEGINNING OF FILE LIST
MOVEI A,STRSIZ*5
CALL GETBUF ;ALLOCATE FREE SPACE FOR TEXTI DESTINATION BUFFER
HRLI A,440700 ;MAKE A BYTE POINTER
MOVEM A,TXTPR ;REMEMBER POINTER
RET ;RETURN
;HE WHO ENTER HERE , BEWARE....
CSCAN: TRVAR <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>
MOVE A,CMPTR ;GET POINTER TO FOLLOWING "COMPILE (FROM)"
MOVEM A,.RDIOJ+CSTXTB ;POINT TEXTI BLOCK AT ORIGINAL COMMAND STRING
MOVEM A,COMPBP ;REMEMBER POINTER FOR CREATING DEFAULT STRING LATER
TXNE P1,F%AGN ;DOING OLD COMMAND AGAIN?
JRST CMAGN1 ;YES, GO DO IT
CALL TI ;READ A LINE
CALL CSCANR ;SCAN RESET
MOVEM P1,CSVCC ;SAVE COMMAND INFO FOR EDIT
CSCAN1: MOVEI A,7 ;ALLOCATE ROOM IN TEXTI BLOCK
MOVEM A,CSTXTB
SETZM .RDRTY+CSTXTB ;SAY NO ^R POINTER
SETZM .RDBFP+CSTXTB ;NO SPECIAL BACKUP POINTER
MOVE A,[TMPCOR,,TMPCOR+1] ;GET READY
SETZM TMPCOR ;TO CLEAR THE TEMPORARY FILE AREA
BLT A,TMPCOR+777 ;DO IT
MOVEI A,BMSK ;SET UP STANDARD BREAK MASK
MOVEM A,BMSKA
SETZM LNGJFN ;SAY NO LANGUAGE JFN YET
SETZM SAILF ;assume not SAIL
SETZM INDJFN ;NO INDIRECT YET
SETZM SRCSAV ;NO PARTIAL SOURCE LIST
SETZM DEBAID ;NO DEBUGGING AID
SETOM LPROC ;UNKNOWN LANG PROCESSOR
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
CSCANO: HLRO A,PRTAB+LT.REL ;GET NAME OF LINK-20
TXNE P1,F%NLOD ;ARE WE GOING TO LOAD?
MOVEI A,0 ;NO - THEN NO FILESPEC
MOVEM A,NXPROC ;SAVE AS NEXT PROCESSOR
;;;; FALL INTO NEXT PHASE
;START SCAN TO LOOK FOR THINGS TO COMPILE
MOVEI P4,%LT ;GET HIGHEST LANG TYPE
P1LUP: 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
CAIN P4,LT.74C ;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: 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
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
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
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
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 <CCLJFN>
CALL TRYGTJ ;TRY TO GET JFN
ERROR <Cannot find process>
MOVEM A,CCLJFN ;REMEMBER JFN OF PROGRAM
CALL ERESET ;RESET
MOVE A,CCLJFN ;SAY WHICH PROGRAM TO LOAD
CALL $GET2 ;DO GET ETC...
CALL DPRARG ;SEND TMP FILES
CALL UNMAP ;UNMAP FREE SPACE USED
SETZM STAYF ;DON'T STAY AT COMMAND LEVEL
CALL SETGO ;Setup for program running
MOVX B,<XWD 1,0> ;Increment 1 into vector location 0
SFRKV ; is CCL start address, start process
ERJMP RUNGO1 ;Failed-- try to do old style
JRST WAITF ;Wait for process to terminate
;**** Old style CCL start ***** Remove this code sometime ****
RUNGO1: MOVEI A,JOBSA ;NEED TO GET STARTING ADDRS
CALL LOADF ;READ WORD
JRST CJERRE ;Failed-- say why
AOS B,A ;INCREMENT
MOVEI A,JOBSA ;WRITE BACK ALTERED START ADDRS
CALL STOREF ;...
JRST CJERRE ;Failed-- say why
TLZ B,-1 ;CLEAR LHS
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 A COMMA
CALLRET TBOUT ;...
;ROUTINE TO SETUP DEBUG AID IF ANY
SETDEB: HRROI B,[ASCIZ "/DEBUG"]
CALL TSOUT0 ;DUMP LINK SWITCH
TXNN P1,F%LANG ;WAS A LANGUAGE SWITCH SEEN?
JRST TRYDDT ;NO, HOW ABOUT /DDT ?
LDB B,[POINTR(P1,F.LMSK)] ;GET DEFAULT LANG COMPILER NAME
CAIE B,0 ;IF NONE, MOVE ON...
MOVEM B,DEBAID ;OTHERWISE, USE IT TO SELECT DEBUGGER
TRYDDT: MOVEI B,LT.MAC ;BUT FIRST,
TXNE P1,F%DDT ;CHECK FOR /DDT IN COMMAND
MOVEM B,DEBAID ;YES, SO USE REAL DDT INSTEAD!
SKIPN B,DEBAID ;ANYTHING ELSE?
CALLRET SPOUT ;NO
HRRO B,DBTAB(B) ;YES - GET AID NAME
CALL TSOUT0 ;DUMP IT
CALLRET SPOUT ;AND SPACE
;LSCAN - ROUTINE TO CRAWL THROUGH LIST OF FILE SPECS
;CALL: CALL LSCAN
; <COROUTINE ADDRS>
; RETURN ON EMPTY LIST
LSCAN: MOVEI P2,LHED ;GET LIST HEAD
LSCAN0: HRRZ P2,LNK(P2) ;LOOK AT NEXT ENTRY
JUMPE P2,RSKP ;SKIP RETURN WHEN DONE
SKIPGE P5,FLG(P2) ;LOAD FLAGS
JRST LSCAN0 ;YES - SKIP IT
HLL P2,SRC(P2) ;LOAD SOURCE PNTR IF ANY
CALL @0(P) ;INVOKE COROUTINE
JRST LSCAN0 ;TRY NEXT
;SRCSCN - ROUTINE TO SCAN ALL SOURCES AND CALL SOURCE COROUTINE
SRCSCN: TLNN P2,-1 ;SINGLE SOURCE?
JRST [CALL @0(P) ;INVOKE ROUTINE
RETSKP] ;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 ROUTINE
HRRZ P2,LNK(P2) ;LINK TO NEXT
JUMPN P2,SRCSC1 ;PROCEED IF EXISTS
POP P,P5 ;RESTORE FLAGS
POP P,P2 ;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(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: MOVEI Q2,0 ;SAY WE LOST
RET ;RETURN
;PASS2 - BUILD LINK-20 COMMAND FILE
PASS2: TXNE P5,D%LINK ;LINK SWITCH
JRST PASS2S ;YES - HANDLE SPECIAL
SKIPN OVER(P2) ;HAVE REL SOMEWHERE?
JRST [TXO P1,F%SUPP ;LOSAGE NOTED
PUSH P,A ;SAVE JFN
TYPE <%Object file missing: >
MOVE B,NAM(P2) ;TELL HIM WHAT
CALL DSOUTR ;PRINT SPEC
POP P,A ;RESTORE JFN
RET] ;RETURN
TXZE P1,F%NCMA ;NEED COMMA?
CALL CMOUT ;YES - PUT ONE IN
CALL P2SYMS ;DO SYMBOL CODE
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 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(P2) ;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 CALLED TO DUMP LINK SWITCH
PASS2S: MOVEI B,"/" ;OUTPUT SLASH
MOVE Q1,NAM(P2) ;GET STRING PNTR
ILDB Q1,Q1 ;PEEK AT FIRST CHAR
CAIE Q1,"/" ;IS IT A SLASH?
CALL TBOUT ;NO - DUMP ONE
MOVE B,NAM(P2) ;GET STRING
CALL TSOUT0 ;DUMP IT
TXO P1,F%NCMA ;NO COMMA YET
PASOUT: MOVEM A,TMPJFN ;SAVE UPDATED JFN
RET
;ROUTINE TO OUTPUT /LOCAL OR /NOLOCAL ETC...
P2SYMS: 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
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(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 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(P2) ;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(P2);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(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
JFCL ;IGNORE
SKIPE B,PPN(P2) ;WANT PPN
CALL PUTPPX ;YES - DUMP IT
MOVEI D,"C" ;OUTPUT SW
CALL SWOUT ;...
CAIN P4,LT.74C ;74 COBOL?
JRST BLDCM3 ;YES, SO DON'T CREF
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
SKIPE B,LSWPTR ;GLOBAL LANGUAGE SWITCHES?
CALL TSOUT0 ;YES, DUMP THEM
SKIPE B,SWP(P2) ;LANGUAGE SWITCHES?
CALL TSOUT0 ;YES, DUMP THEM
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(P2) ;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.74C ;COBOL 74?
CAIN P4,LT.CBL ;IS IT COBOL
CAIA
RET ;NO RETURN
MOVEI 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: 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 C,CSBUFP ;CURRENT PNTR
MOVE Q1,NAM(P2) ;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 ;...
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,CSBUFP ;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: MOVEI A,2 ;ALLOCATE CELL
CALL BALLOC ;...
HRRM A,0(Q1) ;LINK TO OLD
MOVE A,CSBUFP ;POINTER TO NEW STRING
CALL BUFFS ;ISOLATE THE STRING
HRRZ B,0(Q1) ;GET ADDRESS OF NEW BLOCK
MOVEM A,1(B) ;STORE POINTER TO STRING IN SECOND WORD OF BLOCK
RET ;RETURN
;ROUTINE TO MERGE EXISTING CREF FILE WITH CORE INFO
FINCRF: SKIPN CRFHED ;ANYTHING NEW?
RET ;NO - THEN DONE
CALL TJNUM ;GO MAKE A FILENAME
MOVEI A,"CR"
DPB A,[POINT 14,FSPEC,34]
MOVE A,[ASCII "E.TMP"]
MOVEM A,1+FSPEC ;COMPLETE NAME
SETZM 2+FSPEC ;MAKE ASCIZ
LDF A,GJ%SHT!GJ%PHY!GJ%OLD
HRROI B,FSPEC ;ARGS FOR GTJFN
CALL GTJFS ;SEE IF FILE EXISTS
JRST DONCRF ;NO - JUST DUMP CORE
LDF B,7B5+1B19 ;BITS FOR READ
OPENF ;OPEN FILE
CALL CJERR ;LOSAGE
PUSH P,A ;SAVE JFN ON STACK
PUSH P,EOFDSP ;SAVE EOF TRAP
MOVEI A,CRFEOF ;NEW ADDRS FOR TRAP
MOVEM A,EOFDSP ;...
;;;; FALL INTO FNCRFN
;HERE TO SCAN FILE FOR SPEC
FNCRFN: MOVE A,-1(P) ;FETCH JFN
FNCRF1: BIN ;READ A CHAR
CAIE B,"=" ;SEARCH FOR BEGINNING OF SPEC
JRST FNCRF1 ;LOOP TILL FOUND
MOVE C,CSBUFP ; " PNTR
FNCRF2: BIN ;GOBBLE CHAR
CAIN B,LF ;LOOK FOR EOL
JRST FNCRF3 ;FOUND - CHECK FOR MERGE
IDPB B,C ;COPY TO STRING SPACE
JRST FNCRF2
FNCRF3: MOVEI B,0 ;REPLACE CR WITH NULL
DPB B,C ;...
CALL CHKCRF ;CALL COMMON CODE
JRST FNCRFN ;LOOK FOR MORE
;HERE ON EOF INTERUPT FROM READING CREF FILE
CRFEOF: POP P,EOFDSP ;RESTORE THIS
MOVE A,0(P) ;GET JFN
TLO A,(1B0) ;RETAIN IT
CLOSF ;CLOSE FILE
CALL CJERR ;NEVER HAPPEN
LDF B,7B5+1B20 ;OPEN FOR WRITE
TLZ A,(1B0) ;CLEAR FLAG
OPENF ;...
CALL CJERR ;SOMETHING WENT WRONG
JRST DNCRF1 ;JOIN WRITE
;ROUTINE TO WRITE OUT NEW CREF FILE
DONCRF: CALL TOPNF ;OPEN TMP FILE IN FSPEC
PUSH P,A ;STACK JFN
DNCRF1: MOVE Q1,CRFHED ;GET LIST HEAD
MOVE A,0(P) ;GET JFN
DNCRF2: MOVEI B,"=" ;EQUAL SIGN
CALL TBOUT ;DUMP IT
MOVE B,1(Q1) ;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(P2) ;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
RET
;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
CAIN A,1 ;FIRST ONE?
JRST OPNT2 ;YES
MOVE B,ADDTAB-2(A) ;NO, IT STARTS RIGHT AFTER LAST ONE
ADD B,TMPCOR(B) ;GET ADDRESS OF NEXT FILE
AOJ B, ;LENGTH DOESN'T INCLUDE HEADER
OPNT1: HRRZM B,ADDTAB-1(A) ;REMEMBER STARTING ADDRESS OF TMP FILE
HLLZ C,SIXTAB(P4) ;GET NAME OF TMP FILE, MAC, FOR, LNK ETC.
MOVEM C,TMPCOR(B) ;STORE NAME IN LEFT HALF OF FIRST WORD
MOVEI A,TMPCOR+1(B) ;MAKE BYTE POINTER TO SECOND WORD OF
HRLI A,440700 ;FILE
RET ;GIVE CALLER THE BYTE POINTER ("JFN")
OPNT2: SETZM ADDTAB ;CLEAR BUFFER
MOVE B,[ADDTAB,,ADDTAB+1]
BLT B,BUF1-1
MOVEI B,TMPBUF-TMPCOR ;ASSUME FIRST ONE
JRST OPNT1
;CLOSE TEMP FILE
CLSTMP: MOVE B,NFILES
MOVE C,ADDTAB-1(B) ;GET BEGINNING OF FILE ADDRESS
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(C) ;CALCULATE LENGTH OF FILE
HRRM A,TMPCOR(C) ;REMEMBER LENGTH
RET
;ROUTINE TO ATTEMPT TO OPEN FILE IN FSPEC
TOPNF: LDF A,GJ%SHT!GJ%FOU!GJ%PHY!GJ%TMP
HRROI B,FSPEC ;POINT TO FILESPEC
CALL GTJFS ;GET A JFN
CALL CJERR ;TEMP FILE LOSAGE
LDF B,7B5+1B20 ;BYTE SIZE + WRITE
OPENF ;OPEN FILE
CALL CJERR ;TEMP FILE LOSAGE
RET ;RETURN
TJNUM: MOVEI Q1,3 ;NEED TO MAKE TMP FILE
MOVE A,CSJOB ;GET JOB #
TJNM1: IDIVI A,^D10 ;DIVIDE INTO DIGITS
ADDI B,"0" ;CONVERT TO ASCII
LSHC B,-7 ;SHIFT OVER
SOJG Q1,TJNM1 ;LOOP
MOVEM C,FSPEC ;PUT IN BLOCK
RET ;RETURN
SUBTTL PARSE
;The CMPRES routine tidies up command strings for the COMPILE-class
;commands. Lots of these petty chores are normally handled by the monitor
;via the COMND jsys. However, since the PARSE routine doesn't use COMND,
;this CMPRES routine is needed.
;CMPRES does the following:
;
; o Carriage returns are ignored. Linefeeds are changed to
; commas. This is so that multiple-line indirect files work.
;
; o All multiple spaces are compressed to at most one space
;
; o Any spaces following end of line are
; deleted. Neglecting to remove spaces at end of line causes
; "COMP FOO.MAC " to force a compilation.
;
; o Spaces preceding percent signs are deleted.
; If spaces aren't removed in front of percent, the command
; LOAD FOO %"text" fails to call the compiler!
; o Comments enclosed in exclams (!) are removed
;
; o Comments starting with semicolon (;) last through the next
; linefeed or end of command
;
; o All spaces other than those sandwiched between filespecs
; are removed.
;Accepts: AC1/ Pointer to command string
C%PLUS==1B0 ;Last non-space was not a filespec constituent
CMPRES: MOVEI A,CMPWDS ;INITIALLY ALLOCATE ENTIRE BUFFER FOR COMMAND
CALL GETBUF
MOVEM A,CMPBUF ;REMEMBER ADDRESS OF BLOCK
ADDI A,CMPWDS-1 ;GET LAST ADDRESS IN BLOCK
SETZM (A) ;GUARANTEE NULL AT END OF STRING
HRLI A,100700 ;GET STARTING POINTER IF STRING WERE 0 BYTES
MOVEM A,CMPPT0 ;REMEMBER POINTER TO NULL COMMAND
MOVE A,.RDIOJ+CSTXTB ;GET POINTER TO COMMAND STRING
CALL BCOUNT ;SEE HOW MANY CHARACTERS ARE IN IT
MOVEI C,1(B) ;LEAVE ROOM FOR NULL
CAILE C,CMPMSZ ;MAKE SURE THERE'S ROOM FOR COMMAND STRING
ERROR <COMPIL-class command string is too long>
MOVEM C,CMPSIZ ;REMEMBER INITIAL SIZE OF STRING
MOVN A,B ;GET NEGATIVE NUMBER OF CHARACTERS
MOVE C,A ;REMEMBER NEGATIVE COUNT FOR SOUT JSYS
ADJBP A,CMPPT0 ;GET ACTUAL STARTING BYTE POINTER FOR COMMAND
MOVEM A,CMPPT0 ;REMEMBER STARTING POINTER
MOVEM A,CSPTR ;INITIALIZE SOURCE POINTER
MOVEM A,CDPTR ;INITIALIZE DESTINATION POINTER
MOVE B,.RDIOJ+CSTXTB ;GET POINTER TO COMMAND STRING
SOUT ;CREATE INITIAL COMMAND (BEFORE EXPANDING INDIRECT FILES!)
MOVX Z,C%PLUS ;FORCE LEADING SPACES TO BE FILTERED OUT
CALL REMNUL ;REMOVE NULLS FROM COMMAND
CMP2: CALL GCMC ;GET CHARACTER, STRIP COMMENT IF SEEN
CAIE A,.CHTAB ;TABS ARE THE SAME AS SPACES
CAIN A," " ;A SPACE?
JRST CMP1 ;YES, GO HACK IT
CMP4: IDPB A,CDPTR ;NOT A SPACE, STORE IT IN NEW STRING
JUMPE A,CMPDON ;DONE IF NULL
TXZ Z,C%PLUS ;FIRST ASSUME FILEPSEC CHARACTER
CALL SKPFCH ;IS CHARACTER A FILESPEC CHARACTER?
TXO Z,C%PLUS ;NO, REMEMBER
JRST CMP2 ;GO BACK FOR REST OF CHARACTERS
CMPDON: MOVE A,CMPPT0 ;GET RESULTANT STARTING POINTER
MOVEM A,.RDIOJ+CSTXTB ;PLACE IN TEXTI BLOCK
HRRZ A,A ;KEEP FIRST ADDRESS USED
SUB A,CMPBUF ;CALCULATE NUMBER OF WORDS UNUSED
MOVE B,CMPBUF ;TELL RETBUF WHERE THE BLOCK IS
CALLRET RETBUF ;RETURN THE UNUSED WORDS AND EXIT
CMP1: CALL GCMC ;GET CHARACTER AFTER SPACE
CAIE A,.CHTAB ;TABS ARE THE SAME AS SPACES
CAIN A," " ;MULTIPLE SPACES?
JRST CMP1 ;YES, SEARCH FOR FIRST NON-SPACE
TXNE Z,C%PLUS ;WAS CHARACTER BEFORE SPACES A NON-FILE CHARACTER?
JRST CMP4 ;YES, SO LEAVE OUT THE SPACES
JUMPE A,CMP4 ;THROW AWAY TRAILING SPACES
CALL SKPFCH ;SKIP IF CHARACTER IS A FILE CHARACTER
JRST CMP7 ;NOT A FILE CHARACTER, SO THROW AWAY SPACES
MOVEI A," " ;SPACE SANDWICHED BETWEEN FILESPECS, LEAVE IT IN
IDPB A,CDPTR
CMP7: LDB A,CSPTR ;GET THE FILE CHARACTER BACK
JRST CMP4
;SKPFCH SKIPS IF CHARACTER IS A FILE CONSTITUENT FOR COMPIL-CLASS COMMANDS.
;
;ACCEPTS: A/ CHARACTER
;
;RETURNS: +1: CHARACTER IS NOT PART OF A FILESPEC
; +2: CHARACTER IS PART OF A FILESPEC
SKPFCH: IDIVI A,4*8 ;GET INDEX AND OFFSET
MOVE B,BITS(B) ;GET BIT POSITION
TDNE B,NFLBTS(A) ;SKIP IF BIT NOT ON
RET ;BIT ON, CHARACTER IS NOT PART OF FILESPEC
RETSKP ;CHARACTER IS PART OF FILESPEC, SKIP.
;TABLE OF CHARACTERS NOT INCLUDED IN COMPIL-CLASS FILESPECS. THERE ARE
;FOUR WORDS, EACH OF WHICH CONTAINING 32 LEFT-JUSTIFIED BITS, YIELDING A TOTAL
;OF 128 BITS, ONE FOR EACH POSSIBLE CHARACTER. THE BIT IS ON IF THE CHARACTER
;IS NOT PART OF A FILESPEC
NFLBTS: BRMSK. FILB0.,FILB1.,FILB2.,FILB3.,,<%> ;PERCENT IS PART OF A LINK SWITCH
;GET CHARACTER, STRIP COMMENT OR CARRIAGE RETURN IF SEEN
GCMC: ILDB A,CSPTR ;LOOK AT CHARACTER FROM OLD STRING
CAIN A,"@" ;INDIRECT FILE?
JRST GCMIND ;YES, GO STUFF IT INTO THE STRING
CAIN A,.CHCRT ;CARRIAGE RETURN
JRST GCMC ;YES, IGNORE IT
CAIN A,"""" ;QUOTED STRING?
JRST GCMQT ;YES, FIND THE END OF IT
CAIE A,"," ;COMMA IS SAME AS LINEFEED!
CAIN A,.CHLFD ;END OF LINE?
JRST GCMLF ;YES
CAIN A,";" ;IS REST OF LINE A COMMENT?
JRST CMP6 ;YES, GO FIND END OF LINE
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 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,CSPTR ;POINTER TO STRING
CALL GTJFS ;GET A JFN
CALL [ MOVE B,CSPTR ;FAILED, TRY TO GET PARSE-ONLY JFN
MOVE Q1,A ;REMEMBER ERROR CODE
MOVX A,GJ%OFG ;SAY WE WANT NAME ONLY
MOVEM A,.GJGEN+CJFNBK
MOVEI A,CJFNBK
CALL GTJFS ;ATTEMPT PARSE-ONLY
CALL [ MOVE A,Q1 ;FAILED, GET ORIGINAL ERROR
ERROR <Can't access indirect file - %1?>]
MOVE B,Q1 ;GOT A JFN, GET THE ERROR CODE
ERROR <Can't access indirect file %1S - %2?>]
MOVNI C,1
ADJBP C,B ;KEEP CHARACTER AFTER FILESPEC
MOVEM C,CJEPTR ;REMEMBER POINTER TO END OF FILESPEC
LDF B,7B5+OF%RD ;BITS FOR OPENF
MOVEM A,INDJFN ;REMEMBER INDIRECT JFN
OPENF ;OPEN FILE
CALL CJERR ;WHOOPS
MOVE B,[2,,.FBBYV] ;WE WANT BYTE SIZE AND NUMBER OF BYTES
MOVEI C,C ;READ INFO INTO C AND D
GTFDB
ERCAL [ERROR <Can't determine size of indirect file %1s>]
LOAD C,FB%BSZ,C ;ISOLATE THE BYTE SIZE
MOVE A,[440000,,1] ;GET BYTE POINTER TO 0TH BYTE IF BYTE SIZE WAS 0
DPB C,[300600,,A] ;NOW A HAS BYTE POINTER TO 0TH BYTE
ADJBP D,A ;GET POINTER TO LAST BYTE IN D
HRRZ A,D ;REMEMBER NUMBER OF WORDS
LDB C,[360600,,D] ;GET NUMBER OF UNUSED BITS IN LAST WORD
SOJ C, ;BIT 35 IS UNUSED FOR ASCII
IDIVI C,7 ;SEE HOW MANY ASCII BYTES ARE UNUSED IN LAST WORD
IMULI A,5 ;GET MAXIMUM NUMBER OF ASCII CHARACTERS
SUB A,C ;GET RID OF UNUSED CHARACTERS
MOVEM A,INDSIZ ;REMEMBER TOTAL NUMBER OF ASCII CHARACTERS
MOVNI A,1
ADJBP A,CSPTR ;BACKUP ONE FROM CURRENT TO FLUSH THE ATSIGN
MOVEM A,CSPTR ;STORE SO THAT FIRST CHARACTER OF INDIRECT FILE GETS SEEN
MOVE B,CJEPTR ;GET POINTER TO END OF FILESPEC
CALL SUBBP ;GET NEGATIVE CHARACTERS FILESPEC AND ATSIGN TAKES
ADD A,INDSIZ ;ADD TO SPACE NEEDED BY INDIRECT FILE TO GET DISTANCE STUFF HAS TO BE SHUFFLED
MOVEM A,ADDSIZ ;REMEMBER ADDITIONAL SIZE OF COMMAND
MOVE B,CMPPT0 ;GET POINTER TO BEGINNING OF STRING
MOVE A,CSPTR ;GET POINTER TO BEFORE ATSIGN
CALL SUBBP ;CALCULATE LENGTH OF STRING TO MOVE
MOVN C,A ;TELL SOUT TO MOVE EXACTLY THAT NUMBER OF CHARACTERS
MOVE A,ADDSIZ ;GET ADDITIONAL SIZE (MIGHT BE NEGATIVE!)
ADDB A,CMPSIZ ;GET TOTAL NEW SIZE OF COMMAND STRING
SKIPGE ADDSIZ ;IS COMMAND STRING SHRINKING?
JRST GSHRNK ;YES, CONTENTS IS SHORTER THAN FILEPSEC!
CAILE A,CMPMSZ ;STILL LESS THAN MAXIMUM ALLOWED?
ERROR <Indirect file too large or too many indirect files>
MOVN A,ADDSIZ ;GET NEGATIVE AMOUNT WE HAVE TO MOVE THE COMMAND
ADJBP A,CMPPT0 ;BACKUP POINTER TO GET NEW BEGINNING
MOVE B,CMPPT0 ;MOVE FROM OLD BEGINNING
MOVEM A,CMPPT0 ;REMEMBER NEW BEGINNING
CAIE C,0 ;DON'T GIVE SOUT 0, SINCE IT DOESN'T MEAN 0 BYTES
SOUT ;SHOVE FIRST PORTION TO THE LEFT
MOVE B,A ;B NOW HAS PLACE WHERE INDIRECT FILE GOES
MOVE A,INDJFN ;SAY WHAT CHANNEL INDIRECT FILE IS ON
MOVN C,INDSIZ ;PREPARE TO READ EXACT NUMBER OF CHARACTERS
CALL GEOFQ ;DO SIN AND CHECK FOR EOF
JUMPN C,[ MOVE A,CJEPTR ;SIN STOPPED SHORT. GET POINTER TO COMMAND BEYOND THE INDIRECT SPEC
MOVEI C,0 ;STOP ON NULL
SIN ;SLIDE STUFF LEFT TO FILL GAP AFTER INDIRECT FILE CONTENTS
JRST .+1]
MOVN A,ADDSIZ ;GET NEGATIVE AMOUNT WE MOVED STRING
ADJBP A,CDPTR ;FIX DESTINATION POINTER TO ACCOUNT FOR MOVED STRING
MOVEM A,CDPTR ;REMEMBER FIXED POINTER
MOVN A,ADDSIZ ;FIX SOURCE POINTER
ADJBP A,CSPTR
MOVEM A,CSPTR ;STORE FIXED SOURCE POINTER
GCOMMN: CALL RJFN ;CLOSE INDIRECT FILE SO THAT HAVING MANY LEVELS DOESN'T RUN OUT OF JFNS
CALL REMNUL ;REMOVE ANY NULLS THAT WERE IN INDIRECT FILE
JRST GCMC ;CONTINUE PARSING WITH CONTENTS OF INDIRECT FILE
GCMQT: IDPB A,CDPTR ;SAVE QUOTED STRING
GCQ1: ILDB A,CSPTR ;QUOTED STRING, FIND ITS END
CAIE A,"""" ;FIND THE END YET?
JRST GCMQT ;NO, KEEP LOOKING
RET
;REMNUL USES CSPTR AS POINTER TO "REST" OF UNCOMPRESSED STRING AND REMOVES
;ANY NULLS EXCEPT THE ONE TERMINATING THE STRING. THE REASON WE DON'T MERELY
;STRIP NULLS AS WE SCAN THE STRING, IS THAT WHEN ATSIGN IS SEEN, GTJFN IS
;SCANNING, SO WE MUST MAKE SURE WE STRIP AT LEAST THOSE NULLS THAT MAY FALL
;WITHIN A FILESPEC.
REMNUL: MOVE A,CSPTR ;START SCANNING HERE
MOVE B,CSPTR ;STORE NON-NULLS WITH B POINTER
REMN1: ILDB C,A ;PICK UP NEXT CHARACTER FROM COMMAND STRING
IDPB C,B ;STORE IT, NULL OR NOT.
JUMPN C,REMN1 ;JUST CONTINUE IF NON-NULL
MOVE C,CMPSIZ ;NULL FOUND, CALCULATE POINTER TO END OF STRING
ADJBP C,CMPPT0
CAMN B,C ;IS THIS NULL AT END OF STRING?
RET ;YES, WE'RE DONE
MOVNI C,1 ;STRING DIDN'T END, BACK UP DESTINATION POINTER
ADJBP C,B
MOVE B,C ;CAUSE INTERNAL NULL TO BE OVERWRITTEN
SOS CMPSIZ ;REMEMBER REDUCED SIZE TOO
JRST REMN1 ;LOOP FOR CHARACTERS AFTER INTERNAL NULL
;HERE DURING INDIRECT PROCESSING IF INDIRECT FILE CONTENTS IS SHORTER THAN
;ITS NAME. HANDLE THIS BY COPYING THE INDIRECT FILE CONTENTS OVER THE FILESPEC
;AND THEN SLIDING THE REMAINDER OF THE COMMAND STRING TO THE LEFT
GSHRNK: MOVE A,INDJFN ;GET HANDLE OF INDIRECT FILE
MOVE B,CSPTR ;COPY OVER THE ATSIGN AND FILESPEC
MOVN C,INDSIZ ;INPUT EXACT NUMBER OF CHARACTERS
CALL GEOFQ ;DO SIN AND CHECK FOR EOF
MOVE A,CJEPTR ;NOW INPUT CHARACTERS STARTING AFTER FILESPEC
MOVEI C,0 ;READ UNTIL NULL FOUND
SIN ;SLIDE STUFF LEFT THAT WAS AFTER INDIRECT SPEC
JRST GCOMMN ;JOIN COMMON CODE
;GEOFQ DOES SIN AND VERIFIES THAT THE FAILING SIN JSYS READING THE INDIRECT FILE WAS DUE
;TO EOF. THIS IS EXPECTED IF THE INDIRECT FILE HAS LINE NUMBERS.
;
;RETURNS +1 EOF WAS THE CAUSE OF THE ERROR. ALL AC'S PRESERVED.
; NEVER IF SOME STRANGE ERROR OCCURRED
GEOFQ: SIN ;READ ENTIRE FILE
ERJMP .+2 ;FAILED, GO INVESTIAGE
RET ;SUCCEEDED, RETURN
ADDM C,CMPSIZ ;FIX COMMAND SIZE. C WILL BE NEGATIVE IF LINE NUMBERS IN INDIRECT FILE
SAVEAC <A,B,C,D> ;SAVE WHAT THE SIN JSYS RETURNED
CALL DGETER ;GET THE ERROR CODE
CAIE A,IOX4 ;END OF FILE REACHED?
CALL CJERRE ;NO, SO BOMB OUT
RET ;YES, SO RETURN GOOD
;COME HERE IF COMMA OR LF. WE MUST FILTER OUT MULTIPLE COMMAS, SINCE CRLF AT THE
;END OF INDIRECT FILES GENERATES ONE COMMA, AND THEN THE COMMA IN THE COMMAND
;FOLLOWING THE INDIRECT SPEC WOULD CAUSE A MULTIPLE ONE.
GCMLF: MOVE B,CDPTR
CAMN B,CMPPT0 ;IS LINEFEED AT BEGINNING OF COMMAND?
JRST GCMC ;YES, SO IGNORE IT
LDB A,CDPTR ;LINEFEED IS USUALLY COMMA, BUT SEE IF COMMA ALREADY
CAIN A,"," ;DO WE ALREADY HAVE A COMMA?
JRST GCMC ;YES, IGNORE THIS LINEFEED
MOVEI A,"," ;TREAT END OF LINE AS COMMA
DPB A,CSPTR ;STORE IN SOURCE STRING IN FOR LDB INSTRUCTION
RET ;ACCOUNT FOR COMMA
;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: MOVEI A,QMSK ;GET ADDRESS OF MASK THAT ONLY BREAKS ON QUOTE
MOVEM A,BMSKA ;SET UP MASK ADDRESS
MOVEI Q1,QUOTE ;PASS OVER THE QUOTE
CALL CAPND1 ;READ THROUGH CLOSED QUOTE
MOVEI A,BMSK ;RESTORE STANDARD BREAK MASK
MOVEM A,BMSKA
MOVEI Q1,QUOTE
CALL CAPND1 ;READ TO NEXT STANDARD BREAK CHARACTER
JRST XTAB(A) ;DISPATCH ON WHATEVER COMES NEXT
;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: MOVEI Q1,":" ;REPLACE DELIMITER
CAPND1: DPB Q1,3+CSTXTB ;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
MOVEI A,L.SIZE ;SIZE FOR L20 SWITCH
CALL BALLOC ;ALLOCATE BLOCK
HRRM A,LNK(P2) ;LINK TO NEW BLOCK
MOVE P2,A ;UPDATE AC P2
CALL RDQUOT ;READ QUOTED STRING
MOVEM A,NAM(P2) ;STORE STRING PNTR
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 ;PNTR TO LAST OBJ BLOCK
HRRM P2,LNK(Q1) ;POINT TO NEW ONE
MOVEI Q2,LT.REL ;MARK AS RELOC
DPB Q2,[POINTR (<FLG(P2)>,F.LMSK)]
SETZM SRCSAV ;CLEAR 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
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 PNTR
HLL P2,SRC(P2) ;POINTER TO SOURCE LIST
MOVE P5,FLG(P2) ;GET FLAGS
MOVEI Q2,0 ;INIT REG
CALL SRCSCN ;LOOP THROUGH SOURCES
JRST [DPB B,[POINTR (<FLG(P2)>,F.LMSK)] ;STORE TYPE
ANDI P5,F.ALL ;MASK FLAGS WE WANT
IOR Q2,P5 ;ACCUMULATE RESULT
RET] ; AND EXIT
POP P,P2 ;RESTORE ORIG PNTR
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 PNTR
HRLI Q2,NAM(A) ;...
BLT Q2,B.SIZE-1(P2);MOVE VALUES
LDF A,D%EXTN ;CLEAR EXPLICIT EXTN
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 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 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 PNTR TO BE SAVED
SKIPN SRCSAV ;FIRST TIME?
MOVEM P2,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 P2.
FILBLK: TXOA P1,F%LOBJ ;SAY OK TO LOOK FOR OBJECT
FILBK1: TXZ P1,F%LOBJ ;SAY NOT TO LOOK FOR OBJCECT
MOVE B,[POINT 7,FSPEC] ;COPY STRING TO FSPEC
FILBK2: ILDB A,P4 ;...
IDPB A,B
JUMPN A,FILBK2
MOVEI A,B.SIZE ;SIZE OF BLOCK
CALL BALLOC ;ALLOCATE IT
HRRM A,LNK(P2) ;STORE PNTR TO NEW BLOCK
PUSH P,P2 ;SAVE OLD PNTR
MOVE P2,A ;SET UP NEW PNTR
HRRM P1,FLG(P2) ;SET DEFAULTS
SETZM NAM(P2) ;NONE YET
TXO P1,F%FILE!F%SPEC ;SAY FILE SEEN
CALL GTLANG ;FILL IN LANG TYPE INFO
JRST [LDF A,D%FNF ;SET FILE NOT FOUND
IORM A,FLG(P2) ;IN FLAGS OF SPEC
JRST NODEF] ;KEEP GOING
MOVE A,EXTP ;GET POINTER TO EXTENSION
TXNN P1,F%OBJ ;ON OBJECT OR FILE NOT FOUND?
CALL PARDEF ;NO, GOBBLE THE DEFAULT SWITCHES
NODEF: POP P,B ;RETURN BACK POINTER
MOVEM B,BAKPTR ;STORE IN BAKPTR TOO
RET ;...
;ROUTINE TO ALLOCATE SOME SPACE IN STRING SPACE
;CALL: MOVEI A,<SIZE-IN-WORDS>
; CALL BALLOC
; <RETURN> C(A) := ADDRS OF BLOCK, BLOCK ZEROED
BALLOC: STKVAR <BSZ>
MOVEM A,BSZ ;REMEMBER HOW MUCH IS WANTED
CALL GETBUF ;GET THE MEMORY
SETZM (A) ;CLEAR OUT THE BLOCK
SOSGE B,BSZ ;GET ONE LESS THAN SIZE
RET ;NO MORE TO CLEAR, BLOCK IS ONE ONE WORD
ADD B,A ;GET LAS WORD TO CLEAR
HRRI C,1(A) ;MAKE BLT POINTER FOR 0ING BLOCK
HRL C,A
BLT C,(B) ;0 THE BLOCK
RET
;GTLANG - ROUTINE TO DETERMINE LANGUAGE TYPE AND CHECK FOR
;EXISTING OBJECT FILE.
GTLANG: CALL GTLNGX ;CALL SUBROUTINE
JRST GTLNGA ;NO SUCH FILE RETURN
AOS 0(P) ;SKIP RETURN
GTLNGB: HRRZ A,LNGJFN ;GET JFN USED
JUMPE A,R ;NONE - RETURN
CALL RJFN ;RELEASE LNGJFN
SETZM LNGJFN ;SAY RELEASED
RET ;GIVE DESIRED RETURN
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,[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
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 GTLNG1 ;YES - LOOK FOR STANDARD EXT
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 ;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(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 CJFNBK+2 ;CLEAR DEFAULTS
MOVE Q1,[CJFNBK+2,,CJFNBK+3]
BLT Q1,XTNCNT-1 ;...
LDF A,GJ%OLD ;OLD FILE ONLY
MOVEM A,CJFNBK ;...
GTLNGY: MOVEI A,CJFNBK ;POINT TO BLOCK
SKIPN B,SRCPTR ;TRY SOURCE AREA?
MOVE B,DSKPTR ;NO, DSK:
CALL GTJFS ;LOOKUP
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 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
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
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
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 EXTN 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
JFCL ;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.
;POINTER TO THE COPY IS STORED IN EXTP
COPEXT: HRROI A,CWBUF ;POINT TO EXTENSION
CALL BUFFS ;MAKE A COPY
MOVEM A,EXTP ;REMEMBER POINTER TO COPY
RET
;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
SKIPN NAM(P2) ;HAVE A NAME YET?
CALL GTASC ;NO - GET ONE
RET ;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,1B2+1B35 ;GET DEVICE
JFNS
CALL GTASIZ ;GET STRING SIZE
CAILE C,7 ;MAX LEGAL
JRST [ HRROI A,FSPEC
ERROR <Device name exceeds 6 characters: %1M>]
HRRZ B,LNGJFN ;JFN
LDF C,1B8+1B35 ;FILE NAME
JFNS
CALL GTASIZ ;GET SIZE
CAILE C,7 ;MAX LEGAL
JRST [ HRROI A,FSPEC
ERROR <File name exceeds 6 characters: %1M>]
HRRZ B,LNGJFN ;JFN
LDF C,1B11+1B35 ;GET EXTENSION
JFNS
CALL GTASIZ
CAILE C,4 ;MAX LEGAL
JRST [ HRROI A,FSPEC
ERROR <File type exceeds 3 characters: %1M>]
MOVEI B,0 ;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: MOVEI C,0 ;INIT COUNT
GTASZ1: CAMN A,D ;COMPARE
RET ;MATCH RETURN
ILDB B,D ;PROCEED - GET CHAR
CAIE B,"-" ;CHECK LEGAL
CAIN B,"_"
JRST ILCHR ;INFORM LOSER
CAIN B,"$"
JRST ILCHR
AOJA C,GTASZ1 ;LOOP TILL MATCH
ILCHR: HRROI A,FSPEC ;GET FILESPEC THAT'S WRONG
ERROR <Illegal character %2\ in file: %1m">
;DOSWIT - DECODE SWITCH AND TAKE ACTION
DOSWIT: MOVE A,P4 ;STR PNTR TO A
CALL SWMOV ;MOVE STR TO FSPEC
MOVE B,A ;REMEMBER POINTER TO LAST CHARACTER
HRROI A,FSPEC ;PNTR TO SW NAME
CALLRET DOSWI0 ;DO THE SWITCH
;ROUTINE TO PARSE A SWITCH. GIVE IT POINTER TO SWITCH IN A.
;GIVE IT POINTER TO END OF SWITCH IN B.
DOSWI0: STKVAR <ENDPTR,SUFFIX>
MOVEM B,ENDPTR ;REMEMBER POINTER TO END OF STRING
MOVE B,A ;PUT POINTER IN B
TLC B,-1
TLCN B,-1
HRLI B,440700 ;MAKE REAL BYTE POINTER
SETZM SUFFIX ;NO SUFFIX YET
DOSWI1: ILDB D,B ;SCAN SWITCH STRING
JUMPE D,DOSWI2 ;IF NULL CHARACTER, NO SUFFIX TO WORRY ABOUT
CAIE D,":" ;FIND A COLON?
JRST DOSWI1 ;NO, KEEP LOOKING
MOVEM B,SUFFIX ;REMEMBER POINTER TO SUFFIX
MOVEI C,0 ;MAKE STRING END IN NULL
DPB C,B
DOSWI2: MOVE B,A ;GET POINTER TO SWITCH AGAIN
MOVEI A,SWTAB ;THE SWITCH TABLE
TBLUK ;LOOK UP THE SWITCH
TXNE B,TL%NOM ;NO MATCH AT ALL?
JRST NOMAT ;CORRECT
TXNE B,TL%AMB ;AMBIGUOUS?
JRST AMBIG ;YUP
MOVE C,(A) ;PUT VALUE INTO C
HRRZ B,(C) ;GET RHS OF TABLE
HLL C,(C) ;GET FLAGS FROM LHS
MOVE A,SUFFIX ;GIVE SUPPORT ROUTINES POINTER TO SWITCH ARG
TXNE C,S%DSP ;CHECK FOR ROUTINE ADDRS
JRST 0(B) ;EXIT THROUGH ROUTINE
TXNE C,S%VAL!S%LINK ;VALUE ALLOWED OR L20 SWITCH?
JRST SWVAL ;YES - FURTHER WORK REQ'D
CAIN P5,":" ;CHECK FOR COLON
JRST [ HRROI A,FSPEC
ERROR <Value illegal for switch: %1m>]
TXNE C,S%LTYP ;LANGUAGE TYPE DESIGNATOR?
JRST SWLTYP ;YES - CHECK PERM/TEMP
MOVE D,[IORM B,FLG(P2)] ;INTSTR TO SET FLAGS
TXNE C,S%TOFF ;CLEAR FLAGS?
TLC D,(<IORM>-<ANDCAM>) ;YES - CHANGE INSTR
TXNE C,S%FLH ;FLAGS IN LH?
MOVSS B ;YES - SWAP HALVES
TXNN C,S%FLH ;PERM FLAGS?
TXNN P1,F%SPEC ;OR FILE SPEC SEEN YET
JRST [TLZ D,17 ;CLEAR INDEX REG
HRRI D,P1 ;SET FLAG ADDRS
JRST DOSWIX] ;DO FLAGS & RETURN
TXNE C,S%FRH ;TEMP FLAGS?
DOSWIX: XCT D ;YES - SET/CLR IN DESC BLOCK
RET ;RETURN
;HERE TO HANDLE ADDITIONAL VALUES AND LINK-20 SWITCHES
SWVAL: RET ;RETURN FOR NOW
;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 B,ENDPTR ;PASS END POINTER
CALL LGOBBL ;ISOLATE THE ARG
MOVEM A,LSWPTR ;REMEMBER POINTER TO STRING
RET
;ROUTINE WHICH TAKES POINTER TO QUOTED STRING IN A, AND RETURNS POINTER
;TO ISOLATED STRING (IN A).
;GIVE IT POINTER TO END OF STRING IN B
LGOBBL: MOVEI C,0
DPB C,B ;GET RID OF CLOSED QUOTE
ILDB B,A ;THROW AWAY THE OPEN QUOTE
CALLRET BUFFS ;BUFFER THE ARG
DOL1: SKIPE SWP(P2) ;SWITCH GIVEN FOR THIS FILE YET?
ERROR <Only one /LANGUAGE-SWITCHES: switch allowed per source module>
MOVE B,ENDPTR ;GIVE IT POINTER TO END OF STRING
CALL LGOBBL ;NO, READ THE ARG
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
;PASS IT POINTER TO THE FILE TYPE IN A.
PARDEF: STKVAR <QUOF,PAREND,SWIPTR>
CALL GETDL ;GET DEFAULT SWITCHES FOR FILE TYPE
MOVEM A,SWIPTR ;INITIALIZE POINTER TO SWITCH LIST
PARD0: MOVE A,[440700,,SWIBUF] ;POINTER TO SWITCH BUFFER
MOVE B,SWIPTR ;POINTER TO NEXT SWITCH
MOVEI C,SWISIZ*5 ;MAXIMUM CHARACTERS TO READ
ILDB D,B ;READ THE SLASH
JUMPE D,R ;IF NULL, LAST ONE WAS LAST SWITCH
SETZM QUOF ;NOT IN QUOTED STRING YET
PARD3: ILDB D,B ;READ CHARACTER OF SWITCH
JUMPE D,PARD4 ;IF NULL, SWITCH OVER
SKIPE QUOF ;IN QUOTED STRING?
JRST PARD5 ;YES, SO "/" DOESN'T START NEXT SWITCH
CAIN D,"/" ;OR IF SLASH OF NEXT SWITCH, SWITCH OVER
JRST PARD4 ;YES, SWITCH OVER
PARD5: IDPB D,A ;SWITCH NOT OVER, ACCUMULATE NAME
CAIN D,QUOTE ;START OR END OF A QUOTED STRING?
SETCMM QUOF ;YES, REMEMBER WHETHER STARTING OR ENDING
SOJG C,PARD3 ;READ REST OF NAME
ERROR <Default switch too long>
PARD4: MOVEM A,PAREND ;REMEMBER POINTER TO END OF SWITCH
MOVEI C,0 ;PUT NULL AFTER NAME
IDPB C,A
MOVNI A,1
ADJBP A,B ;BACK SOURCE POINTER BACK TO BEGINNING OF NEXT SWITCH
MOVEM A,SWIPTR ;REMEMBER POINTER FOR NEXT SWITCH
HRROI A,SWIBUF ;POINT AT THE DEFAULT SWITCH
MOVE B,PAREND ;PASS POINTER TO END OF SWITCH
CALL DOSWI0 ;PARSE THE SWITCH
JRST PARD0 ;LOOP FOR REST OF SWITCHES
;ROUTINES TO PROCESS /MAP AND /SAVE SWITCHES
SWMAP: PUSH P,[MAPPNT] ;SAVE ADDRS ON STACK
SKIPE @0(P) ;ALREADY SEE THIS SWITCH?
ERROR <MAP or SAVE switch seen twice>
CAIE P5,":" ;MORE COMING?
JRST [MOVEI P4,-1 ;NO - SET FLAG
JRST SWSAV2] ;AND EXIT
CALL RDFLD ;YES - READ NEXT FIELD
CAIN P5,":" ;CHECK FOR DEVICE
CALL CAPND ;AND APPEND TO COLON
SWSAV2: EXCH P4,0(P) ;REVERSE ARGS
POP P,@P4 ;AND SAVE VALUE
RET ;RETURN
;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
LDF C,1B2+1B5+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 BY JFN IN A
;RETURNS ASCIZ IN CWBUF
DJFNSE: LDF C,1B11 ;EXTENSION ONLY ENTRY
SETZM CWBUF ;CLEAR DESTINATION
HRRZ B,A ;JFN TO B
HRROI A,CWBUF ;PNTR TO DEST
JFNS ;GET EXTN
RET ;RETURN
;DOJFNS - OBTAIN DESIRED TEXT FOR JFN IN A
;FORMAT DESIRED IN C
;RETURNS ASCIZ IN CSBUF
DOJFNS: HRRZ B,A ;JFN TO B
MOVE A,CSBUFP ;PNTR TO DEST
JFNS ;GET IT
RET ;RETURN
;ROUTINE TO LOOKUP EXTENSION FOUND IN CWBUF AND RETURN
;LANG TYPE IN B
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
SKIPN B ;ANYTHING?
LDB B,[POINTR (P1,F.LMSK)] ;NO - MUST BE NULL EXT
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
ERJMP .+2 ;FAILED, SEE WHY
RET
;THE PRARG FAILED, PROBABLY BECAUSE WE TRIED TO SEND TOO MUCH.
;WRITE FILES TO DISK.
MOVE Q1,NFILES ;GET NUMBER OF FILES
TMP1: SOJL Q1,TMP2 ;JUMP TO TMP2 IF NO MORE TMP FILES
MOVEI P1,0 ;NO HIGH ORDER BITS
MOVE P2,CSJOB ;BINARY JOB NUMBER
MOVEI P3,0 ;UNUSED WORD
MOVE P4,[400000,,3] ;WE WANT FILLING, THREE DIGITS
MOVE P5,CSBUFP ;POINTER TO AREA INTO WHICH TO WRITE NUMBER
EXTEND P1,[CVTBDO "0"
"0"] ;THREE DIGITS TO ASCII(FILL WITH "0" AT BEGINNING)
ERCAL CJERRE ;FAILED, SAY WHY
MOVE D,ADDTAB(Q1) ;GET ADDRESS OF FILE
MOVEI P2,TMPCOR(D) ;GET SIXBIT NAME OF FILE(ADDRESS THEREOF)
HRLI P2,440600 ;MAKE BYTE POINTER
MOVEI P1,3 ;WE WANT TO CONVERT 3 CHARACTERS
MOVEI P4,3
EXTEND P1,[MOVSO "A"-'A'];SIXBIT TO ASCII CONVERSION
ERCAL CJERRE
MOVE A,P5 ;RETAIN UPDATED BYTE POINTER
HRROI B,[ASCIZ /.TMP;T/];REST OF FILESPEC
MOVEI C,0
SOUT
MOVX A,GJ%FOU+GJ%SHT ;OUTPUT USE, SHORT FORM
MOVE B,CSBUFP ;POINT TO FILESPEC
CALL GTJFS ;GET HANDLE
CALL CJERRE ;FAILED
MOVE B,[70000,,OF%WR] ;OPEN FOR WRITING
OPENF
ERCAL CJERRE ;FAILED
MOVE D,ADDTAB(Q1) ;GET ADDRESS OF FILE
HRROI B,TMPCOR+1(D) ;GET POINTER TO DATA
MOVEI C,0 ;END ON NULL
SOUT ;WRITE THE DATA TO FILE
CLOSF ;CLOSE FILE
ERCAL CJERRE ;COULDN'T
JRST TMP1 ;DO NEXT FILE
TMP2: RET ;ALL DONE
;GTDT - GET DATE/TIME OF FILE JFN IN A
;RETURNS VERSION D/T IN A
GTDT: PUSH P,[0] ;PLACE TO READ D/T
PUSH P,B ;SAVE ACS
PUSH P,C
MOVEI C,-2(P) ;POINT TO SPECIAL CELL
MOVE B,[1,,.FBWRT] ;GET TIME LAST WRITTEN
GTFDB
POP P,C ;RESTORE STUFF
POP P,B
POP P,A ;SHOULD HAVE D/T
RET ;RETURN
;ROUTINE TO STORE DATE/TIME IN SPEC BLOCK ACCORDING TO
;LANGUAGE TYPE (I.E. REL OR NOT)
STODT: CAIN B,LT.REL ;RELOC TYPE?
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
MOVEI C,0
SOUT ;PRINT STRING
RET ;RETURN
;PUNCTUATION ROUTINES
PROUT: SKIPA B,["."] ;PERIOD
CMOUT: MOVEI B,"," ;COMMA
CALLRET TBOUT ;DUMP IT
SWOUT: MOVEI B,"/" ;SLASHIFY IT
CALL TBOUT ;...
MOVE B,D ;SW VALUE
CALLRET TBOUT ;DUMP IT
EOLOUT: MOVEI B,15
CALL TBOUT
SKIPA B,[12] ;END-OF-LINEF
SPOUT: MOVEI B," " ;SPACE
CALLRET TBOUT ;DUMP AND RETURN
SUBTTL RDSKP AND RDFLD
;RDFLD - READS NEXT FIELD USING TEXTI
;RETURNS: P5 := BREAK CHAR
; A := BREAK TYPE
; P3 := CHAR COUNT
; P4 := POINTER TO STRING
RDFLD: MOVE Q1,.RDIOJ+CSTXTB ;CURRENT PNTR
TXZE P1,F%LAHD ;CHECK IF NEED BACKUP
ADD Q1,[B.BP] ;YES - ADD CONST
MOVEM Q1,.RDIOJ+CSTXTB ;NOW HAVE CORRECT POSITION
MOVE P4,TXTPR ;POINTER TO STRING SPACE
MOVEM P4,3+CSTXTB ;OUTPUT STRING HERE
RDFLD0: MOVEI P3,STRSIZ ;ENOUGH LENGTH FOR ANY REASNABLE FIELD
MOVEM P3,4+CSTXTB ; IN STRING SPACE
LDF Q1,RD%RIE ;RETURN ON EMPTY STRING
MOVE A,BMSKA ;GET SPECIAL BREAK MASK ADDRESS
MOVEM A,7+CSTXTB
MOVEM Q1,1+CSTXTB ;...
MOVEI A,CSTXTB ;POINT AT ARGS
TEXTI ;SNARF FIELD
CALL EOFJER ;CHECK FOR END OF FILE
MOVE Q1,1+CSTXTB ;GET FLAGS
TXNN Q1,RD%BTM ;BREAK ON TERM?
ERROR <Command string space exhausted>
LDB P5,3+CSTXTB ;GET BREAK CHAR
CALL GTYP ;GET CHAR TYPE
MOVEI Q1,0 ;NULL OUT DELIM
DPB Q1,3+CSTXTB ;...
SUB P3,4+CSTXTB ;SIZE = ORIG - NEW COUNT
RET ;AND RETURN
;ROUTINE TO READ A QUOTED STRING. RETURNS POINTER TO IT IN A.
RDQUOT: CALL LDCHR ;GET A CHAR
CAIE P5,QUOTE ;GRNTEE QUOTED
ERROR <String must be quoted>
MOVE P4,CSBUFP ;PICK UP STRING PNTR
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: MOVEI P5,0 ;TERMINATE WITH NULL
IDPB P5,P4 ;...
MOVE A,CSBUFP
CALLRET BUFFS ;BUFFER THE STRING AND RETURN POINTER TO CALLER
;LDCHR - ROUTINE TO GET NEXT CHARACTER
;RETURNS: P5: = CHARACTER
; A := CHAR TYPE
LDCHR: TXZN P1,F%LAHD ;CHECK FLAG
IBP .RDIOJ+CSTXTB ;INCR BYTE PNTR
LDB P5,.RDIOJ+CSTXTB ;GET CHAR
CALLRET GTYP ;GET TYPE INFO AND EXIT
;GTYP - GET CHAR TYPE IN A
GTYP: MOVE Q1,P5 ;COPY IT
IDIVI Q1,^D9 ;LOOK IT UP IN TABLE
LDB A,PTAB(Q2) ;...
RET ;RETURN
;THE FOLLOWING ROUTINE GETS A POINTER TO THE STRING OF DEFAULT
;SWITCHES FOR A PARTICULAR EXTENSION. THE ROUTINE RETURNS WITH 0
;OR A POINTER IN A.
;PASS THE ROUTINE IN A A POINTER TO THE DESIRED EXTENSION
GETDL: MOVE C,A ;POINTER IN C
BIN ;READ FIRST CHARACTER
CAIN B,0 ;NULL EXTENSION?
SKIPA B,[440700,,[ASCIZ /./]] ;YES, SO LOOK UP DOT
MOVE B,C ;RETRIEVE POINTER
MOVEI A,DEXTBL ;ADDRESS OF DEFAULT TABLE
TBLUK ;LOOK FOR THE EXTENSION
TXNN B,TL%EXM ;EXACT MATCH?
JRST GETDL0 ;NO
HRR A,(A) ;YES, GET POINTER TO STRING
HRLI A,440700 ;MAKE BYTE POINTER
RET ;GIVE IT TO CALLER
GETDL0: MOVEI A,0 ;NO DEFAULTS SET, RETURN 0
RET
;INFO DEFAULT COMPILE-SWITCHES
.IDCS:: STKVAR <NWHICH,NS>
HLRZ A,DEXTBL ;GET NUMBER OF FILE TYPES
MOVEM A,NS ;REMEMBER HOW MANY TO DO
SETZM NWHICH ;INITIALIZE WHICH ONE WE'RE ON
IDC0: AOS C,NWHICH ;STEP TO NEXT FILE TYPE
CAMLE C,NS ;DONE THEM ALL YET?
RET ;YES
HLRO A,DEXTBL(C) ;GET POINTER TO FILE TYPE
HRRO B,DEXTBL(C) ;GET POINTER TO LIST OF SWITCHES
ETYPE < SET DEFAULT COMPILER-SWITCHES %1M %2M%%_>
JRST IDC0 ;LOOP FOR REST
;SET NO DEFAULT COMPILE-SWITCHES (FILE TYPE)
.SNDCS:: STKVAR <<WHAT,2>>
NOISE (FILE TYPE)
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,<"*" for all>,,[
FLDDB. .CMKEY,,DEXTBL,<File type,>,,[
FLDDB. .CMFLD,CM%SDH]]] ;.CMFLD MERELY FOR NONX ENTRIES
CALL FLDSKP ;GET SOME INPUT
CMERRX
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
DMOVEM B,WHAT ;REMEMBER COMND DATA
CONFIRM ;CONFIRM THE COMMAND
DMOVE B,WHAT ;GET WHAT WAS TYPED
CAIN C,.CMFLD ;NONEXISTENT ENTRY?
JRST [ HRROI A,ATMBUF ;POINTER TO NONEXISTENT FILE TYPE
LDB B,[350700,,ATMBUF] ;SEE IF ANYTHING TYPED
CAIN B,.CHNUL ;ANYTHING TYPED?
ERROR <File type or "*" expected>
ETYPE <%%No defaults were set for file type %1m%%_>
RET]
CAIN C,.CMTOK ;STAR?
JRST SNDALL ;YES, DELETE ALL DEFAULTS
MOVEI A,DEXTBL ;POINT AT TABLE
TBDEL ;REMOVE REQUESTED ENTRY
RET ;ALL DONE
;HERE TO DELETE ALL ENTRIES
SNDALL: HRRZS DEXTBL ;CLEAR ALL ENTRIES
RET
;SET DEFAULT COMPILE-SWITCHES (FILE TYPE) TYP (SWITCHES) /SW/SW/SW...
.SDCS:: STKVAR <STE,SAVOP,SAVSCT,SAVFGS,EXTPTR,OLDEND,ANYYET,EXTSTR,<LST,DCSSIZ>,SWPT,LSTPT,LSTRM>
NOISE (FILE TYPE)
DOTX <File type (without the dot), or just dot (.) for null type>
CAIA ;NOT DOT, MUST BE REAL FILE TYPE
jrst SDC0 ;user typed dot
WORDX <File type (without the dot)>
CMERRX <File type or dot (.) required>
SDC0: CALL BUFFF ;ISOLATE THE EXTENSION
MOVEM A,EXTPTR ;REMEMBER IT
MOVEI A,DCSSIZ*5 ;INITIALIZE AMOUNT OF ROOM LEFT
MOVEM A,LSTRM
HRROI A,LST ;INITIALIZE POINTER TO LIST OF SWITCHES
MOVEM A,LSTPT ;REMEMBER POINTER
SETZM ANYYET ;NOTE THAT NO SWITCHES INPUT YET
SDC1: MOVEI B,[FLDDB. .CMCFM,,,,,[FLDDB. .CMSWI,,SWTAB]]
SKIPN ANYYET ;GOT ANY SWITCHES YET?
MOVE B,(B) ;NO, SO NO CR ALLOWED
CALL FLDSKP ;READ FIELD, SKIP IF SUCCESSFUL
CMERRX <Invalid switch>
LDB C,[331100,,(C)] ;SEE WHAT WAS TYPED
SETOM ANYYET ;MARK THAT WE'VE GOT AT LEAST ONE SWITCH
CAIN C,.CMCFM ;END OF LINE
JRST SDC3 ;YES, GO STORE SWITCHES
MOVEM B,STE ;REMEMBER TABLE ENTRY
MOVE B,(B) ;GET TABLE ENTRY
HLRO B,B ;MAKE POINTER TO SWITCH STRING
MOVEM B,SWPT ;REMEMBER POINTER TO SWITCH
SETZB C,D ;STOP ON NULL (D USED FOR SECOND SOUT)
HRROI B,[ASCIZ ./.] ;PUT SLASH IN FOR SWITCH
MOVE A,LSTPT ;GET POINTER TO LIST
SOUT ;WRITE THE SLASH
SOS C,LSTRM ;GET ROOM LEFT, ACCOUNT FOR SLASH
MOVE B,SWPT ;GET POINTER TO SWITCH
CALL SOUTN ;SOUT BUT DON'T KEEP NULL
MOVEM A,SAVOP ;SAVE OUTPUT POINTER
MOVEM C,SAVSCT ;SAVE SWITCH CHARACTER COUNT
MOVE A,STE ;GET SWITCH TABLE ENTRY
CALL HANSWI ;DO SPECIAL PARSING
JRST [ MOVE A,SAVOP
MOVE C,SAVSCT ;NO, RESTORE SOUT STUFF
JRST SDC4]
MOVEM A,SAVFGS ;SAVE SPECIAL FLAGS
MOVE A,SAVOP ;GET BACK DATA TO CONTINUE SOUT
MOVE C,SAVSCT
MOVX D,S%QUO
TDNE D,SAVFGS ;IS SWITCH QUOTED?
JRST [ MOVEI D,0 ;END SOUT ON NULL
HRROI B,[ASCIZ /"/]
CALL SOUTN ;SOUT BUT DON'T KEEP NULL
JRST .+1]
MOVEI D,0 ;END ON NULL
HRROI B,ATMBUF ;GET SPECIAL DATA
CALL SOUTN ;SOUT BUT DON'T KEEP NULL
MOVX D,S%QUO
TDNE D,SAVFGS ;QUOTED?
JRST [ MOVEI D,0
HRROI B,[ASCIZ /"/]
CALL SOUTN ;SOUT AND DON'T KEEP NULL
JRST .+1]
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
HLRZ A,DEXTBL ;GET BLOCK NUMBER FOR STORING THIS EXTENSION
IMULI A,EXTSIZ ;GET RELATIVE ADDRESS
ADD A,[-1,,EXTBUF] ;MAKE BYTE POINTER
HRRZM A,EXTSTR ;REMEMBER ADDRESS OF EXTENSION STRING
MOVE B,EXTPTR ;GET POINTER TO EXTENSION USER TYPED
MOVEI C,EXTSIZ*5 ;MAKE SURE EXTENSION ISN'T TOO LARGE
MOVEI D,0 ;USUALLY STOP ON NULL (INSTEAD OF RUNNING OUT OF ROOM)
SOUT ;WRITE THE NEW EXTENSION
CAIG C,0 ;ANY ROOM LEFT?
ERROR <File type too long>
HLRZ B,DEXTBL ;GET NUMBER OF ENTRIES SO FAR
IMULI B,DCSSIZ ;GET RELATIVE ADDRESS FOR NEW CHUNK
ADDI B,DCSSTG ;MAKE ABSOLUTE ADDRESS
SETZM (B) ;START WITH NULL STRING
HRL B,EXTSTR ;GET TABLE ENTRY TO BE ADDED
MOVEI A,DEXTBL ;ADDRESS OF TABLE
TBADD ;ADD NEW ENTRY
ERJMP [ERROR <No room for another file type>]
SDC2: HRRO A,(A) ;MAKE BYTE POINTER TO DEFAULT STRING SO FAR
MOVEI B,0 ;WE'RE ONLY SCANNING, NO INPUT POINTER
MOVEI C,DCSSIZ*5 ;START WITH FULL SIZE
MOVEI D,0 ;SCAN FOR NULL
SIN ;LOOK FOR THE NULL
MOVEM A,OLDEND ;REMEMBER POINTER IN CASE NEW STRING DOESN'T FIT
BKJFN ;BACK UP TO OVERWRITE THE NULL
CALL JERR ;SHOULDN'T FAIL
AOJ C,
HRROI B,LST ;GET POINTER TO DEFAULT LIST GIVEN IN COMMAND
MOVEI D,0 ;STOP COPYING ON NULL
SOUT ;ADD IT TO REST
JUMPG C,R ;IF MORE ROOM, WE'RE O.K.
DPB D,OLDEND ;NO ROOM, LEAVE LIST AS WAS
MOVE A,EXTPTR ;POINTER TO EXTENSION
ERROR <No room for more defaults for file type %1M>
;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
SUBTTL TI - TEXT INPUT ROUTINE
;TEXTI/GTJFN BLOCK INIT ROUTINE
TIRST: LDF Q1,GJ%XTN!GJ%OLD ;EXTENDED GTJFN
MOVEM Q1,CJFNBK
SETZM CJFNBK+2 ;CLEAR DEFAULTS
MOVE Q1,[CJFNBK+2,,CJFNBK+3]
BLT Q1,XTNCNT-1 ;...
LDF Q1,G1%RBF!G1%RND!G1%NLN+3 ;RETURN ON NULL NAME
MOVEM Q1,XTNCNT
RET ;RETURN
;ROUTINE FOR DOING COMND JSYS FOR COMPILE-CLASS COMMANDS. PREVENTS
;"@" FROM HAVING STANDARD EFFECT, AS COMPILE-CLASS COMMANDS WANT TO
;PROCESS "@" THEMSELVES.
CFIELD: MOVX A,CM%XIF ;WE WANT TO DO INDIRECT FILESPEC OURSELF
IORM A,CMFLG
CALLRET FIELD ;READ INPUT AND RETURN
;MAIN ROUTINE
;INPUT ROUTINE, MERELY INPUTS ENTIRE LINE, DOING RECOGNITION ON
;FILESPECS AND SWITCHES
TI: SETZM NFIAR ;NO FILES IN A ROW YET
SETZM NFILS ;NO FILES AT ALL
MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL FIELD POSSIBILITY
FLDDB. .CMSWI,,SWTAB,,,[;SWITCH
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE INDICATOR
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
CAIA ;FAILED
jrst @d ;dispatch on field flavor
CALL SKCROK ;DIFFERENT ERROR DEPENDING ON WHETHER CR ALLOWED
CMERRX <Switch, filespec, "@", or "%" required>
CMERRX <Carriage return, switch, filespec, "@", or "%" required>
;CR GOT TYPED
TCR: RET ;RETURN TO CALLER
;AT SIGN TYPED
TAT: DEXTX <CMD> ;DEFAULT COMMAND FILE EXTENSION IS "CMD"
MOVX A,GJ%OLD ;COMMAND FILE MUST EXIST
MOVEM A,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMFIL,,,<Name of indirect file>,,]
CALL CFIELD ;READ INDIRECT FILESPEC
TXNE A,CM%NOP
CMERRX <Invalid indirect file specification>
AOS NFILS ;WE MUST ASSUME THERE IS A FILESPEC IN THE INDIRECT FILE
JRST TALL ;AFTER INDIRECT FILE, ANYTHING CAN BE INPUT
;FILE SPEC SEEN. MAY BE FOLLOWED BY ANYTHING.
TFILE: AOS NFILS ;REMEMBER HOW MANY FILES
AOS A,NFIAR ;COUNT HOW MANY FILESPECS IN A ROW
CAIGE A,2 ;DON'T ALLOW MORE THAN TWO FILESPECS IN A ROW (WITHOUT THIS CHECK, "COMP /L" CAUSES "?TOO MANY JFNS IN COMMAND")
JRST TALL
MOVEI B,[
FLDDB. .CMCFM,, ,,,[ ;CR IS LEGAL FIELD POSSIBILITY
FLDDB. .CMSWI,,SWTAB,,,[;SWITCH
FLDDB. .CMCMA,,,,,[ ;COMMA
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE INDICATOR
FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]] ;PERCENT SIGN
CALL COMIN ;TRY TO PARSE A FIELD
CMERRX ;FAILED, USE SYSTEM'S REASON
JRST @D ;SUCCEEDED, DISPATCH ON FLAVOR
;plus sign seen
tplus: movei b,[FLDDB. .CMFIL,CM%SDH,,<Source file specification>,,] ;FILESPEC
call comin ;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 FIELD POSSIBILITY
FLDDB. .CMSWI,,SWTAB,,,[;SWITCH
FLDDB. .CMFIL,CM%SDH,,<File name>,,[ ;FILESPEC
FLDDB. .CMCMA,,,,,[ ;COMMA
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE INDICATOR
FLDDB. .CMTOK,,<440700,,[ASCIZ /+/]>,,,[ ;PLUS SIGN
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]]]]]] ;PERCENT SIGN
CALL COMIN ;INPUT THE FIELD
CAIA ;FAILED
JRST @D ;DISPATCH ON FIELD FLAVOR
CALL SKCROK ;SEE IF CARRIAGE RETURN ALLOWED
CMERRX <Switch, filespec, comma, "@", "+", or "%" required>
CMERRX <Carriage return, switch, filespec, comma, "@", "+", or "%" required>
;SKCROK SKIPS IF CARRIAGE RETURN VALID NOW. CLOBBERS NOTHING.
SKCROK: SKIPN CSVC ;IF DEFAULT STRING, THEN CR IS O.K.
SKIPE NFILS ;IF NO DEFAULT STRING BUT FILE SEEN, THEN CR O.K.
RETSKP ;SKIP, CR O.K.
RET ;DON'T SKIP, CR NOT O.K.
;ROUTINE TO DO INPUT FOR COMPILE-CLASS COMMAND. TAKES NON-SKIP
;RETURN IF FIELD DOESN'T MATCH SOMETHING IN THE REQUESTED CHAIN (FED
;BY AC2 ON THE CALL). SKIP RETURNS WITH ADDRESS OF SUPPORT ROUTINE
;IN D IF SUCCESSFUL PARSE.
COMIN: CALL SKCROK ;SEE IF CARRIAGE RETURN LEGAL
MOVE B,(B) ;NO, SO CR INVALID ON EMPTY LINE
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
MOVSI C,(1B8) ;ALWAYS OUTPUT THE FILE NAME ONLY
JFNS ;GET THE FILE NAME THAT WAS ENTERED
ILDB A,CSBUFP ;TAKE A LOOK AT THE FIRST CHARACTER
SKIPN A ;IF NULL FILE NAME...
RET ;THAT'S AN ERROR
MOVEI D,TFILE ;SAY THAT FILESPEC TYPED
RETSKP
;ROUTINE TO CALL AFTER COMND TO FIGURE OUT WHAT GOT TYPED. RETURNS ADDRESS
;IN D OF ROUTINE TO JUMP TO TO HANDLE THAT FIELD.
IDEN: MOVE A,B ;IF FILE TYPED, JFN NOW IN A!
LDB D,[331100,,.CMFNP(C)] ;FIND OUT WHAT WAS TYPED
CAIE D,.CMFIL ;FILESPEC?
SETZM NFIAR ;NO, SO TALLY ZERO FILESPECS IN A ROW
EXCH C,D ;FUNCTION CODE IN C, POINTER IN D
CAIN C,.CMTOK ;TOKEN?
JRST IDTOK ;YES, GO INVESTIGATE FURTHER
CAIN C,.CMCMA ;COMMA?
MOVEI D,TCOMM ;YES
CAIN C,.CMCFM ;CARRIAGE RETURN?
MOVEI D,TCR ;YES
CAIN C,.CMFIL ;FILESPEC?
MOVEI D,TFILE ;YES
CAIN C,.CMSWI ;SWITCH?
MOVEI D,TSWI ;YES
RET
IDTOK: MOVE A,.CMDAT(D) ;TOKEN TYPED, GET POINTER TO WHICH KIND
BIN ;GET THE TOKEN
CAIN B,"%" ;LINK SWITCH DELIMITER?
MOVEI D,TPER ;YES
CAIN B,"@" ;INDIRECT FILE DELIMITER?
MOVEI D,TAT ;YES
CAIN B,"+" ;PLUS SIGN?
MOVEI D,TPLUS ;YES
RET
;% TYPED. READ THE LINK SWITCH
TPER: QUOTEX <LINK switch, in quotes>
CMERRX <Invalid LINK switch>
JRST TALL ;AFTER LINK SWITCH, ANYTHING MAY BE TYPED
;SWITCH TYPED. ANYTHING MAY FOLLOW
TSWI: MOVE A,B ;PUT TABLE ADDRESS IN A
CALL HANSWI ;HANDLE DETAILS ABOUT PARSING THE SWITCH
JFCL ;WE DON'T CARE IF SPECIAL VALUE WAS REQUIRED
JRST TALL
;ROUTINE TO DO SWITCH-SPECIFIC PARSING
;GIVE IT TABLE ADDRESS IN A. IT SKIPS WITH ARG PARSED, IFF A SPECIAL
;ARG IS REQUIRED
;RETURNS VALID SETTING OF S%QUO IN A.
HANSWI: STKVAR <QQQ>
HRRZ A,(A) ;GET ADDRESS OF SWITCH DATA
MOVEI B,1(A) ;GET ADDRESS CONTAINING SPECIAL DISPATCH ADDRESS
MOVE A,(A) ;GET SWITCH DATA
MOVEM A,QQQ ;REMEMBER FLAGS
TXNN A,S%DSP ;SPECIAL DISPATCH?
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,,<File name>,,[ ;FILESPEC
FLDDB. .CMTOK,,<440700,,[ASCIZ /@/]>,,,[ ;INDIRECT FILE INDICATOR
FLDDB. .CMTOK,,<440700,,[ASCIZ /%/]>,,]]] ;PERCENT SIGN
CALL COMIN ;INPUT FIELD
CMERRX <Filespec, "@", or "%" required after comma>
JRST @D ;DISPATCH
;SWMOV - ROUTINE TO PLACE SWITCH NAME IN BUFFER IN PROPER
;FORMAT FOR FSYM
;CALL: MOVE A,<PNTR-TO-STRING>
; CALL SWMOV
; RETURN HERE (STRING IN FSPEC), POINTER TO LAST CHAR IN A
swmov: move b,a ;source pointer in b
hrroi a,fspec ;copy to fspec
movei c,0 ;stop on null
sout
ret
;LANGUAGE EXTENSION TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
LT.'EXT==<%LT==%LT+1>
ASCII "EXT"
>
%LT==0 ;INITIAL VALUE
LTAB: 0 ;ILLEGAL ENTRY (NULL EXTENSION)
LANGUAGE ;EXPAND MACRO
LTABL==.-LTAB ;LENGTH OF TABLE
;TABLE OF SIXBIT TMP FILE NAMES
SIXTAB: 0 ;TYPE 0 UNUSED
DEFINE L(A,B,C,D)
< SIXBIT /D/
>
LANGUAGE
;LANGUAGE TMP FILE NAME TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
[GETSAVE (<SYS:'PROC'.>)],,[ASCIZ \TNAME'.TMP\]
>
PRTAB: ;PROCESS NAME TABLE(LH)
0 ;TEMP NAME (RH)
LANGUAGE ;EXPAND
;DEBUG AID TABLE
DEFINE L(LANG,EXT,PROC,TNAME) <
0,,[ASCIZ \:'LANG\]
>
DBTAB: 0 ;LOSAGE ENTRY
LANGUAGE ;EXPAND
DEFINE NAMES <
NM (68-COBOL,S%LTYP,LT.CBL)
NM (74-COBOL,S%LTYP,LT.74C)
NM (ALGOL,S%LTYP,LT.ALG)
NM (BINARY,S%TOFF!S%FRH,F%NBIN)
NM (COBOL,S%LTYP,LT.CBL)
NM (COMPILE,S%FRH,F%CMPL)
NM (CREF,S%FRH,F%CREF!F%LIST)
NM (DDT,S%FLH,F%DDT)
NM (DEBUG,S%FRH,F%DEB)
NM (FAIL,S%LTYP,LT.FAI)
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 (MACRO,S%LTYP,LT.MAC)
NM (MAP,S%DSP,SWMAP,[RET])
NM (NOBINARY,S%FRH,F%NBIN)
NM (NOCOMPILE,S%TOFF!S%FRH,F%CMPL)
NM (NODEBUG,S%TOFF!S%FRH,F%DEB)
NM (NOLIBRARY,S%TOFF!S%FRH,F%LIB)
NM (NOLIST,S%TOFF!S%FRH,F%CREF!F%LIST)
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 (OPTIMIZE,S%FRH,F%OPT)
NM (RELOCATABLE,S%LTYP,LT.REL)
NM (SAIL,S%LTYP,LT.SAI)
NM (SEARCH,S%FRH,F%LIB)
NM (SNOBOL,S%LTYP,LT.SNO)
NM (SYMBOLS,S%FRH,F%LSYM)
>
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.
QMSK: BRINI.
BRKCH. (QUOTE)
EXP W0.,W1.,W2.,W3. ;SPECIAL BREAK MASK FOR QUOTED STRINGS
;CTAB - CHARACTER TYPE TABLE
;EACH 4-BIT ENTRY CONTAINS THE CHARACTER TYPE FOR CHARACTER N
CTAB: BYTE (4) 7,0,0,0,0,0,0,0,0 ; NULL THRU ^H(NULL MARKS END OF COMMAND)
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ^I THRU ^Q
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ^R THRU ^Z
BYTE (4) 0,0,0,0,0,1,0,13,0 ; ESC,PS,CS,RS,^_,SP,!,",#
BYTE (4) 0,11,0,0,0,0,0,2,6 ; $,%,&,',(,),*,+,,
BYTE (4) 0,0,3,0,0,0,0,0,0 ; -,.,/,0,1,2,3,4,5
BYTE (4) 0,0,0,0,12,0,0,0,0 ; 6,7,8,9,:,;,<,=,>
BYTE (4) 0,0,0,0,0,0,0,0,0 ; ?,@,A,B,C,D,E,F,G
BYTE (4) 0,0,0,0,0,0,0,0,0 ; H,I,J,K,L,M,N,O,P
BYTE (4) 0,0,0,0,0,0,0,0,0 ; Q,R,S,T,U,V,W,X,Y
BYTE (4) 0,0,0,0,0,0,0,0,0 ; Z,[,\,],^,_,@,a,b
BYTE (4) 0,0,0,0,0,0,0,0,0 ; c,d,e,f,g,h,i,j,k
BYTE (4) 0,0,0,0,0,0,0,0,0 ; l,m,n,o,p,q,r,s,t
BYTE (4) 0,0,0,0,0,0,0,0,0 ; u,v,w,x,y,z,[,\,]
BYTE (4) 0,0 ; 176,177
;PTAB - BYTE POINTER TABLE FOR CTAB
PTAB: POINT 4,CTAB(Q1),3
POINT 4,CTAB(Q1),7
POINT 4,CTAB(Q1),11
POINT 4,CTAB(Q1),15
POINT 4,CTAB(Q1),19
POINT 4,CTAB(Q1),23
POINT 4,CTAB(Q1),27
POINT 4,CTAB(Q1),31
POINT 4,CTAB(Q1),35
;TRANSLATE (DIRECTORY) COMMAND
;ALLOWS EITHER PPN OR DIRECTORY NAME TO BE INPUT AND TRANSLATES TO THE
;OTHER
.TRANS::NOISE (DIRECTORY)
DIRX <Directory name or project-programmer-number>
JRST PPNQ ;USER DIDN'T TYPE DIRECTORY NAME.
CONFIRM ;GET CONFIRMATION OF COMMAND
move c,b ;remember directory number in c
move a,csbufp
dirst ;get directory string
ercal cjerre
move a,csbufp
stdev ;get device associated with directory
ercal cjerre
move a,csbufp
push p,a ;remember pointer to device name
devst ;get name of device
ercal cjerre
MOVE a,c ;PUT DIRECTORY NUMBER IN A
STPPN ;GET IT'S PPN
HLRZ C,B ;LEFT HALF IN C
HRRZ B,B ;LEAVE RIGHT HALF IN B
pop p,d ;get pointer to device name
ETYPE <%1r (IS) %4m:[%3o,%2o]
>
RET
;USER TYPED NON-DIRECTORY. MAYBE IT'S A PPN.
PPNQ: CALL CONST ;GET DEVICE DESIGNATOR FOR CONNECTED STRUCTURE
MOVEM A,FBLOCK+.CMDEF ;FILL IN DEFAULT INFO
move d,a ;remember pointer in case user doesn't type structure name
DEVX <Structure name or/and "[" to start PPN>
skipa a,d ;no device typed, use connected structure
CALL BUFFF ;ISOLATE THE DEVICE NAME
PUSH P,A ;REMEMBER POINTER TO DEVICE NAME
MOVEI A,"["
CHARX <"[" to start PPN>
JRST BADPPN ;BAD SYNTAX FOR PPN
OCTX <Octal programmer number>
JRST BADPPN
push p,b ;save project number
COMMAX <Comma to separate programmer number from project number>
JRST BADPPN
OCTX <Octal project number>
JRST BADPPN
push p,b ;programmer number
MOVEI A,"]"
CHARX <"]" to end PPN>
JRST BADPPN
CONFIRM
POP P,B ;GET PROGRAMMER NUMBER
POP P,D ;AND PROJECT NUMBER
HRL B,D ;PUT THEM TOGETHER
move c,(p) ;get pointer to structure name
MOVE A,CSBUFP ;GET SOME SPACE FOR WRITING DIRECTORY NAME INTO
PPNST ;GET THE DIRECTORY NAME
ERCAL CJERRE ;ASSUME FAILURE WILL HAVE REASONABLE MESSAGE
HRRZ B,B ;KEEP ONLY THE PROGRAMMER NUMBER IN B
MOVE A,CSBUFP ;GET POINTER TO STRUCTURE NAME
pop p,c ;get pointer to structure name
ETYPE <%3m:[%4o,%2o] (IS) %1m
>
ret
;THE FOLLOWING VERBOSE ERROR MESSAGE WAS PUT IN BECAUSE AT TIME
;OF THIS COMMAND, DOCUMENTATION DEPARTMENT DIDN'T HAVE TIME TO UPDATE
;ALL THE DOCUMENTATION TO DESCRIBE IT, AS MANY PLACES HAD TO BE EDITED.
BADPPN: ERROR <To translate between PPN's and directories, type one of:
TRANSLATE str:<directory>
TRANSLATE str:[n,m]
>
END