Trailing-Edge
-
PDP-10 Archives
-
bb-bt99g-bb
-
compil.c09
There is 1 other file named compil.c09 in the archive. Click here to see a list.
REP 1/1 ;09C1
TITLE COMPIL 22E(443) CCL CONTROL CUSP
SUBTTL WEIHER/CLEMENTS/RCC/PMH/NGP/DMN/HPW/JNG/SMM/JMT/WCL 12-OCT-78
WIT
TITLE COMPIL 22F(574) CCL CONTROL CUSP
SUBTTL OWNER HISTORY
; WEIHER/CLEMENTS/RCC/PMH/NGP/DMN/HPW/JNG
; /SMM/JMT/WCL/BCM/GAT 9-AUG-84
REP 30/1 ;09C2
VUPDATE==5 ;DEC UPDATE LEVEL
VEDIT==443 ;EDIT LEVEL
WIT
VUPDATE==6 ;DEC UPDATE LEVEL
VEDIT==574 ;EDIT LEVEL
INS 59/1 ;09C3
IFNDEF SIMULA,<SIMULA==1> ;[452] ACCEPT SIMULA AS A COMPILER
IFNDEF PASCAL,<PASCAL==1> ;[463] ACCEPT PASCAL AS A COMPILER
REP 72/1 ;09C4
IFNDEF DCOBOL,<DCOBOL==0> ;[324] DEFAULT VALUE 0=COBOL-68, 1=COBOL-74
WIT
IFNDEF DCOBOL,<DCOBOL==1> ;[324] DEFAULT VALUE 0=COBOL-68, 1=COBOL-74
;[451] MAKE COBOL-74 DEFAULT COBOL COMPILER
REP 291/2 ;09C5
;443 NO SPR BCM 4-FEB-81
; MAKE BLISS10 PROCESSOR AND SWITCH THE SAME (RUN BLIS10 FOR .BLI)
WIT
;443 NO SPR BCM 19-FEB-81
; FIX PROCESSOR vs. SWITCH PROBLEM INTRODUCED BY EDIT 441
;444 10-30513 BCM 24-Mar-81
; MAKE /SAVE AND /SSAVE WORK RIGHT
;445 10-05955 BCM 28-Apr-81
; FIX /NOCOMP SWITCH FOR "DEBUG A.MAC/NOCOMP"
;446 10-30567 BCM 16-Jun-81
; INCREASE BUFFER SIZE FOR NUMBER OF LINK SWITCHES
;447 QAR 10-05958 BCM 8-Aug-81
; implement global processor switches
;450 NO SPR BCM 11-Aug-81
; Fix an assumption that processors can still parse parenthesis.
;451 QAR 10-05959 BCM 12-Aug-81
; make COBOL-74 the default COBOL compiler
;452 QAR 10-05957 BCM 25-Aug-81
; add code to support SIMULA compiler
;453 SPR 10-31944 BCM 5-Jan-82
; Fix edit 444 to not overlay the extension as the output extension.
;
;454 SPR #32066 BCM 2-JAN-82
; Reinsert the code at IDENT which was removed incorrectly
; by a zealous edit 441.
;455 SPR #30256 BCM 15-Mar-82
; We output an "S" as the first chacracter in the TMPCOR file
; that is passed to LINED or TECO. Since we removed the LINED
; support we will gradually remove this from crock from COMPIL.
; Change the "S" to "<space>" since TECO skips it anyway.
;456 SPR #31279 BCM 15-Mar-82
; Replace code removed by edit 430. Makes PIP run faster
; on copies.
;457 SPR #31693 BCM 16-Mar-82
; Allow compiler selection switches (/C74,/C68,/F10,/F40) to
; imply compiler type. A long overdue correction.
;460 SPR #32659 BCM 28-Sep-82
; Edit 454 incomplete. Add LABEL to command table.
;461 SPR #32416 BCM 22-Apr-82
; Increase the core argument to optimal size.
;462 SPR #31449 BCM 29-Sep-82
; Always LOOKUP the REL file if the processor is unknown. This
; avoids debugging with DDT, when the link block type is Fortran.
; Made new routine SETPTH which should always be called to set
; up path for DOLOOK. Changed all LOOKUP's to call DOLOOK.
;463 NO SPR BCM 19-Apr-83
; Add the PASCAL compiler to compiler list and add new compiler
; attribute flag word.
;
;START OF VERSION 22(F)
;
;564 SPR 10-32178/32177 GAT 4-JAN-84
; Fix ADDRESS CHECKS/ILL MEM REFS which were not thoroughly
; eliminated by edits 176/241.
;
;565 10-32625 GAT 19-JAN-84
; GIVE APPROPRIATE ERROR MESSAGE IF SOURCE FILES ARE NOT FOUND OR
; .REL FILES ARE SPECIFIED IN THE "+" CONSTRUCTION.
;566 10-31613 GAT 14-FEB-84
; DELETE TMPCOR FILE IF WRITING .TMP FILE ONTO DISK.
;567 SPR 10-32007 GAT 10-FEB-84
; CORRECT PARSING OF COMMAND FILES THAT START WITH A COMMENT LINE(S).
;570 10-34129 GAT 22-MAR-84
; ALLOW "MINUS SIGN" IN PROCESSOR SWITCHES NEEDED FOR COBOL-74.
;571 33631 GAT 21-MAR-84
; USE ALGDDT AS DEFAULT DEBUGGER INSTEAD OF DDT FOR ALGOL
;572 10-32034 GAT 8-MAY-84
; GIVE ERROR IF TRYING TO DEFAULT SFD(S).
;573 SPR 10-31549 GAT 14-MAY-84
; DON'T PASS EXPLICIT SOURCE DEVICE TO LINK IF A /LIB FILE NEEDS
; TO BE RECOMPILED (INTO OUR DIRECTORY).
;574 10-34735 GAT 9-AUG-84
; MAKE GFLOAT AND F66 SWITCHES KNOWN TO COMPIL.
INS 27/3 ;09C6
SALL ;SUPPRESS ALL MACROS AND REPEATS
MLON
REP 33/3 ;09C7
LODSCT==^D80 ;NUMBER OF LOADER SWITCHES PER FILE ALLOWED
WIT
LODSCT==^D200 ;[446] # OF CHRS IN LINK SWITCHES PER FILE ALLOWED
INS 1/4 ;09C8
;[463] FLAG WORD
SCANCH==000001 ;[463] USE SCAN CHAINING ARG CONVENTIONS
INS 36/4 ;09C9
NOCMPL==2000 ;[445] NOCOMPLE REGARDLESS OF DATES
INS 41/4 ;09C10
F66SW==2000 ;[574] F66 CODE
GFLSW==4000 ;[574] GFLOATING CODE
REP 12/5 ;09C11
>
DEFINE PROCESS<
IFN DFORTRAN,<X FORTRAN,FOR,FORTRAN,,,FORDDT,=>
IFE DFORTRAN,<X FORTRAN,FOR,F40,,,,=>
X MACRO,MAC,MACRO,,,,=
IFE DCOBOL,<X COBOL,CBL,COBOL,,,COBDDT,=>
IFN DCOBOL,<X COBOL,CBL,CBL74,,,COBDDT,=>
X ALGOL,ALG,ALGOL,,,,=
IFN SNOBOL,<X SNOBOL,SNO,SNOBOL,,,,_>
IFN MACY11,<X MACY11,P11,MACY11,,OBJ,,_>
IFN BLISS,<X BLISS,BLI,BLIS10,,,,=> ;[443] MAKE PROCESSOR THE SAME AS SWITCH
WIT
H COMPILER ATTRIBUTE FLAGS, USED FOR SCAN VS. BANG CHAINING
>
DEFINE PROCESS<
IFN DFORTRAN,<X FORTRAN,FOR,FORTRAN,,,FORDDT,=,SCANCH>
IFE DFORTRAN,<X FORTRAN,FOR,F40,,,,=>
IFN PASCAL,<X PASCAL,PAS,PASCAL,,,PASDDT,=,SCANCH>;[462] PASCAL USES SCAN ARGS
X MACRO,MAC,MACRO,,,,=
IFN SIMULA,<X SIMULA,SIM,SIMULA,,,SIMDDT,=> ;[452] SW,EXT,PROC,,,DEBUG
IFE DCOBOL,<X COBOL,CBL,COBOL,,,COBDDT,=>
IFN DCOBOL,<X COBOL,CBL,CBL74,,,COBDDT,=>
X ALGOL,ALG,ALGOL,,,ALGDDT,=
IFN SNOBOL,<X SNOBOL,SNO,SNOBOL,,,,_>
IFN MACY11,<X MACY11,P11,MACY11,,OBJ,,_>
IFN BLISS,<X BLISS,BLI,BLIS10,,,,=>
REP 10/6 ;09C12
DEFINE X (A,B,C,D,E,F,G)<
WIT
DEFINE X (A,B,C,D,E,F,G,H)<
REP 22/6 ;09C13
DEFINE X (A,B,C,D,E,F,G)<
WIT
DEFINE X (A,B,C,D,E,F,G,H)<
REP 27/6 ;09C14
IFE BLISS,<BLISW==0> ;MAKES TESTS EASIER AND NEATER
WIT
IFE SIMULA,<SIMSW==0> ;[452] FOR LATER TESTS
IFE BLISS,<BLISW==0> ;MAKES TESTS EASIER AND NEATER
UNKSW==0 ;[462] AN UNKNOWN PROC TYPE
INS 29/8 ;09C15
COMAND LABEL,<JRST IDENT> ;[460] REINSERT COMMAND
REP 10/9 ;09C16
SWITCH NOCOMPILE,COMPLS
WIT
SWITCH NOCOMPILE,<NOCMPL,,0> ;;[445] MAKE A SEPERATE BIT FOR NOCOMP
INS 18/9 ;09C17
SWITCH F66,<F66SW,,0> ;[574]
SWITCH GFLOATING,<GFLSW,,0> ;[574]
INS 40/13 ;09C18
TRNN FL,IDF ;[572] MUST SEE IDENTIFIER HERE
JRST SFDER2 ;[572] NO, GIVE SFD ERROR AND ABORT
INS 1/17 ;09C19
XALL ;BACK TO NORMAL LISTING
REP 33/20 ;09C20
MOVEI C," " ;SUPPLY A FREE BLANK IF "@" SO COM@FOO WORKS
SETZ CS, ;STATUS OF A BLANK
SETZM INLFLG ;[305] CLEAR IN-LINE FLAG
WIT
SETZM INLFLG ;[305] CLEAR IN-LINE FLAG
PUSHJ P,CHKTRM ;[567] EAT ANY TERMINATORS
CAMN CS,COMMA ;[567] IF COMMA, DON'T BACKUP POINTER
JRST NEXT2A ;[567] PRESERVE OLD WORK AROUND
MOVSI T1,70000 ;[567]
ADDM T1,@GETB3(IOPNT);[567] AND BACK UP BYTE POINTER
AOS @GETB1(IOPNT) ;[567] ALSO BACKUP COUNT
NEXT2A: SETZB CS,SAVCHR ;[567] DON'T SAVE ANY CHARS
MOVEI C," " ;[567] SUPPLY A FREE BLANK SO COM@FOO WORKS
INS 1/21 ;09C21
SALL
INS 3/22 ;09C22
IFDEF SALL,<SALL> ;MAKE LISTING NEATER
REP 54/22 ;09C23
SAVERR: STRING [ASCIZ .?CMLNFS No file on SAVE or SSAVE.] ;[256]
JRST ABORT ;[256]
WIT
RLFERR: STRING [ASCIZ .?CMLRLF Problem with REL file and /REL was specified.]
JRST ABORT ;[462] DIE GRACEFULLY
RLFER1: STRING [ASCIZ .?CMLRLS Problem with REL file and no source specified.]
JRST ABORT ;[462] DIE GRACEFULLY
SAVERR: STRING [ASCIZ .?CMLNFS No file on SAVE or SSAVE.] ;[256]
JRST ABORT ;[256]
SAVER2: STRING [ASCIZ .?CMLASF Ambiguous /SAVE or /SSAVE usage on files.]
JRST ABORT ;[444] THIS IS ON USING THE SWITCH TWICE
NOSRCS: STRING [ASCIZ .?CMLMSF Must have source files for "+" contruction.]
JRST ABORT ;[565]
REP 19/23 ;09C24
ABORT: CLRBFI ;CLEAR INPUT BUFFER SO GARBAGE IS NOT READ;"22A-160"
RESET
DOEND: SETZB 0,.JBSA ;SO START FAILS
;[432] REMOVE ONE LINE
; SETNAM 0, ;SO RUN FAILS
EXIT 1,
EXIT ;IN CASE SOME IDIOT TYPES CONTINUE
WIT
ABORT: CLRBFI ;CLEAR INPUT BUFFER SO GARBAGE IS NOT READ
RESET
DOEND: SETZB 0,.JBSA ;SO START FAILS
EXIT 1,
JRST .-1 ;IN CASE SOME IDIOT TYPES CONTINUE
INS 63/23 ;09C25
SFDER2: STRING [ASCIZ .?CMLISS Illegal SFD specification.] ;[572]
CAIE C,","
CAIN C,"]"
MOVEM CS,SAVCHR
JRST ERRCOM
REP 32/25 ;09C26
IFN FORTRAN,<
CAIN T3,CHNFOR ;IS THIS FORTRAN?
JRST [SKIPN T1,FORPRC ;YES, BUT SEE WHICH
MOVE T1,PRCNAM(T3) ;EITHER F40 OR F-10
CAME T1,['FORTRA'] ;F-10 IS SPECIAL
JRST NF10 ;F40
MOVE T2,['/RUN: '] ;AS IT USES SCAN
PUSHJ P,OUTSIX
SKIPE T2,PCDEV ;USE DEVICE IF GIVEN
PUSHJ P,OUTDEV
MOVE T2,PCNAM ;NAME WE WANT TO RUN
PUSHJ P,OUTSIX
PUSHJ P,OUCRLF
JRST NONAM]
NF10:
>
SKIPE T2,PCDEV ;GET DEVICE IF GIVEN
WIT
SKIPN T1,PRCFLG(T3) ;[463] ARE THERE ANY FLAGS FOR THIS PROC
JRST NOTSCN ;[463] NONE, DO THE BANG PROCESSING BY DEFAULT
TLNN T1,SCANCH ;[463] DOES THIS PROCESS USE SCAN CHAINING?
JRST NOTSCN ;[463] NOPE, USE OLD STYLE BANG STUFF
MOVE T2,['/RUN: '] ;AS IT USES SCAN
PUSHJ P,OUTSIX
SKIPE T2,PCDEV ;USE DEVICE IF GIVEN
PUSHJ P,OUTDEV
MOVE T2,PCNAM ;NAME WE WANT TO RUN
PUSHJ P,OUTSIX
PUSHJ P,OUCRLF
JRST NONAM
NOTSCN: SKIPE T2,PCDEV ;GET DEVICE IF GIVEN
REP 56/25 ;09C27
CAIN T3,CHNLNK ;[441] IS THIS LINK-10?
SKIPA T1,PROCTB(T3) ;[441] YES, IT IS SPECIAL
MOVE T1,PRCNAM(T3) ;[441] NO, GET PROCESSOR NAME
WIT
CAIN T3,CHNLNK ;[443] IS THIS LINK-10?
SKIPA T1,PROCTB(T3) ;[443] YES, ITS SPECIAL
MOVE T1,PRCNAM(T3) ;[443] NO, SO GET THE PROCESSOR NAME
REP 13/26 ;09C28
SOJA T2,LDN1 ;NO, TRY AGAIN [441] use LDN1
WIT
SOJA T2,LDN1 ;[441] NO, JUMP BACK TO TRY AGAIN
REP 5/27 ;09C29
AOBJN T1,CKRM1 ;TRY AGAIN [441] use CKRM1
WIT
AOBJN T1,CKRM1 ;[441] JUMP BACK AND TRY AGAIN
REP 44/29 ;09C30
RPGRET: SKIPA P,RP1 ;SET UP PDL [441] use RP1
WIT
RPGRET: SKIPA P,RP1 ;[441] SET UP PDL
REP 10/30 ;09C31
SOJG T1,LSOJ1 ;THREE DIGITS [441] use LSOJ1
WIT
SOJG T1,LSOJ1 ;[441] THREE DIGITS
INS 32/30 ;09C32
HRRZ T1,.JBFF ;[564] DISK BUFFERS WILL GET PUT HERE
MOVEM T1,DSKBUF ;[564] SAVE BUFFER ADDRESS
INS 9/31 ;09C33
SETZM SWGKB ;[447]
SETZM SWGKL ;[447]
SETZM SWGKS ;[447]
INS 29/32 ;09C34
XALL
INS 6/34 ;09C35
SALL
INS 8/35 ;09C36
CAIN C,"(" ;[447]
JRST PROCSX ;[447]
REP 30/36 ;09C37
TRNA ;"," AND TERMF ARE OK [441] faster than JRST
WIT
TRNA ;[441] "," AND TERMF ARE OK SO SKIP
REP 39/38 ;09C38
ANDI T1,DEVSWS ;SEE IF FIRST DEVICE SWITCH
WIT
;**;[457] after SMATCH + 6L, insert
TLNN FL3,C74SW!C68SW!F10SW!F40SW ;[457] IMPLY COMPILER?
JRST SMATC1 ;[457] NO, CONTINUE NORMALLY
TLNE FL3,C74SW!C68SW ;[457] IMPLY COBOL?
TRZA FL2,ALPROC-CBLSW ;[457] YES, TURN OFF ALL BUT COBOL
TRZA FL2,ALPROC-FORSW ;[457] NO, TURN OFF ALL BUT FORTRA
TROA FL2,CBLSW ;[457] YES, SET PROC TYPE
TRO FL2,FORSW ;[457] NO, MUST FOR FORTRA
TRNE FL,PERF ;[457] WAS IT PERMANENT?
HRRZM FL2,DFPROC ;[457] YES, STORE DEF PROC
SMATC1: ANDI T1,DEVSWS ;SEE IF FIRST DEVICE SWITCH
REP 2/39 ;09C39
DEFINE X (A,B,C,D,E,F,G)<
WIT
DEFINE X (A,B,C,D,E,F,G,H)<
INS 5/45 ;09C40
;**; [444] at SSAVE plus 3
SKIPE SAVSW ;[444] IS THIS THING ALREADY SET?
JRST SAVER2 ;[444] YES, YOU CAN'T SAVE TWO DIF FILES
REP 1/46 ;09C41
PROCSW: TROE FL,PROCS ;HAVE WE ALREADY SEEN SOME?
GOTO SYNERR ;YES, I DEFINE THIS AS ILLEGAL
WIT
;here on "(" as first char of ident, i.e. perm proc sw
PROCSX: PUSH P,SWPT ;[447] save switch pointer
MOVE SWPT,[POINT 7,SWGLK]
PUSHJ P,PROCS0 ;[447] get switches
POP P,SWPT ;[447] restore switch pointer
MOVE T1,SWBKB ;[447] transfer binary switch ptr.
MOVEM T1,SWGKB ;[447]
SETZM SWBKB ;[447]
MOVE T1,SWBKL ;[447] listing switch ptr.
MOVEM T1,SWGKL ;[447]
SETZM SWBKL ;[447]
MOVE T1,SWBKS(SVPT) ;[447] source switches
MOVEM T1,SWGKS ;[447]
SETZM SWBKS(SVPT) ;[447]
JRST ILP0
;here on "(" after a file name
PROCSW: TROE FL,PROCS ;HAVE WE ALREADY SEEN SOME?
GOTO SYNERR ;YES, I DEFINE THIS AS ILLEGAL
PUSHJ P,PROCS0 ;[447] get switches
JRST ILP2A
PROCS0:
INS 23/46 ;09C42
CAIN C,"-" ;[570] ALLOW "-"
JRST PROCS2 ;[570] FOR COBOL-74
REP 58/46 ;09C43
JRST ILP2A]
WIT
POPJ P,] ;[447]
REP 62/46 ;09C44
JRST ILP2A ;NEXT
WIT
POPJ P, ;[447] next
REP 9/50 ;09C45
JRST LSET1 ;[240] NO, ASSUME DISK [441] use LSET1
WIT
JRST LSET1 ;[240] NO, ASSUME DISK
REP 14/50 ;09C46
;[441] label LSET1
DSKLUP: SKIPN T2,SVDEV(T1) ;[240] DEVICE GIVEN?
JRST LDSK1 ;[240] NO, ASSUME A DISK [441] use LDSK1
WIT
DSKLUP: SKIPN T2,SVDEV(T1) ;[240] DEVICE GIVEN?
JRST LDSK1 ;[240] NO, ASSUME A DISK
REP 20/50 ;09C47
LDSK1: AOBJN T1,DSKLUP ;[240] LOOP FOR ALL DEVICES [441] label LDSK1
WIT
LDSK1: AOBJN T1,DSKLUP ;[240] LOOP FOR ALL DEVICES
REP 28/50 ;09C48
SKIPE SAVSW ;[234] IS THIS A SAVE FILE REQUEST?
TLOA FL2,RELSW ;[234] YES, PRETEND ITS A REL FOR NOW
PUSHJ P,GETPRO ;GO FIND DATE AND PROCESSOR
TLNE FL2,RELSW ;IF A REL FILE
JRST LDREL ;GO LOAD IT NOW
WIT
PUSHJ P,GETPRO ;GO FIND DATE AND PROCESSOR
SKIPE SAVSW ;[444] IS THIS A SAVE FILE REQUEST
PUSHJ P,OUTSAV ;[444] YES, PUT OUT OUTPUT FILENAME NOW
TLNE FL2,RELSW ;IF A REL FILE
JRST LKREL ;[462] SETUP THE PROCESSOR TYPE FROM REL FILE
REP 39/50 ;09C49
IFN SFDSW,<
MOVE T1,SVPPN(SVPT) ;GET PPN
SKIPN SVSFD(SVPT) ;ANY SFD'S SPECIFIED?
JRST REREL0 ;NO
MOVEM T1,LSFDPP ;STORE PPN
X==<Y==0> ;INITIAL CONDITION
REPEAT SFDLEN,<
MOVE T1,SVSFD+X(SVPT)
MOVEM T1,LSFD+Y
X==X+NFILE
Y==Y+1
>
SKIPA T1,[EXP LSFDAD] ;POINT TO SFD BLOCK IN LPPN>
IFE SFDSW,<
SKIPA T1,SVPPN(SVPT) ;LOOK ON THIS AREA FOR REL
>
REREL: SETZ T1,
REREL0: MOVEM T1,LPPN ;BUT ONLY FIRST TIME
MOVEM T1,SVRPP ;SO WE KNOW IF SECOND TIME
WIT
MOVE T1,SVPT ;[462] USE THE CURRENT FILE POINTER
PUSHJ P,SETPTH ;[462] SETUP THE LOOKUP PATH
TRNA ;[462] SKIP THE FIRST TIME
REREL: SETZ T2, ;[462] CLEAR THE FLAG
MOVEM T2,LPPN ;[462] SAVE THE PATH POINTER OR 0
MOVEM T2,SVRPP ;[462] STORE RESULT SO WE KNOW IF SECOND TIME
REP 67/50 ;09C50
SKIPE EXTEND ;[240] ALL DEVICES DISKS?
JRST EREL ;[240] YES, DO EXTENDED LOOKUP
LOOKUP LOOK,LNAM ;IS IT THERE
JRST LBCOMP ;NO, WE MUST RECOMPILE
WIT
PUSHJ P,DOLOOK ;[462] LOOKUP THE REL FILE
JRST LBCOMP ;[462] COULD NOT FIND IT, RECOMP
DEL 15/51 ;09C51
EREL: MOVEI T2,.RBTIM ;[240] HERE IF DOING EXTENDED LOOKUP..
MOVEM T2,EBLK ;[240] SET UP EXTENDED LOOKUP BLOCK.
MOVE T2,LPPN ;[240]
MOVEM T2,EPPN ;[240]
LOOKUP LOOK,EBLK ;[240] DO EXTENDED LOOKUP
JRST LBCOMP ;[240] NOT THERE, TOO BAD
PUSHJ P,CHKAGE ;[317] COMPARE THE AGE OF THE FILE
JRST DOCOMP ;[240] YES.
JRST NOCOM1 ;[240] NO, NOT UNLESS BAD REL FILE.
INS 49/51 ;09C52
;
; This routine does not decide wether to COMPILE or not but
; simply sets the processor type from the REL file if it is
; as yet, unknown.
;
LKREL: SKIPGE DEBFL ;[462] IF NOT DEBUG, DON'T WASTE TIME ON REL
TLNE FL2,ALPROC-RELSW ;[462] SEE IF ANY PROCESSORS ALREADY SET
JRST LDREL ;[462] YES, GO LOAD REL FILE NOW!
SKIPN T1,LOKNAM ;[462] PICK UP A DEVICE IF THERE
SKIPA T1,['DSK '] ;[462] ELSE USE DSK:
TRNA ;[462] SKIP STORAGE IF ALREADY THERE
MOVEM T1,LOKNAM ;[462] STORE IT AWAY
OPEN LOOK,LOKINT ;[462] OPEN FOR INPUT
JRST DEVNA ;[462] NOT THERE
MOVE T1,SVPT ;[462] USE CURRENT FILE POINTER
PUSHJ P,SETPTH ;[462] SET UP THE LOOKUP BLOCK
MOVE T1,ONAM ;[462] SEE IF REL IS THERE
MOVEM T1,LNAM ;[462]
SKIPN T1,OEXT ;[462] OUTPUT EXTENSION ALREADY SPECIFIED?
SKIPE T1,SVEXT(SVPT) ;[462] NO, GET INPUT SPECIFIED
SKIPN T1 ;[462] DO WE HAVE SOMETHING?
MOVSI T1,'REL' ;[462] NO USE REL
MOVEM T1,LEXT ;[462] STORE LOOKUP EXTENSION
PUSHJ P,DOLOOK ;[462] IS IT THERE?
JRST FIU ;[462] NO, GIVE ERROR SINCE /REL IS SET
PUSHJ P,INSREL ;[462] GET THE LINK BLOCK TYPE FROM REL FILE
JRST LKRER ;[462] PROBLEM, TRY TO ISOLATE THE ERROR
PUSHJ P,SETPRC ;[462] SET THE PROC TYPE FROM TABLE
JRST LDREL ;[462] CONTINUE LOADING
;
; There are two cases for falling through here:
; 1) user type /REL
; 2) we only found a .REL file
;
LKRER: HLRZ T1,SVEXT(SVPT) ;[462] GET THE USERS SPECIFIED EXTENSION
JUMPN T1,RLFER1 ;[462] PROB WITH REL FILE SPECIFIED
JRST RLFERR ;[462] ASSUME /REL WAS SPECIFIED
REP 27/52 ;09C53
DOCOM1: SKIPE T2,SWBKB ;ARE THERE SWITCHES
WIT
DOCOM1: TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKB ;[447] yes, get them
MOVE T2,SWGKB ;[447] get global switches
SKIPE T2 ;[447] anything ?
REP 36/52 ;09C54
JRST DOCOMD ;NO, TAKE DEFAULT
WIT
JRST DOCOMB ;[574] NO, TAKE DEFAULT
INS 41/52 ;09C55
DOCOMB: TLNN FL3,F66SW ;[574] /F66 SEEN?
JRST DOCOMC ;[574] NO, TAKE DEFAULT
MOVE T2,['/F66 '] ;[574] OUTPUT SWITCH
PUSHJ P,OUTSIX ;[574]
DOCOMC: TLNN FL3,GFLSW ;[574] /GFLOAT SEEN?
JRST DOCOMD ;[574] NO, TAKE DEFAULT
MOVE T2,['/GFLO '] ;[574] OUTPUT SWITCH
PUSHJ P,OUTSIX ;[574]
REP 61/52 ;09C56
SKIPN SWBKL ;[321] PROCESSOR LISTING SWITCHES SPECIFIED?
WIT
IFN PASCAL,<
CAIE T3,CHNPAS ;[463] IS IT PASCAL?
JRST DOCM2B ;[463] NO, SKIP THIS JUNK
MOVE T2,['/DEBUG'] ;[463] GET READY FOR /DEBUG
TLNN FL3,DEBUGSW ;[463] AND /DEBUG?
SKIPGE DEBFL ;[463] OR DEBUG COMMAND?
PUSHJ P,OUTSIX ;[463] YES, SO TELL THE COMPILER
DOCM2B:
>
TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKL ;[447] yes, get them
MOVE T2,SWGKL ;[447] get global switches
SKIPN T2 ;[447] any switches ?
REP 4/53 ;09C57
TLNN FL2,CBLSW!BLISW ;DON'T WRITE /CREF IF COBOL OR BLISS (SPECIAL)
PUSHJ P,ENTCRF ;PUT IT IN THE ###CREF FILE
POP P,T3
NOLST1: SKIPE T2,SWBKL ;SWITCHES?
WIT
;**; at DOCOM3 plus 16 lines change 1 line
TLNN FL2,CBLSW!BLISW!SIMSW ;[452] DON'T WRITE /CREF IF
;[452] COBOL, BLISS OR SIMULA
PUSHJ P,ENTCRF ;PUT IT IN THE ###CREF FILE
POP P,T3
NOLST1: TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKL ;[447] yes, get them
MOVE T2,SWGKL ;[447] get global switches
SKIPE T2 ;[447] anything ?
REP 21/53 ;09C58
SKIPE T2,SWBKS(SVPT) ;AND SWITCHES
WIT
TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKS(SVPT) ;[447] yes, get them
MOVE T2,SWGKS ;[447] get global switches
SKIPE T2 ;[447] anything ?
REP 27/54 ;09C59
MOVEM T1,SVNAM
MOVE T3,PCNUM ;GET BACK PROCESSOR NUMBER
MOVE T1,INTEXT(T3) ;GET EXTENSION
MOVEM T1,SVEXT
SETZM SVPPN
SETZM SWBKS
SETZM SWBKB
SETZM SWBKL
WIT
;**; [444] at ENDCOB plus 9 lines
MOVEM T1,SVNAM(SVPT) ;PUT IT AS CURRENT FILENAME
MOVE T3,PCNUM ;GET BACK PROCESSOR NUMBER
MOVE T1,INTEXT(T3) ;GET EXTENSION
MOVEM T1,SVEXT(SVPT) ;AND PUT IT AS CURRENT EXTENSION
SETZM SVPPN(SVPT)
SETZM SWBKS(SVPT)
SETZM SWBKB(SVPT)
SETZM SWBKL(SVPT)
REP 29/55 ;09C60
JUMPE T1,LSFP1 ;ZERO IS JUST , [441] use LSFP1
WIT
JUMPE T1,LSFP1 ;ZERO IS JUST
REP 2/56 ;09C61
JRST NOFIL ;IF MORE THAN ONE, THERE IS AN ERROR
WIT
JRST NOSRCS ;[565] IF MORE THAN ONE, THERE IS AN ERROR
REP 10/56 ;09C62
MOVEI T3,CHNLNK ;SET FOR LINK [441]
WIT
MOVEI T3,CHNLNK ;[441] SET FOR LINK
;**; [444] at NOCOMP plus 7
REP 15/56 ;09C63
SKIPE SAVSW ;[256] IS THIS A SAVE FILE?
PUSHJ P,[SKIPE T2,SVDEV ;[256] DEVICE THERE?
PUSHJ P,OUTDEV ;[256] YES, OUTPUT IT
PUSHJ P,OUTNM1 ;[256] OUTPUT FILENAME
MOVE T2,SAVSW ;[256] GET THE SWITCH AGAIN
PUSHJ P,OUTSIX ;[234] OUTPUT IT
MOVEI T1," " ;[234] SEPARATE BY SPACE
PJRST TMPOUT] ;[234] RETURN
WIT
;**; [444] at NOCOMP plus 9
REP 41/56 ;09C64
jrst NDBA ;[220] then return [441] use NDBA
WIT
jrst NDBA ;[220] then return
REP 60/56 ;09C65
JUMPE T2,ND2P1 ;[165] IGNORE IF 0 [441] JUMP to OUTSPC
WIT
JUMPE T2,ND2P1 ;[165] IGNORE IF 0
REP 95/56 ;09C66
TLNN FL3,LIBSW
TLNE FL2,RELSW ;USING A REL FILE?
LODR0: SKIPE T2,LOKNAM ;ON NON-DISK DEVICE?
LODR3: PUSHJ P,OUTDEV ;YES. OUTPUT DEVICE
LODR1: SKIPE SAVSW ;[256] ONLY OUTPUT NAME IF NOT /SAVE
JRST ELOD ;[256] IT'S /SAVE OR /SSAVE
MOVE T2,ONAM ;NOW FILE NAME
PUSHJ P,OUTSIX
TLNN FL2,RELSW ;REL
JRST [SKIPE T2,OEXT ;EXTENSION GIVEN?
WIT
TLNE FL2,RELSW ;[573] DO WE HAVE A REL FILE?
LODR0: SKIPE T2,LOKNAM ;ON NON-DISK DEVICE?
LODR3: PUSHJ P,OUTDEV ;YES. OUTPUT DEVICE
LODR1: MOVE T2,ONAM ;[444] IN WHICH CASE USE ONAM
PUSHJ P,OUTSIX
TLNN FL2,RELSW ;REL
JRST [SKIPE T2,OEXT ;[444] OUTPUT EXTENSION GIVEN?
REP 109/56 ;09C67
SKIPE T2,SVEXT ;ALSO USE EXT IF GIVEN
PUSHJ P,OUTEXT
LODR2: TLNE FL2,RELSW ;[322] DO WE HAVE THE REL FILE?
SKIPN T2,SVPPN(SVPT) ;[322] YES, THEN OUTPUT PPN IF SPECIFIED
TRNA ;[322] EITHER RECOMPILING OR NO PPN GIVEN
;[441] TRNA is faster than SKIPA
PUSHJ P,OUTPPN
MOVSI T2,'/S ' ;USES SEARCH
TLNN FL3,LIBSW ;LIBRARY?
JRST ELOD ;NO
PUSHJ P,OUTSIX
PUSHJ P,OUTSPC ;NEEDS SPAC
SETOM NSWTCH ;[236] SIGNAL /L LAST
ELOD:
ELOD1: MOVE T2,[POINT 7,LODSB2] ;[174] OUTPUT SECOND SET OF SWITCHES
PUSHJ P,OUTSW
SKIPN T2,FORLIB ;FORSE/FOROTS SWITCH SET?
JRST ELOD2 ;NO
WIT
SKIPE T2,SVEXT(SVPT) ;ALSO USE EXT IF GIVEN
PUSHJ P,OUTEXT
LODR2: TLNE FL2,RELSW ;[322] DO WE HAVE THE REL FILE?
SKIPN T2,SVPPN(SVPT) ;[322] YES, THEN OUTPUT PPN IF SPECIFIED
TRNA ;[322] EITHER RECOMPILING OR NO PPN
PUSHJ P,OUTPPN
MOVSI T2,'/S ' ;USES SEARCH
TLNN FL3,LIBSW ;LIBRARY?
JRST ELOD ;NO
PUSHJ P,OUTSIX
PUSHJ P,OUTSPC ;NEEDS SPAC
SETOM NSWTCH ;[236] SIGNAL /L LAST
ELOD: MOVE T2,[POINT 7,LODSB2] ;[174] OUTPUT SECOND SET OF SWITCHES
PUSHJ P,OUTSW
SKIPN T2,FORLIB ;FORSE/FOROTS SWITCH SET?
JRST ELOD2 ;NO
REP 8/59 ;09C68
INSRL1: MOVE T1,SVJFF ;[241] GET FIRST FREE LOCATION
ADDI T1,406 ;[241] ADD ROOM FOR 2 DSK BUFFERS
PUSHJ P,GETSPC ;[241] ALLOCATE CORE
MOVEM T1,.JBFF ;[241] SO MONITOR WILL PUT BUFFERS THERE
MOVEM T1,SVJFF ;[241] SO CORE WILL BE RETURNED IF DONE
INBUF LOOK,2 ;[241]SETUP THE BUFFERS
IN LOOK, ;YES, MUST CHECK FOR DEBUGGER DATA
JRST INSRL3 ;IN OK, PICKUP BUFFER ADDRESS
JRST INSRL2 ;[176] ERROR - FORCE RECOMPILE
WIT
INSRL1: SKIPGE LOOKBF ;[564] DO WE HAVE BUFFERS?
JRST INSRIN ;[564] YES, CONTINUE
MOVE T1,DSKBUF ;[564] GET DISK BUFFER ADDRESS
EXCH T1,.JBFF ;[564] SET .JBFF TO DSKBUF ADDRESS
INBUF LOOK,2 ;[241]SETUP THE BUFFERS
EXCH T1,.JBFF ;[564] RESTORE .JBFF TO ORIGINAL VALUE
INSRIN: IN LOOK, ;YES, MUST CHECK FOR DEBUGGER DATA
JRST INSRL3 ;IN OK, PICKUP BUFFER ADDRESS
POPJ P, ;[564] ERROR - FORCE RECOMPILE
REP 24/59 ;09C69
JRST [SETZ T3, ;UNLESS NOT A REL FILE
JRST CPOPJ1] ;IN WHICH CASE DON'T REASSEMBLE
WIT
JRST INSERR ;[462] IF NOT A REL FILE, THEN DON'T REASSEMBLE
REP 41/59 ;09C70
CLOSE LOOK, ;[176] CLEAR FILE
AOS 0(P) ;[176] SET SKIP RETURN
INSRL2: MOVE T1,SVJFF ;[176] RESTORE .JBFF
MOVEM T1,.JBFF ;[176] TO PRE-INPUT VALUE
SETZM LOOKBF ;[176] AVOID MONITOR BUG
POPJ P,
GETPRO: MOVSI T1,-NFILE ;NUMBER OF FILES
TRNN FL2,-1 ;[303] LOCAL PROCEESOR SET ?
SETOM DEFPRO ;[303] SET FLAG SAYING DEFAULT PROC USED
TRNN FL2,-1 ;LOCAL PROCESSOR SET?
HRR FL2,DFPROC ;NO, SET FROM GLOBAL
TRNE FL2,RELSW ;IF USER SAID /REL
TRNE FL3,COMPLS ;AND NOT /COMP
JRST GETPR1 ;NOT TRUE
TLO FL2,RELSW ;DON'T WASTE TIME ON LOOKUPS
PUSH P,SVDEV(T1) ;AND COPY "SOURCE" DEVICE
POP P,LOKNAM ;TO OUTPUT DEVICE
POPJ P, ;JUST SET PROCESSOR=LOADER
GETPR1: SETOM PTHBLK ;[246] SETUP TO FIND THIS JOB'S PATH
MOVE T3,[3,,PTHBLK] ;[246] POINT TO 3 WORD PATH BLOCK
PATH. T3, ;[246] FIND USER'S DEFAULT PATH
SETZM PTHBLK+1 ;[246] NO LIB: IF NO PATH
MOVE T3,PTHBLK+1 ;[246] GET PATH FLAGS
TRNN T3,20 ;[246] DOES USER HAVE A LIBRARY?
SETZM PTHBLK+2 ;[246] NO, ONLY 1 PASS NEEDED.
SKIPE T3,SVPPN(T1) ;[246] DID USER TYPE A PPN?
SKIPN PTHBLK+2 ;[246] AND HAS HE A LIBRARY?
SKIPA ;[246] NO, FORGE AHEAD
MOVEM T3,PTHBLK+2 ;[246] YES, PUT "MUST MATCH" PPN IN
GETPR2: MOVEI T3,1 ;[246] SET UP LOOK OF EXTENSION POINTER
NFIL: MOVE T2,SVNAM(T1) ;SET UP NAME AND PPN
MOVEM T2,LNAM
HLLZ T2,SVEXT(T1)
NXEXT: MOVEM T2,LEXT ;START WITH ORIGINAL EXT
MOVEM T2,OLDEXT ;SAVE FOR RAS SYSTEM
MOVE T2,SVPPN(T1)
IFN SFDSW,<
SKIPN SVSFD(T1) ;ANY SFD'S?
JRST NXSFD ;NO
MOVEM T2,LSFDPP ;SAVE PPN
X==<Y==0> ;INITIAL CONDITION
WIT
TRNA ;[462] SKIP THE ERROR JUMP ENTRY
INSERR: SETZ T3, ;[462] CLEAR TYPE IF NOT REL FILE
CLOSE LOOK, ;[564] CLOSE FILE
AOS 0(P) ;[176] SET SKIP RETURN
POPJ P,
;[462]
; This routine sets up for a DOLOOK call by setting up
; LPPN and associated locations for lookups.
; T1/ contains file pointer
; Returns:
; T2/ pointer to LSFDAD or SVPPN if SFDSW is 0
; Always returns with POPJ, no skip return.
;
SETPTH: MOVE T2,SVPPN(T1) ;[462] GET USER SPECIFIED PPN
IFN SFDSW,<
SKIPN SVSFD(T1) ;[462] ANY SFD'S?
JRST NXSFD ;[462] NO
MOVEM T2,LSFDPP ;[462] SAVE PPN
X==<Y==0> ;[462] INITIAL CONDITION
REP 43/60 ;09C71
MOVEI T2,LSFDAD ;POINTER
NXSFD:
> ;END OF IFN SFDSW
MOVEM T2,LPPN
WIT
MOVEI T2,LSFDAD ;[462] POINTER TO PATH
NXSFD:
> ;[462] END OF IFN SFDSW
MOVEM T2,LPPN ;[462] STORE THE POINTER OR PPN
POPJ P, ;[462] RETURN
;
;[462] This routine will set the processor type from the REL file.
; It will also recognize processor conflicts and take an error
; path if necessary. The compiler codes in table CMPCOD are
; expanded from the macro CMPTBL. These codes are taken from the
; LINK version 5 manual, page A-13. Those compiler types that
; COMPIL does not know, have zero entries which cause no action.
;
; Assumes:
; T3/ contains compiler type, usually set by INSREL
; Returns: +1
; T3/ contains processor flags
;
SETPRC: SKIPLE T3 ;[462] CHECK LOW RANGE
CAMLE T3,CMPLEN ;[462] CHECK HIGH RANGE
POPJ P, ;[462] DO NOTHING IF BAD
SKIPN T3,CMPCOD(T3) ;[462] GET THE PROC CODE
POPJ P, ;[462] IF ZERO, DO NOTHING
TLO FL2,(T3) ;[462] SET THE FLAG FOR THIS PROC
POPJ P, ;[462] AND RETURN
;
; The X macro takes two arguments:
; A = compiler type code
; B = processor flags to set in FL2
;
DEFINE CMPTBL,<
X 0,UNKSW ;;Code 0, unknown
X 1,FORSW ;;Code 1, F40
X 2,CBLSW ;;Code 2, COBOL-68
X 3,ALGSW ;;Code 3, ALGOL
X 6,BLISW ;;Code 6, BLISS
X 7,SAISW ;;Code 7, SAIL
X 10,FORSW ;;Code 10, FORTRAN-10
X 11,MACSW ;;Code 11, MACRO
X 12,FAISW ;;Code 12, FAIL
X 15,SIMSW ;;Code 15, SIMULA
X 16,CBLSW ;;Code 16, COBOL-74
X 24,PASSW ;;Code 24, PASCAL-36
>
SALL
GETPRO: MOVSI T1,-NFILE ;NUMBER OF FILES
TRNN FL2,-1 ;[303] LOCAL PROCEESOR SET ?
SETOM DEFPRO ;[303] SET FLAG SAYING DEFAULT PROC USED
TRNN FL2,-1 ;LOCAL PROCESSOR SET?
HRR FL2,DFPROC ;NO, SET FROM GLOBAL
TRNE FL2,RELSW ;IF USER SAID /REL
TRNE FL3,COMPLS ;AND NOT /COMP
JRST GETPR1 ;NOT TRUE
TLO FL2,RELSW ;DON'T WASTE TIME ON LOOKUPS
PUSH P,SVDEV(T1) ;AND COPY "SOURCE" DEVICE
POP P,LOKNAM ;TO OUTPUT DEVICE
POPJ P, ;JUST SET PROCESSOR=LOADER
GETPR1: SETOM PTHBLK ;[246] SETUP TO FIND THIS JOB'S PATH
MOVE T3,[3,,PTHBLK] ;[246] POINT TO 3 WORD PATH BLOCK
PATH. T3, ;[246] FIND USER'S DEFAULT PATH
SETZM PTHBLK+1 ;[246] NO LIB: IF NO PATH
MOVE T3,PTHBLK+1 ;[246] GET PATH FLAGS
TRNN T3,20 ;[246] DOES USER HAVE A LIBRARY?
SETZM PTHBLK+2 ;[246] NO, ONLY 1 PASS NEEDED.
SKIPE T3,SVPPN(T1) ;[246] DID USER TYPE A PPN?
SKIPN PTHBLK+2 ;[246] AND HAS HE A LIBRARY?
SKIPA ;[246] NO, FORGE AHEAD
MOVEM T3,PTHBLK+2 ;[246] YES, PUT "MUST MATCH" PPN IN
GETPR2: MOVEI T3,1 ;[246] SET UP LOOK OF EXTENSION POINTER
NFIL: MOVE T2,SVNAM(T1) ;SET UP NAME AND PPN
MOVEM T2,LNAM
HLLZ T2,SVEXT(T1)
NXEXT: MOVEM T2,LEXT ;START WITH ORIGINAL EXT
MOVEM T2,OLDEXT ;SAVE FOR RAS SYSTEM
PUSHJ P,SETPTH ;[462] SET UP LOOKUP BLOCK
REP 80/60 ;09C72
JUMPL T3,LBLS1 ;JUMP IF FOUND SOMETHING [441] use LBLS1
WIT
JUMPL T3,LBLS1 ;JUMP IF FOUND SOMETHING
REP 36/61 ;09C73
JRST LNTY1 ;[246] NO, FORGET IT [441] use LNTY1
WIT
JRST LNTY1 ;[246] NO, FORGET IT
REP 1/64 ;09C74
OUTSW: MOVEM T2,SVSWP ;SAVE THE POINTER
ILDB T1,T2 ;PICK UP THE FIRST CHR
JUMPE T1,CPOPJ ;AND CHECK FOR NULL AS A PRECAUTION
TRNE FL,DOLOD ;[441] are we loading?
JRST OUTSW2 ;[441] yes, go do LINK-10 output switches
CAIN T3,CHNFOR ;OR FORTRAN-10
IFE DFORTRAN,< ;[200] F40 IS DEFAULT
TLNN FL,F10SW ;[200] F10 SWITCH SEEN
> ;[200] END OF CONDITIONAL
IFN DFORTRAN,< ;[200] F10 IS THE DEFAULT
TLNE FL,F40SW ;[200] F40 SWITCH SEEN
> ;[200] END OF CONDITIONAL
TRNA ;[441] a faster CAIA
JRST OUTSW2 ;YES, ALSO USES SCAN
MOVEI T1,"("
PUSHJ P,TMPOUT ;SWITCHES ARE IN () TO PROCESSOR
OUTSW1: ILDB T1,SVSWP
JUMPE T1,LPAR
PUSHJ P,TMPOUT
JRST OUTSW1 ;A NULL WILL MARK THE END
LPAR: MOVEI T1,")"
JRST TMPOUT
;HERE FOR LINK-10 SWITCHES
;OUTPUT AS /SWITCH:ARG
;BLANK MARKS END OF SWITCH
;NULL MARKS END OF SET OF SWITCHES
WIT
;
;[450] Routine to output a set of switches. This routine defines a
; switch as a string of non-blank characters delimited by a
; blank. A set of switches is a series of multiple switches
; delimited by a null.
;
OUTSW: MOVEM T2,SVSWP ;SAVE THE POINTER
REP 32/64 ;09C75
JRST .-3 ;AND MULTIPLE BLANKS
MOVEI T1,"/" ;LINK-10 WANT A SLASH FIRST
PUSHJ P,TMPOUT
WIT
JRST OUTSW2 ;AND MULTIPLE BLANKS
MOVEI T1,"/" ;A SLASH SAYS THIS IS A SWITCH
PUSHJ P,TMPOUT ;SO TELL WHOMEVER
REP 38/64 ;09C76
CAIN T1," "
JRST OUTSW4 ;END OF THIS SWITCH IF BLANK
JUMPE T1,OUTSW5 ;OR IF NULL
PUSHJ P,TMPOUT
JRST OUTSW3 ;KEEP GOING
OUTSW4: PUSHJ P,TMPOUT ;OUTPUT BLANK INCASE FILE NAME FOLLOWING
MOVE T2,SVSWP ;COPY BYTE POINTER
ILDB T1,T2 ;SEE IF END
JUMPN T1,OUTSW2 ;NO, MORE SWITCHES
POPJ P, ;END
WIT
JUMPE T1,OUTSW5 ;IS THIS NULL? (IF YES, DONE)
PUSHJ P,TMPOUT ;NON-NULL SO OUTPUT THIS CHAR
CAIN T1," " ;WAS THAT A BLANK?
JRST OUTSW2 ;YES, END OF SWITCH SO GET A NEW ONE
JRST OUTSW3 ;NO, LOOP UNTIL DONE
REP 3/67 ;09C77
DEFINE X (A,B,C,D,E,F,G)<
<SIXBIT /C/>>
PRCNAM: PROCESS
DEFINE X (A,B,C,D,E,F,G)<
WIT
XALL
DEFINE X (A,B,C,D,E,F,G,H)<
<SIXBIT /C/>>
PRCNAM: PROCESS
DEFINE X (A,B,C,D,E,F,G,H)<
REP 16/67 ;09C78
DEFINE X (A,B,C,D,E,F,G)<
WIT
DEFINE X (A,B,C,D,E,F,G,H)<
REP 23/67 ;09C79
DEFINE X (A,B,C,D,E,F,G)<
SIXBIT /E/>
INTEXT: PROCESS
IFN SPRC,< DEFINE X (A,B,C,D,E,F,G)
WIT
DEFINE X (A,B,C,D,E,F,G,H)<
SIXBIT /E/>
INTEXT: PROCESS
IFN SPRC,< DEFINE X (A,B,C,D,E,F,G,H)
REP 33/67 ;09C80
DEFINE X (A,B,C,D,E,F,G)<
SIXBIT /F/>
DEBAID: PROCESS
DEFINE X (A,B,C,D,E,F,G)<
"G">
SEPTAB: PROCESS
WIT
DEFINE X (A,B,C,D,E,F,G,H)<
SIXBIT /F/>
DEBAID: PROCESS
DEFINE X (A,B,C,D,E,F,G,H)<
"G">
SEPTAB: PROCESS
;[463] SETUP PROCESS FLAGS IF ANY
DEFINE X (A,B,C,D,E,F,G,H)<
IFNB "H",< XWD H,0> ;;put flags in left half(arbitrary)
IFB "H",< EXP 0 > ;;no process flags
>
PRCFLG: PROCESS
INS 45/67 ;09C81
SALL
REP 3/69 ;09C82
DOCOPY: ;[430] REMOVE TWO LINES
WIT
DOCOPY: MOVEI T2,<<^D29+^D11>*1000>-1 ;[461] USE 29P LOW WITH 11P HIGH
MOVEM T2,RUNCOR ;[461] STORE CORE ARGUMENT
INS 1/70 ;09C83
SUBTTL LABEL/TAPE ID
IDENT: TRO FL,PIPF ;WHY NOT, IT IS PIP
PUSHJ P,SCANAM ;GET DEVICE
MOVEI T3,CHNPIP ;PIP TMP FILE
SKIPN T2,SVDEV ;DEVICE SPECIFIED?
GOTO XPDERR ;NO, ERROR
PUSHJ P,OUTDEV ;YES, USE IT
SKIPN T2,SVNAM ;FILENAME = TAPE ID
JRST [PUSHJ P,TAPEID ;NO, USING DELIMITERS
JRST IDENT1] ;FINISH OFF ID WITH UP ARROW
MOVEI T1,"^" ;PIP EXPECTS ^ AS DELIMITER
PUSHJ P,TMPOUT
PUSHJ P,OUTSIX ;OUTPUT SIXBIT LABEL
MOVEI T1,"^" ;AND DELIMITER
PUSHJ P,TMPOUT
IDENT1: MOVEI T1,"="
PUSHJ P,TMPOUT
PUSHJ P,OUCRLF ;FINISH LINE
PUSHJ P,SCAN ;SEE WHATS NEXT
CAIN C,"," ;MORE
JRST IDENT ;YES
JRST OPIP2 ;NO GIVE UP
REP 7/74 ;09C84
PUSHJ P,TMPOUT ;OUTPUT THE S
SKIPE T2,SVDEV ;AND A DEVICE SEEN [441] else skip
WIT
TRNE FL,TECOF ;[455] DO WE WANT TECO?
MOVEI T1," " ;[455] YES, PASS A SPACE
PUSHJ P,TMPOUT ;OUTPUT THE S
SKIPE T2,SVDEV ;[441] AND A DEVICE SEEN ELSE SKIP
REP 41/76 ;09C85
JRST LTPS1 ;SHIFT AND TRY AGAIN [441] use LTPS1
WIT
JRST LTPS1 ;SHIFT AND TRY AGAIN
INS 36/81 ;09C86
;
; This routine will output ONAM with a /SAVE (/SSAVE)
; and check to see where in the flow it is. If it is the
; first output out to the LNK tmpcor file, then it puts a
; comma after. If there is already output there, it prefixes
; a comma.
;
OUTSAV: PUSH P,T3 ;[444] PUSH THE CURRENT CHAN NO. DOWN
MOVEI T3,CHNLNK ;[444] SET CHAN NO. FOR LINK
TRNE FL,LODOUT ;[444] IS OUTPUT THERE?
SKIPA T1,[","] ;[444] YES, SO PREFIX WITH A COMMA
TRNA ;[444] A PSUEDO SKIP TO KEEP FLOW
PUSHJ P,TMPOUT ;[444] OUTPUT THE COMMA AND CONTINUE
SKIPE T2,ODEV ;[444] OUTPUT DEVICE THERE?
PUSHJ P,OUTDEV ;[444] YES, OUTPUT IT
MOVE T2,SVDEV(SVPT) ;[444] GET THE CURRENT DEV NAME
MOVEM T2,ODEV ;[444] AND MAKE IT THE OUTPUT DEV
MOVE T2,ONAM ;[444] GET OUTPUT FILENAME
PUSHJ P,OUTSIX ;[444] PUT IT OUT THERE
MOVE T2,SVNAM(SVPT) ;[444] GET CURRENT FILENAME
MOVEM T2,ONAM ;[444] STORE IT AS OUTPUT NAME
SKIPE T2,OEXT ;[444] GET OUTPUT EXTENSION
PUSHJ P,OUTEXT ;[444] PUT IT OUT IF THERE
SETZM OEXT ;[453] CLEAR OUTPUT FILE EXTENSION
MOVE T2,SAVSW ;[444] GET THE SWITCH AGAIN
PUSHJ P,OUTSIX ;[444] OUTPUT IT
MOVEI T1,"," ;[444] THIS IS THE OUTPUT FILE
TRNN FL,LODOUT ;[444] IS THERE ALREADY OUTPUT THERE?
PUSHJ P,TMPOUT ;[444] NO, SO OUTPUT A COMMA, ELSE DON'T
POP P,T3 ;[444] PUT THE ORIGINAL CHAN NO. BACK
POPJ P, ;[444] AND RETURN
REP 49/83 ;09C87
TMPDS2: HLRZ T1,PROCTB(T3) ;GET PROCESSOR
WIT
TMPDS2: HLLZ T1,PROCTB(T3) ;[566] GET TMPCOR FILE
MOVEM T1,TMPFIL ;[566] TO DELETE
SETZM TMPFIL+1 ;[566] ZERO I/O WORD
MOVE T1,[2,,TMPFIL] ;[566] DELETE TMPCOR FILE
TMPCOR T1, ;[566]
JFCL ;[566] MUST NOT BE ONE
HLRZ T1,PROCTB(T3) ;GET PROCESSOR
REP 1/85 ;09C88
SUBTTL TABLE OF PROCESSOR NAMES
DEFINE X (A,B,C,D,E,F,G)<
WIT
SUBTTL TABLE OF PROCESSOR NAMES
DEFINE X (A,B,C,D,E,F,G,H)<
INS 1/86 ;09C89
SUBTTL COMPILER TYPE TABLE
;[462] EXPAND CMPTBL MACRO INTO COMPILER TYPES AND PROCESSOR FLAGS
; A = compiler type code
; B = processor flags to set in FL2
;
DEFINE X(A,B),<
IFLE A,< .CMPTD==1 ;;crock it once
> ;;ENDIFE
IFG A,< .CMPTD==A-.CMPTC ;;calc dif in entries
> ;;ENDIFG
IFLE .CMPTD,<
PRINTX ?CMPTBL IS OUT OF ORDER
.CMPTD==1
>;;ENDIFLE ;;make a best guess at this point
REPEAT .CMPTD-1,<
XWD 0,UNKSW ;;not used
>;;END REPEAT
IFDEF B,<
XWD 0,B ;;Code A
> ;;ENDIFDEF
IFNDEF B,<
XWD 0,UNKSW ;;Zero entry, not defined here
> ;;ENDIFNDEF
.CMPTC==A ;;set our counter
>;;ENDDEF X
CMPCOD: CMPTBL
CMPLEN: .-CMPCOD-1 ;[462] length of table
REP 8/86 ;09C90
WIT
WORDS <SWGKB,SWGKL,SWGKS> ;[447]
U (SWGLK,SWBK+1) ;[447]
INS 29/86 ;09C91
U (DSKBUF,1) ;[564] DISK BUFFER ADDRESS
REP 20/87 ;09C92
XWD LOOKBF,LOOKBF
DSKLK: 1
SIXBIT /DSK/
XWD LOOKBF,LOOKBF
WIT
XWD 0,LOOKBF ;[462] NO NEED FOR OUTPUT BUFFER
DSKLK: 1
SIXBIT /DSK/
XWD 0,LOOKBF ;[462] DON'T USE UNNECESSARY OUTPUT BUFFER
DEL 51/87 ;09C93
>
SUM 54278