Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
compil.mac
There are 5 other files named compil.mac in the archive. Click here to see a list.
TITLE COMPIL 22C(307) CCL CONTROL CUSP
SUBTTL WEIHER/CLEMENTS/RCC/PMH/NGP/DMN/HPW/JNG/SMM/JMT 28-JUL-76
SUBTTL PROGRAM TO COMPILE LOAD EXECUTE AND DEBUG USER PROGRAMS
VCOMPIL==22
VUPDATE==3 ;DEC UPDATE LEVEL
VEDIT==307 ;EDIT LEVEL
VCUSTOM==0 ;NON-DEC UPDATE LEVEL
;THE ORIGINAL VERSION OF
;THIS PROGRAM WAS WRITTEN AT THE STANFORD UNIVERSITY
;ARTIFICIAL INTELLIGENCE LABORATORY BY WILLIAM F. WEIHER.
;MR. WEIHER'S COOPERATION, AND THAT OF THE A-I LABORATORY,
;ARE GRATEFULLY ACKNOWLEDGED.
;
;CONVERTED TO MACRO SOURCE LANGUAGE FROM FAIL ON
;1 NOVEMBER 68 BY R CLEMENTS
;***COPYRIGHT 1976, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
INTERN VCOMPILE,.JBVER ;FOR LOADER MAP AND LIBRARY
LOC <.JBVER==137>
<VCUSTOM>B2+<VCOMPIL>B11+<VUPDATE>B17+VEDIT
RELOC 0
IFNDEF TEMP,<TEMP==1> ;TEMP=1 ALLOWS THE TMPCOR UUO TO BE USED
IFNDEF RUNSW,<RUNSW==1> ;NON-ZERO TO USE THE RUN UUO
IFNDEF PURESW,<PURESW==1> ;NON-ZERO FOR A SHARED VERSION OF COMPIL
IFNDEF STANSW,<STANSW=0> ;NON-ZERO TO INCLUDE STANFORD FEATURES
IFN STANSW,<FAIL==1>
IFNDEF LSTRSW,<LSTRSW=0> ;NON-ZERO TO USE "LISTER" INSTEAD OF PIP
;FOR TYPE AND LIST COMMANDS
IFNDEF SAVEXT,<SAVEXT=='SAV'> ;USE DMP FOR PDP6'S
IFNDEF FASTFS,<FASTFS=0> ;FASTEST FILE STRUCTURE
;IF ZERO COMPIL WILL FIND IT AT RUN TIME
IFNDEF DIRSW,<DIRSW==1> ;USE DIRECT CUSP IF NON-ZERO
IFNDEF TENEX,<TENEX==0> ;CHANGES FOR TENEX OPERATION
IFN TENEX,<
FAIL==1
SFDSW==0
DEBSW==1
>
IFNDEF SNOBOL,<SNOBOL==1> ;ACCEPT SNOBOL AS A COMPILER
IFNDEF MACY11,<MACY11==1> ;[203] ACCEPT MACY11 (PDP-11) ASSEMBLER
IFNDEF BLISS,<BLISS==1> ;ACCEPT BLISS COMPILER
IFNDEF FAIL,<FAIL==1> ;[202] FAIL ASSEMBLER
IFNDEF SAIL,<SAIL==1> ;SAIL COMPILER
IFNDEF PAL10,<PAL10==0> ;PAL10 ASSEMBLER (NO CCL INTERFACE YET)
IFNDEF DEBSW,<DEBSW==0> ;DEBUGGING AIDS IF NON-ZERO
IFNDEF SFDSW,<SFDSW==1> ;ENABLED FOR SUB-FILE DIRECTORY
IFN SFDSW,<IFNDEF SFDLEN,<SFDLEN==5>> ;LENGTH ALLOWED
IFDEF SFDLEN,<IFLE SFDLEN,<SFDSW==0>> ;NO SFD'S IF LENGTH.LE.0
IFNDEF MANTIS,<MANTIS==0> ;SPECIAL F4 DEBUGGER
IFNDEF FORTRAN,<FORTRAN==1> ;NON-ZERO IF BOTH F40 AND FORTRAN-10 ALLOWED
IFNDEF DFORTRAN,<DFORTRAN==1> ;DEFAULT VALUE 0=F40, 1=FORTRAN-10
IFNDEF LINK10,<LINK10==1> ;0 FOR LOADER, 1 FOR LINK-10
IFNDEF EDITOR,<EDITOR=='LINED '>;EITHER LINED OR EDITS
SUBTTL REVISION HISTORY
;START OF VERSION 22A
;144 PASS FORTRAN-10 SWITCHES IN () CORRECTLY
;145 (10405) CLEAR .JBSA & JOB NAME SO START, RUN, GET FAIL
;146 MAKE ERROR MESSAGES CONFORM TO STANDARD CMLxxx
;147 (9096) MAKE TECO COMMAND ACCEPT SWITCHES IN ()
;150 TEST FOR LINK/LOADER CONFLICT AND WARN USER
;151 (9949) FIX TO RECOMPILE LIBRARY FILE WITH NULL EXT
;152 FIX TO RECOMPILE FILE IF TEMP /COM BUT PERMANENT /REL
;153 MAKE LINK-10 & FORTRAN-10 THE DEFAULT
;154 (11535) FIX COPY WITH TAPEID AND SWITCH BEFORE =
;155 (10817) FIX TYPO IN SFDPPN ROUTINE
;156 ADD DATE75 HACK
;157 READ SVC FILE IF ONLY SWITCHES HAVE BEEN SEEN (NO FILE NAME)
;160 FIX ILL MEM REF FROM ZERO COMMAND WITH NO ARGS
;161 (11209) ?COMMAND ERROR: .Y WITH DEL X.,*.Y; DON'T SCAN OFF COMMA AT GETN1+5
;162 FIX PC OUT OF BOUNDS
;163 REVERSE ORDER OF LOOKUPS SO FORTRAN IS FIRST
;164 LOAD CORRECT REL FILE IN LOAD FOO.BIN=FOO[PPN] WHERE BOTH FILES ON [PPN]
;165 GET STACK CORRECT ON DEBUG /LINK A+<B,C>
;166 (11466) CORRECT TECO COMMAND STRING IF [PPN] PRESENT
;167 (11643) ACCEPT "_" FOR "=" IN RENAME AND COPY
;170 TYPE RUN UUO ERROR CODES IN OCTAL
;171 MAKE CODE MORE READABLE
;172 FIX TYPO AT NOCOM3 + 3
;173 (11377) PASS ()'D SWITCHES TO COMPILERS IN ()'S (EXCEPT F10)
;174 (10945) LOADER NEEDS /N OR /L ON EACH FILE
;175 (11831) DO NOT TEST FOR .REL ON /COMP
;176 (11620) FIX ADDRESS CHECK ON EX DSKC:A,B (A.F4)
;177 FIX EDIT 173
;200 EXTEND EDIT 153
;201 EDIT 161 KILLED <progname> . / <switch>
; REDO EDIT 161 AND ALLOW [P,PN] IN <progname>.[P,PN]
; AS A SIDE EFFECT
;202 TURN FAIL ON
;203 CHANGE MACX11 TO MACY11 AND TURN MACY11 ON
;START OF VERSION 22B
;204 (12705) IMPLEMENT NEW ERROR MESSAGE IF NO PREVIOUS COMMAND
;205 (12994) GIVE ERROR MESSAGE IF NO COMMAND TO RESCAN
;206 (12705) EXTEND EDIT #145 TO ALL POSSIBLE "EXIT"S
;207 (13072) ALLOW COMPILATION OF FILE WITH NULL EXTENSION
;210 (12259) FIX SO THAT TECO COMMAND CAN BE TERMINATED WITH ALTMODE
;211 (13801) FIX BUG IN #205 WHICH MAKES DEBUGGING HARD
;212 (13036) PUT OUTPUT EXTENSION IN A TABLE
;213 GIVE EDR ERROR ON MTA OPERATION WITH NO DEVICE SPECIFIED
;214 (12998) OUTPUT /C RATHER THAN /T ON TYPE COMMAND
;215 (12993) DELETE CODE TO RUN RANDOM CUSPS, ITS NEVER USED
;216 (13000) ALLOW MAKE AND TECO WITH NO PREVIOUS COMMAND RUN TECO
;217 TURN SAIL ON AND ADD SDDT FOR FAIL AND SAIL
;220 fix /debug switch for link-10 to contain the process name
;221 ADD SUPPORT FOR FORDDT, /DEBUG, /FORDDT
;222 (11911) ADD ERROR MESSAGE IF USER TRIES TO USE F40 AND F10 IN SAME COMMAND
;223 (12374) REMOVE UNNECESSARY CORE UUO
;224 (12162) FIX BUG IN MAKE [1,3] WHICH CAUSES COMPIL TO GROW WITHOUT LIMIT
;225 (12992) TRY NULL EXTENSION AFTER CMD EXTENSION
;226 (11977) GIVE BETTER MESSAGE IF @DEV DOES NOT EXIST
;227 (12051) FIX VARIOUS COPY BUGS
;230 (13351) FIX ILL MEM REF IF /MAP SPECIFIED AND NOT LOADING
;231 (13881) GIVE ERROR IF PROTECTION CODE GREATER THAN 3 CHARACTERS
;232 (12269) BACKUP CHAR COUNT AS WELL AS BYTE PTR IN SCANS
;233 (12273) USE "=" RATHER THAN "-" WHERE EVER POSSIBLE FOR .TMP FILES
;234 (11937) IMPLEMENT /SAVE SWITCH TO PASS COMMAND TO LINK-10
;235 MAKE /FOR AND /MAC UNIQUE
;236 (13963) FIX EDIT #174 TO PUT OUT /L OR /N ONLY IF NEEDED
;START OF VERSION 22C
;237 (14041) THE COMMAND "PROT DSKA:UFD[,]<765>" WORKED DUE
; TO A PIP BUG. IMPLEMENT UFD'S CORRECTLY. (JNG)
;240 (14125) ON A TECO, COMPILE, LOAD SEQUENCE, COMPIL OFTEN
; RECOMPILES AT THE LOAD. DIAGNOSIS: CREATION DATE IS ACCURATE
; ONLY TO THE NEAREST MINUTE. FIX: DO EXTENDED LOOKUPS FOR
; .RBTIM (1/3 SEC.) IF DEVICE IS A DISK. (JNG)
;241 (14082) FIX MEMORY MANAGEMENT PROBLEM WITH REL FILE I/O BUFFERS
; OVERWRITING TMPCOR BUFFERS. (JNG)
;242 (14087) DELAY DECIDING FORMAT OF FOROTS/FORSE SWITCH TO ALLOW
; "COMP/FOROTS/LINK" TO WORK. (JNG)
;243 (14732) ALLOW A DEVICE TO BE SPECIFIED FOR TMP FILES. THIS
; WAS BROKEN BY EDIT 226. (JNG)
;244 (14663) USE USER'S DEVICE FOR REL FILE IF HE GAVE ONE.
;245 (14409) ADD SOME SYNTAX CHECKING TO THE PROTECT COMMAND.
;246 (14678) IGNORE FILES IN USER'S LIBRARY IN PREFERENCE TO
; THOSE IN HIS DEFAULT PATH.
;247 DON'T TRY TO COMPILE REL FILES WITH NO ACCOMPANYING SOURCES.
; THIS WAS BROKEN BY EDIT 240.
;250 TRY LIBRARY IF USER GAVE AN EXTENSION AND FILE IS NOT IN THE
; DEFAULT PATH. THIS WENT DOWN WITH EDIT 246.
;251 IMPLEMENT DLIST SWITCH TO SPECIFY LIST FILE SPECIFICALLY
; ON DISK, LIST WILL NOW SPECIFY TO INIT DEVICE LPT: WHETHER
; SPOOLED OR UNSPOOLED
; AREAS AFFECTED: STABLE MACRO DEFINITION, ATABLE MACRO DEFINITION
; DOCOM2
; LABELS ADDED: SETDSK,SETLPT
;252 (14995) ALLOW SLASH FOR MULTIPLE CHARACTER SWITCHES TO ALGOL
; AREAS AFFECTED: PROCS1
;253 COMPLETE EDIT 243
; AREAS AFFECTED: NEST
;254 MAKE DEVICE SPECIFICATIONS "STICKY"
; AREAS AFFECTED: GETDEV,NODEV
; LABELS ADDED: SVDEVV
;255 (15503) FIX MANTIS FEATURE SO THAT WHEN MORE THAN ONE
; PROGRAM IS COMPILED, ALL PROGRAMS GET THE /D SWITCH SET.
; NOTE THAT MANTIS IS UNSUPPORTED. AREA AFFECTED - ONSET
;256 (15575) MAKE /SAVE AND /SSAVE PRODUCE THE CORRECT
; COMMAND FILE TO LINK.
; AREAS AFFECTED - SSAVE & NOCOMP & LODR1
;257 (15711) MAKE LINK LOAD LOCAL SYMBOLS FOR /LMAP SWITCH
; AREAS AFFECTED: SETMPL
;260 (16101,16201) BANDAGE COMPIL AFTER MAULING BY EDIT 254
; AREAS AFFECTED: GETDEV, NOTCPY
;261 (16120)MAKE COMPIL RESPECT ALL DOCUMENTED BREAK CHARACTERS
; AREAS AFFECTED: CTBL
;262 (16412)EDIT 241 CAN CAUSE COMPIL TO GROW BY 1K NEEDLESSLY
; AREAS AFFECTED: RPGRET
;263 (16558)INVALID LOGIC IS USED FOR CONVERTING UFD PROTECTION.
; IT CAN STOP TOO EARLY.
; AREAS AFFECTED: UFDSET
;264 (16648)COPY A.=A1,A2 DOESN'T WORK LIKE COPY A=A1,A2
; AREAS AFFECTED: NXTNM2,NOTCPY
; LABELS ADDED: NXTNOX
;265 (16774)EDIT 212 HAD ERROR - JFFO WON'T WORK PROPERLY
; IF AN UNRECOGNIZED PROCESSOR IS SPECIFIED BY EXTENSION
; AREAS AFFECTED: REREL0
;266 (16808) COMPIL LOSES ACTUAL REASON FOR LOOKUP ERROR
; AREAS AFFECTED: NOFIL, NOTYT2, LOSE1
;267 (16937)"STICKY" DEVICE NAMES ARE STILL TOO STICKY WITH EDIT 244
; AREAS AFFECTED: SETONM
;270 (17022) MAKE ".PROT <777>[,].UFD" WORK, & CLEAN UP DEFAULTING.
; AREAS: DOPROT
;271 (17329) ALLOW TRAILING ASTERISK WILDCARDS IN PIP COMMANDS.
; AREAS: SCAN
;272 (18957) ALLOW THREE AND ONLY THREE #'S IN RENAMES
; PROTECTION SPECIFICATION.
; AREAS: NXTNM0
;273 (18542) REMOVE EDIT #216, TECO,MAKE, ETC. SHOULD
; GIVE "NO PREVIOUS COMMAND" ERROR AS DOES LOAD , ETC.
; AREAS: NOFIL
;274 (18807) A PPN OF LEFT SIDE OF AN "=" IN A COMPILE-CLASS
; COMMAND CAN BE IGNORED !
; AREAS: DOCOMP, DOCOM3, ELOD3, ENTC2
;275 (17540) PPN NOT PASSED TO LINK TMP FILE CORRECTLY ON
; "+" CONSTRUCTIONS.
; AREAS AFFECTED: LODR2
;276 IF ENTER ON TMP FILE FAILS, TRY GENERIC DEVICE DSK
; AREAS AFFECTED: NOFIT, TMPDS0
;277 SETZ SHOULD BE A SETZM WHICH CAN CAUSE A RUN
; UUO FAILURE BECAUSE PPN WORD IS -1. COULD CAUSE
; OTHER UNPREDICTABLE RESULTS SINCE AC 0 IS CLEARED. ?
; AREA AFFECTED: RUNIT
;300 (19716) BLANK LINES AT THE BEGGINING OF A COMMAND FILE
; CAN CAUSE UNWARRANTED COMMAND ERRORS.
; AREAS AFFECTED: SYNERP, SCNAGN
;301 EDIT #300 FIXED AN AGE OLD BUG WHICH WAS PARTIALLY
; FIXED BY A TEMPORAY PATCH AT LOCATION POPFIL.
; WITH EDIT #300 AND THIS PATCH IN, AN ILL MEM REF
; WILL OCCUR WHEN ANY PIP COMMAND IS TYPED WITH NO
; ARGUMENT, THEREFORE REMOVE THIS PATCH !
; AREA AFFECTED: POPFIL
;302 IN ANSWER TO SPR# 17024, AN EDIT #272 WAS MADE
; AND UNFORTUNATLY WAS LOST. THIS EDIT REPLACES
; THAT EDIT AND ONCE AGAIN FIXES A STICKY DEVICE/PPN
; PROBLEM. DEVICES AND PPN'S AS SWITCH ARGUMENTS
; SHOULD NOT STICK.
;303 IN ANSWER TO SPR# 17989, ANOTHER EDIT #272 WAS
; GENERATED AND ALSO UNFORTUNATELY LOST. THIS
; EDIT REPLACES THAT ONE AND MAKES THE DEFAULT
; DEBUGGING AIDE FOR FORTRAN TO BE FORDDT WITH
; REGULAR DDT ALSO LOADED.
;304 AS A SIDE AFFECT OF EDIT #301, LABEL DEV:/ABC/
; WAS BROKEN. REMOVE EXTRA CALL TO SCAN GENERATED
; BY EDIT #154.
; AREA AFFECTED: IDENT3
;305 EDIT #300 IS INCOMPLETE AND CAUSED MANY SIDE AFFECTS.
; EDIT #301 ATTEMPTED TO FIX ONLY ONE OF THESE EFFECTS
; AND DID NOT FIX THE FULL SCOPE OF RELATED PROBLEMS.
; THIS EDIT COMPLETES THE FIX EDIT #300 ATTEMPTED,
; SUPERCEDES EDIT #301 (PUT TEMP. PATCH BACK),
; AND ELIMINATES THE SUBTLE SIDE AFFECTS
;306 IF NO DEVICE IS SPECIFIED FOR A REWIND OR UNLOAD
; COMMAND, THE ERROR MESSAGE SHOULD INDICATE
; "? EXPLICITE DEVICE REQUIRED" RATHER THAN
; "? COMMAND ERROR"
; AREA AFFECTED: NOMTPD
;307 (QAR#484)SPACES AFTER A DEVICE SPECIFICATION ARE
; IGNORED AND DO NOT TERMINATE THE FILE SPECIFICATION.
; THEY SHOULD !
; AREA AFFECTED:GETDEV
SUBTTL ASSIGNMENTS
;ACS
P=17 ;PUSHDOWN POINTER
C=16 ;CHARACTERS RETURNED HERE
CS=15 ;CHARACTER STATUS BITS HERE
SVPT=14 ;POINTER TO CURRENT FILE IN LIST OF FILES (AOBJN)
SWPT=13 ;BYTE POINTER INTO SWITCH STORAGE AREA
SWCNT=12 ;NUMBER OF BYTES LEFT FOR SWITCH STORAGE
FL3=11 ;FLAG REGISTER (LEFT HALF IS GLOBAL SWITCHES)
FL2=10 ;FLAG REGISTER (LEFT HALF INDICATES PROCESSOR)
;RIGHT HALF IS DEFAULT LOCAL PROCESSOR (SET BY /F ETC)
IOP=7 ;PDL FOR INPUT NESTING
IOPNT=6 ;POINTER TO CURRENT INPUT FILE
T5=5 ;USED IN OUTPUT ROUTINES ONLY (DMN)
T4=4 ;TEMPORARY ACCUMS
T3=3
T2=2
T1=1
FL=0 ;FLAG REGISTER (LEFT HALF LOCAL SWITCHES)
;(RIGHT HALF MISC BITS)
IFN PURESW,<IFE RUNSW,<
PRINTX ;ASSEMBLY SWITCHES CONFLICT>>
SALL ;SUPPRESS ALL MACROS AND REPEATS
MLON
IFN TENEX,<
SEARCH STENEX ;GET THE TENEX OPERATION CODES
OPDEF RESET [CALLI 0] ;THE ONLY CONFLICTING JSYS/CALLI
>
IFE DEBSW,<OPDEF GOTO [JRST]>
IFN DEBSW,<OPDEF GOTO [PUSHJ P,] ;LEAVE TRACES IN STACK>
IFE SFDSW,<PDL==100 ;LENGTH OF PDL>
IFN SFDSW,<PDL==200 ;NESTING TAKES UP MORE SPACE>
SWBK==5 ;NUMBER OF WORDS FOR SWITCHES TO PROCESSOR
LODSCT==^D40+^D40*LINK10 ;NUMBER OF LOADER SWITCHES PER FILE ALLOWED
DEBSIZ==5 ;[221] NO. OF WORDS OF FORDDT SWITCHES
.TYSPL==(1B13) ;DEVTYP BIT FOR SPOOLING
.RBSIZ==5 ;[240] LAST WORD USED IN 4-WORD LOOKUP
.RBTIM==35 ;[240] INTERNAL CREATION DATE OF DSK FILE
DV.DSK==(1B1) ;[240] DEVICE IS A DSK
FRSCOD==1 ;[242] MEANS USE FORSE
FRTCOD==2 ;[242] MEANS USE FOROTS
;FLAGS (RH OF FL)
PROCS==1 ;PROCESSOR SWITCHES SEEN
DOLOD==2 ;WE WANT TO DO LOADING
PCM1==4 ;FIRST COMMA SEEN IN PROCESSOR SWITCHES
PCM2==10 ;SECOND COMMA SEEN
IDF==20 ;SCAN SAW AN IDENTIFIER
LODOUT==40 ;SOME OUTPUT HAS BEEN DONE TO LOADER
SOSF==100 ;SOS FOR AN EDITOR?
PERF==200 ;PERMANENT TYPE FLAGS
LINKFL==400 ;LINK-10 REQUIRED (RATHER THAN LOADER)
CMDSN==1000 ;THE COMMAND SHOULD BE WRITTEN AS SVC OR EDS
INCRF==2000 ;WE ARE FINISHING CREF OUTPUT
INPRNT==4000 ;WE ARE PRINTING A CHARACTER STRING IN ERROR MSG
PIPF==10000 ;DOING SOMETHING FOR PIP
EDITF==20000 ;IN EDIT OR CREATE
CREATF==40000 ;CREATE
FFLG==PCM1 ;/F FLAG IN DIRECTORY COMMAND
LPTFG==PCM2 ;/L FLAG IN DIRECTORY COMMAND
NODAT==PCM1 ;FILE FROM OTHER THAN DSK
NOLOOK==PCM2 ;LOOKUP FAILED
TECOF==100000 ;WE WANT TECO
RECALF==200000 ;WE ARE READING A COMMAND SAVE FILE
F.STKY==400000 ;[302] DEVICE'S AND PPN'S SHOULD NOT STICK
;TABLE OF NEW DEVICES
DEFINE DEVICE<
X NEW,NEW
X OLD,OLD
X SYS,SYS
X SELF,DSK
>
;FLAGS (SWITCH TYPE)
LISTSW==1 ;DO LISTING
CRSW==2 ;DO A CREF
LIBSW==4 ;DO A LIBRARY SEARCH OF THIS FILE
DEBUGSW==10 ;[221] COMPIL SPECIAL CODE FOR FORDDT
COMPLS==20 ;COMPILE REGARDLESS OF DATES
NOBINSW==40 ;DON'T DO A REL FILE
MANTSW==100 ;COMPIL SPECIAL MANTIS CODE IF F4
NOMANTSW==200 ;DON'T
F40SW==400 ;COMPILE FORTRAN WITH F40
F10SW==1000 ;COMPILE FORTRAN WITH FORTRAN-10
KA10SW==2000 ;COMPIL CODE FOR KA-10
KI10SW==4000 ;COMPIL CODE FOR KI-10
CPUSW==KA10SW!KI10SW ;SPECIFIC CPU REQUIRED
OPTSW==10000 ;OPTIMIZED CODE
NOPTSW==20000 ;NON-OPTIMIZED CODE
;NEWSW==(1B0) ;USE DEVICE NEW:
;OLDSW==(1B1) ;USE DEVICE OLD:
;SYSSW==(1B2) ;USE DEVICE SYS:
;SELFSW==(1B3) ;USE DEVICE DSK:
DEVSW==(1B0) ;INITIAL VALUE
DEVSWS==0 ;SUM OF DEVSW
DEFINE X(A,B)<
A'SW==DEVSW
DEVSWS==DEVSWS!DEVSW
DEVSW==DEVSW_-1>
DEVICE
REPEAT 0,< THE MACRO PROCESS DEFINES DETAILS ABOUT THE VARIOUS
PROCESSORS WHICH COMPILE IS EXPECTED TO HANDLE BY CALLING
THE MACRO X WHICH IS REDEFINED TO PRODUCE THE INFORMATION REQUIRED.
THE ARGUMENTS ARE :-
A SWITCH NAME
B EXTENSION
C PROCESSOR NAME
D <OPTIONAL>EXTENSION OF NEXT PROCESSOR IF MUST BE PROCESSED MORE THAN ONCE
E EXTENSION PRODUCED
F DEBUGGING AID USED ON DEBUG COMMAND (DDT IF NULL)
G SEPARATOR, EITHER "=" OR "_"
>
DEFINE PROCESS<
IFN DFORTRAN,<
IFN MANTIS,<X FORTRAN,FOR,FORTRAN,,,MANTIS,=>
IFE MANTIS,<X FORTRAN,FOR,FORTRAN,,,FORDDT,=>>
IFE DFORTRAN,<
IFN MANTIS,<X FORTRAN,FOR,F40,,,MANTIS,=>
IFE MANTIS,<X FORTRAN,FOR,F40,,,FORDDT,=>>
X MACRO,MAC,MACRO,,,,=
X COBOL,CBL,COBOL,,,COBDDT,=
X ALGOL,ALG,ALGOL,,,,=
IFN SNOBOL,<X SNOBOL,SNO,SNOBOL,,,,_>
IFN MACY11,<X MACY11,P11,MACY11,,OBJ,,_>
IFN BLISS,<X BLISS,BLI,BLIS10,,,,=>
IFN FAIL,<X FAIL,FAI,FAIL,,,SDDT,_>
IFN SAIL,<X SAIL,SAI,SAIL,,,SDDT,_>
IFN PAL10,<X PAL10,PAL,PAL10,,,,=>
>
DEFINE XPROCESS<
X LOADER,LOD,LOADER
X LINK,LNK,LINK
X CREF,CRF,CREF
X PIP,PIP,PIP
X EDT,EDT
IFN LSTRSW,<X LIST,LST,LISTER>
>
;PROCESSOR FLAGS IN FL2
RELSW==1 ;DO A LOAD ONLY ON THIS FILE (PROCESSOR IS LOADER)
ALPROC==RELSW ;OR OF BITS FOR ALL THE PROCESSORS
NPROCS==0 ;NUMBER OF PROCESSORS
PROCBIT==400000 ;USE TO ASSIGN PROCESSOR FLAGS
MXPROC==^D17 ;MAXIMUM PROCESSORS ALLOWED (REAL COMPILERS)
XTPROC==0 ;EXTRA "PROCESSORS (PIP,LOADER, ETC)
SPRC==0 ;BITS FOR THOSE PROCESSORS WHICH OUTPUT TO ANOTHER
DEFINE X (A,B,C,D,E,F,G)<
CHN'B==NPROCS ;INDEX TO OUTPUT ROUTINE
B'SW==PROCBIT ;PROCESSOR BIT
IFDIF <D><>,<SPRC==SPRC!PROCBIT>
ALPROC==ALPROC!PROCBIT
NPROCS==NPROCS+1
PROCBIT==PROCBIT_-1>
PROCESS
IFG NPROCS-MXPROC,<PRINTX TOO MANY PROCESSORS DEFINED>
DEFINE X (A,B,C,D,E,F,G)<
CHN'B==MXPROC+XTPROC
XTPROC==XTPROC+1>
XPROCESS
IFE BLISS,<BLISW==0> ;MAKES TESTS EASIER AND NEATER
LOOK==0 ;CHANNEL FOR DOING LOOKUPS FOR INFORMATION
NFILE==^D40 ;NUMBER OF FILES PERMITTED IN A + CONSTRUCTION
IFNDEF NESTDP,<NESTDP==17> ;MAXIMUM NESTING DEPTH TO PERMIT
IFLE NESTDP,<NESTDP==17>
IFG NESTDP-17,<NESTDP==17>
SUBTTL MACROS
EXTERN .JBFF,.JBREL,.JBERR,.JBSA
%LOREL:! ;RELOCATABLE BEGINNING OF LOW SEGMENT
IFN PURESW,< TWOSEGMENTS
.ZZ:
RELOC 400000>
OPDEF STRING [TTCALL 3,]
OPDEF PJRST [JRST] ;POPJ RETURN
DEFINE SKIP (J)<JRST .+1+'J>
;MACROS FOR THE DATA STORAGE IN PURE AND IMPURE VERSIONS
DEFINE WORDS(A)<
IRP A,<
U(A,1)>>
IFE PURESW,<
DEFINE U(A,B)<
A: BLOCK B>>
IFN PURESW,<
DEFINE U(A,B)<
RELOC
A: BLOCK B
RELOC>>
SUBTTL COMMAND AND SWITCH TABLES
DEFINE CTABLE<
COMAND COMPILE,<TRZ FL,DOLOD>
COMAND LOAD,JFCL
COMAND DEBUG,<PUSHJ P,DEBUG>
COMAND EXECUTE,<PUSHJ P,XCTR>
COMAND EDIT,<TRO FL,EDITF>
COMAND CREATE,<TRO FL,EDITF!CREATF>
COMAND LIST,<JRST LISTR>
COMAND CREF,<JRST CREFIT>
COMAND DELETE,<JRST DODEL>
COMAND TECO,<TRO FL,EDITF!TECOF>
COMAND MAKE,<TRO FL,EDITF!TECOF!CREATF>
COMAND RENAME,<JRST DOREN>
COMAND TYPE,<JRST TYPR>
COMAND COPY,<JRST DOCOPY>
COMAND PRESERVE,<JRST DOPRES>
COMAND PROTECT,<JRST DOPROT>
COMAND REWIND,<JRST DOREW>
COMAND UNLOAD,<JRST DOUNLD>
COMAND ZERO,<JRST DOZERO>
COMAND ZER,<JRST DOZERO>
COMAND SKIP,<JRST DOSKIP>
COMAND BACKSPACE,<JRST DOBKSP>
COMAND EOF,<JRST DOEOF>
COMAND FUDGE,<JRST FUDGIT>
COMAND CTEST,<JRST TESTIT>
COMAND SOS,<TRO FL,EDITF!SOSF>
COMAND LABEL,<JRST IDENT>
IFE DIRSW,<
COMAND DIRECTORY,<JRST DODIR>
>>
DEFINE STABLE<
;[251]REMOVED SWITCH LIST,<XWD LISTSW,CRSW>
SWITCH CREF,<XWD CRSW!LISTSW,0>
SWITCH C,<XWD CRSW!LISTSW,0>
SWITCH SEARCH,<LIBSW,,0>
SWITCH LIBRARY,<LIBSW,,0>
SWITCH NOLIST,LISTSW
SWITCH NOSEARCH,LIBSW
;[251]REMOVED SWITCH L,<XWD LISTSW,CRSW>
SWITCH N,LISTSW
SWITCH COMPILE,<XWD COMPLS,0>
SWITCH NOCOMPILE,COMPLS
SWITCH NOBINARY,<NOBINSW,,0>
SWITCH BINARY,NOBINSW
SWITCH NODEBUG,DEBUGSW
IFN MANTIS,<SWITCH MANTIS,<XWD MANTSW,NOMANTSW!RELSW>
SWITCH NOMANTIS,<XWD NOMANTSW,MANTSW!RELSW>>
SWITCH F40,<F40SW,,F10SW>
SWITCH F10,<F10SW,,F40SW>
SWITCH KA10,<KA10SW,,KI10SW>
SWITCH KI10,<KI10SW,,KA10SW>
SWITCH OPTIMIZE,<OPTSW,,NOPTSW>
SWITCH NOPTIMIZE,<NOPTSW,,OPTSW>
SWITCH NEW,<NEWSW,,DEVSWS>
SWITCH OLD,<OLDSW,,DEVSWS>
SWITCH SYS,<SYSSW,,DEVSWS>
SWITCH SELF,<SELFSW,,DEVSWS>
>
DEFINE PTABLE<
SWITCH REL,<XWD RELSW,ALPROC>
SWITCH M,<XWD MACSW,ALPROC>
SWITCH F,<XWD FORSW,ALPROC>
SWITCH MA,<XWD MACSW,ALPROC>
SWITCH FO,<XWD FORSW,ALPROC>
SWITCH MAC,<XWD MACSW,ALPROC>
SWITCH FOR,<XWD FORSW,ALPROC>
PROCESS
>
DEFINE ATABLE<
SWITCH MAP,<0,,SETMAP>
SWITCH LMAP,<0,,SETMPL>
SWITCH FUDGE,<0,,SETFUD>
SWITCH DDT,<0,,SETDDT>
SWITCH FOROTS,<0,,FOROTS>
SWITCH FORSE,<0,,FORSE>
SWITCH LOADER,<0,,LOADIT>
SWITCH LINK,<0,,LINKIT>
SWITCH DEBUG,<0,,SETDEB>
SWITCH FORDDT,<0,,FORDDT>
SWITCH SAVE,<0,,SAVE>
SWITCH SSAVE,<0,,SSAVE>
SWITCH LIST,<0,,SETLPT> ;[251]
SWITCH L,<0,,SETLPT> ;[251]
SWITCH DLIST,<0,,SETDSK> ;[251]
SWITCH DL,<0,,SETDSK> ;[251]
>
SUBTTL RUN UUO
IFE RUNSW,<
NUNPNT==6
NUNTOP==7
EXTERN .JBDDT,.JBSA,.JBS41,.JBCOR
OFFSET==INHERE-74
NUNCOM: IOWD 0,INHERE
0
NUNGO2: CALLI 15,11 ;GET PROPER CORE SIZE
JRST NOCOR ;LOSE
IN 1,NUNCOM ;GET IT
JRST NUNGO3 ;OK
NUNERR: CALLI NUNPNT,3 ;WE LOSE, PRINT ERROR
CALLI 12
NUNERM: ASCIZ #?LINKAGE ERROR - I/O#
NUNGO3: SKIPE 12,OFFSET+.JBCOR ;GET JOBCOR
CAMG 12,.JBREL ;AND SEE IF WE SHOULD EXPAND
JRST NUNGO4 ;NO, START THE BLT
MOVEI NUNPNT,NUNCER
CALLI 12,11 ;YES, DO IT
JRST NUNERR ;LOSE
MOVE 12,OFFSET+.JBS41 ;RESET 41
MOVEM 12,41
JRST NUNGO4 ;WIN
NUNCER: ASCIZ /?CORE NEEDED/
INHERE:
NUNAC: PHASE 0 ;THE CODE TO GO IN THE ACS
NUNGO4: MOVE 12,OFFSET+.JBDDT;SET JOBDDT
CALLI 12,2 ;SET JOBDDT
NUNBLT: BLT NUNTOP,0
CALLI ;RESET THE WORLD
AOS 1,.JBSA ;GET STARTING ADDRESS
JRST (1)
NUNERM
XWD INHERE+1,75 ;THE BLT WORD
DEPHASE
%RNBLK==NAME-1
>
CREFIT: SKIPA T1,[SIXBIT /CREF/]
FUDGIT: MOVSI T1,'PIP'
NUNDO: MOVSI T2,1 ;START ADDR PLUS ONE
RUNIT: MOVEM T1,%RNBLK+1 ;[216] SET FILE NAME SINCE WE HAVE IT IN T1
RESET ;RESET THINGS
;**;[277] @RUNIT+2, JMT, 4-MAY-76
;**;DELETE SETZ %RNBLK+4 ;USE DEFAULT PPN
SETZM %RNBLK+4 ;[277] USE DEFAULT PPN
MOVE T1,RUNCOR ;GET CORE ARG (USUALLY 0)
MOVEM T1,%RNBLK+5 ;BUT NOT FOR COPY (^D10)
IFN RUNSW,<
SKIPN T1,PCDEV ;USE SPECIAL DEVICE IF SET
MOVSI T1,'SYS' ;GET SYS DEVICE
MOVEM T1,%RNBLK ;SET IT IN LOW SEG RUN BLOCK
SETZM %RNBLK+2 ;CLEAR EXTENSION - LET MONITOR CHOOSE
SETZM %RNBLK+3 ;THIS ALSO (DATE, TIME, ETC)
HRRI T2,%RNBLK ;GET LOWSEG ADDRESS OF RUN BLOCK
MOVSI T1,1 ;SET TO REMOVE HIGH SEGMENT
HRRI T1,%LENTH-1 ;REDUCE LOWSEG FOR SIMILAR REASON
MOVE T3,[%RUN1,,%LOREL] ;GET READY TO PHASE CODE INTO LOWSEG
BLT T3,%RNBLK-1 ;PERFORM THE TRANSFER
MOVEM T2,%RUNT2 ;INCASE OF FAILURE
JRST %LOREL ;DO UUO'S IN LOWSEG SINCE HIGH SEG GONE
%RUN1:
PHASE %LOREL
CORE T1, ;ALREADY SET UP IN HIGH SEG
JFCL ;DON'T CARE IF IT FAILS
%RUN: RUN T2, ;T2 ALREADY SET UP ABOVE
HRRZ T1,T2 ;GET ERROR CODE
CAIN T1,10 ;NOT ENOUGH CORE ERROR?
SKIPN %RNBLK+5 ;ONLY IF TOO MUCH ASKED FOR
JRST %RUN2 ;NO, U LOSE
SETZM %RNBLK+5 ;USE WHAT WE GET
SKIPA T2,.+1 ;RESET T2
%RUNT2: Z ;SET FROM HIGH SEG
JRST %RUN ;TRY AGAIN
%RUN2: OUTSTR RUNER1 ;WARN USER OF FAILURE
IDIVI T1,10 ;[170] MAY BE 2 DIGITS
JUMPE T1,.+3 ;NO, ONLY ONE
ADDI T1,"0" ;MAKE ASCII
OUTCHR T1 ;OUTPUT IT
ADDI T2,"0"
OUTCHR T2
OUTSTR RUNER2 ;REST OF MESSAGE
MOVE T2,%RNBLK ;PICK UP DEVICE
SETZ T1, ;CLEAR OUT JUNK
LSHC T1,6 ;MOVE LEADING CHARACTER INTO T1
MOVEI T1,40(T1) ;FORM ASCII
OUTCHR T1 ;PRINT IT
JUMPN T2,.-4 ;MORE TO GO
MOVEI T1,":" ;USUAL SEPARATOR
OUTCHR T1
MOVE T2,%RNBLK+1 ;FILE NAME
SETZ T1,
LSHC T1,6
MOVEI T1,40(T1)
OUTCHR T1
JUMPN T2,.-4
EXIT ;AND GIVE UP
RUNER1:! ASCIZ /?CMLRUF RUN UUO failure (/
RUNER2:! ASCIZ /) for /
%RNBLK:! ;SIZE OF PHASED CODE FOR BLT
%LENTH==%RNBLK+6 ;FOR CORE UUO WHICH INCLUDES RUN BLOCK
DEPHASE>
IFE RUNSW,<
NORUN: INIT 1,16 ;GET A DSK IN DUMP MODE
EXP SYSDEV ;SIXBIT SYS OR DSK
0
JRST DSKNA
MOVSI T1,SAVEXT ;SIXBIT FOR SAVE OR DMP.
MOVEM T1,NAME+1
LOOKUP 1,NAME
JRST NOFIL
MOVE T1,NAME ;SET NAME OF NEW PROCESSOR
CALL T1,[SIXBIT /SETNAM/]
HLRO 15,NAME+3 ;GET COUNT
HRLM 15,NUNCOM
MOVNS 15 ;MAKE POSITIVE
MOVEI 16,73(15) ;GET END
ADDI 15,INHERE ;CHECK CORE SIZE
IORI 15,1777
MOVSI NUNTOP,NUNAC
BLT NUNTOP,NUNTOP ;GET ACS LOADER
HRR NUNBLT,16 ;AND SET END OF BLT
JRST NUNGO2
>
SUBTTL SCANNER
TERMF==200000
NUMF==100000
SPCF==400000
SPACT==40000 ;SPECIAL ACTION TO BE TAKEN ON CHAR
SCANAM: PUSHJ P,SCAN ;GET NEXT CHAR. FIRST
GETNAM: SETZM SVNAM(SVPT) ;ZERO OUT CELLS IN CASE NOTHING
SETZM SVEXT(SVPT) ;GETS PUT THERE
SETZM SVPPN(SVPT)
SETZM SWBKS(SVPT)
SETZM SVDEV(SVPT)
IFN SFDSW,<X==0 ;INITIAL CONDITION
REPEAT SFDLEN,<
SETZM SVSFD+X(SVPT)
X==X+NFILE>
> ;END OF IFN SFDSW
GETNM0: TRNE FL,IDF ;[154] WAS THE THING SCANNED AN IDENT
JRST GETDEV ;YES, SEE WHAT WE'VE GOT
CAIE C,"[" ;MIGHT BE A PPN
JRST SYNERP ;NO, LOSE UNLESS A PIP COMMAND
PUSHJ P,GETPP1 ;READ THE PPN
PUSHJ P,SCAN ;AND GET RID OF "]"
;**;[305] @GETNM0 + 5 1/2, JMT, 21-JUN-76
SETOM INLFLG ;[305] SET IN-LINE FLAG
TRNE FL,PIPF ;[227] IS THIS PIP?
TRNE FL,IDF ;[227] YES, IDENTIFIER ALREADY SEEN?
JRST GETDEV ;[227] NO
POPJ P, ;IT IS, SO RETURN
;**;[305] @GETDEV, JMT, 21-JUN-76
GETDEV: SETOM INLFLG ;[305] SET IN-LINE FLAG
PUSH P,ACCUM
PUSHJ P,SCANS ;CHECK FOR EXT OR PPN
CAIE C,":" ;IS IT A DEVICE NAME
JRST NODEV ;NO
POP P,T1 ;[260]WE WERE HIDING IT IN THE STACK
;**;[302] @GETDEV+4 1/2, JMT, 27-MAY-76
TRNN FL,F.STKY ;[302] DON'T MAKE STICKY IF FROM SWITCH
MOVEM T1,SVDEVV ;[260]REMEMBER FOR 'STICKINESS'
MOVEM T1,SVDEV(SVPT) ;[260]SAVE IT AS DEVICE NOW
PUSHJ P,SCAN ;BYPASS
;**;[307] @GETDEV+9 1/2, JMT, 22-JUN-76
PUSHJ P,SCANS ;[307] DO LOOK AHEAD
SKIPN SAVCHR ;[307] NEXT CHARACTER A BLANK ?
POPJ P, ;[307] YES--THAT'S IT, RETURN
PUSHJ P,SCAN ;AND GET NEXT
CAIN C,"[" ;CHECK FOR PROJ-PROG
PUSHJ P,[PUSHJ P,GETPP1
JRST SCAN] ;POPJ RETURN
TRNN FL,IDF ;MUST BE AN IDENT
POPJ P, ;RETURN, ONLY DEVICE SEEN
PUSH P,ACCUM
PUSHJ P,SCANS
SETZM SVPPP ;CLEAR STICKY PPN ON NEW DEVICE
IFN SFDSW,<
SETZM SVSFP ;AND STICKY SFD
MOVE T1,[SVSFP,,SVSFP+1]
BLT T1,SVSFP+SFDLEN-1>
NODEV: POP P,SVNAM(SVPT)
;**;[302] @NODEV+1, JMT, 27-MAY-76
;**;[302] DELETE SKIPE T1,SVDEVV ;[254]IF NO DEVICE, SKIP
SKIPN T1,SVDEVV ;[302] IF DEVICE, SKIP
JRST NODEV1 ;[302] OTHERWISE, PROCEED
TRNN FL,F.STKY ;[302] IF FROM SWITCH, DON'T SAVE
MOVEM T1,SVDEV(SVPT) ;[254]ELSE, MAKE DEVICE HAPPEN
NODEV1: TRNE FL,F.STKY ;[302] SHOULD PPN STICK ?
JRST GOTSTK ;[302] NO--PROCEED
IFE SFDSW,<SKIPE T1,SVPPN(SVPT) ;FOUND A NEW STICKY PPN?
MOVEM T1,SVPPP ;YES>
IFN SFDSW,<SKIPN T1,SVPPN(SVPT) ;STICKY PPN?
JRST NOTSTK ;NO
MOVEM T1,SVPPP ;YES
X==<Y==0> ;INITIAL CONDITION
REPEAT SFDLEN,<
MOVE T1,SVSFD+X(SVPT)
MOVEM T1,SVSFP+Y
X==X+NFILE
Y==Y+1>
JRST GOTSTK ;DON'T MOVE IT BACK AGAIN
NOTSTK:>
MOVE T1,SVPPP ;GET STICKY PPN
MOVEM T1,SVPPN(SVPT) ;SET PPN INCASE ONE NOT FOLLOWING
IFN SFDSW,<X==<Y==0> ;INITIAL CONDITION
REPEAT SFDLEN,<
MOVE T1,SVSFP+Y
MOVEM T1,SVSFD+X(SVPT)
X==X+NFILE
Y==Y+1>
GOTSTK:>
CAIN C,"[" ;IS IT PPN
JRST GETPP
CAIE C,"." ;NO, EXT?
POPJ P, ;NEITHER, RETURN
PUSHJ P,SCAN ;NO. GO OVER DOT
PUSHJ P,SCANS ;PEEK AT NEXT CHAR
SKIPG SAVCHR ;ALPHANUMERIC?
JRST GETN1 ;NO. IT MAY BE A STAR IN PIP MODE
GETN2: PUSHJ P,SCAN ;GET EXT
TRNN FL,IDF
GOTO SYNERR
MOVE T1,ACCUM
HLLZM T1,SVEXT(SVPT)
GETN3: PUSHJ P,SCANS ;[201] FIND DELIMITER
CAIE C,"[" ;CHECK FOR PPN AGAIN
POPJ P,
JRST GETPP ;READ PROG-PROG PAIR
GETN1: TRNE FL,PIPF ;PIP MODE?
CAIE C,52 ;YES. ASTERISK?
TROA FL,IDF ;[201] SIMULATE IDENTIFIER SEEN
JRST GETN2 ;WILD EXTENSION. GO GET IT.
HLLOS SVEXT(SVPT) ;MARK NULL EXT WITH -1
PJRST GETN3 ;[201] ALLOW PPN AFTER <progname>.
GETPP: PUSHJ P,SCAN
GETPP1: PUSHJ P,SCAN
SETZM SVPPN(SVPT) ;INCASE NOT FIRST TIME IN
IFN SFDSW,<X==0 ;INITIAL CONDITION
REPEAT SFDLEN,<
SETZM SVSFD+X(SVPT)
X==X+NFILE>>
TRNN FL,IDF
JRST [SKIPN T1,MYPPN ;ALLOW [,,]
PUSHJ P,USRPPN ;NOT GOT IT YET
HLLZM T1,SVPPN(SVPT)
JRST GETPP2]
MOVE T1,ACCUM
PUSHJ P,RJUST ;THIS NEED TO BE RIGHT JUSTIFIED
HRLM T1,SVPPN(SVPT) ;STORE LEFT HALF
PUSHJ P,SCAN
GETPP2: CAIE C,","
GOTO SYNERR
PUSHJ P,SCAN
TRNN FL,IDF
JRST [SKIPN T1,MYPPN
PUSHJ P,USRPPN ;GET USERS PPN VIA UUO
HRRM T1,SVPPN(SVPT)
JRST GETPP3]
MOVE T1,ACCUM
PUSHJ P,RJUST
HRRM T1,SVPPN(SVPT)
PUSHJ P,SCAN
GETPP3: SETZM ACCUM ;[227] CLEAR JUNK
CAIN C,"]"
POPJ P, ;ALL DONE
IFN SFDSW,<CAIE C,"," ;COMMA MEANS SFD COMING
JRST ENDSFD ;NO, ALL OVER
HRRZ T2,SVPT ;STORAGE POINTER IN RIGHT
HRLI T2,-SFDLEN ;AOBJN WORD FOR ALL SFD'S
GETSFD: PUSHJ P,SCAN ;GET SOMETHING
MOVE T1,ACCUM ;GET WHAT WAS SEEN
MOVEM T1,SVSFD(T2) ;STORE IT
PUSHJ P,SCAN ;GET NEXT CHAR
CAIN C,"]" ;END OF PPN
JRST GETPP3 ;[227] YES, BUT CLEAR ACCUM
CAIE C,"," ;MORE TO COME
JRST ENDSFD ;NO
ADDI T2,NFILE-1 ;ADD DIFFERENCE OVER FILE
AOBJN T2,GETSFD ;MORE TO COME
GOTO SFDERR ;YES, BUT YOU LOSE
ENDSFD: > ;END OF IFN SFDSW
TLNN CS,TERMF ;END OF LINE?
GOTO SYNERR ;NO
MOVEI C,"]" ;FAKE CLOSING BRACKET
MOVEM CS,SAVCHR ;SEE TRMF NEXT TIME
POPJ P, ;RETURN
USRPPN: GETPPN T1, ;GET USER'S LOGGED IN PPN
JFCL ;INCASE JACCT ON
MOVEM T1,MYPPN ;SAVE IT
POPJ P,
IFN STANSW,<
RJUST: TRNE T1,77
POPJ P, ;GET IT OVER THERE
LSH T1,-6
JRST RJUST>
IFE STANSW,<
RJUST: PUSH P,T3
MOVE T3,T1 ;CONVERT SIXBIT TO OCTAL
MOVEI T1,0
CONVOC: MOVEI T2,0
LSHC T2,6
CAIL T2,20
CAILE T2,27
GOTO SYNERR
LSH T1,3
IORI T1,-20(T2)
JUMPN T3,CONVOC
POP P,T3
POPJ P,0
>
SCANS: MOVNI T1,1 ;FLAG AS NOTHING SEEN YET
SKIPN CS,SAVCHR ;CHARACTER WAITING?
SCNS2: PUSHJ P,GETCH
JUMPN CS,SCNS1 ;FOUND SOMETHING
MOVEI T1,0
JRST SCNS2
SCNS1: JUMPL CS,SCNS4 ;SPECIAL CHARACTER
MOVEM CS,SAVCHR ;SAVE THAT CHARACTER
JUMPL T1,SCNS3 ;DO NOTHING ELSE IF NO BLANKS SEEN
MOVEM T1,SAVCHR ;IF BLANKS SEEN, SAVE ONE
MOVSI T1,70000
ADDM T1,@GETB3(IOPNT) ;AND BACK UP POINTER
AOS @GETB1(IOPNT) ;[232] ALSO BACKUP COUNT
SCNS3: TDZA CS,CS ;IN EITHER CASE, RETURN 0
SCNS4: MOVEM CS,SAVCHR ;SAVE SPECIAL CHARACTER
HRRZ C,CS ;GET A CHARACTER TO RETURN
POPJ P,
SCAN: TRZ FL,IDF ;RESET IN CASE NOT
SKIPN CS,SAVCHR ;WAS THERE SOMETHING LEFT OVER
CONSN: PUSHJ P,GETCH ;NO, GET ANOTHER
JUMPE CS,.-1 ;IGNORE BLANKS
JUMPL CS,SPCHR ;IS IT A SPECIAL CHARACTER
SETZM ACCUM ;PREPARE TO STORE IT
MOVE T1,[POINT 6,ACCUM]
SCAN1: TLNE T1,770000 ;ALL SIX STORED?
IDPB CS,T1 ;NO, STORE ANOTHER
PUSHJ P,GETCH ;GET NEXT
JUMPG CS,SCAN1 ;ANOTHER ALPHA
CAIN C,"*" ;[271] DID WE STOP ON A "*"?
TRNN FL,PIPF ;[271] YES, IS THIS PIP MODE?
JRST SCAN2 ;[271] NO, STOP THE SCAN
MOVEI CS,'*' ;[271] YES, "*" IS JUST ANOTHER CHAR
JRST SCAN1 ;[271] SO GO STORE IT AWAY
SCAN2: TRO FL,IDF ;[271] IT SURE IS
MOVEM CS,SAVCHR
SETZB C,CS ;TO AVOID CONFUSION
POPJ P,
SPCHR: HRRZ C,CS ;RETURN HIM THE HALF OF IT
SETZM SAVCHR ;NOTHING SAVED BY NOW
CAIN C,"*"
TRNN FL,PIPF
JRST SPCHR1
PUSH P,[SIXBIT /*/] ;IN PIP MODE * IS AN IDENT
POP P,ACCUM
TROA FL,IDF
SPCHR1: TLNN CS,SPACT ;DO WE WANT SPECIAL ACTION?
POPJ P, ;NO
JRST (CS) ;YES, RH IS DISPATCH
;GETCH RETURNS 7-BIT ASCII CHAR IN C, TABLE ENTRY IN CS
GETCH: SOSLE @GETB1(IOPNT) ;USE CORRECT BUFFER HEADER
JRST OKPICK
IFN TEMP,<SKIPGE C,TMPFLG(IOPNT) ;IS TMPCOR BEING USED
;SET TO -1 IF YES
AOJE C,POPFL1 ;YES FINISHED WITH THIS READ>
XCT GETB2(IOPNT) ;AN IN UUO
JRST OKPICK
XCT GETB4(IOPNT) ;TO A STATZ
JRST READER ;AN INPUT ERROR
JRST POPFIL ;GO GET PREVIOUS FILE
OKPICK: IBP @GETB3(IOPNT)
MOVE C,@GETB3(IOPNT) ;PICK UP THE NEW BYTE POINTER
MOVE CS,(C) ;GET THE WORD IT CAME FROM
TRNE CS,1 ;AND CHECK FOR SEQ NUM
JRST [AOS @GETB3(IOPNT) ;ADVANCE POINTER
MOVNI CS,5 ;AND ADJUST COUNT
ADDB CS,@GETB1(IOPNT)
SKIPG CS ;CHECK FOR BUFFER OVERRUN
PUSHJ P,GETCH ;GET RID OF TAB
JRST GETCH]
LDB C,@GETB3(IOPNT)
JUMPE C,GETCH ;IGNORE NULLS
CAIN C,";" ;IS IT A COMMENT?
TRNE FL,INPRNT ;IN PRINTING ERROR
JRST EOFRT ;YES, DONT PROCESS ";"
SEMIC: TRO FL,INPRNT ;HACK SO THAT "@" COME HERE
PUSHJ P,GETCH ;READ CHRS
MOVE CS,CTBL(C) ;GET STATUS
TLNN CS,TERMF ;END OF LINE?
JRST SEMIC ;NO, KEEP GOING
TRZ FL,INPRNT ;CLEAR FLAG AGAIN
EOFRT: MOVE CS,CTBL(C) ;GET STATUS BITS
EOFRT1: TRNN FL,INPRNT ;IF PRINTING ERROR, DO NOT NEST
CAIE C,100 ;IS IT @
POPJ P,
JRST NEST ;SPECIAL
XALL ;BACK TO NORMAL LISTING
CTBL: 0
REPEAT 6,< XWD SPCF,.-CTBL> ;[261]
XWD SPCF!SPACT!TERMF+7,CHKTRM ;[261]BELL
XWD SPCF,.-CTBL ;[261]
0 ;TAB
XWD SPCF!SPACT!TERMF+12,CHKTRM ;LF
XWD SPCF!SPACT!TERMF+13,CHKTRM ;VTAB
XWD SPCF!SPACT!TERMF+14,CHKTRM ;FORM
0 ;CARRET
REPEAT 14,< XWD SPCF,.-CTBL> ;[261]
XWD SPCF!TERMF!SPACT+32,CHKTRM ;[261]SUB
XWD SPCF!TERMF!SPACT+44,CHKTRM
REPEAT 4,< XWD SPCF,.-CTBL>
0 ;SPACE
REPEAT 17,< XWD SPCF,.-CTBL>
REPEAT 12,< XWD NUMF,.-CTBL-40 ;DIGIT>
REPEAT 5,< XWD SPCF,.-CTBL>
EXP .-CTBL-40 ;?
XWD SPCF,100
REPEAT 32,< EXP .-CTBL-40 ;UPPER CASE LETTERS>
REPEAT 6,< XWD SPCF,.-CTBL>
REPEAT 32,< EXP .-CTBL-100 ;LOWER CASE LETTERS>
XWD SPCF,.-CTBL
XWD SPCF,.-CTBL
XWD SPCF!TERMF!SPACT+44,CHKTRM
XWD SPCF!TERMF!SPACT+44,CHKTRM
XWD SPCF!SPACT,POPFIL
COMMA==CTBL+","
CHKTRM: PUSH P,CS ;SAVE MAGIC BITS
TERMC1: PUSHJ P,GETCH
JUMPE CS,TERMC1 ;ALSO IGNORE TABS AND SPACES
TLNE CS,TERMF
JRST TERMC1 ;BYPASS TERMINATORS
CAMN CS,COMMA ;CHECK FOR , AFTER CRET
JRST [POP P,(P) ;GET STACK IN SYNC
POPJ P,] ;RETURN THE COMMA
MOVEM CS,SAVCHR ;SAVE FOR LATER
POP P,CS
MOVEI C,0 ;AS GOOD AS ANYTHING ELSE
POPJ P,
DEFINE QQ<
N==1
REPEAT NESTDP,<MAC(\N)
N==N+1>>
GETB1: DINCT
DEFINE MAC(X)<IBUF'X+2>
QQ
GETB2: HALT
DEFINE MAC(X)<IN X,0>
QQ
GETB3: DINPT
DEFINE MAC(X)<IBUF'X+1>
QQ
GETB4: HALT
DEFINE MAC(X)<STATZ X,740000>
QQ
SUBTTL COMMAND NESTING
NEST: PUSH P,ACCUM ;SAVE STATE OF SCANNER
PUSH P,FL ;SAVE THE FLAGS (AS IDF?)
PUSH P,T1
;**; @NEST + 2 1/2, JMT, 21-JUN-76
SETZM FAKEOL ;[305] CLEAR FAKE EOL FLAG
SETOM INLFLG ;[305] SET IN-LINE FLAG
SETZM SAVCHR
PUSH P,NAME ;AND THIS OTHER STUFF
PUSH P,NAME+1
PUSH P,NAME+2
PUSH P,NAME+3
AOBJP SVPT,TMNER ;GET A CLEAR SPACE FOR NAME
;**;[302] @NEST+8 1/2, JMT, 27-MAY-76
TRO FL,F.STKY ;[302] SET FLAG FOR NO STICKINESS
PUSHJ P,SCANAM ;GET ONE TO USE
TRZ FL,F.STKY ;[302] CLEAR FLAG
PUSH IOP,SAVCHR
PUSHJ P,CHKRM ;GET BUFFER SPACE
AOBJP IOPNT,NESTTD ;TOO DEEP?
IFE TEMP,<
SKIPE C,SVDEV(SVPT) ;WAS A DEVICE SPECIFIED?
JRST NSTDEV ;YES, USE IT
>
IFN TEMP,<
MOVS C,SVDEV(SVPT) ;[226] GET DEVICE
MOVSM C,OPENB+1 ;[226] STORE DEV OR 0
CAIN C,'TMP' ;[226] TEST FOR TMPCOR
JRST [MOVSS C ;[253] GET IN PLACE FOR DEVCHR
DEVCHR C, ;[226] BUT NOT IF A REAL DEVICE
JUMPN C,NSTDV1 ;[226] IT REALLY EXISTS
JRST .+2] ;[226] TRY TMPCOR ONLY
;[243] NEST+21,JNG,12/15/74
JUMPN C,NSTDV1 ;[243] DEVICE SPECIFIED
MOVE C,.JBFF ;GET START OF BUFFER
MOVEM C,BUFTAB(IOPNT) ;SAVE IT FOR RELEASING INFO
MOVEM C,TMPFIL+1 ;SAVE IOWD FOR TMPCOR UUO
MOVEM C,@GETB3(IOPNT) ;DUMMY UP BYTE POINTER
SOS TMPFIL+1 ;MAKE TMPFIL INTO CORRECT IOWD FORMAT
MOVNI C,200 ;GET BUFFER LENGTH
HRLM C,TMPFIL+1 ;STORE NEGATIVE WORD COUNT
MOVE C,SVNAM(SVPT) ;PICK UP FILNAM
SKIPE OPENB+1 ;[226] SPECIAL IF TMP:
JRST [HLLZM C,TMPFIL ;[226] 3 CHARS ONLY
JRST ISTMP1] ;[226] TRY TMPUUO
XOR C,JOBNAM ;ONLY ALLOW TMPCOR IF CURRENT JOB NUMBER
TLNE C,-1 ;OTHERWISE WE MIGHT READ XXXPIP ETC
JRST NOTMP ;NOT A VALID TMPCOR FILE NAME
HRLZM C,TMPFIL ;STORE RIGHT THREE LETTERS
ISTMP1: MOVE C,[XWD 1,TMPFIL] ;SET UP FOR TMPCOR READ
TMPCOR C, ;READ FILE AND DON'T DELETE
JRST [SKIPN OPENB+1 ;[226] FAILED, TMP: ONLY?
JRST NOTMP ;[226] NO SUCH FILE, TRY THE DISK
MOVE C,SVNAM(SVPT) ;[226] GET FILE NAME
HLLZM C,LNAM ;[226] FOR ERROR MESSAGE
SETZM LEXT ;[226]
JRST NOFIL] ;[226] FILE NOT THERE
SETOM TMPFLG(IOPNT) ;FLAG THAT TMPCOR READ WAS DONE
IMULI C,5 ;CALCULATE CHARACTER COUNT
MOVEM C,@GETB1(IOPNT) ;STORE IN BUFFER HEADER
MOVEI C,440700 ;SET UP BYTE POINTER
HRLM C,@GETB3(IOPNT) ;BUFFER HEADER FINALLY SET UP
JRST NEXT2 ;CONTINUE INTO MAIN STREAM
NOTMP: >
MOVSI C,'DSK'
NSTDEV: MOVEM C,OPENB+1 ;[226]
NSTDV1: SETZM OPENB ;[226]
MOVE C,NESTB(IOPNT) ;GET BUFFER POINTER
MOVEM C,OPENB+2
MOVE C,[OPEN .-.,OPENB]
DPB IOPNT,[POINT 4,C,12]
XCT C
JRST [MOVE C,OPENB+1 ;[226] GET DEVICE
MOVEM C,LOKNAM ;[226] INCASE IT DOESN'T EXIST
DEVCHR C, ;[226] SEE IF IT DOES
JUMPE C,DEVNA ;[226] NO
JRST DSKNA] ;[226] MUST BE SOMETHING ELSE
MOVE C,.JBFF
MOVEM C,BUFTAB(IOPNT) ;SAVE THE PLACE PUT
XCT INTAB(IOPNT) ;DO AN INBUFF
MOVE C,SVNAM(SVPT)
MOVEM C,LNAM ;SET UP FOR LOOKUP
SKIPN C,SVEXT(SVPT)
JUMPE C,NEST1 ;NOT EXT SUPPLIED
TRZA C,-1 ;INCASE NULL SUPPLIED
NEST1: MOVSI C,'CMD' ;TRY .CMD
MOVEM C,LEXT
NEST1A: MOVE C,SVPPN(SVPT)
IFN SFDSW,<
SKIPE SVSFD(SVPT) ;ANY SFD'S SEEN?
PUSHJ P,SETSFD ;YES, SET PATH>
MOVEM C,LPPN
XCT LKTAB(IOPNT)
JRST [TRNE FL,INCRF ;SPECIAL IF TRYING TO READ QQCREF
JRST DNCRF
HLLZ C,LEXT ;SEE IF BLANK USED
JUMPE C,NOFIL ;[225] NO, NOT THERE
SETZM LEXT ;[225] TRY NULL EXT
JRST NEST1A] ;[225]
NEXT2: SUB SVPT,[XWD 1,1] ;GET HIM POINTED BACK RIGHT
POP P,NAME+3 ;RESTORE THINGS
POP P,NAME+2
POP P,NAME+1
POP P,NAME
POP P,T1
POP P,FL
POP P,ACCUM
TRZ FL,RECALF ;WE HAVE DONE THE FIND
; JRST GETCH ;AND CONTINUE TO GET THAT CHR
MOVEI C," " ;SUPPLY A FREE BLANK IF "@" SO COM@FOO WORKS
SETZ CS, ;STATUS OF A BLANK
;**;[305] @NEXT2+10 1/2, JMT, 21-JUN-76
SETZM INLFLG ;[305] CLEAR IN-LINE FLAG
POPJ P, ;BYPASS GETCH AND RETURN BLANK TO CALLER
IFN SFDSW,<
SETSFD: MOVEM C,LSFDPP ;STORE PPN
X==<Y==0>
REPEAT SFDLEN,<MOVE C,SVSFD+X(SVPT)
MOVEM C,LSFD+Y
X==X+NFILE
Y==Y+1>
MOVEI C,LSFDAD ;TO STORE SFD BLOCK IN LPPN
POPJ P, ;RETURN
>
POPFIL:
;TEMP FIX FOR PIP FUNCTION PROBLEM WITH SCANNER
;SCANNING TO FAR AND ENDING UP AT POPFIL
;THIS CURES SYMPTOMS NOT THE DESEASE
TRNN IOPNT,-1 ;ALREADY AT TOP LEVEL?
TRNN FL,PIPF ;YES, BUT IS IT PIP?
CAIA ;NO
JRST [MOVEI C,12 ;YES, FAKE A LF
MOVE CS,CTBL(C)
;**;[305] @POPFIL+3 ,JMT, 21-JUN-76
SETOM FAKEOL ;[305] SET FAKE EOL FLAG
POPJ P,] ;AND RETURN IT
;END OF "FIX"
XCT RELTAB(IOPNT) ;RELEASE HIM
IFN TEMP,<
POPFL1: SETZM TMPFLG(IOPNT) ;CLEAR TMPCOR FLAG
>
MOVE C,BUFTAB(IOPNT)
MOVEM C,FREBUF(IOPNT) ;MARK BUFFER FREE
POP IOP,CS
HRRZ C,CS
SUB IOPNT,[XWD 1,1] ;POINT IT BACK
JRST EOFRT1 ;AND GIVE BACK THE CHARACTER
SALL
NESTB: 0
DEFINE MAC(X)<IBUF'X>
QQ
DEFINE MAC(X)<U (IBUF'X,3)>
QQ
IFN TEMP,<U(TMPFLG,NESTDP+2)>
INTAB: HALT ;INBUFS
DEFINE MAC(X)<INBUF X,2>
QQ
LKTAB: HALT
DEFINE MAC(X)<LOOKUP X,NAME>
QQ
RELTAB: JRST ALLDON
DEFINE MAC(X)<RELEAS X,0>
QQ
SUBTTL ERROR ROUTINES
IFDEF SALL,<SALL> ;MAKE LISTING NEATER
ETMS: STRING [ASCIZ /?CMLTMS Too many switches: /]
ERRCOM: MOVEI T1,20 ;SET TO TYPE SOME CHRS TO TELL WHERE ERROR
MOVE T2,[POINT 7,ERRBUF] ;IS FROM
TRO FL,INPRNT ;IN CASE EOF WHILE READING CHRS TO TYPE
;**;[305] @ERRCOM+2 1/2, JMT, 21-JUN-76
TRZ FL,PIPF ;[305] CLEAR PIP FLAG
SKIPN C,SAVCHR ;FIND THE ONE LEFT
JRST PUTER
TLNE C,SPACT ;IS IT SPECIAL
JRST NOFIL0 ;YES, GIVE UP AT END OF LINE
SKIP 1
PUTER: PUSHJ P,GETCH
CAIN C,177 ;THIS IS EOF
JRST NOFIL0
IDPB C,T2
SOJGE T1,PUTER
NOFIL0: MOVE T1,T2
JRST NOFIL1 ;PRINT WITH CR/LF
TMNER: STRING [ASCIZ /?CMLTMN Too many names: /]
JRST ERRCOM
DSKNA: STRING [ASCIZ /?CMLDNA Disk not available: /]
JRST ERRCOM
OUTER: STRING [ASCIZ /?CMLOPE Output error: /]
JRST ERRCOM
PROCON: STRING [ASCIZ /?CMLLPC Language processor conflict: /]
JRST ERRCOM
NOCOR: STRING [ASCIZ /?CMLNEC Not enough core: /]
JRST ERRCOM
READER: STRING [ASCIZ /?CMLIPE Input error: /]
JRST ERRCOM
SYNRR1: SUB IOPNT,[XWD 1,1] ;GET HIM BACK TO RIGHT PLACE
SYNRR2: STRING [ASCIZ /?CMLNPC No previous command/] ;[204]
JRST ABORT ;[204] EXIT
SYNERR: STRING [ASCIZ /?CMLCME Command error: /]
JRST ERRCOM
NESTTD: STRING [ASCIZ /?CMLNTD Nesting too deep: /]
JRST ERRCOM
AMBIGU: STRING [ASCIZ /?CMLAMB Ambiguous abbreviation: /]
SKIP 1
UNRECS: STRING [ASCIZ /?CMLURS Unrecognizable switch: /]
MOVE T3,ACCUM ;BAD SWITCH IN HERE
JRST ERRBF1
XPDERR: STRING [ASCIZ /?CMLEDR Explicit device required /]
JRST ABORT ;"22A-160"
LLCERR: STRING [ASCIZ \?CMLLLC LINK-10/LOADER conflict: \]
JRST ERRCOM
IPCERR: STRING [ASCIZ /?CMLIPC Illegal protection code: /] ;[231]
MOVE T3,ACCUM ;[231] BAD CODE
JRST ERRBF1 ;[231] LIST IT
SAVERR: STRING [ASCIZ /?CMLNFS NO FILE ON SAVE OR SSAVE/] ;[256]
JRST ABORT ;[256]
NOFIL: TRNN FL,RECALF ;WE WERE LOOKING UP A SVC FILE
JRST FIU ;[266]YES, TELL OF ERROR
JRST SYNRR1 ;NO, SO GIVE SPECIAL MESSAGE
NAMCOM: MOVE 1,[POINT 7,ERRBUF]
MOVE T3,NAME
PUSHJ P,SIXOUT
HLLZ T3,NAME+1
JUMPE T3,NOFIL1
MOVEI T2,"."
IDPB T2,T1
NOFIL2: PUSHJ P,SIXOUT
NOFIL1: MOVEI T2,0
IDPB T2,T1
STRING ERRBUF
ABORT: CLRBFI ;CLEAR INPUT BUFFER SO GARBAGE IS NOT READ;"22A-160"
RESET
DOEND: SETZB 0,.JBSA ;SO START FAILS
SETNAM 0, ;SO RUN FAILS
EXIT 1,
EXIT ;IN CASE SOME IDIOT TYPES CONTINUE
SIXOUT: MOVEI T2,0
LSHC T2,6
ADDI T2,40
IDPB T2,T1
JUMPN T3,SIXOUT
POPJ P,
DEVNA: STRING [ASCIZ /?CMLDVA Device not available - /]
MOVE T3,LOKNAM
ERRBF1: MOVE T1,[POINT 7,ERRBUF]
JRST NOFIL2
;**;[300] @SYNERP, JMT, 6-MAY-76
;**;[305] @SYNERP, JMT, 21-JUN-76
SYNERP: SKIPN INLFLG ;[305] ARE WE AT BEGINNING OF LINE ?
SKIPE FAKEOL ;[305] AND IS THIS A REAL TERMINATOR ?
JRST ERP1 ;[305] NO--PROCEED
TLNE CS,TERMF ;[305] YES--IS THIS A LINE TERMINATOR ?
JRST SCNAGN ;[300] YES--TRY FOR IDENTIFIER AGAIN
ERP1: TRNN FL,PIPF ;A PIP COMMAND?
GOTO SYNERR ;NO, YOU LOSE
CAIN C,"[" ;START OF PPN?
JRST GETPP1 ;YES, AND PROBABLY NO DEVICE
;**;[305] @SYNERP+5 1/2, JMT, 21-JUN-76
SETZM FAKEOL ;[305] CLEAR FAKE EOL FLAG
POPJ P, ;RETURN AND HOPE IT MAKES SENSE
;**;[300] @SYNERP+4 1/2, JMT, 6-MAY-76
SCNAGN: PUSHJ P,SCAN ;[300] LOOK FOR AN IDENTIFIER
JRST GETNM0 ;[300] AND TRY AGAIN
UNKERR: STRING [ASCIZ /?CMLUNC Unknown command: /]
MOVE T3,ACCUM ;GET IT
JRST ERRBF1 ;OUTPUT IT
IFN SFDSW,<
SFDERR: STRING [ASCIZ /?CMLLRE /]
STRING @ERRTAB+25 ;SFD PATH TOO LONG
JRST ERRCOM
>
FIU: STRING [ASCIZ /?CMLLRE /]
HRRZ T1,LEXT ;GET ERROR CODE
CAIL T1,TABLND-ERRTAB ;SEE IF LEGAL
SKIPA T1,TABLND ;NO USE CATCHALL MESSAGE
MOVE T1,ERRTAB(T1) ;GET ADDRESS OF MESSAGE
STRING (T1) ;OUTPUT IT
JRST NAMCOM
ERRTAB: [ASCIZ /(0) file was not found - /]
[ASCIZ /(1) no directory for project-programmer number - /]
[ASCIZ /(2) protection failure - /]
[ASCIZ /(3) file was being modified - /]
[ASCIZ /(4) rename file name already exists - /]
[ASCIZ /(5) illegal sequence of UUOs - /]
[ASCIZ /(6) bad UFD or bad RIB - /]
[ASCIZ /(7) not a SAV file - /]
[ASCIZ /(10) not enough core - /]
[ASCIZ /(11) device not available - /]
[ASCIZ /(12) no such device - /]
[ASCIZ /(13) not two reloc reg. capability - /]
[ASCIZ /(14) no room or quota exceeded - /]
[ASCIZ /(15) write lock error - /]
[ASCIZ /(16) not enough monitor table space - /]
[ASCIZ /(17) partial allocation only - /]
[ASCIZ /(20) block not free on allocation - /]
[ASCIZ /(21) can't supersede (enter) an existing directory - /]
[ASCIZ /(22) can't delete (rename) a non-empty directory - /]
[ASCIZ /(23) SFD not found - /]
[ASCIZ /(24) search list empty - /]
[ASCIZ /(25) SFD nested too deeply - /]
[ASCIZ /(26) no-create on for specified SFD path - /]
TABLND: [ASCIZ /(?) lookup,enter,or rename error - /]
SUBTTL ALL DONE
ALLDON: TRNE FL,INCRF ;JUST FOUND END OF QQCREF FILE
JRST DNCRF
SKIPE FDGFLG ;WRITING A FUDGE FILE?
PUSHJ P,DNFUDG ;YES, CLOSE IT
TRNE FL,INPRNT
JRST NOFIL0 ;IF PRINTENG AND EOF THEN FIINSH UP
HRRZ T1,(P) ;GET THE ADDRESS WE WANT TO RETURN TO
CAIE T1,NXFIL1 ;THIS SHOULD BE HERE
GOTO SYNERR ;ELSE ERROR
SETZM PCNAM ;NO LINK NAME TO START WITH
SETZM PCDEV ;AND DEVICE
MOVEI T3,CHNLOD ;START WITH LOADER
TRNN FL,DOLOD ;ARE WE LOADING?
JRST ALDN1 ;NO
SKIPN T2,EXECFL ;WANT EXECUTION?
JRST .+4 ;NO
PUSHJ P,OUTSIX ;YES, /E
TRNE FL,LINKFL ;LINK-10?
PUSHJ P,OUTSPC ;NEEDS SEPARATOR
SKIPN T2,MAPSW ;SKIP IF MAP REQUIRED
MOVSI T2,'/G ' ;SET UP FOR TERMINATE LOADING
PUSHJ P,OUTSIX ;YES, PUT IT OUT
TRNE FL,LINKFL ;LINK-10?
PUSHJ P,OUCRLF ;YES, BUG IN SCAN REQUIRES EOL MARKER
HLLZ T1,LODDEV ;LOADER RUN DEV: IN SPECIAL PLACE
HLLM T1,TMPCHN(T3) ;WHERE IT AUGHT TO BE
TRNN FL,LINKFL ;DO WE NEED LINK-10?
JRST ALDN1 ;NO
SETZ T1, ;YES
EXCH T1,TMPCHN(T3) ;MOVE DATA FROM LOADER
MOVEI T3,CHNLNK ;TO LINK-10
MOVEM T1,TMPCHN(T3) ;
ALDN1: SKIPN TMPCHN(T3) ;HAS THAT PROCESSOR BEEN SET UP FOR OUTPUT?
SOJGE T3,ALDN1 ;NO, TRY NEXT (BUT NOT TOO MANY)
JUMPL T3,DONE ;IF OUT OF PROCESSORS THEN DONE
SKIPN PCNAM ;IS THERE A PROCESSOR FOR IT TO CALL?
JRST NONAM ;NO
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 .+1 ;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]>
SKIPE T2,PCDEV ;GET DEVICE IF GIVEN
PUSHJ P,OUTDEV
MOVE T2,PCNAM ;RECOVER NAME OF PROCESSOR
PUSHJ P,OUTSIX ;YES, PUT OUT ITS NAME
MOVEI T1,"!" ;AND THE LOAD SYMBOL
PUSHJ P,TMPOUT
PUSHJ P,OUCRLF
NONAM: PUSHJ P,TMPCHK ;CLOSE IT
CAIE T3,CHNLNK ;IS THIS LINK-10?
CAIN T3,CHNLOD ;IS THIS THE LOADER?
SKIPA T1,PROCTB(T3) ;YES, IT'S SPECIAL
MOVE T1,PRCNAM(T3) ;GET THE NAME OF THAT PROCESSOR
IFN FORTRAN,< ;WE HAVE A CHOICE OF FORTRAN COMPILERS
CAIE T3,CHNFOR ;BUT ONLY IF THIS IS FORTRAN
SKIP 2 ;NOT
SKIPE FORPRC ;USE DEFAULT
MOVE T1,FORPRC ;USE WHATEVER IS SET>
MOVEM T1,PCNAM ;AND SET AS THE ONE TO LINK TO
NOPDEV: SOJGE T3,ALDN1 ;GO BACK IF MORE TO LOOK AT
DONE: TRNE FL,CMDSN ;DID WE SEE COMMAND FROM TTY?
JRST DONE1 ;NO, DO NOT WRITE FILE
MOVE T1,JOBNAM
HRRI T1,'SVC'
TRNE FL,EDITF
HRRI T1,'EDS'
MOVEM T1,LNAM ;SET UP OUTPUT FILE
IFN TEMP,<
HRLZM T1,TMPFIL ;SAVE NAME IN TMPFIL
>
MOVE T1,TTYPT ;GET BYTE POINTER
MOVNI T2,4 ;SET UP FOR CHARACTER COUNT
ILDB T3,T1 ;GET NEXT CHARACTER
CAIE T3,177 ;IS IT A EOF CHARACTER
SOJA T2,.-2 ;NO, TRY AGAIN
IDIVI T2,5 ;CALCULATE CHARACTER COUNT
HRLM T2,TMPFIL+1 ;STORE IN TMPCOR OUTPUT BLOCK
LDB T3,[POINT 6,T1,5] ;PICK UP BIT POS OF LAST CHAR
SETO T2, ;PREPARE TO BUILD MASK
LSH T2,7(T3) ;MASK OFF REST OF LAST WORD
ANDM T2,(T1) ;IN TTY BUFFER
HRRZ T2,TTYPT ;GET START OF BUFFER
SUBI T2,1 ;FOR IOWD
HRRM T2,TMPFIL+1 ;STORE IN WRITE BLOCK FOR TMPCOR UUO
IFN TEMP,<
MOVE T2,[XWD 3,TMPFIL] ;SET UP FOR WRITE
TMPCOR T2, ;WRITE OUT FILE INTO CORE
JRST NOFIT ;IT DID NOT FIT, TRY DISK
JRST DONE1 ;GO CLEAN UP AND LEAVE
NOFIT: >
MOVE T1,TMPFIL+1 ;GET IOWD
MOVEM T1,TMPFIL ;TO FIRST WORD OF PAIR
SETZM TMPFIL+1 ;ZERO SECOND WORD
MOVSI T1,'TMP'
MOVEM T1,LEXT
SETZM LDAT
SETZM LPPN
CLOSE LOOK,20 ;MAKE SURE NOTHING USING THIS CHANEL
IFE FASTFS,<
SKIPN FSNAME ;IS F/S FOUND
PUSHJ P,FNDFST ;NO FIND IT>
RELEAS LOOK,0 ;GIVE UP THE CHANNEL
MOVEI T1,16 ;DUMP MODE
MOVEM T1,FSINIT ;INCASE NOT YET SETUP
TRYAG1: OPEN LOOK,FSINIT ;INIT THE CHAN.
JRST DSKNA ;SHOULDN'T HAPPEN
ENTER LOOK,LNAM ;GET SET TO WRITE
JRST [PUSHJ P,TRYDSK ;[276] TRY GENERIC DSK (ONLY RETURN IF YES) ?
JRST TRYAG1] ;[276] YES--TRY AGAIN
OUTPUT LOOK,TMPFIL ;OUTPUT THE DMP IOWD LIST
DONE2: CLOSE LOOK,20 ;SAVE THE NAME BLOCKS (LEVEL D)
RELEASE LOOK,0 ;LET IT GO
DONE1: SKIPE TMPCHN+CHNCRF ;DID WE DO ANY CREF?
PUSHJ P,FINCRF ;YES, FINISH OFF CREF
SKIPN T1,PCNAM ;IS THERE ONE TO LOAD?
JRST DOEND ;[206] NO, EXIT
JRST NUNDO ;GO LOAD IT
CHKRM: PUSH P,T1 ;SAVE THE REGISTERS WE ARE USING
PUSH P,T2
MOVSI T1,-<NESTDP+1> ;LOOK TO SEE IF ANY FREED BUFFERS
SKIPN T2,FREBUF(T1)
AOBJN T1,.-1 ;TRY AGAIN
JUMPGE T1,USTOP ;NO, GET IT FROMTOP OF STORAGE
MOVEM T2,.JBFF ;YES, SET JOBFF THERE
SETZM FREBUF(T1) ;AND MARK IT USED
JRST TPOPJ2 ;THATS ALL FOR NOW
USTOP: MOVE T1,SVJFF ;GET THE CURRENT TOP OF BUFFER AREA
MOVEM T1,.JBFF
ADDI T1,<203*2>+1 ;LEAVE THIS MUCH ROOM
MOVEM T1,SVJFF ;THATS THE NEW TOP
CAMGE T1,CORTOP ;WILL THAT RUN US OUT OF CORE?
JRST TPOPJ2 ;NO, LEAVE
PUSH P,CTPOPJ
XPAND: MOVEI T1,2000 ;GET SET TO EXPAND
ADDM T1,CORTOP
ADDM T1,CORT1
ADD T1,.JBREL ;NEW TOP DESIRED
CALLI T1,11 ;ASK FOR IT
JRST NOCOR ;LOSE BIG
MOVE T1,.JBREL
MVCR: MOVE T2,-2000(T1) ;MOVE CORE UP
MOVEM T2,(T1)
CAMLE T1,CORTOP ;ARE WE DONE?
SOJA T1,MVCR
CTPOPJ: POPJ P,TPOPJ2
IFE FASTFS,<
;USE FIRST F/S IF SEARCH LIST IS OF FORM
;DSKA/N,DSKB,...FENCE
FNDFST:
IFN TEMP,<
PUSH P,T1 ;SAVE SOME ACS
PUSH P,T2
PUSH P,T3
PUSH P,T4>
;THIS TEST INCASE USE HAS ASSIGNED XXX AS DSK
MOVEI T1,T2 ;ADDRESS OF DATA BLOCK
MOVSI T2,'DSK' ;AND DATA IN IT
DSKCHR T1, ;GET FIRST ARG
JRST USEDSK ;LOSE SOON
TLNE T1,(7B17) ;TESR FOR GENERIC DSK
JRST USEDSK ;IT WAS N'T SO USE WHAT USER REQUESTED
MOVE T1,[3,,T2] ;SET UP BLOCK
SETOB T2,T4 ;REQUEST FIRST F/S
JOBSTR T1, ;GET FIRST F/S IN SEARCH LIST
JRST USEDSK ;LEVEL C
JUMPL T4,USEDSK ;SWP BIT SET
TLNN T4,200000 ;IS NO CREATE SET?
JRST USEDSK ;NO, GENERIC DSK WILL USE THIS F/S
DSKCHR T1, ;GET FIRST 3 ARGS
JRST USEDSK ;SHOULD NEVER HAPPEN BUT ...
TLNN T1,740200 ;RHB!OFL!HWP!SWP!NNA! SET?
CAIGE T3,10 ;ANY ROOM? ,TEN SHOULD BE ENOUGH
USEDSK: MOVSI T2,'DSK' ;JUST USE DSK
MOVEM T2,FSNAME ;STORE FASTEST F/S NAME
IFE TEMP,<
POPJ P, ;RETURN>
;IFN TEMP,<JRST TPOPJ4 ;RESTORE ACS>
>
TPOPJ4: POP P,T4
TPOPJ3: POP P,T3
TPOPJ2: POP P,T2
TPOPJ1: POP P,T1
POPJ P,0
RPGSET: MOVE T1,[POINT 7,FCOMD]
MOVEM T1,DINPT
MOVEI FL,RECALF!CMDSN
JRST RPGRET
SUBTTL INITIALIZATION
STPT: TDZA T4,T4 ;NORMAL ENTRY
MOVNI T4,1 ;REENTRY FROM AN EDITOR
IFN PURESW,<
SETZM .ZZ ;MUST CLEAR LOW CORE
MOVE T1,[XWD .ZZ,.ZZ+1]
BLT T1,LOWTOP
MOVE T1,[XWD INIDAT,INILOW]
BLT T1,INILOW+INILEN
>
;[241] STPT+11,JNG,9/23/74
RESET ;[241]STOP THE WORLD
JUMPL T4,RPGSET
IFE TENEX,<
RESCAN 1 ;[205] RESET POINTER TO START OF COMMAND>
SKIP 2 ;[211] SOMETHING IN INPUT BUFFER
SKIPN .JBDDT## ;[211] WAIT FOR USER IF DEBUGGING
GOTO SYNRR2 ;[205] INPUT BUFFER EMPTY
IFN TENEX,<
OUTSTR [ASCIZ /
./]>
MOVEI FL,0
HLRZ T1,.JBSA ;GET .JBFF (AFTER RESET)
HRLI T1,(POINT 7) ;FORM BYTE POINTER
MOVEM T1,TTYPT ;SAVE INITIAL TTY POINTER
MOVEM T1,DINPT
SETZM (T1) ;CLEAR WORD INCASE BIT 35 ON
START1: INCHWL T2 ;READ A COMMAND CHAR INTO T2
MOVEI T4,2(T1) ;[223] GET NEXT ADDRESS PLUS SPARE
CAMG T4,.JBREL ;[223] WILL IT FIT
JRST .+3 ;YES
CORE T4, ;NO, GET MORE
JRST NOCOR ;YOU LOSE
IDPB T2,T1 ;STORE IN DDTINBUF
TLNN T1,760000 ;THIS WORD FULL?
SETZM 1(T1) ;YES, CLEAR NEXT INCASE BIT 35 ON
MOVE T3,CTBL(T2) ;GET CHARACTER DESCRIPTOR
TLNN T3,TERMF ;IS IT A BREAK CHAR?
JRST START1 ;NO. GO GET MORE.
MOVEI T2,177 ;MARK END WITH AN EOF FLAG
SETZM 1(T1) ;MAKE SURE BIT 35 IS OFF
IDPB T2,T1
IDPB T2,T1 ;MAKE SURE
ADDI T1,1 ;SAVE THE LAST WORD
HRRZM T1,.JBFF ;[262]UPDATE .JBFF
RPGRET: SKIPA P,.+1 ;SET UP PDL
IOWD PDL,PDLB
IFN FASTFS,<
MOVE T1,[EXP FASTFS] ;IF GIVEN FASTEST F/S
MOVEM T1,FSNAME ;USE IT>
IFE TEMP,<IFE FASTFS,<
PUSHJ P,FNDFST ;MAY AS WELL GET IT OVER WITH>>
MOVNI T1,1 ;STANDARD KA/KI TEST
AOBJN T1,.+1
SKIPN T1
AOS CPU ;KA=0, KI=1
MOVEI T1,3
PJOB T2,
IDIVI T2,12
ADDI T3,20 ;TO SIXBIT
LSHC T3,-6
SOJG T1,.-3 ;THREE DIGITS
HLLZM T4,JOBNAM ;SAVE TO MAKE UNIQUE NAMES
TLO T4,404040 ;NOW TO ASCII FOR ASCIZ'S
MOVEI T1,3 ;THREE CHARS
LSH T3,1
LSHC T3,6 ;BRING IN A CHAR
SOJG T1,.-2
DPB T3,[POINT 21,CRFRDR,27] ;SAVE IN ASCIZ
DPB T3,[POINT 21,FCOMD,27]
DPB T3,[POINT 21,FCOMD2,27]
MOVSI T1,377777 ;SET COUNT TO A LARGE NUMBER
MOVEM T1,DINCT
MOVE IOP,[IOWD <NESTDP+1>*3,IOPD] ;AND IO PDL
MOVSI IOPNT,-<NESTDP> ;SET NEXT LIMIT
IFE LINK10,<
TRO FL,DOLOD ;WE WANT TO LOAD
>
IFN LINK10,<
TRO FL,DOLOD!LINKFL ;LOAD USING LINK-10
>
;**;[303] @RPGRET+25 1/2, JMT, 1-JUN-76
SETZM DEFPRO ;[303] CLEAR DEFAULT PROCESSOR FLAG
MOVEI T1,FORSW ;ASSUME FORTRAN
MOVEM T1,DFPROC ;AS DEFAULT PROCESSOR
SETZM LOKNAM ;NO ALTERNATE DEVICE YET
SETZB FL2,FL3 ;AND NO FLAGS EITHER
OPEN LOOK,DSKLK ;GET THE DSK
JRST DSKNA
INBUF LOOK,2
IFE PURESW,<
SETZM FREBUF ;MARK NO FREED BUFFERS
MOVE T1,[XWD FREBUF,FREBUF+1]
BLT T1,FREBUF+NESTDP>
MOVE T1,.JBFF
MOVEM T1,SVJFF
MOVE T1,.JBREL
MOVEM T1,CORTOP
MOVEM T1,CORT1
IFE PURESW,<
SETZM SAVCHR ;TO START THINGS
>
HLLZS .JBERR ;RESET ERROR COUNT
MOVSI SVPT,-NFILE
TESTIT: PUSHJ P,SCAN ;SCAN PAST THE COMPILE ETC
MOVE T1,ACCUM ;FIND OUT WHICH COMMAND
MOVNI T2,1
STPT1: LSH T1,6
LSH T2,-6
JUMPN T1,STPT1
MOVSI T1,-COMTLG
SETOM NUMAT ;-1 TO NUMBER FOUND
STPT2: MOVE T3,COMTAB(T1)
CAMN T3,ACCUM ;EXACT MATCH?
JRST COMATC ;YES, ALL DONE
ANDCM T3,T2
CAME T3,ACCUM
JRST STPT3 ;NO MATCH
AOS NUMAT ;POSSIBLE MATCH
MOVEM T1,SVIND ;SAVE POINTER
STPT3: AOBJN T1,STPT2
SKIPGE NUMAT ;WAS THERE AT LEAST ONE
JRST UNKERR ;NO
SKIPE NUMAT ;BUT NO MORE THAN ONE
JRST AMBIGU ;NO, SO COMMAND IS AMBIGUOUS
MOVE T1,SVIND ;RESTORE THE POINTER
COMATC: XCT COMT2(T1) ;DO THE APPROPRIATE THING
PUSHJ P,SCAN ;GET NEXT THING
TRNN IOPNT,-1 ;IF DOWN A LEVEL ITS OK
TLNN CS,TERMF ;OR IF NOTHING SEEN
SKIP 1
JRST COMAT1
TRNE FL,EDITF
JRST DOEDT1
JRST NXFIL1
COMAT1: MOVE T1,[POINT 7,FCOMD] ;GENERATE FAKE COMMAND TO READ
TRNE FL,EDITF
MOVE T1,[POINT 7,FCOMD2]
MOVEM T1,DINPT ;SAVE FILE
TRO FL,RECALF+CMDSN ;MARK RECALLING FILE, DONT WRITE
SETZM SAVCHR ;CLEAR OUT SCANNER
MOVSI IOPNT,-<NESTDP+1> ;ALLOW EXTRA NESTING
PUSHJ P,SCAN
TRNE FL,EDITF
JRST DOEDIT
NXFIL: PUSHJ P,SCAN
NXFIL1: MOVSI SVPT,-NFILE ;SET UP FOR NUMBER OF FILES
MOVEI SWCNT,SWBK*5 ;SET UP FOR SWITCHES
MOVE SWPT,[POINT 7,SWBLK] ;AND POINTER
SETZM SWBKL
SETZM SWBKB
SETZM ONAM
SETZM OEXT
SETZM OPPN
SETZB FL2,LOKNAM ;CLEAR LAST PROCESSOR FLAGS AND SOURCE DEV
IFN SFDSW,<X==0
REPEAT SFDLEN,<SETZM OSFD+X
X==X+1>
>
HLL FL3,FL ;SET TEMP FLAGS FROM PERM FLAGS
MOVE T1,[POINT 7,LODSBK] ;SET POINTER TO LOADER
MOVEM T1,LODSP ;SWITCH BLOCK
MOVEI T1,LODSCT
MOVEM T1,LODCTR
MOVEM T1,LODCT2 ;AND SET COUNT FOR AFTER FILE NAME SWITCHES
MOVE T1,[POINT 7,LODSB2]
MOVEM T1,LODSP2
SETZM BROCNT ;CLEAR OUT THE <> COUNT
SETZM SAVSW ;[234] INCASE LAST WAS SAVE FILE
JRST ILP0A
XALL
SUBTTL COMMAND DISPATCH
DEFINE COMAND (A,B)<
<SIXBIT /A/>>
COMTAB: CTABLE
COMTLG==.-COMTAB
DEFINE COMAND (A,B)<
B>
COMT2: CTABLE
SALL
DEBUG: SETOM DEBFL ;DEFER UNTIL WE SEE FIRST FILE
POPJ P,
XCTR: MOVSI T2,'/E '
MOVEM T2,EXECFL ;DEFER UNTIL WE GET CHANCE TO SEE /LINK
POPJ P,
SUBTTL MAIN LOOP FOR READING INPUT
ILP0: PUSHJ P,SCAN ;GET FIRST "THING"
ILP0A: CAIN C,"/" ;CHECK FOR PERM COMPILE SWITCHES
JRST COMPS1
CAIN C,"%" ;CHECK FOR PERM LOADER FLAGS
JRST LOADS1
ILP1A: TRZ FL,PROCS ;NO PROCESSOR SWITCHES SEEN YET
SETOM GOTPST ;GOT PAST SWITCH SCANNER
ILP1: PUSHJ P,GETNAM ;GO GET A FILE NAME
PUSH P,C ;INCASE WE NEED TO RESTORE IT
MOVE C,LODSP ;EXCHANGE POINTERS
EXCH C,LODSP2
MOVEM C,LODSP
MOVE C,LODCTR
EXCH C,LODCT2
MOVEM C,LODCTR
POP P,C ;RESTORE C
CAIE C,"]" ;GET RID OF CLOSING PPN IF LAST WAS ONE
TRNE FL,IDF ;ALREADY SCANNED FAR ENOUGH IF NO FILE NAME
ILP2A: PUSHJ P,SCAN ;GET THE SPECIAL CHR OR WHATEVER
ILP2: CAIE C,"," ;DONE WITH THIS SET OF NAMES?
TLNE CS,TERMF ;WILL ACCEPT A TERMINATOR
JRST SETUP ;GO SET UP THE FILES FOR PROCESSORS
CAIN C,"(" ;MAYBE SWITCHES TO BE PASSED TO PROCESSORS
JRST PROCSW
CAIN C,"/" ;OR FOR US
JRST COMPSW
CAIN C,"%"
JRST LOADS2
CAIN C,">"
JRST ENDBRO ;THIS IS THE END OF A BROKET STRING
CAIN C,"=" ;MAYBE HE IS SETTING THE OUTPUT NAME
JRST SETONM
CAIN C,"[" ;IS IT PROJECT-PROGRAMMER NUMBER?
JRST GETDIR ;YES
CAIE C,"+" ;IS THIS A SECOND FILE
GOTO SYNERR ;IT SHOULD HAVE BEEN ONE OF THOSE
AOBJP SVPT,TMNER ;MAYBE TOO MANY FILES
MOVE C,LODSP ;EXCHANGE POINTERS AGAIN
EXCH C,LODSP2
MOVEM C,LODSP
MOVE C,LODCTR
EXCH C,LODCT2
MOVEM C,LODCTR
PUSHJ P,SCAN ;GET NEXT
CAIE C,"<" ;IS THIS THE <> CONSTRUCTION
JRST ILP0A ;NO
AOS BROCNT ;WE ARE ONE DEEPER IN BROKETS
PUSHSZ==.
IFN SFDSW,<
X==SFDLEN-1
REPEAT SFDLEN,<
PUSH P,OSFD+X
X==X-1>
>
PUSH P,OPPN
PUSH P,OEXT
PUSH P,SVPT ;SAVE AWAY ALL THE IMPORTANT INFORMATION
PUSH P,SWPT
PUSH P,SWCNT
PUSH P,LODSP
PUSH P,LODSP2
PUSH P,LODCTR
PUSH P,LODCT2
PUSH P,SWBKL
PUSH P,SWBKB
PUSH P,ONAM
PUSHSZ==.-PUSHSZ
JRST ILP0 ;GO FINISH THINGS UP
GETDIR: PUSHJ P,GETPP1 ;GO GET [PPN]
JRST ILP2A ;AND SEE WHAT ELSE WE HAVE
ENDBRO: PUSHJ P,SCAN ;GO GET NEST THING (SHOULD BE A ",")
TLNN CS,TERMF
CAIN C,","
SKIP 1 ;"," AND TERMF ARE OK
CAIN C,">" ;SO IS ANOTHER END-BRACKET
SOSGE BROCNT ;ALSO ERROR IF NO < WAS SEEN
GOTO SYNERR
SUB P,[PUSHSZ,,PUSHSZ] ;RESET PDL
CAIN C,">" ;END-BRACKET GETS DIFFERENT TREATMENT
JRST ENDBRO ;TO COMMA
JRST SETUP ;GO TAKE CARE OF THINGS
NXFILP: SKIPG BROCNT ;ARE WE DONING BROKETS?
JRST NXFIL ;NO, JUST CONTINUE
MOVE T1,(P)
MOVEM T1,ONAM
MOVE T1,-1(P)
MOVEM T1,SWBKB
MOVE T1,-2(P)
MOVEM T1,SWBKL
MOVE T1,-3(P)
MOVEM T1,LODCT2
MOVE T1,-4(P)
MOVEM T1,LODCTR
MOVE T1,-5(P)
MOVEM T1,LODSP2
MOVE T1,-6(P)
MOVEM T1,LODSP
MOVE SWCNT,-7(P)
MOVE SWPT,-10(P)
MOVE SVPT,-11(P)
MOVE T1,-12(P)
MOVEM T1,OEXT
MOVE T1,-13(P)
MOVEM T1,OPPN
IFN SFDSW,<
X==0
REPEAT SFDLEN,<
MOVE T1,SFDLEN-PUSHSZ-X(P)
MOVEM T1,OSFD+X
X==X+1>
>
JRST ILP0
COMPS: PUSHJ P,SCAN ;GET THE NAME OF THE SWITCH
TRNN FL,IDF ;WAS THERE REALLY AN IDENTIFIER THERE?
GOTO SYNERR ;LOSE
MOVE T1,ACCUM ;GET ITS SIXBIT
MOVNI T2,1 ;SET UP MASK
CMP1: LSH T1,6
LSH T2,-6
JUMPN T1,CMP1 ;WHEN DONE T2 HAS 0'S FOR ALL CHRS IN T1
MOVSI T1,-TBLG ;GET SET TO SCAN FOR NAME
SETOM NUMAT ;-1 TO NUMBER FOUND
CMP3: MOVE T3,SWTAB(T1) ;GET A SWITCH
CAMN T3,ACCUM ;EXACT MATCH?
JRST MATCH ;YES, ALL DONE
ANDCM T3,T2 ;0 OUT UNNECESSARY CHRS
CAME T3,ACCUM
JRST CMP2 ;NO MATCH
AOS NUMAT ;POSSIBLE MATCH
MOVEM T1,SVIND ;SAVE POINTER
CMP2: AOBJN T1,CMP3
SKIPGE NUMAT ;WAS THERE AT LEAST ONE MATCH
JRST UNRECS
SKIPE NUMAT ;BUT NO MORE THAN ONE?
JRST AMBIGU ;NO, SO COMMAND IS AMBIGUOUS
MOVE T1,SVIND ;RESTORE THE POINTER
MATCH: HRRZ T1,T1 ;INDEX ONLY
CAIL T1,ASWTAB-SWTAB ;IN ADDRESS TABLE?
JRST [MOVE T1,SWTAB2(T1) ;YES, LOAD UP JUMP ADDRESS
JRST (T1)] ;GO TO ROUTINE (LEFT HALF MAY BE SET)
CAIL T1,PSWTAB-SWTAB ;IN PROCESSOR TABLE?
JRST PMATCH ;YES, USE OTHER FLAGS
MOVE T1,SWTAB2(T1) ;NO, GET ACTION
SMATCH: TLZ FL3,(T1) ;[221] TURN OFF SWITCHES AS NEEDED
TRNE FL,PERF ;PERMANENT?
TLZ FL,(T1) ;SET THAT TOO
MOVSS T1
TLO FL3,(T1) ;AND TURN ON OTHERS
TRNE FL,PERF
TLO FL,(T1)
ANDI T1,DEVSWS ;SEE IF FIRST DEVICE SWITCH
SKIPN LODDEV ;AND IF SO
HRLOM T1,LODDEV ;SAVE AS LOADER DEVICE (RH SET TO -1)
JRST SCAN ;GET SOMETHING ELSE
PMATCH: MOVE T1,SWTAB2(T1) ;GET SWITCHES
TRZ FL2,(T1) ;TURN OFF LOCAL PROCESSOR
MOVSS T1
TRO FL2,(T1) ;TURN IT ON
TRNE FL,PERF
HRRZM T1,DFPROC ;CHANGE DEFAULT PROCESSOR TO
JRST SCAN
XALL
DEFINE X (A,B,C,D,E,F,G)<
SWITCH A,<XWD B'SW,ALPROC>>
DEFINE SWITCH (A,B)<
< SIXBIT /A/>>
SWTAB: STABLE
PSWTAB: PTABLE
ASWTAB: ATABLE
TBLG==.-SWTAB
DEFINE SWITCH (A,B)<
B>
SWTAB2: STABLE
PTABLE
ATABLE
;HERE ON "/" AFTER A FILE NAME
COMPSW: TRZ FL,PERF ;DOING TEMP
PUSHJ P,COMPS
JRST ILP2
;HERE ON "/" AS FIRST CHAR OF IDENT, I.E. PERM SW
COMPS1: TRO FL,PERF
PUSHJ P,COMPS
TLNE CS,TERMF ;CHECK FOR TERMINATOR
JRST SWTERM ;YES, EITHER ERROR OR READ SVC FILE
CAIE C,"," ;IS NEXT CHAR. A COMMA
JRST ILP0A
JRST ILP0 ;YES,SO SCAN FOR CHAR. AFTER IT
SWTERM: SKIPN GOTPST ;IF WE GOT PAST SWITCH SCANNER
TRNE FL,RECALF!CMDSN ;OR ALREADY READING SVC FILE
JRST ILP0A ;THEN ITS AN ERROR
JRST COMAT1 ;NO, SO READ SVC FILE
SETLPT: SKIPA T1,[SIXBIT /LPT/] ;[251] SET TO USE LPT:
SETDSK: MOVEI T1,. ;[251] SET AS DSK:
MOVEM T1,SPDLPT ;[251] SAVE IN SWITCH WORD
MOVE T1,[LISTSW,,CRSW] ;[251] SET UP T1 AS A SWITCH
JRST SMATCH ;[251] TABLE MATCH AND DO THAT PROCESS
SETMPL: TRNN FL,DOLOD ;OR NOT LOADING?
SKIPA T3,[-1] ;DON'T STORE ANYTHING
MOVEI T3,CHNLOD
MOVE T2,['(F1MG)']
TRNN FL,LINKFL ;LINK-10
JRST SETMP ;NO
MOVEI T1,"," ;MIGHT NEED A SEPARATOR
SKIPE TMPCHN(T3) ;UNLESS NOTHING OUTPUT YET
PUSHJ P,TMPOUT ;SEP FROM PREV FILE SPEC
MOVE T2,['/CONTE'] ;USE NEW SWITCHES
PUSHJ P,OUTSIX
MOVE T2,[':LOCAL']
PUSHJ P,OUTSIX
PUSHJ P,OUTSPC ;AND PUT /GO IN MAPSW
MOVE T2,['/LOCAL'] ;[257]LOCAL MAP NEEDS LOCAL SYMBOLS
PUSHJ P,OUTSIX ;[257]PUT SPEC INTO TMPCOR
PUSHJ P,OUTSPC ;[257]PLUS A SPACE
JRST LNKMAP ;NOW FOR /MAP
SETMAP: TRNN FL,DOLOD ;OR NOT LOADING?
SKIPA T3,[-1] ;DON'T STORE ANYTHING
MOVEI T3,CHNLOD
MOVE T2,['(FMG) ']
TRNN FL,LINKFL ;LINK-10
JRST SETMP ;NO
MOVEI T1,"," ;MIGHT NEED A SEPARATOR
SKIPE TMPCHN(T3) ;UNLESS NOTHING OUTPUT YET
PUSHJ P,TMPOUT ;SEP FROM PREV FILE SPEC
LNKMAP: MOVSI T2,'/G ' ;JUST TO TERMINATE
SETMP: SKIPN MAPSW ;ALREADY SET?
MOVEM T2,MAPSW ;STORE AND USE AS FLAG
TRNN FL,LINKFL ;NOTHING TO OUTPUT YET
PUSHJ P,OUCRLF
PUSHJ P,SCAN ;LOOK AT NEXT CHAR.
CAIE C,":" ;IS THIS A KEY WORD SPECIFICATION
JRST SETMP1 ;NO
AOBJP SVPT,NESTTD ;MAKE SPACE FOR FIELDS
;**;[302] @SETMP+7 1/2, JMT, 27-MAY-76
TRO FL,F.STKY ;[302] SET FLAG FOR NO STICKINESS
PUSHJ P,SCANAM ;YES, SO GO GET SPECIFICATIONS
TRZ FL,F.STKY ;[302] CLEAR FLAG
SKIPE T2,SVDEV(SVPT) ;A DEVICE SPECIFIED?
PUSHJ P,OUTDEV ;YES
SKIPE T2,SVNAM(SVPT) ;NAME SPECIFIED?
JRST .+4 ;YES
TRNE FL,LINKFL ;NO, BUT LINK-10 MAKES ITS OWN
JRST .+3 ;SO DON'T DO IT HERE
MOVSI T2,'MAP' ;DEFAULT NAME
PUSHJ P,OUTSIX ;OUTPUT IT
SKIPE T2,SVEXT(SVPT) ;AN EXTENSION ALSO?
PUSHJ P,OUTEXT ;YES
SUB SVPT,[1,,1] ;BACK TO WHERE IT WAS
CAIN C,"/" ;IF WE ENDED WITH A SWITCH
TRNE FL,IDF ;AND HAVE N'T YET SEEN IT
PUSHJ P,SCAN
TRNN FL,LINKFL ;IF LINK-10 DON'T FORGET /MAP
JRST SETMP2
SETMP1: MOVSI T2,'MAP' ;DEFAULT NAME
TRNE FL,LINKFL ;LINK-10?
MOVSI T2,'/M ' ;YES
PUSHJ P,OUTSIX
TRNE FL,LINKFL
PUSHJ P,OUTSPC
SETMP2: MOVEI T1,"=" ;NEW STANDARD
PUSHJ P,TMPOUT
TRZ FL,LODOUT ;DO NOT NEED A COMMA FOR NEXT FILE
POPJ P,
SETDDT: SETOM DDTFL
PJRST SCAN ;RETURN VIA SCAN
FORSE: MOVEI T1,FRSCOD ;[242] FLAG USE OF FORSE
JRST SETOTS ;STORE RESULT
FOROTS: MOVEI T1,FRTCOD ;[242] FLAG USE OF FOROTS
SETOTS: MOVEM T1,FORLIB
PJRST SCAN
LOADIT: TRZA FL,LINKFL ;MAKE SURE NOT SET
LINKIT: TRO FL,LINKFL ;WANTS LINK-10
;[242] LINKIT+1,JNG,10/3/74
SKIPN TMPCHN+CHNLOD ;MAKE SURE NO LOADER/LINK-10 OUTPUT
SKIPE MAPSW
JRST LLCERR
MOVEI T1,LODSCT ;OR LOAD SWITCHES STORED
CAMG T1,LODCTR ;FOR FUTURE
CAMLE T1,LODCT2 ;BUT NOT YET OUTPUT
JRST LLCERR ;YES, BOMB USER
PJRST SCAN
SETDEB: PUSH P,SWPT ;[221] SAVE ACCS INCASE USED
PUSH P,SWCNT ;[221] ...
MOVEI SWCNT,DEBSIZ*7-1 ;[221] NO. OF CHARS ALLOWED TO STOR
MOVE SWPT,[POINT 7,DEBPRM] ;[221] WHERE IF PERM?
TRNN FL,PERF ;[221] WAS IT?
HRRI SWPT,DEBTMP ;[221] NO, BAD GUESS
SETZM (SWPT) ;[221] INCASE NO SWITCHES
AOS (SWPT) ;[221] BUT MARK IT SEEN
PUSHJ P,SCANS ;[221] LOOK AT NEXT CHAR
CAIE C,":" ;[221] VALUE SPECIFED
JRST RETDB1 ;[221] NO
SETZM SAVCHR ;[221] GET RID OF ":"
SETZM PARLVL ;[221] INCASE WE SEE ENCLOSED LIST
DEBLUP: PUSHJ P,GETCH ;[221] GET NEXT CHAR
TLNE CS,TERMF ;[221] TERMINATOR?
JRST RETDEB ;[221] YES, END
CAIN C,"(" ;[221] SWITCH LIST?
AOS CS,PARLVL ;[221] COUNT UP, AND FAKE OUT CS
CAIN C,")" ;[221] END OF SWITCH LIST?
JRST [SOSLE CS,PARLVL ;[221] BACK TO 0 LEVEL
JRST OUTDEB ;[221] NOT YET, JUST OUTPUT IT
PUSHJ P,STRDEB ;[221] OUTPUT IT
JRST RETDEB] ;[221] AND GIVE UP
SKIPN PARLVL ;[221] IF NESTED PASS ANYTHING
JUMPLE CS,RETDEB ;[221] OTHERWISE GIVE UP ON DELIMITER
OUTDEB: PUSHJ P,STRDEB ;[221] OUTPUT THIS CHAR
JRST DEBLUP ;[221] LOOP
RETDEB: MOVEM CS,SAVCHR ;[221] REPEAT DELIMITER
SETZ C, ;[221] MAKE SURE TERMINATED
IDPB C,SWPT ;[221] ALWAYS ENOUGH SPACE
RETDB1: MOVSI T1,DEBUGSW ;[221] SET SWITCH
POP P,SWCNT ;[221] RESTORE
POP P,SWPT ;[221] ...
JRST SMATCH ;[221] BY NORMAL CODE
STRDEB: SOJLE SWCNT,ETMS ;[221] NOT ENOUGH ROOM
IDPB C,SWPT ;[221] STORE CHAR
POPJ P, ;[221] RETURN
FORDDT: TLO FL,DEBUGSW ;[221] SET PERM FLAG
TLO FL3,DEBUGSW ;[221] AND TEMP
SETZM DEBPRM ;[221] USE DEFAULT
SETZM DEBTMP ;[221] ...
MOVE T1,['FORDDT'] ;[221] NAME OF DEBUGGER
MOVEM T1,DDTFL ;[221] PRE-EMPT NORMAL TESTS
PJRST SCAN ;[221] RETURN
SAVE: SKIPA T2,['/SAVE '] ;[234]
SSAVE: MOVE T2,['/SSAVE'] ;[234]
;[256] SSAVE+1
SKIPN SVNAM(SVPT) ;[256] IS THERE A SAVE NAME?
JRST SAVERR ;[256] NO, THAT IS AN ERROR
MOVEM T2,SAVSW ;[234] SAVE WHICH SWITCH
TRNN FL,DOLOD ;[234] ARE WE LOADING?
SKIPA T3,[-1] ;[234] NO, DON'T CREATE TMP FILE
MOVEI T3,CHNLOD ;[234] YES, GET CHAN NO.
TRNN FL,LINKFL ;[234] ONLY WORKS FOR LINK-10
GOTO LLCERR ;[234] WARN USER IF LOADER SPECIFIED
PJRST SCAN ;[234]
PROCSW: TROE FL,PROCS ;HAVE WE ALREADY SEEN SOME?
GOTO SYNERR ;YES, I DEFINE THIS AS ILLEGAL
MOVEM SWPT,SWBKS(SVPT) ;SAVE BYTE POINTER TO NEW ONES
TRZ FL,PCM1!PCM2 ;NO COMMAS YET
SETZM PARLVL ;[221] START AT LEVEL 0 (SEEN 1)
PROCS1: PUSHJ P,GETCH ;GIVE ME A CHARACTER
CAIN C,")" ;DONE?
JRST [SOSGE PARLVL ;[221] BACK TO LEVEL -1 YET?
JRST ESTR ;[221] YES
JRST PROCS2] ;[221] NO, STORE ")"
CAIN C,"," ;POSSIBLY COMMA
JRST [SKIPG PARLVL ;[221] SEE IF NESTED
JRST PCCOM ;[221] AT TOP LEVEL, GO TAKE GOOD CARE OF IT
JRST PROCS2] ;[221] YES, STORE IT
CAIE C,":" ;[221] ALLOW ":" FOR SWITCH VALUES
CAIN C," " ;ALLOW SPACE FOR MULTIPLE SWITCHES
JRST PROCS2 ;TO FORTRAN-10
CAIN C,"/" ;[252] ALLOW "/" FOR SWITCH VALUE
JRST PROCS2 ;[252] FOR ALGOL
CAIN C,"(" ;[221] ALLOW "(" TO ENCLOSE SWITCH VALUES
AOS CS,PARLVL ;[221] COUNT LEVEL UP AND FAKE CS
IFE DEBSW,<
JUMPLE CS,SYNERR ;NOT ANUMBER OR LETTER, HE LOSES
>
IFN DEBSW,<
SKIPG CS ;SAME CODE BUT LONGER
GOTO SYNERR
>
PROCS2: IDPB C,SWPT ;SAVE IT AWAY
SOJG SWCNT,PROCS1 ;NEXT PLEASE
JRST ETMS ;TOO MANY SWITCHES FOR SPACE RESERVED
PCCOM: TROE FL,PCM1 ;IS THIS THE FIRST OR SECOND COMMA
JRST NOTBIN ;NOT FIRST, TRY FOR SECOND
CAMN SWPT,SWBKS(SVPT) ;WAS ANYTHING STORED?
JRST PROCS1 ;NO, JUST IGNORE
SKIPE SWBKB ;ARE THERE ALREADY BINARY SWITCHES
GOTO SYNERR ;YES, MORE NOT ALLOWED
MOVE T1,SWBKS(SVPT) ;GIVE THIS TO BINARY
MOVEM T1,SWBKB
COMCOM: MOVEI C,0 ;MARK END OF STRING
IDPB C,SWPT
SOJLE SWCNT,ETMS ;HAVE WE RUN OUT?
MOVEM SWPT,SWBKS(SVPT) ;AND A NEW ONE FOR SRC
JRST PROCS1
NOTBIN: TROE FL,PCM2 ;SECOND ALREADY SEEN?
GOTO SYNERR ;YES, THREE NOT PERMITTED
CAMN SWPT,SWBKS(SVPT) ;ANYTHING THERE?
JRST PROCS1 ;HE WOULD HAVE BEEN JUST AS WELL WITHOUT IT
SKIPE SWBKL ;ALREADY LIST SWITCHES?
GOTO SYNERR ;YES, HE LOSES
MOVE T1,SWBKS(SVPT) ;AND GIVE TO CORRECT PERSON
MOVEM T1,SWBKL
JRST COMCOM
ESTR: CAMN SWPT,SWBKS(SVPT) ;WAS ANYTHING STORED?
JRST [SETZM SWBKS(SVPT) ;NO, ZERO IT
JRST ILP2A]
MOVEI C,0
IDPB C,SWPT ;MARK
SOJLE SWCNT,ETMS
JRST ILP2A ;NEXT
SETONM: SKIPE ONAM ;OUTPUT NAME GIVEN BEFORE?
SKIPLE BROCNT ;BUT OK IN BROKETS
TRNE FL,PROCS ;PROCESSOR SWITCHES NOT PERMITTED HERE
GOTO SYNERR
MOVE T1,SVNAM(SVPT) ;GET THE NAME
MOVEM T1,ONAM ;AND SAVE IT AWAY
MOVE T1,SVEXT(SVPT)
MOVEM T1,OEXT
MOVE T1,SVPPN(SVPT)
MOVEM T1,OPPN
MOVE T1,SVDEV(SVPT)
MOVEM T1,ODEV ;SAVE OUTPUT DEVICE
;[267] SETONM+13 1/2 , SMM , 2-SEP-75
SETZM SVDEVV ;[267]OKAY, DONE WITH STICKY-NESS
IFN SFDSW,<
X==<Y==0>
REPEAT SFDLEN,<
MOVE T1,SVSFD+X(SVPT)
MOVEM T1,OSFD+Y
X==X+NFILE
Y==Y+1
>
>
PUSHJ P,SCAN
JRST ILP1
LOADS1: PUSHJ P,LODS1
JRST ILP0
LOADS2: PUSH P,[ILP2A] ;SET RETURN POINT
LODS1: PUSHJ P,GETCH ;NEXT CHR
CAIG C," " ;NON-PRINTING CHARS. NOT ALLOWED
GOTO SYNERR ;THIS REALLY IS A BUG
TRNE FL,LINKFL ;LINK-10?
JRST LODS2 ;YES, SPECIAL HANDLING
CAIN C,"&" ; SYMBOLIC SWITCH
JRST LODSWS
CAIN C,"-" ;SPECIAL CHECK FOR -SWITCH
LODS1A: TLO CS,NUMF ;PRETEND ITS A NUMBER
IDPB C,LODSP ;SAVE IT
SOSG LODCTR ;CHECK SIZE
JRST ETMS
TLNN CS,NUMF ;A NUMBER
POPJ P, ;NO, DONE
JRST LODS1 ;YES, THEY GET PASSED ON
;HERE FOR SYMBOLIC SWITCHES %&SYMBOL&SWITCH
LODSWS: IDPB C,LODSP
SOSG LODCTR
JRST ETMS
PUSHJ P,GETCH
CAIE C,"&"
JRST LODSWS
JRST LODS1A
;HERE FOR LINK-10 SWITCHES
;THEY ARE IN FORM %'SWITCH:ARG'
LODS2: PUSH P,C ;SAVE TERMINATOR
CAIL C,"0" ;LOOK FOR POTENTIALLY DANGEROUS
CAILE C,"9" ;SWITCH DELIMITERS
CAIA ;I.E. THOSE THAT COULD BE
JRST LODS4 ;LOADER SINGLE CHAR SWITCHES
CAIL C,"A" ;WARN USER
CAILE C,"Z" ;BUT CONTINUE
CAIA ;REMOVE AT SOME FUTURE DATA
JRST LODS4 ;WHEN LINK-10 HAS REPLACED LOADER
CAIL C,"a"
CAILE C,"z"
CAIA
CAIE C,"-" ;DONT FORGET MINUS
CAIN C,"&" ;OR SYMBOLIC SWITCH
JRST LODS4
LODS3: PUSHJ P,GETCH ;NEXT CHR
CAIG C," " ;NON-PRINTING CHARS. NOT ALLOWED
GOTO SYNERR ;THIS REALLY IS A BUG
CAMN C,0(P) ;TERMINATOR?
JRST LODS5 ;YES, STORE BLANK AND ZERO
IDPB C,LODSP ;SAVE IT
SOSG LODCTR ;CHECK SIZE
JRST ETMS
JRST LODS3 ;LOOP FOR MORE
;HERE TO WARN USER INCASE CTL FILE CONTAINS LOADER SWITCHES
LODS4: STRING [ASCIZ /%CMLILS Illegal LINK-10 switch delimiter: /]
OUTCHR C
STRING [ASCIZ \
\]
JRST LODS3
;HERE TO TERMINATE THIS SWITCH
;MARK END WITH BLANK
;STORE ZERO IN CASE END (BUT DON'T INCREMENT BYTE POINTER OR COUNT)
LODS5: MOVEI C," " ;NEED TO OUTPUT A SPACE
IDPB C,LODSP ;SO STORE IT
SOSG LODCTR ;MAKE SURE IT FITS
JRST ETMS ;NO
SETZ C, ;NULL TERMINATOR
MOVEM T2,0(P) ;JUST INCASE
MOVE T2,LODSP ;GET BYTE POINTER
IDPB C,T2 ;WILL GET OVERWRITTEN IF MORE SWITCHES
MOVE T2,LODCTR ;MAKE SURE NULL FITTED
SOJLE T2,ETMS ;INCASE NO MORE SWITCHES
POP P,T2 ;RESTORE T2, GET STACK BACK IN SHAPE
POPJ P, ;FINISHED
SETUP: MOVE T1,SVNAM(SVPT) ;LAST FILE NAME
SKIPN ONAM ;SET ONAM IF NOT ALREADY
MOVEM T1,ONAM
SETOM EXTEND ;[240] HERE TO CHECK IF ALL DEVICES
;[240] ARE DISKS SO CAN USE EXTENDED
;[240] LOOKUPS FOR MORE ACCURATE
;[240] CREATION TIME CHECKS.
SKIPN T1,ODEV ;[240] OUTPUT DEVICE SPECIFIED?
JRST .+4 ;[240] NO, ASSUME DISK
DEVCHR T1, ;[240] FIND OUT WHAT IT IS
TLNN T1,DV.DSK ;[240] A DISK?
JRST ONSET1 ;[240] NO.
MOVSI T1,-NFILE ;[240] SETUP TO CHECK ALL INPUTS
DSKLUP: SKIPN T2,SVDEV(T1) ;[240] DEVICE GIVEN?
JRST .+4 ;[240] NO, ASSUME A DISK
DEVCHR T2, ;[240] WHAT IS IT?
TLNN T2,DV.DSK ;[240] A DISK?
JRST ONSET1 ;[240] NOPE.
AOBJN T1,DSKLUP ;[240] LOOP FOR ALL DEVICES
JRST ONSET ;[240] THEY'RE ALL DISKS!
ONSET1: SETZM EXTEND ;[240] THEY'RE NOT ALL DISKS
ONSET: TRZ FL,NODAT ;WE HAVE NOT SEEN A DIFFERENT DEVICE
SETZM SDAT ;LATEST DATE
SETZM STIM ;AND LATEST TIME
TLZ FL2,-1 ;NO PROCESSOR YET
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
IFN MANTIS,<
SKIPGE DEBFL ;[255]IF NOT DEBUGGING
SKIPE DDTFL ;OR EXPLICIT DDT REQUEST
JRST ONSET1 ;DON'T WANT MANTIS
TLNN FL2,FORSW ;FIRST PROG F4?
JRST ONSET1 ;NO, THEN NOT MANTIS BY DEFAULT
TLNN FL3,NOMANTSW ;WANT MANTIS FOR THIS PROG?
TLO FL3,MANTSW ;YES
TLO FL,MANTSW ;AND FOR WHOLE
ONSET1:>
TLNE FL2,RELSW ;IF A REL FILE
JRST LDREL ;GO LOAD IT NOW
TRNE FL,NODAT ;NO DATES ON OTHER DEVICES
JRST LBCOMP ;BUT CHECK FOR /LIB FIRST
TLC FL3,NOBINSW!LISTSW ;INVERT /NOBIN/LIST SWITCHES
TLCE FL3,NOBINSW!LISTSW ;TEST FOR BOTH ON
TLNE FL3,COMPLS ;DO WE ALWAYS WANT TO COMPILE?
JRST DOCOMP ;YES, COMBINATION FORCES COMPILE
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
MOVE T1,ONAM ;SEE IF REL IS THERE
MOVEM T1,LNAM
HLLZ T1,FL2 ;[265]GET ONLY LH SO DEFUALT TO 'REL'
JFFO T1,.+1 ;[212] GET PROCESSOR INDEX INTO T2
SKIPN T1,OEXT ;[212] OUTPUT EXTENSION ALREADY SPECIFIED?
SKIPE T1,INTEXT(T2) ;[212] NO, GET FROM TABLE
SKIPN T1 ;[212] HAVE WE GOT SOMETHING YET?
MOVSI T1,'REL' ;[212] NO USE REL
MOVEM T1,LEXT
;[240] REREL+14
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
IFN TENEX,< ;GET EXACT TIMES IN TENEX SYSTEM
PUSHJ P,GDTLOK ;GET DATE AND TIME OF LOOK CHANNEL
JRST REREL2 ;NOT IN THE COMPATIBILITY
HLRZ T2,LDAT ;OK. LH LDAT IS DATE IN TENEX FORMAT
CAMGE T2,SDAT
JRST DOCOMP ;COMPILE THIS
CAME T2,SDAT ;SAME DATE?
JRST NOCOM1 ;NO. DON'T COMPILE
HRRZ T2,LDAT ;GET TIME IN SECONDS
CAMLE T2,STIM ;NEWER?
JRST NOCOM1 ;SOURCE OLDER
JRST DOCOMP ;SOURCE NEWER OR EQUAL
GDTLOK: PUSH P,T1 ;SAVE SOME ACS
PUSH P,T2
PUSH P,T3
MOVEI T1,LOOK ;CHANNEL
CALL T1,['FILJFN'] ;TENEX HANDLE OF THIS CHANNEL
JRST TPOPJ3 ;NOT FOUND. NOT IN PA1050?
PUSH P,T1 ;SAVE JFN
DVCHR ;GET DEVICE BITS
POP P,T1 ;RESTORE JFN
TLNE T2,777 ;ON DISK?
JRST TPOPJ3 ;NO.
MOVE T2,[1,,14] ;POINT TO THE WRITE DATE AND TIME
MOVEI T3,LDAT ;PUT IT IN LOOKUP BLK DATE WRD
GTFDB ;DO IT
AOS -3(P) ;SUCCESS RETURN
JRST TPOPJ3 ;RESTORE 3 TEMPS AND RETURN
>
REREL2: LDB T2,[POINT 12,LDAT,35] ;GET LOW 12 BITS OF DATE
LDB T1,[POINT 3,LEXT,20] ;GET HIGH 3 BITS OF DATE
DPB T1,[POINT 3,T2,23] ;MERGE THE TWO PARTS
CAMGE T2,SDAT ;EARLIER
JRST DOCOMP ;YES, COMPILE
CAME T2,SDAT ;SAME?
JRST NOCOM1 ;NO, ALL OK
LDB T2,[POINT 11,LDAT,23] ;YES, GET TIME
CAMG T2,STIM ;LATER?
JRST DOCOMP ;NO, RECOMPILE
NOCOM1: TLNN FL2,FORSW ;FORTRAN PROG
JRST NOCOM3 ;NO, SKIP CHECKING REL FILE
PUSHJ P,CHKREL ;SEE WHAT TYPE OF REL FILE WE HAVE
JRST DOCOMP ;ERROR, SO RECOMPILE
NOCOM3: SKIPN SVRPP ;DID WE FIND THE REL FILE SOMEWHERE ELSE?
JRST NOCOMP ;NO
MOVE T1,OEXT ;MAKE SOURCE EXT = OUTPUT EXT
MOVEM T1,SVEXT ;[172]
TLO FL2,RELSW ;AND PRETEND HE SAID .REL
JRST NOCOMP
;[240] NOCOM3+6, JNG, 9/19/74
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
MOVE T2,EBLK+.RBTIM ;[240] GET CREATION TIME
CAMG T2,STIM ;[240] COMPILE?
JRST DOCOMP ;[240] YES.
JRST NOCOM1 ;[240] NO, NOT UNLESS BAD REL FILE.
DOCOMP: SKIPE SVRPP ;DID WE LOOK ON THIS AREA?
JRST REREL ;NO, TRY IT
MOVE T1,FL2 ;GET PROCESSOR FLAGS
JFFO T1,.+1 ;GET COUNT IN T2
MOVEM T2,PCNUM ;SAVE IT FOR LATER
MOVE T3,T2 ;GET THE # OF THE OUTPUT ROUTINE
TLNE FL3,NOBINSW ;REL FILE NOT WANTED?
JRST [MOVEI T1,"-" ;NO, LOAD T1
CAIN T3,CHNCBL ;IN CASE THIS IS COBOL
PUSHJ P,TMPOUT ;WHAT A LOSER COBOL IS
JRST DOCOM1] ;BUT LIST ANY RELEVANT SWITCHES
;[244] DOCOMP+10,JNG,12/15/74
SKIPE T2,ODEV ;[244] DID HE SPECIFY A DEVICE?
PUSHJ P,OUTDEV ;[244] YES, USE IT.
MOVE T2,ONAM ;START PUTTING OUT
PUSHJ P,OUTSIX
SKIPN T2,OEXT ;[212] EXTENSION EXPLICITLY GIVEN?
SKIPE T2,INTEXT(T3) ;[212] NO, SEE IF DEFAULT IS NOT REL
PUSHJ P,OUTEXT ;YES
IFN SFDSW,<
SKIPN T2,OPPN ;[274] OUTPUT PPN GIVEN?
SKIPE OSFD ;OR SFD?
>
IFE SFDSW,<
SKIPE T2,OPPN ;[274] OUTPUT PPN GIVEN?
>
PUSHJ P,SFDPPN ;YES
IFN MANTIS,<
TLNN FL2,FORSW ;FORTRAN PROGRAM?
JRST DOCOM1 ;NO, CERTAINLY DON'T WANT MANTIS
MOVSI T2,'/D ' ;ASSUME WE DO
TLNE FL3,MANTSW ;WELL DO WE?
PUSHJ P,OUTSIX ;YES, OUTPUT DEBUG SWITCH>
DOCOM1: SKIPE T2,SWBKB ;ARE THERE SWITCHES
PUSHJ P,OUTSW ;YES, OUTPUT THEM
TLNE FL2,FORSW ;FORTRAN?
IFE DFORTRAN,< ;YES, BUT IS IT F-10
TLNN FL3,F10SW ;DEFINITELY?>
IFN DFORTRAN,<
TLNE FL3,F40SW ;DEFINITELY NOT>
JRST DOCOM2 ;WE DONT WANT FORTRAN-10
TLNN FL3,CPUSW ;YES, BUT DO WE CARE WHICH TYPE OF CPU?
JRST DOCOMA ;NO, TAKE DEFAULT
MOVE T2,['/KA10 ']
TLNN FL3,KA10SW ;GUESS RIGHT?
HRLI T2,'/KI' ;NO
PUSHJ P,OUTSIX
DOCOMA: TLNN FL3,OPTSW!NOPTSW ;OPTIMIZER INFO?
JRST DOCOMD ;NO, TAKE DEFAULT
MOVE T2,['/OPT ']
TLNN FL3,OPTSW ;OPTIMIZE?
MOVE T2,['/NOPT '] ;NO
PUSHJ P,OUTSIX
DOCOMD: TLNN FL3,DEBUGSW ;[221] /DEBUG SEEN?
JRST DOCOM2 ;[221] NO
MOVE T2,['/DEBUG'] ;[221] OUTPUT SWITCH
PUSHJ P,OUTSIX ;[221]
SKIPE T2,DEBPRM ;[221] IF ANY PERM SWITCHES
MOVE T2,[POINT 7,DEBPRM] ;[221] LOAD POINTER TO THEM
SKIPE DEBTMP ;[221] BUT IF TEMP ONES
MOVE T2,[POINT 7,DEBTMP] ;[221] USE THEM
JUMPE T2,DOCOM2 ;[221] DONE IF NO ARGS
MOVE T1,(T2) ;[221] BUT MIGHT JUST BE MARKER
SOJE T1,DOCOM2 ;[221] IT WAS
MOVEI T1,":" ;[221] DELIMITER
PUSHJ P,TMPOUT ;[221] BETWEEN SWITCH AND ARGS
ILDB T1,T2 ;[221] GET NEXT CHAR
JUMPN T1,.-2 ;[221] END ON NULL
DOCOM2: TLNN FL3,LISTSW ;LISTING REQUESTED?
JRST [MOVSI T2,',- ' ;NO
CAIN T3,CHNCBL ;TEST FOR COBOL
PUSHJ P,OUTSIX ;YES
JRST NOLST]
MOVEI T1,"," ;YES, NEED A COMMA
PUSHJ P,TMPOUT
TLNN FL2,CBLSW!BLISW ;SKIP /CREF IF COBOL OR BLISS (SPECIAL)
;[251]REMOVED TLNN FL3,CRSW ;USE DSK IF /CREF
;[251]REMOVED SKIPLE T2,SPDLPT ;OTHERWISE USE SPOOLED LPT
;[251]REMOVED JRST DOCOM3 ;WE KNOW WE'RE NOT SPOOLED
;[251]REMOVED JUMPE T2,[MOVSI T1,'LPT' ;TEST FOR SPOOLED LISTING DEVICE
;[251]REMOVED MOVEM T1,SPDLPT ;ASSUME TRUE
;[251]REMOVED DEVTYP T1,
;[251]REMOVED CAIA ;CERTAINLY NOT SPOOLED
;[251]REMOVED TLNN T1,.TYSPL ;TEST SPOOL BIT
;[251]REMOVED HRRZM P,SPDLPT ;SET POSITIVE TO SHOW NOT SPOOLED LPT
;[251]REMOVED SKIPL T2,SPDLPT ;SEE IF WE WON
;[251]REMOVED JRST DOCOM3 ;NO
;[251]REMOVED JRST .+1] ;YES
TLNE FL3,CRSW ;[251]USE DSK: IF /CREF
JRST DOCOM3 ;[251]
SKIPG T2,SPDLPT ;[251]ELSE, IS THIS /DLIST OR /LIST?
PUSHJ P,OUTDEV ;SET LIST DEVICE
DOCOM3: MOVE T2,ONAM ;SET IT UP
PUSHJ P,OUTSIX
IFN SFDSW,<
SKIPN T2,OPPN ;[274] OUTPUT PPN GIVEN?
SKIPE OSFD ;OR SFD?
>
IFE SFDSW,<
SKIPE T2,OPPN ;[274] OUTPUT PPN GIVEN?
>
PUSHJ P,SFDPPN ;YES
TLNN FL3,CRSW ;CREF MAYBE
JRST NOLST1
MOVSI T2,'/C '
PUSHJ P,OUTSIX
PUSH P,T3
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?
PUSHJ P,OUTSW
NOLST: MOVE T1,SEPTAB(T3) ;[233] GET SEPARATOR
PUSHJ P,TMPOUT
MOVE T4,SVPT ;SAVE CURRENT POINTER
MOVSI SVPT,-NFILE ;RESET TO START
PRCLP: SKIPE T2,SVDEV(SVPT) ;IS THERE A DEVICE THERE
PUSHJ P,OUTDEV ;YES, PRINT IT
MOVE T2,SVNAM(SVPT) ;PUT OUT NAME
PUSHJ P,OUTSIX
SKIPE T2,SVEXT(SVPT) ;AND EXT IF NECESSARY
PUSHJ P,OUTEXT
SKIPE T2,SVPPN(SVPT) ;NEED PPN?
PUSHJ P,OUTPPN ;PUT THEM OUT
SKIPE T2,SWBKS(SVPT) ;AND SWITCHES
PUSHJ P,OUTSW
CAMN T4,SVPT ;ALL DONE?
JRST ENDPRC ;YES, GO FINISH UP AND CONSIDER LOADING
MOVEI T1,","
PUSHJ P,TMPOUT ;NEXT FILE
AOBJN SVPT,PRCLP
MOVE SVPT,T4 ;SHOULD NEVER GET HERE
ENDPRC: PUSHJ P,OUCRLF
IFN FORTRAN,< ;CHOICE OF FORTRAN COMPILERS
TLNE FL2,FORSW ;IGNORE IF NOT FORTRAN
TLNN FL3,F40SW!F10SW ;AND IF NOTHING OF INTEREST
JRST ENDFOR ;SKIP REST OF TESTS
MOVSI T1,'F40' ;ASSUME F40 WANTED
TLNN FL3,F40SW ;GOOD GUESS?
MOVE T1,['FORTRA'] ;NO, EXACTLY WRONG
SKIPN FORPRC ;SETUP ALREADY?
MOVEM T1,FORPRC ;NO, DO SO NOW
CAMN T1,FORPRC ;[222] SAME VALUE, OR FIRST TIME?
JRST ENDFOR ;[222] YES
STRING [ASCIZ /%CMLOFC Only one Fortran compiler allowed, /]
MOVEI T1,[ASCIZ /FORTRAN-10/] ;[222]
TLNN FL3,F40SW ;[222] SEE WHICH WE WANTED, USE OTHER
MOVEI T1,[ASCIZ /F40/] ;[222]
STRING (T1) ;[222] TYPE ONE WE WILL USE
STRING [ASCIZ / used
/]
ENDFOR:>
IFN SPRC,<
TLNN FL2,SPRC
>
JRST NOCOMP ;GO LOAD
IFN SPRC,<
MOVSI SVPT,-NFILE ;RESET POINTER
MOVE T1,ONAM ;AND FAKE WORLD
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
HRL FL2,NXPC(T3) ;SET FOR NEXT PROCESSOR
JRST DOCOMP ;AND GO EMIT CALLS
>
;HERE TO TEST FOR /LIB
;COMPLICATED BY FACT THAT FOO.LIB IS PROBABLY BINARY
;THEREFORE ONLY COMPIL IF EXT IS A KNOWN ONE
; I.E. FOR, F40, MAC, ALG, CBL, BLI, FAI ETC
;OR NULL
LBCOMP: TLNN FL3,LIBSW ;/LIB?
JRST DOCOMP ;NO, RECOMPILE
MOVE T1,FL2 ;GET PROCESSOR FLAGS
JFFO T1,.+1 ;COUNT THE EASY WAY
HLLZ T1,SVEXT(SVPT) ;GET EXT OF INPUT
JUMPE T1,DOCOMP ;RECOMPILE IF NULL EXT
CAME T1,F4 ;ALTERNATIVE FORTRAN EXT
CAMN T1,PXTAB+1(T1+1);TEST AGAINST EXPECTED EXT
JRST DOCOMP ;IT IS SO RECOMPILE
IFN BLISS,<
CAMN T1,B10 ;TEST AGAINST ALTERNATIVE EXT
JRST DOCOMP ;YES, SO RECOMPILE>
MOVEM T1,OEXT ;FAKE OUTPUT EXT SO LOADER SEES IT
JRST LDREL ;NOT, SO ASSUME BINARY
SFDPPN: MOVEI T1,"[" ;START OUT RIGHT
HRRZM T2,SAVPPN ;SAME CODE AS OUTPPN (ALMOST)
PUSHJ P,TMPOUT
HLRZ T1,T2 ;GET NUMBER (LH)
JUMPE T1,.+2 ;ZERO IS JUST ,
PUSHJ P,OUTOCT
MOVEI T1,","
PUSHJ P,TMPOUT
SKIPE T1,SAVPPN ;[155] PPN SPECIFIED?
PUSHJ P,OUTOCT
IFN SFDSW,<X==0 ;INITIAL CONDITION
REPEAT SFDLEN,< SKIPN T2,OSFD+X
JRST SFDPP1
PUSHJ P,SFDOUT
X==X+1>
SFDPP1: > ;END OF IFN SFDSW
MOVEI T1,"]"
PJRST TMPOUT
LDREL: TRNE SVPT,-1 ;CHECK FOR ONLY ONE FILE
JRST NOFIL ;IF MORE THAN ONE, THERE IS AN ERROR
NOCOMP: SKIPE FDGFLG ;NEED TO MAKE FUDGED LIBRARY?
PUSHJ P,ENTFUD ;YES
TRNN FL,DOLOD ;DO WE WANT TO LOAD?
JRST NXFILP ;NO, GO TO NEXT
MOVEI C,0
IDPB C,LODSP ;END SECOND SET OF SWITCHES
IDPB C,LODSP2
MOVEI T3,CHNLOD ;SET FOR LOADER
TRZE FL,LODOUT ;IS THERE ALREADY OUTPUT THERE?
PUSHJ P,[TRNN FL,LINKFL ;LINK10?
PJRST OUCRLF ;NO, OUTPUT A CRLF AS SEPARATOR
MOVEI T1,"," ;YES
PJRST TMPOUT] ;YES, ALL ON SAME LINE SAVES TIME
;[256] NOCOMP+12
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
SKIPL DEBFL ;DEBUG SEEN AND NOT YET SET?
JRST NODDT ;NO
SKIPE T1,DDTFL ;[221] PRE-EMPTED
AOJA T1,[JUMPN T1,[PUSH P,DDTFL ;[221] STORE DEBUG AID
JRST GETDD1] ;[221] BYPASS TEST FOR COMPILER TYPE
MOVSI T2,'/T ' ;YES
TRNN FL,LINKFL ;LINK-10?
JRST ISDDT ;NO, ALWAYS USE UST DDT
MOVSI T2,'/D ' ;DDT BY DEFAULT
PUSHJ P,OUTSIX
PUSHJ P,OUTSPC ;TERMINATE SWITCH
JRST NODDT]
HLLZ T1,FL2 ;GET PROCESSOR
MOVEI T2,^L<MACSW>-22 ;PRESET INCASE REL ONLY
TLNE T1,ALPROC-RELSW ;SEE IF ANY SET
JRST GETDDT ;YES, FIND OUT WHICH
;**;[303] @GETDDT-2 1/2, JMT, 1-JUN-76
SKIPGE DEFPRO ;[303] DID WE USE DEFAULT PROCESSOR ?
JRST USEDEF ;[303] THEN SKIP LOCAL PROCESSOR TEST
HRLZ T1,FL2 ;TRY LOCAL PROCESSOR SWITCHES
TLNE T1,ALPROC-RELSW
GETDDT: JFFO T1,.+1 ;YES, SO SEE WHICH
;**;[303] @GETDDT+1, ADD LABEL, JMT, 1-JUN-76
USEDEF: PUSH P,DEBAID(T2) ;STORE NAME
trne fl,linkfl ;[220] check for link-10
jrst [skipn (p) ;[220] if no debug aid
jrst .+1 ;[220] then return
move t1,prcnam(t2) ;[220] else get process name
movem t1,0(p) ;[220] to replace debug aid
jrst .+1] ;[220] proceed as before
CAIN T2,^L<CBLSW>-22 ;COBOL IS A LOSER
JRST [SOS DEBFL ;AS IT MUST LOAD COBDDT
JRST NODDT1] ;AFTER MAIN PROG
GETDD1: TRNE FL,LINKFL ;IF LINK-10
JRST [MOVSI T2,'/D '
SKIPE (P) ;BUG IN SCAN (LINK-10)
tlO T2,' :' ;OBJECTS TO /D: FOR DDT
PUSHJ P,OUTSIX
POP P,T2 ;[165] GET NAME OF DEBUGGING AID
;**;[303] @GETDD1+5 1/2 (SOURCE LINES), JMT, 27-MAY-76
CAMN T2,[SIXBIT/FORTRA/] ;[303] FORDDT ?
JRST FOR ;[303] YES--PROCESS DIFFERENTLY
SKIPE T2 ;[165] IGNORE IF 0
PUSHJ P,OUTSIX ;DEFAULT IS DDT IF 0
PUSHJ P,OUTSPC ;TERMINATE
JRST NODDT]
MOVSI T2,'/T ' ;USE DDT
SKIPN (P) ;IF NULL
PUSHJ P,OUTSIX
MOVE T2,['SYS: '] ;GET IT FROM SYS
SKIPE (P) ;IF NEEDED
PUSHJ P,OUTSIX
POP P,T2 ;RECOVER FILE
JUMPE T2,NODDT ;DONE
PUSHJ P,OUTSIX
MOVE T2,[',/E/S '] ;SWITCHES AND SEPARATOR
TRNN FL,LINKFL ;BUT LINK-10 IS HARDER
JRST ISDDT ;JUST LOADER
HRRI T2,'/L ' ;CHANGE /S TO /L
PUSHJ P,OUTSIX ;SWITCH
PUSHJ P,OUTSPC ;FOLLOWED BY SPACE
JRST NODDT
NODDT1: MOVE T2,['/E/S '] ;COBOL ONLY
TRNN FL,LINKFL ;LINK-10
JRST ISDDT ;NO
HRRI T2,'L ' ;CHANGE /S TO /L
PUSHJ P,OUTSIX
PUSHJ P,OUTSPC ;TERMINATE WITH SPACE
JRST NODDT
;**;[303] @NODDT1+6 1/2, JMT, 27-MAY-76
FOR: PUSH P,T2 ;[303] SAVE NAME ON STACK
MOVE T2,[SIXBIT/(DDT,/] ;[303] LOAD REGULAR
PUSHJ P,OUTSIX ;[303] DDT AS WELL AS
POP P,T2 ;[303] FORDDT.
PUSHJ P,OUTSIX ;[303] . .
MOVSI T2,') ' ;[303] . .
PUSHJ P,OUTSIX ;[303] . .
PUSHJ P,OUTSPC ;[303] FINISH WITH SPACE
JRST NODDT ;[303] AND PROCEED
ISDDT: PUSHJ P,OUTSIX
NODDT: MOVE T2,[POINT 7,LODSBK] ;OUTPUT FIRST SWITCHES
PUSHJ P,OUTSW
MOVSI T2,'DSK'
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?
PUSHJ P,OUTEXT ;YES
TLNN FL3,LIBSW ;IF LIBRARY
JRST ELOD3 ;NO, CONTINUE
JRST LODR2] ;YES
SKIPE T2,SVEXT ;ALSO USE EXT IF GIVEN
PUSHJ P,OUTEXT
;[275] LODR2, JMT, 2-APR-76
;[275] DELETE LODR2: SKIPE T2,SVPPN ;THEN THINK ABOUT PPN
LODR2: SKIPE T2,SVPPN(SVPT) ;THEN THINK ABOUT PPN
PUSHJ P,OUTPPN
MOVSI T2,'/L ' ;TELL LOADER
TRNE FL,LINKFL ;LINK-10
MOVSI T2,'/S ' ;USES SEARCH
TLNN FL3,LIBSW ;LIBRARY?
JRST ELOD ;NO
PUSHJ P,OUTSIX
TRNE FL,LINKFL ;LINK-10
PUSHJ P,OUTSPC ;NEEDS SPAC
SETOM NSWTCH ;[236] SIGNAL /L LAST
ELOD: TRNN FL,LINKFL ;[174] LINK-10 OR
TLNE FL3,LIBSW ;[174] OR /LIB
JRST ELOD1 ;[174] YES - /N NOT NEEDED
SKIPN NSWTCH ;[236] WAS PREVIOUS /L?
JRST ELOD1 ;[236] NO
SETZM NSWTCH ;[236] SIGNAL /N LAST
MOVSI T2,'/N ' ;[174] LOADER NEEDS /N
PUSHJ P,OUTSIX ;[174] LOADER NEEDS /N
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
;[242] ELOD1+4,JNG,10/3/74
TRNN FL,LINKFL ;[242] LINK-10?
SKIPA T2,[ '/1F '
'/2F ']-1(T2) ;[242] NO, GET RIGHT OLD SWITCH
MOVE T2,[ '/FORSE'
'/FOROT']-1(T2) ;[242] YES, GET RIGHT NEW SWITCH
PUSHJ P,OUTSIX ;[242] AND TYPE THE SWITCH
SETZM FORLIB ;ONLY DO IT ONCE
TRNE FL,LINKFL
PUSHJ P,OUTSPC
ELOD2: TRO FL,LODOUT ;MARK AS HAVING OUTPUT THERE
AOSL DEBFL ;ARE WE FINISHED WITH DDT?
JRST NXFILP
TRNE FL,LINKFL ;LINK-10?
JRST [MOVSI T2,'/D:' ;YES, PUT AFTER FILE NAME
PUSHJ P,OUTSIX
POP P,T2 ;[220] fixed to be correct
PUSHJ P,OUTSIX
PUSHJ P,OUTSPC
JRST ELOD4] ;OUTPUT /DEBUG:COBOL
MOVE T2,[',SYS: '] ;NO, MUST BE COBOL
PUSHJ P,OUTSIX
POP P,T2 ;GET FILE
PUSHJ P,OUTSIX
ELOD4: AOS DEBFL ;AT LAST
JRST NXFILP
ELOD3:
IFN SFDSW,<
SKIPN T2,OPPN ;[274] OUTPUT PPN GIVEN?
SKIPE OSFD ;OR SFD?
>
IFE SFDSW,<
SKIPE T2,OPPN ;[274] OUTPUT PPN GIVEN?
>
PUSHJ P,SFDPPN ;YES
JRST ELOD ;AND CONTINUE
;HERE TO CHECK REL FILE TO SEE IF IT IS WHAT WE EXPECT
;MAINLY FOR F40 VS FORTRAN-10
;RETURN
;+1 FILE NOT OK, SHOULD RECOMPILE
;+2 FILE OK
CHKREL: PUSHJ P,INSREL ;INSPECT REL FILE, T2 POINTS TO WORD IN FILE
POPJ P, ;ERROR, SO RECOMPILE
;T3 CONTAINS TYPE
;T2 CONTAINS CPU INFO
SOJE T3,CHKF40 ;1=F40
CAIE T3,10-1 ;MAKE SURE IT FORTRAN-10
JRST CPOPJ1 ;NO, SO LEAVE ALONE
CHKFOR: ;10 IS FORTRAN-10
IFE DFORTRAN,< ;IF DEFAULT IS F40
TLNN FL3,F10SW ;RECOMPILE UNLESS DEFINITELY WANTS F-10
>
IFN DFORTRAN,< ;BUT IF DEFAULT IS F-10
TLNE FL3,F40SW ;RECOMPILE ONLY IF DEFINITELY WANTS F40
>
POPJ P,
;OK, NOW CHECK KA/KI TYPE
SOJE T2,CHKFKA ;KA-10 =1
SOJE T2,CHKFKI ;KI-10 =2
JRST CPOPJ1 ;DON'T CARE
CHKFKI: ;KI-10 TYPE
MOVE T2,CPU ;GET HOST CPU
XCT [TLNE FL3,KI10SW ;RECOMPILE UNLESS DEFINITELY WANTS KI-10
TLNN FL3,KA10SW](T2) ;RECOMPILE ONLY IF DEFINITELY WANTS KA-10
CPOPJ1: AOS (P) ;[176] SKIP RET, THIS REL WILL DO
POPJ P,
CHKFKA: ;HERE IF FOUND REL IS F-10 KA-10 TYPE
MOVE T2,CPU ;GET HOST CPU
XCT [TLNN FL3,KI10SW ;RECOMPILE ONLY IF DEFINITELY WANTS KI-10
TLNE FL3,KA10SW](T2) ;RECOMPILE UNLESS DEFINITELY WANTS KA-10
AOS (P) ;SKIP RET, THIS REL WILL DO
POPJ P,
CHKF40: ;HERE IF FOUND REL WAS F40 STYLE
IFE DFORTRAN,< ;IF DEFAULT IS F40
TLNE FL3,F10SW ;RECOMPILE ONLY IF DEFINITELY WANTS F10
>
IFN DFORTRAN,< ;BUT IF DEFAULT IS F10
TLNN FL3,F40SW ;RECOMPILE UNLESS DEFINITELY WANTS F40
>
POPJ P,
IFE MANTIS,<
JRST CPOPJ1 ;SKIP RET, THIS FILE WILL DO>
IFN MANTIS,<
TLNE FL3,MANTSW ;DO WE WANT SPECIAL DATA
TRC T2,1 ;YES SO COMPLEMENT TYPE CODE
CAIN T2,400 ;SHOULD WE RECOMPILE?
AOS (P) ;NO, RIGHT KIND OF CODE
POPJ P, ;YES, WRONG KIND OF REL FILE
>
;HERE TO READ REL FILE IN USERS [DIRECTORY] ON DSK
;RETURNS
;+1 FILE ERROR, FORCE RECOMPILATION
;+2 FILE READ, T3 = PROCESSOR CODE
; T2 = CPU TYPE
INSREL:
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
INSRL3: MOVE T2,LOOKBF ;GET BUFFER POINTER
ADDI T2,2 ;POINT TO FIRST DATA WORD
INSNXT: HLRZ T3,(T2) ;GET LOADER BLOCK TYPE
CAIN T3,6 ;LOOK FOR NAME BLOCK
JRST FNDTY6 ;FOUND IT
CAIE T3,4 ;MUST BE EITHER ENTRY OR NAME
JRST [SETZ T3, ;UNLESS NOT A REL FILE
JRST CPOPJ1] ;IN WHICH CASE DON'T REASSEMBLE
HRRZ T3,(T2) ;GET WORD COUNT
CAIG T3,^D18 ;MORE THAN 1 SUB BLOCK?
AOJA T3,INSNXB ;NO
IDIVI T3,^D18 ;YES, ACCOUNT FOR 1 BYTE WORD
IMULI T3,^D19 ;PER 18 WORD SUB BLOCK
JUMPE T4,INSNXB ;ANY REMAINDER?
ADDI T3,1(T4) ;YES, DON'T FORGET BYTE WORD
INSNXB: ADDI T2,1(T3)
JRST INSNXT ;TRY AGAIN
FNDTY6: HRRZ T3,0(T2) ;GET WORD COUNT
SOSLE T3 ;USE ZERO IF NO 2ND WORD
HLRZ T3,3(T2) ;GET PROCESSOR TYPE FROM 2ND DATA WORD
IFN MANTIS,<
HLRZ T1,4(T2) ;GET NEXT BLOCK INCASE F40/MANTIS
>
HRRZ T2,T3 ;AND COPY FOR CPU INFO
ANDI T3,7777 ;BITS 6-17
LSH T2,-^D12 ;BITS 0-5
IFN MANTIS,<
CAIN T3,1 ;IF F40 AND WANTS MANTIS
MOVE T2,T1 ;PUT 400 OR 401 IN CPU BLOCK
>
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,
SALL
GETPRO: MOVSI T1,-NFILE ;NUMBER OF FILES
;**;[303] @GETPRO+1/2, JMT, 1-JUN-76
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
REPEAT SFDLEN,<
MOVE T2,SVSFD+X(T1)
MOVEM T2,LSFD+Y
X==X+NFILE
Y==Y+1
>
MOVEI T2,LSFDAD ;POINTER
NXSFD: > ;END OF IFN SFDSW
MOVEM T2,LPPN
SKIPN T2,SVDEV(T1) ;A DEVICE?
SKIPE T2,LOKNAM ;OR SAVING ONE UP
JRST ALTDEV
OKLOOK: SKIPE EXTEND ;[240] IS FILE ON DISK?
JRST ELOOK ;[240] YES, DO EXTENDED LOOKUP.
LOOKUP LOOK,LNAM ;[240] NO, PROCEDE BY OLD METHOD
JRST NOTYET ;HAVE NOT FOUND IT YET
DNLOK: HLLZ T2,LEXT ;GET THE EXTENSION
CAME T2,OLDEXT ;WAS IT WHAT WE ASKED FOR
JRST NOTYET ;TREAT AS IF LOOKUP FAILED
HLLM T2,SVEXT(T1) ;[207] SAVE EXT (WILL HELP <> CODE)
IFN TENEX,<
PUSHJ P,GDTLOK ;GET DATE AND TIME OF LOOK CHAN
JRST DNLOK1 ;NOT IMPL OR NOT DSK
HLRZ T2,LDAT ;DO THE COMPARES
CAMLE T2,SDAT
JRST [MOVEM T2,SDAT
HRRZ T2,LDAT ;GET TIME
JRST SETTM] ;STORE IT
CAME T2,SDAT
JRST OLDAT
HRRZ T2,LDAT
CAMLE T2,STIM
JRST SETTM
JRST OLDAT
>
DNLOK1: SKIPE EXTEND ;[240] WAS EXTENDED LOOKUP DONE?
JRST [MOVE T2,EBLK+.RBTIM ;[240] YES, GET CREATION TIME
JRST SETTM1] ;[240] AND GO TEST IT
LDB T2,[POINT 12,LDAT,35] ;GET LOW 12 BITS OF DATE
LDB T3,[POINT 3,LEXT,20] ;GET HIGH 3 BITS OF DATE
DPB T3,[POINT 3,T2,23] ;MERGE THE TWO PARTS
CAMLE T2,SDAT ;AND CHECK TO SEE IF LATEST
JRST SETDT
CAME T2,SDAT
JRST OLDAT
LDB T2,[POINT 11,LDAT,23]
SETTM1: CAMLE T2,STIM ;[240] NEWEST FILE?
SETTM: MOVEM T2,STIM ;MARK WITH LATER ONE
OLDAT: HLLZ T2,LEXT ;GET THE EXTENSION WE FOUND
JUMPE T2,SETCP ;SET TO CURRENT PROCESSOR
MOVSI T3,-<NPROCS+1> ;LOOK AT EXTENSION TO FIND PROCESSOR
CAMN T2,F4 ;TEST FOR ALT FORTRAN EXT
JRST [HRROI T3,^L<FORSW>-21 ;FAKE FORTRAN SEEN
JRST .+3] ;AND PROCCESS IT
CAME T2,PXTAB(T3)
AOBJN T3,.-1
IFE BLISS,<
JUMPGE T3,SETCP ;NOT THERE
>
IFN BLISS,<
JUMPL T3,.+4 ;JUMP IF FOUND SOMETHING
CAME T2,B10 ;IS IT ALTERNATIVE BLISS EXT
JRST SETCP ;NO
HRROI T3,CHNBLI+1 ;YES, SET FOR BLISS
>
TLNE FL2,@ISPTAB(T3) ;IS THAT ONE ALREADY SET?
JRST NFIL2
TLNE FL2,ALPROC ;IS ANY SET?
JRST FIXCON ;YES, WE MAY HAVE A CONFLICT
TLO FL2,@ISPTAB(T3) ;SET UP FOR THIS ONE
NFIL2: CAME T1,SVPT ;ARE WE DONE?
NFIL1: AOBJN T1,GETPR1 ;NO, GO ON
POPJ P,
;THERE IS NO CONFLICT IF THIS IS A REL FILE
FIXCON: MOVE T2,ONAM
CAMN T2,LNAM
TRNE T3,-1 ;IF NOT OUTPUT REL FILE
JRST PROCON ;THEN WE HAVE A CONFLICT
FIX1: SETOM STIM ;[247] FORCE REL FILE USEAGE
SETOM SDAT ;[247] BY MAKING SOURCE OLD
POPJ P, ;AND RETURN TO SETUP
SETDT: MOVEM T2,SDAT
LDB T2,[POINT 11,LDAT,23] ;AND TIME
JRST SETTM
SETCP: CAME T1,SVPT ;AT END?
JRST NFIL1 ;NO, DO NOT SET
TLNN FL2,ALPROC ;SOMETHING ALREADY SET?
HRL FL2,FL2 ;NO, SET TO CURRENT PROCESSOR
POPJ P, ;AND DONE
NOTYET: MOVE T2,SVEXT(T1) ;GET THE CURRENT EXT
JUMPN T2,OKREL ;IF HE SPECIFIED AN EXT WE LOSE
TLZE T3,-1 ;WAS THIS A RETRY WITH ALT EXT?
JRST NOTYT1 ;YES, ONLY DO IT ONCE
CAIN T3,CHNFOR+2 ;FORTRAN USES EITHER .FOR OR .F4
MOVE T2,F4 ;SO TRY OTHER
IFN BLISS,<
CAIN T3,CHNBLI+2 ;BLISS USES .BLI OR .B10
MOVE T2,B10 ;TRY OTHER
>
JUMPE T2,NOTYT1 ;NO SUCH LUCK
TLO T3,-1 ;MARK IT SO WE DONT LOOP
JRST NXEXT ;AND TRY AGAIN
NOTYT1: JUMPE T3,NOTYT2 ;TRIED ALL IF ZERO
MOVE T2,PXTAB(T3) ;ELSE PICK UP ONE
CAIG T3,NPROCS ;SEE IF LIST EXHAUSTED
AOJA T3,NXEXT ;NO, TRY THIS ONE
;[246] NOTYT1+4,JNG,12/25/74
SKIPN PTHBLK+2 ;[246] WAS THIS ONLY PASS 1?
SKIP 2 ;[246] NO, FORGET IT
SETZM PTHBLK+2 ;[246] YES, RETRY WITH LIBRARY
JRST GETPR2 ;[246] AND TRY AGAIN
TLNE FL3,COMPLS ;[175] /COMP SEEN?
JRST NOTYT2 ;[175] YES - DON'T TRY /REL
SETZ T3, ;YES, TRY REL AS LAST RESORT
MOVE T2,PXTAB
JRST NXEXT
NOTYT2: HLLZ T2,SVEXT(T1) ;GET THE ORIGINAL EXT
HLLM T2,LEXT ;[266]
JRST NOFIL ;ARE OUT OF THINGS TO TRY
;MAKE IT OKAY IF THE OUTPUT REL FILE IS THERE
OKREL: SKIPN PTHBLK+2 ;[250] WAS LIB: SEARCHED?
SKIP 2 ;[250] YES, WE'RE OUT OF LUCK
SETZM PTHBLK+2 ;[250] NO, SEARCH IT NOW
JRST GETPR2 ;[250] ...
TLNN FL3,COMPLS ;[175] MUST COMPILE IF /COMP
TRNN FL,DOLOD ;IF NOT JUST COMPILING
JRST LOSE1 ;THEN
MOVE T3,LNAM ;PROTECT CURRENT NAME
MOVE T1,ONAM ;TRY LOOKING UP
MOVEM T1,LNAM ;OUTPUT FILE
SKIPN T1,OEXT ;USING EXTENSION
MOVSI T1,'REL' ;IF GIVEN
MOVEM T1,LEXT ;AND TRYING SVPPN
MOVE T1,SVPPN
OKREL1: MOVEM T1,LPPN
LOOKUP LOOK,LNAM
JRST .+2
JRST FIX1 ;FOUND SO NO COMPIL
JUMPE T1,LOSE ;IF THIS WASN'T OUR PPN
SETZ T1, ;THEN TRY IT NOW
JRST OKREL1
LOSE: MOVEM T3,LNAM ;RESTORE FILE NAME FOR ERROR MESSAGE
LOSE1: HLLM T2,LEXT ;[266]RESTORE EXTENSION
JRST NOFIL ;OUT OF THINGS TO TRY
;[240] LOSE1+2
ELOOK: MOVEI T2,.RBTIM ;[240] DO EXTENDED LOOKUP
MOVEM T2,EBLK ;[240] SETUP LOOKUP BLOCK..
MOVE T2,LPPN ;[240]
MOVEM T2,EPPN ;[240]
LOOKUP LOOK,EBLK ;[240] DO THE LOOKUP
JRST NOTYET ;[240] NO SUCH LUCK
;[246] ELOOK+7,JNG,12/15/74
SKIPE T2,PTHBLK+2 ;[246] FORCING PPNS TO MATCH?
CAMN T2,EPPN ;[246] AND DO THEY?
JRST DNLOK ;[246] GOOD LOOKUP - GO CHECK IT OUT
JRST NOTYET ;[246] ITS IN LIB: - IGNORE FOR NOW
ALTDEV: MOVEM T2,LOKNAM ;SAVE FOR LATER
MOVEM T2,SVDEV(T1) ;AND IN DEVICE FOR OUTPUT
DEVCHR T2, ;GET CHARACTERISTICS
TLNE T2,200000 ;A DSK?
JRST ALTDSK ;YES
TLNE T2,4 ;A DECTAPE?
JRST ALTDAT ;YES,
TRO FL,NODAT ;NO DATES ON OTHER DEVICES
JRST OLDAT ;DON'T BOTHER WITH LOOKUP
ALTDSK: MOVSI T2,'DSK'
CAMN T2,LOKNAM ;LOGICAL NAME?
JRST OKLOOK ;NO, STILL DSK
ALTDAT: TRZ FL,NOLOOK ;NOT FAILED YET
OPEN LOOK,LOKINT ;OPEN FOR INPUT
JRST DEVNA ;NOT THERE
LOOKUP LOOK,LNAM ;SEE IF FILE IS
TRO FL,NOLOOK ;NO
OPEN LOOK,DSKLK ;GET THE DSK BACK
JRST DSKNA ;I HOPE THIS NEVER HAPPENES
TRZE FL,NOLOOK ;SEE IF FAILED
JRST NOTYET ;IT DID
TLNN T2,4 ;DECTAPE?
JRST DNLOK ;NO, BUT LOOKUP HAPPENED
HLRZ T2,LEXT ;GET EXTENSION LOOKED UP
CAIE T2,'REL'
AOS LDAT ;IF SOURCE FILE MAKE IT MIDNIGHT TONIGHT
JRST DNLOK ;AND CONTINUE
IFE STANSW,<
OUTPPN: HRRZM T2,SAVPPN ;CONVERT TO SIXBIT FOR OUTPUT
MOVEI T1,"[" ;START OUT
PUSHJ P,TMPOUT
HLRZ T1,T2 ;GET NUMBER
JUMPE T1,.+2 ;JUST COMMA IF ZERO
PUSHJ P,OUTOCT
MOVEI T1,","
PUSHJ P,TMPOUT
SKIPE T1,SAVPPN
PUSHJ P,OUTOCT
IFN SFDSW,<
SKIPE SVSFD(SVPT) ;AN SFD SEEN?
PUSHJ P,OUTSFD ;YES
>
MOVEI T1,"]"
JRST TMPOUT
OUTOCT: IDIVI T1,10 ;OCTAL OUTPUT
HRLM T2,(P)
SKIPE T1
PUSHJ P,OUTOCT
HLRZ T1,(P)
ADDI T1,"0"
PJRST TMPOUT
>
SUBTTL OUTPUT ROUTINES
OUTSIX: MOVEI T1,0
LSHC T1,6
ADDI T1,40
PUSHJ P,TMPOUT
JUMPN T2,OUTSIX
CPOPJ: POPJ P,
OUTSPC: MOVEI T1," "
PJRST TMPOUT
IFN STANSW,<
OUTPPN: MOVEM T1,SAVPPN ;SAVE IT AWAY
ANDCMI T2,-1
MOVEI T1,"["
PUSHJ P,TMPOUT
PUSHJ P,OUTSIX ;PRINT IT
MOVEI T1,"," ;AND A COMMA
PUSHJ P,TMPOUT
HRLZ T2,SVPPN
PUSHJ P,OUTSIX
MOVEI T1,"]"
JRST TMPOUT
>
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
CAIE T3,CHNLOD ;[177] LOADER OUTPUT LINE
JRST .+3 ;[173] NO - DON'T CHECK WHICH LOADER
TRNE FL,LINKFL ;LINK-10?
JRST OUTSW2 ;YES, SPECIAL
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
CAIA ;NO
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
OUTSW2: ILDB T1,SVSWP ;GET 1ST CHAR
JUMPE T1,OUTSW5 ;ALL DONE IF NULL
CAIN T1," " ;IGNORE LEADING BLANKS
JRST .-3 ;AND MULTIPLE BLANKS
MOVEI T1,"/" ;LINK-10 WANT A SLASH FIRST
PUSHJ P,TMPOUT
LDB T1,SVSWP ;GET FIRST NON-BLANK CHAR AGAIN
CAIA ;AND PROCESS IT
OUTSW3: ILDB T1,SVSWP ;GET NEXT CHAR
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
OUTSW5: MOVEI T1," " ;OUTPUT BLANK
PJRST TMPOUT ;AND RETURN
SUBTTL CREF
ENTCRF: MOVE T1,CORTOP ;CHECK TO SEE IF NAME ALREADY THERE
MOVE T2,ONAM
ENTC1: CAMN T1,CORT1
JRST ENTC2
CAMN T2,1(T1)
POPJ P, ;NAME THERE, EXIT
AOJA T1,ENTC1 ;CHECK ANOTHER
ENTC2: MOVEM T2,@CORTOP ;SAVE IT
SOS T1,CORTOP
CAMG T1,SVJFF ;CHECK TO SEE IF CORE EXCEEDED
PUSHJ P,XPAND
MOVEI T3,CHNCRF
MOVEI T1,"=" ;[233]
PUSHJ P,TMPOUT
MOVE T2,ONAM
PUSHJ P,OUTSIX
IFN SFDSW,<
SKIPN T2,OPPN ;OUTPUT PPN GIVEN?
SKIPE OSFD ;OR SFD?
>
IFE SFDSW,<
SKIPE T2,OPPN ;OUTPUT PPN GIVEN?
>
PUSHJ P,SFDPPN ;YES
PJRST OUCRLF
FINCRF: MOVSI IOPNT,-2 ;PERMIT ONLY THIS ONE LEVEL
TRO FL,INCRF ;SAY WE ARE FINISHING
MOVEM P,SVPDL ;SAVE THE PDL FOR LATER
MOVE T1,[POINT 7,CRFRDR]
MOVEM T1,DINPT
FINC1: PUSHJ P,SCAN ;GET SOMETHING
TRNN FL,IDF ;IGNORE ALL BUT IDENTIFIERS
JRST FINC1
MOVE T1,ACCUM
MOVEM T1,ONAM ;SET AS NAME
PUSHJ P,ENTCRF ;ENTER IT
JRST FINC1
DNCRF: MOVEI T3,CHNCRF
PUSHJ P,TMPCHK ;CLOSE OUTPUT
MOVE P,SVPDL ;GET THE ENTERING PDL BACK
TRZ FL,INCRF ;NO LONGER THERE
POPJ P,
SUBTTL FUDGE
CHNFUD==CHNPIP
SETFUD: SKIPE FDGFLG ;ENTER DONE ALREADY?
POPJ P, ;YES , RETURN
MOVEI T3,CHNFUD ;USE PIP FOR NOW
PUSHJ P,SCAN ;LOOK AT NEXT CHAR
CAIE C,":" ;THERE BETTER BE A NAME
GOTO SYNERR ;YOU LOSE
AOBJP SVPT,NESTTD ;MAKE SPACE FOR FIELDS
;**;[302] @SETFUD+6 1/2, JMT, 27-MAY-76
TRO FL,F.STKY ;[302] SET FLAG FOR NO STICKINESS
PUSHJ P,SCANAM ;GO GET THEM
TRZ FL,F.STKY ;[302] CLEAR FALG
SKIPE T2,SVDEV(SVPT) ;A DEVICE?
PUSHJ P,OUTDEV ;YES
SKIPN T2,SVNAM(SVPT) ;THERE HAS TO BE A NAME
GOTO SYNERR ;NOT FOUND
PUSHJ P,OUTSIX ;OUTPUT IT
SKIPN T2,SVEXT(SVPT) ;EXTENSION?
MOVSI T2,'REL' ;USE REL IF MISSING
PUSHJ P,OUTEXT
SKIPE T2,SVPPN(SVPT) ;PPN
PUSHJ P,OUTPPN ;YES
SUB SVPT,[1,,1] ;BACK AS IT WAS
MOVSI T2,'/B=' ;[233] FORSE BINARY
PUSHJ P,OUTSIX
SETOM FDGFLG ;ONLY DO IT ONCE
PJRST SCAN ;RETURN VIA SCAN
ENTFUD: PUSH P,T3 ;SAVE T3
MOVEI T3,CHNFUD ;USE PIP TIL FUDGE2 FIXED FOR CCL
MOVEI T1,"," ;SETUP COMMA
SKIPL FDGFLG ;BUT NOT FIRST TIME THROUGH
PUSHJ P,TMPOUT ;OUTPUT SEPARATING COMMA
MOVE T2,ONAM ;GET NAME
PUSHJ P,OUTSIX ;OUTPUT IT
SKIPN T2,OEXT ;SPECIFIED EXT?
MOVSI T2,'REL' ;NO USE DEFAULT
PUSHJ P,OUTEXT
HRRZS FDGFLG ;COMMA NEXT TIME
POP P,T3 ;RESTORE T3
POPJ P, ;RETURN
DNFUDG: MOVEI T3,CHNFUD ;MAKE SURE USING PIP
PUSHJ P,OUCRLF ;TERMINATE LINE
PUSHJ P,TMPCHK
SETZM FDGFLG ;CLEAR FLAG
POPJ P, ;RETURN
SUBTTL TABLES
XALL
DEFINE X (A,B,C,D,E,F,G)<
<SIXBIT /C/>>
PRCNAM: PROCESS
DEFINE X (A,B,C,D,E,F,G)<
SIXBIT /B/>
PXTAB: SIXBIT /REL/
PROCESS
IFN BLISS,<
B10: SIXBIT /B10/ ;ALTERNATIVE BLISS EXT>
F4: SIXBIT /F4/
DEFINE X (A,B,C,D,E,F,G)<
B'SW>
ISPTAB: RELSW
PROCESS
DEFINE X (A,B,C,D,E,F,G)<
SIXBIT /E/>
INTEXT: PROCESS
IFN SPRC,< DEFINE X (A,B,C,D,E,F,G)
<D'SW>
NXPC: PROCESS
SW==0>
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
DEFINE X (A,B)<
< SIXBIT /B/>>
PRCDEV: DEVICE
SALL
SUBTTL DIRECT
IFE DIRSW,<
DODIR: TROA FL,PIPF ;SO *.* WILL WORK
DODIR0: PUSHJ P,GETPP1 ;GET PROJ-PROG
DODIR1: PUSHJ P,SCAN ;FIND OUT IF HE WANTS /L OR /F SWITCH
DODIR2: TRNN FL,IDF ;WAS IT AN IDENT?
JRST SLSH ;NO, CHECK FOR "/"
PUSH P,SVPPN ;IN CASE WE HAVE SEEN PPN ALREADY
PUSHJ P,GETNAM ;GET DEV AND FILE NAME
POP P,T2 ;GET PREVIOUS PPN
JUMPE T2,.+3 ;WASN'T ONE
SKIPN SVPPN ;SEEN ONE AFTER DEVICE?
MOVEM T2,SVPPN ;NO SO USE ONE BEFORE
CAIE C,"]" ;SCAN OVER PPN
TRNE FL,IDF ;LAST THING AN IDENT.?
PUSHJ P,SCAN ;YES, GET NEXT CHAR
SLSH: CAIE C,"/"
JRST NOSLSH
PUSHJ P,SCAN ;WHICH ONE
TRNN FL,IDF ;MUST SEEN AN IDENTIFIER
JRST [PUSHJ P,SCAN ;TRY NEXT (NUL EXT FAILS)
TRNN FL,IDF ;FOUND IDENT. NOW?
GOTO SYNERR ;NO, FATAL ERROR
JRST .+1] ;OK NOW
MOVS T1,ACCUM
CAIN T1,'F '
JRST SETF
CAIE T1,'L '
GOTO SYNERR ;DO NOT RECOGNIZE THIS SWITCH
TROA FL,LPTFG ;HE WANTS IT ON THE LINE PRINTER
SETF: TRO FL,FFLG
JRST DODIR1 ;BACK FOR MORE
NOSLSH: CAIN C,"[" ;PROJ-PROG NUMBER
JRST DODIR0 ;YES
MOVE T2,['TTY:/L']
TRNE FL,LPTFG ;ON LINE PRINTER INSTEAD?
HRLI T2,'LPT' ;YES
MOVEI T3,CHNPIP
TRNE FL,FFLG
HRRI T2,':/F'
PUSHJ P,OUTSIX
MOVEI T1,"=" ;[233]
PUSHJ P,TMPOUT
DODIR3: SKIPE T2,SVDEV ;SEE IF DEVICE SPECIFIED
PUSHJ P,OUTDEV ;OUTPUT DEVICE AND COLON
PUSHJ P,OUTNAM ;SEE IF NAME AND EXT OR PROJ-PROG
OPIP1A: CAIE C,","
JRST OPIP1 ;FINISHED
MOVEI T1,","
PUSHJ P,TMPOUT
PUSHJ P,SCAN
CAIN C,"," ;STILL ON COMMA?
JRST .-2 ;YES, GET RID OF IT
PUSHJ P,GETNAM
JRST DODIR3
JRST OPIP1
>
SUBTTL DELETE
DODEL: TRO FL,PIPF ;SET TO ALLOW * AS AN IDENT
PUSHJ P,SCANAM
MOVSI T1,'DSK'
SKIPN SVDEV ;FORCE TO DSK IF NONE
MOVEM T1,SVDEV
JRST DEL2
DEL3: PUSHJ P,SCANAM
DEL2: MOVEI T3,CHNPIP
SKIPN T2,SVDEV ;DEVICE?
JRST NODVC
PUSHJ P,OUCRLF
PUSHJ P,OUTSIX ;DUMP NAME
MOVE T2,[':/D= '] ;[233]
PUSHJ P,OUTSIX
JRST DIDDEV
NODVC: MOVEI T1,"," ;IF NO DEV, JUST A ,
PUSHJ P,TMPOUT
DIDDEV: PUSHJ P,OUTNAM ;WRITE THE NAME
PUSHJ P,SCAN ;SEE IF MORE THERE
CAIN C,","
JRST DEL3 ;GO ON
TLNN CS,TERMF ;MAKE SURE THAT LINE ENDS PROPERLY
GOTO SYNERR
OPIP1: PUSHJ P,OUCRLF
OPIP2: PUSHJ P,TMPCHK ;OUTPUT TMP FILE NOW
MOVSI T1,'PIP'
MOVEM T1,PCNAM ;LOAD THIS ONE
JRST DONE1
SUBTTL RENAME/COPY
DOCOPY: MOVEI T2,9*2000-1 ;USE 5K LOW SEG
MOVEM T2,RUNCOR ;RUN PIP IN 5K+4K FOR COPY
SKIPA T2,['/X=',,0] ;[233] FOR COPY
DOREN: MOVSI T2,'/R=' ;[233] SET FOR RENAME
PUSH P,T2 ;SAVE IT
TRO FL,PIPF ;PERMIT * IN FILES
NXTNAM: PUSHJ P,SCAN ;GET A FILE NAME
PUSHJ P,GETNAM ;[154]
MOVEI T3,CHNPIP ;[154]
NXTNM0: CAIE C,"/" ;[227] CHECK FOR SINGLE SWITCH
CAIN C,"(" ;CHECK FOR SWITCHES
JRST [JFCL ;RETURNS HERE FROM COPYSW
CAIA
PUSHJ P,COPYSW ;OUTPUT THEM
PUSHJ P,GETNM0 ;[154] TRY AGAIN FOR NAME
JRST NXTNM0]+2 ;TRY AGAIN FOR NAME
CAIN C,"^" ;TAPE ID?
JRST [PUSHJ P,TAPEID ;[154] GET TAPE ID
PUSHJ P,GETNM0 ;[154] TRY AGAIN FOR
JRST NXTNM0] ;[154] NAME
SKIPN T2,SVDEV ;SEE IF DEVICE SPECIFIED
MOVE T2,LOKNAM ;OR SAVED
MOVEM T2,LOKNAM
JUMPE T2,.+2 ;IF NO NAME SPECIFIED
PUSHJ P,OUTDEV ;PUT IT OUT
PUSHJ P,OUTNAM
CAIE C,"]" ;ALWAYS GET RID OF SPARE "]"
TRNE FL,IDF ;DON'T SCAN IF WE ALREADY HAVE IT
PUSHJ P,SCAN
CAIN C,"^" ;TAPE ID?
PUSHJ P,TAPEID ;YES
CAIE C,"<" ;IS IT PROTECTION?
JRST NXTNM1 ;NO
PUSHJ P,GTPROT ;[272] GET PROTECTION CODE
PUSHJ P,OUTSIX
PUSHJ P,SCAN
NXTNM1: CAIE C,"[" ;[227] CHECK FOR PROJ-PROG
JRST NXTNM2 ;[227] NO
PUSHJ P,GETPP1 ;YES, GET IT
SKIPE T2,SVPPN ;IF NON-ZERO
PUSHJ P,OUTPPN ;PUT IT OUT
PUSHJ P,SCAN ;GO BEYOND "]"
NXTNM2: CAIE C,"/" ;[227] CHECK FOR SINGLE SWITCH
CAIN C,"(" ;CHECK FOR SWITCHES
PUSHJ P,COPYSW ;AND OUTPUT THEM
CAIN C,"^" ;TAPE ID?
PUSHJ P,TAPEID ;YES
MOVE T2,(P)
CAME T2,['/X=',,0] ;[233] IS IT COPY?
JRST NOTCPY ;NO, MUST BE RENAME
MOVS T1,SVNAM ;GET NAME
JUMPE T1,NOTCPY ;ZERO FILE NAME NEEDS /X
CAIN T1,'* ' ;WILD CARD?
JRST NOTCPY ;YES, USE /X
TLC T1,'? ' ;STUPID TEST FOR ? IN FILE NAME
TLCN T1,'? '
JRST NOTCPY ;WELL WE FOUND ONE, USE /X
LSH T1,6 ;SHIFT LEFT
JUMPN T1,.-4 ;TRY NEXT CHAR
MOVS T1,SVEXT ;NO, TRY EXT
CAMN T1,[XWD -1,0] ;[264]WAS IT FNAME. ?
JRST NXTNOX ;[264]YES, DO COPY
CAIN T1,'* ' ;IS THIS WILD CARD?
JRST NOTCPY ;YES, /X NEEDED
TLC T1,'? ' ;SAME TEST FOR EXT
TLCN T1,'? '
JRST NOTCPY ;WELL WE FOUND ONE, USE /X
LSH T1,6 ;SHIFT LEFT
JUMPN T1,.-4 ;TRY NEXT CHAR
NXTNOX: MOVSI T2,'= ' ;[233] NO, SO JUST COPY
NOTCPY: PUSHJ P,OUTSIX
CAIE C,"_" ;[167] "_" SEEN
CAIN C,"=" ;[167] "=" SEEN
CAIA ;[167] "_" OR "=" MUST BE THERE
GOTO SYNERR
SETZM SVPPP ;CLEAR STICKY PPN ON OUTPUT SIDE
SETZM SVDEVV ;[260]CLEAR STICKY DEVICE ON =
COPY1: PUSHJ P,SCANAM
MOVEI T3,CHNPIP ;RESET
CAIN C,"[" ;MIGHT BE *.[PPN]
PUSHJ P,GETPP ;SO GET IT
CAIN C,"^" ;TAPE ID?
PUSHJ P,TAPEID ;YES
SKIPE T2,SVDEV ;DEVICE SEEN?
PUSHJ P,OUTDEV
PUSHJ P,OUTNAM
SETZM SVPPP ;CLEAR STICK PPN NOW PIP HAS SEEN IT
MOVE T1,(P) ;GET EITHER /X OR /R
CAMN T1,['/X=',,0] ;[233] WHICH IS IT?
JRST COPY2 ;IT WAS COPY
PUSHJ P,SCAN ;CHECK FOR MORE
FINCPY: PUSHJ P,OUCRLF
CAIN C,","
JRST NXTNAM ;YES
TLNN CS,TERMF ;NO MORE, SEE IF END
GOTO SYNERR
POP P,T2 ;CLEAR STACK
JRST OPIP2
COPY2: CAIE C,"]" ;IF WE FINISHED ON PPN GET RID OF CHAR
TRNE FL,IDF ;SKIP IF WE ALREADY HAVE NEXT CHAR
PUSHJ P,SCAN ;GET NEXT CHAR
CAIE C,"/"
CAIN C,"(" ;FIRST SEE IF ANY SWITCHES
PUSHJ P,COPYSW ;YES
CAIE C,"," ;MORE COMMAND?
JRST FINCPY ;NO, GIVE UP
MOVEI T1,"," ;OUTPUT THE COMMA
PUSHJ P,TMPOUT
JRST COPY1 ;GET NEXT NAME
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
TAPEID: TRO FL,INPRNT ;TREAT @ AND ; AS NORMAL CHARS
PUSH P,C ;SAVE DELIMITER
MOVEI T1,"^"
PUSHJ P,TMPOUT
IDENT2: PUSHJ P,GETCH
HRRZ T1,C
CAMN T1,(P) ;SAME DELIMITER?
JRST IDENT3 ;YES
CAIN C,177 ;EOF ?
GOTO SYNERR ;YES, GET OUT OF LOOP
PUSHJ P,TMPOUT ;NO
JRST IDENT2 ;READ MORE
IDENT3: TRZ FL,INPRNT ;@ AND ; ARE SPECIAL AGAIN
SETZM SAVCHR ;CLEAR "^"
;**;[304] @IDENT3+2, JMT, 1-JUN-76
;**;[304] DELETE PUSHJ P,SCAN ;[154] CLEAR "^"
POP P,T1 ;CLEAR STACK
MOVEI T1,"^" ;AND DELIMITER
PJRST TMPOUT ;UP ARROW AND RETURN
SUBTTL PRESERVE/PROTECT
DOPROT:
DOPRES: PUSH P,[0] ;[270] RESERVE SPACE FOR PROTECTION
SETZM LOKNAM ;[237] NO DEVICE YET
MOVEI T3,CHNPIP ;USE PIP
TRO FL,PIPF ;SO *.* WILL WORK
PROT1: PUSHJ P,SCANAM ;GO GET FILE NAME ETC
CAIN C,"]" ;DID WE HAVE A PPN?
PUSHJ P,SCAN ;YES, GET RID OF "]"
SKIPN T2,SVDEV ;A NEW DEVICE?
SKIPA T2,LOKNAM ;WELL AN OLD ONE THEN?
MOVEM T2,LOKNAM ;STORE NEW ONE AS OLD ONE
CAIE C,"<" ;PROTECTION FIELD?
JRST .+3 ;NO
SKIPN SVNAM ;NAME SEEN YET?
JRST PROT3 ;NO, GET DEFAULT PROTECTION
SKIPE T2,LOKNAM ;DID WE FIND A DEVICE?
PUSHJ P,OUTDEV ;YES, OUTPUT IT
TRNE FL,IDF ;DON'T IF WE ALREADY HAVE IT
PUSHJ P,SCAN
;[237] PROT1+16
CAIE C,"." ;[237] EXTENSION WITHOUT FILENAME?
JRST PROT5 ;[237] NO.
PUSHJ P,SCAN ;[237] GET EXTENSION.
TLNE CS,TERMF ;[245] IS THIS EOL?
SETZM ACCUM ;[245] YES, WE DIDN'T READ ANYTHING
MOVE T2,ACCUM ;[237] INTO AN AC...
MOVEM T2,SVEXT ;[237] SAVE IT.
PUSHJ P,SCAN ;[237] SETUP FOR PROT5
CAME T2,[SIXBIT/UFD/] ;[237] A UFD?
JRST PROT6 ;[237] NO.
SKIPN T1,SVPPN ;[237] WAS PPN TYPED?
PUSHJ P,USRPPN ;[237] NO, GET IT.
MOVEM T1,SVPPP ;[237] AND PUT BACK.
JRST PROT5 ;[237] CONTINUE...
PROT6: MOVSI T2,(SIXBIT/*/) ;[237] NO FILENAME MEANS ALL
MOVEM T2,SVNAM ;[237] ..
PROT5: CAIE C,"<" ;[237] PROTECTION CODE
JRST PROT2 ;NO
PUSHJ P,GTPROT ;GET PROTECTION IN T2
PUSHJ P,OUTSIX
PUSHJ P,SCAN
CAIE C,"[" ;CHECK AGAIN FOR PPN
JRST PROT4 ;NO
PUSHJ P,GETPP1 ;YES, GET IT
PUSHJ P,SCAN ;PASS OVER "]"
JRST PROT4 ;ALREADY PUT OUT PROTECTION
PROT2: SKIPN T2,(P) ;[270] GET PROTECTION IF GIVEN
PUSHJ P,DFPROT ;[270] DO SOME DEFAULTING IF NOT
PUSHJ P,OUTSIX ;USE IT EVEN IF ZERO
PROT4: MOVSI T2,'/R=' ;[233] RENAME FOR PIP
PUSHJ P,OUTSIX
PUSHJ P,OUTNAM ;NAME.EXT [PPN]
PUSHJ P,OUCRLF ;END WITH CR-LF
CAIN C,"," ;MORE TO COME
JRST PROT1 ;YES
TLNN CS,TERMF ;[245] IS THIS EOL?
GOTO SYNERR ;[245] NOT EOL AND NOT COMMA IS VERY BAD
SUB P,[1,,1] ;PUT STACK BACK
JRST OPIP2 ;AND EXIT
PROT3: PUSHJ P,GTPROT ;GET PROTECTION
MOVEM T2,(P) ;SAVE AS NEW DEFAULT
JRST PROT1 ;SCAN AGAIN FOR FILE NAME
GTPROT: PUSHJ P,SCAN ;GET NUMBER
PUSHJ P,SCAN ;AND DELIMITER
CAIE C,">" ;IT BETTER BE RIGHT ONE
GOTO SYNERR ;IT WASN'T
MOVS T2,ACCUM ;[231] GET 3 NUMBERS
TRC T2,'000' ;[231] BUT WE NEED ALL 3
TRCN T2,'000' ;[231] OR ITS AN ERROR
TDNE T2,[-1,,505050] ;[231] MORE THAN 3 OR NOT ALL OCTAL?
GOTO IPCERR ;[231] ERROR
TLO T2,'<'
LSH T2,^D12 ;SHIFT TO LEFT
TRO T2,'> '
POPJ P, ;RETURN WITH PROTECTION IN T2 IN SIXBIT
;[270] HERE TO DEFAULT THE PROTECTION
DFPROT: HLRZ T3,SVEXT ;[270] GET EXTENSION READ
CAIE T3,'UFD' ;[270] IF A DIRECTORY...
CAIN T3,'SFD' ;[270] THEN READ THE CORRECT DEFAULT
SKIPA T3,[13,,16] ;[270] STANDARD UFD PROTECTION
MOVE T3,[12,,16] ;[270] TABLE FOR STANDARD PROTECTION
GETTAB T3, ;[270] GET IT
MOVSI T3,057000 ;[270] BETTER THAN NOTHING
TLNN T3,(7B2) ;[270] TEST FOR ALREADY PRESERVED
TLO T3,(1B2) ;[270] PRESERVE BIT
MOVEI T2,'<' ;[270] START WITH OPEN ANGLE
MOVEI T4,3 ;[270] SET UP LOOP COUNTER
LSH T2,3 ;[270] GET FIRST DIGIT
LSHC T2,3 ;[270] IN AS SIXBIT
ADDI T2,20 ;[270]
SOJG T4,.-3 ;[270] LOOP FOR ALL THREE DIGITS
LSH T2,^D12 ;[270] LEFT JUSTIFY
TRO T2,'> ' ;[270] CLOSE PROTECTION
MOVEI T3,CHNPIP ;[270] RESTORE TMPFILE CHANNEL
POPJ P, ;[270] AND RETURN
SUBTTL EDIT
DOEDIT: PUSHJ P,SCAN ;START ON THE FILE NAME
DOEDT1: PUSHJ P,GETNAM
MOVEI T3,CHNEDT
MOVEI T1,"S" ;COMMAND FOR LINED
;CROCK IN TECO DELETES FIRST CHARACTER
TRNN FL,SOSF ;DON'T GIVE SOS THE S
PUSHJ P,TMPOUT ;OUTPUT THE S
TRNE FL,TECOF!SOSF ;IF TECO OR SOS
SKIPN T2,SVDEV ;AND A DEVICE SEEN
JRST .+2 ;NO, NOT BOTH CONDITIONS
PUSHJ P,OUTDEV ;OUTPUT THE DEVICE
PUSHJ P,OUTNAM ;OUTPUT THE NAME & EXT
;THIS CODE PASSES REST OF LINE TO THE EDITOR SO SWITCHES CAN BE USED
;BUT CHANGES (SWITCH) TO /SWITCH
CAIE C,POPFIL ;[224] TERMINATOR?
TLNE CS,TERMF ;ALREADY TERMINATED?
JRST %NOSLS ;YES - HANDLE NORMALLY
CAIN C,"(" ;IF FIRST CHAR IS OPEN PAREN
MOVEI C,"/" ;CHANGE TO SLASH
CAIE C,"]" ;GET RID OF "]" IF JUST SEEN PPN
JRST %GIVE ;PASS REMAINDER OF STRING TO NEXT CUSP
%MORE: PUSHJ P,GETCH ;MORE CHARS COMING (MAYBE SWITCHES)
CAIN C,"(" ;OPEN PAREN
MOVEI C,"/" ;BECOMES SLASH
CAIN C,")" ;CLOSE PAREN
JRST %MORE ;IS IGNORED
;[210] CODE DELETED HERE
TLNE CS,TERMF ;SOME OTHER KIND OF TERMINATOR?
JRST %NOSLS ;YES - FINISH UP NORMALLY
%GIVE: MOVE T1,C ;PASS THE CHARACTER TO THE EDITOR
CAIE C,15 ;[166] DON'T PASS CR TO EDITOR
PUSHJ P,TMPOUT ;LEAVE ERROR DETECTION TO THE EDITOR
JRST %MORE ;GO BACK FOR ANOTHER CHAR
%NOSLS: TRNE FL,CREATF ;EDIT OR CREATE?
JRST DOEDT3 ;CREATE (OR MAKE)
PUSHJ P,OUCRLF ;EDIT (OR TECO) - OUTPUT CRLF
DOEDT2: PUSHJ P,TMPCHK
MOVE T1,[EXP EDITOR]
TRNE FL,SOSF ;SOS?
MOVSI T1,'SOS' ;YES
TRNE FL,TECOF
JRST ISTECO ;TECO OR MAKE COMMAND
ENDED: MOVEM T1,PCNAM
JRST DONE ;GO GET IT LOADED
DOEDT3: MOVEI T1,175 ;OLD ALTMODE
PUSHJ P,TMPOUT ;ENDS CREATE OR MAKE COMMAND
JRST DOEDT2
ISTECO: MOVE 14,SVNAM ;EDITING THIS PROGRAM
TRNE FL,CREATF ;CHECK FOR MAKE COMMAND
CAME 14,[SIXBIT /LOVE/] ;WITH ARGUMENT OF LOVE
JRST ISTEC1 ;NO SUCH HACK
SKIPE SVEXT ;BUT ONLY IF EXT IS BLANK
JRST ISTEC1 ;NO SUCH LUCK
MOVEI T2,2 ;YES. PAUSE THOUGHTFULLY
CALLI T2,31 ;BY SLEEPING
STRING [ASCIZ /not WAR?
/]
ISTEC1: MOVE T1,[SIXBIT /TECO/] ;NAME OF CUSP
JRST ENDED
;NOTE: LEAVE THE ABOVE HACK IN FOR SALES DEMOS
SUBTTL TYPE/LIST
IFE LSTRSW,<
CHNLST==CHNPIP ;USE PIP FOR A LISTER
>
TYPR: SKIPA T2,['TTY:/C'] ;[214]
LISTR: MOVE T2,['LPT:/X']
MOVEI T3,CHNLST
PUSHJ P,OUTSIX
MOVEI T1,"=" ;[233]
PUSHJ P,TMPOUT ;DON'T FORGET "_"
IFE LSTRSW,<
TRO FL,PIPF ;IF IT'S PIP, ALLOW *.MAC, ETC.
>
LSTLP: PUSHJ P,SCANAM ;GET NAME
SKIPN T2,SVDEV
JRST LSTLP1 ;USE PREV NAME IF NO NEW NAME
PUSHJ P,OUTDEV ;OUTPUT IT
LSTLP1: PUSHJ P,OUTNAM ;FILE NAME
PUSHJ P,SCAN
IFE LSTRSW,<
CAIE C,"/"
CAIN C,"(" ;SWITCHES?
PUSHJ P,COPYSW ;YES, OUTPUT THEM
>
IFN LSTRSW,<
CAIE C,"(" ;PAGE SPEC?
JRST ENDLST ;NO
MOVEI T1,"(" ;OUTPUT THE ( TO FILE
PUSHJ P,TMPOUT
LST1: PUSHJ P,GETCH ;COPY PAGE SPEC
MOVE T1,C ;TO OUTPUT AC
PUSHJ P,TMPOUT ;THENCE TO FILE
CAIE C,")" ;THROUGH END OF ARG
JRST LST1 ;MORE
PUSHJ P,SCAN ;NOW WHAT?
>
ENDLST: CAIN C,"," ;SHOULD BE COMMA OR CR
JRST [MOVEI T1,","
PUSHJ P,TMPOUT
JRST LSTLP]
TLNN CS,TERMF ;SHOULD BE TERMINATOR
GOTO SYNERR ;WASNT
IFE LSTRSW,<
JRST OPIP1
>
IFN LSTRSW,<
PUSHJ P,OUCRLF ;ADD CRLF TO COMMAND
PUSHJ P,TMPCHK ;OUTPUT THE FILE
MOVE T1,[SIXBIT /LISTER/]
MOVEM T1,PCNAM
JRST DONE1
>
SUBTTL TAPE FUNCTIONS
DOEOF: SKIPA T2,['(MF)= '] ;[233]
DOZERO: MOVSI T2,'/Z=' ;[233]
TRO FL,PIPF ;INCASE *.*
PUSH P,T2 ;SAVE COMMAND
MOVEI T3,CHNPIP ;OUTPUT CHANNEL
TAPEF: PUSHJ P,SCANAM ;GO GET DEVICE ETC
SKIPN T2,SVDEV ;[213] WAS DEVICE SPECIFIED?
GOTO XPDERR ;[213] NO, GIVE ERROR MESSAGE
PUSHJ P,OUTDEV ;YES, OUTPUT IT
PUSHJ P,OUTNAM ;FILENAME AND PPN
MOVE T2,(P) ;GET TAPE FUNCTION
PUSHJ P,OUTSIX
PUSHJ P,OUCRLF ;FINISH LINE
CAIE C,"," ;MORE COMMAND?
JRST OPIP2 ;NO, EXIT
TRNE FL,IDF ;MORE THAN JUST DEVICE?
PUSHJ P,SCAN ;YES, PASS OVER COMMA
JRST TAPEF ;YES
DOSKIP: TDZA T2,T2 ;SIGNAL FORWARDS BY 0
DOBKSP: SETO T2, ;BACKWARDS BY -1
PUSH P,T2 ;STORE IT
PUSH P,[0] ;AND COUNT
TRO FL,PIPF ;JUST INCASE
MOVEI T3,CHNPIP ;USE PIP
PUSHJ P,SCANAM ;GO GET SOMETHING
SKIPN T2,SVDEV ;[213] FIND A DEVICE?
GOTO XPDERR ;[213] NO, GIVE ERROR MESSAGE
PUSHJ P,OUTDEV ;YES
TAPESP: SKIPN T2,SVNAM ;[213] FIND SOMETHING IN FILE NAME?
GOTO SYNERR ;MUST FIND SOMETHING
SETO T1, ;FIND THE MASK
LSH T1,-6 ;MUST BE AT LEAST ONE CHAR. ANYWAY
TDNE T2,T1 ;DON'T MASK REAL CHAR.
JRST .-2 ;SHIFT AND TRY AGAIN
SETZ T4, ;START AT FRONT OF TABLE
TPSRCH: MOVE T3,TPTBL(T4) ;GET FUNCTION
ANDCM T3,T1 ;MASK IT
CAMN T2,T3 ;FOUND IT?
JRST TPFND ;YES
CAIGE T4,TPLEN ;STILL IN TABLE
AOJA T4,TPSRCH ;YES, TRY NEXT
TLNE T2,(1B0) ;IS IT A NUMBER?
GOTO SYNERR ;NO
MOVEM T2,(P) ;REPLACE DUMMY COUNT
PUSHJ P,SCANAM ;[213] FIND SOMETHING
JRST TAPESP
TPFND: MOVEI T3,CHNPIP ;RESTORE PIP
MOVSI T2,'(M ' ;START OF SWITCH
SKIPE (P) ;NUMBER SPECIFIED
TLO T2,' #' ;YES
PUSHJ P,OUTSIX ;OUTPUT IT
POP P,T2 ;GET NUMBER
SKIPE T2 ;DON'T BOTHER IF ZERO
PUSHJ P,OUTSIX
MOVE T2,TPFN(T4) ;PICK UP PIP CHAR
SKIPE (P) ;IF FORWARDS
MOVSS T2 ;NO, BACKSPACE
HLLZS T2 ;CLEAR RIGHT
PUSHJ P,OUTSIX
PUSHJ P,OUCRLF ;FINISH WITH CRLF
CAIE C,"," ;MORE TO COME
JRST OPIP2 ;NO, EXIT
PUSHJ P,SCAN ;PASS OVER COMMA
JRST DOBKSP+2 ;YES, START AGAIN
TPTBL: SIXBIT /FILES/
SIXBIT /RECORD/
SIXBIT /EOT/
TPLEN==.-TPTBL
TPFN: 'A)=',,'B)=' ;[233]
'D)=',,'P)=' ;[233]
'T)=',,'T)=' ;[233]
DOREW: SKIPA T2,[1]
DOUNLD: MOVEI T2,11
TRO FL,PIPF
PUSH P,T2 ;SAVE FUNCTION
DOMTP: PUSHJ P,SCANAM ;GET A DEVICE ETC
DOMTP0: SKIPN T1,SVDEV ;GET THE DEVICE
JRST NOMTPD ;NO DEV: SEEN
DOMTP1: MOVEM T1,LOKNAM ;STORE IN LOOKUP BLOCK
OPEN LOOK,LOKINT ;INIT
JRST DODVNA ;NO SUCH DEVICE
MTAPE LOOK,0 ;WAIT ON FREE DEVICE
MTAPE LOOK,@(P) ;DO FUNCTION
RELEASE LOOK, ; AND FREE UP THE DRIVE
DOMTPC: CAIE C,"," ;MORE TO DO?
JRST DOEND ;NO
TRNE FL,IDF ;UNLESS DONE ALREADY
PUSHJ P,SCAN ;PASS OVER THE COMMA
JRST DOMTP ;GET NEXT
NOMTPD: SKIPN T1,SVNAM ;DID WE SEE A FILE NAME?
;**;[306] @NOMTPD+1, JMT, 21-JUN-76
;**;[306] DELETE GOTO SYNERR ;NO, U LOSE
GOTO XPDERR ;[306] NO, U LOSE
CAIN C,"," ;IF A COMMA WE'RE AT END OF THIS SPEC
JRST DOMTP1 ;SO USE "FILE NAME" AS DEVICE
PUSH P,T1 ;SAVE IT
SETZM SVNAM ;CLEAR NAME
PUSHJ P,SCANAM ;SEE IF MORE SPECIFIED
POP P,T1 ;RECOVE PREV NAME
SKIPE SVDEV ;FOUND A DEV AT LAST?
JRST DOMTP0 ;YES, USE IT
SKIPE SVNAM ;BUT NOT 2 NAMES
GOTO SYNERR
JRST DOMTP1 ;USE SINGLE "FILE NAME"
DODVNA: STRING [ASCIZ /?CMLDVA Device not available - /]
MOVE T3,LOKNAM
MOVE T1,[POINT 7,ERRBUF]
PUSHJ P,SIXOUT
MOVEI T2,":"
IDPB T2,T1
MOVEI T2,15
IDPB T2,T1
MOVEI T2,12
IDPB T2,T1
MOVEI T2,0
IDPB T2,T1
STRING ERRBUF
JRST DOMTPC ;SEE IF MORE TO DO
SUBTTL OUTPUT ROUTINES
OUTDEV: PUSHJ P,OUTSIX ;OUTPUT DEVICE
MOVEI T1,":" ;AND A COLON
PJRST TMPOUT ;RETURN TO USER
OUTNAM: SKIPN T2,SVPPP ;STICKY PPN?
JRST OUTNM1 ;NO
IFN SFDSW,<
PUSH P,SVPPN ;SAVE
SETZM SVPPN ;MARKER FOR OUTSFD/OUTSFP
>
PUSHJ P,OUTPPN ;OUTPUT [DIRECTORY]
IFE SFDSW,<
MOVE T2,SVPPP
CAMN T2,SVPPN ;SAME AS NON-STICKY?
>
IFN SFDSW,<
POP P,SVPPN ;RESTORE
PUSHJ P,CHKSFD ;SEE IF WHOLE SFD SAME
>
SETZM SVPPN ;YES, PIP CAN HANDLE IT OK
OUTNM1: SKIPE T2,SVNAM ;[237]
PUSHJ P,OUTSIX
SKIPE T2,SVEXT
PUSHJ P,OUTEXT
OUTPP: SKIPE T2,SVPPN ;GET PPN
PJRST OUTPPN ;OUTPUT IF NON-ZERO
POPJ P,
OUTEXT: MOVEI T1,"."
PUSHJ P,TMPOUT
HLLZ T2,T2 ;3 CHAR ONLY
JRST OUTSIX
OUCRLF: MOVEI T1,15 ;CARRIAGE RETURN
PUSHJ P,TMPOUT ;TO CURRENT OUTPUT FILE
MOVEI T1,12 ;LINE FEED
JRST TMPOUT ;TO OUTPUT FILE
PUSHJ P,GETCH ;COPY THE SWITCH
COPYSW: CAIN C,"/" ;SINGLE SWITCH
JRST COPYS1 ;YES
MOVE T1,C ;TO OUTPUT AC
PUSHJ P,TMPOUT ;THENCE TO FILE
CAIE C,")" ;UNTIL END OF SWITCH
JRST COPYSW-1 ;BUT NOT YET
COPYSR: ;BACKUP 3 LOCS INCASE MORE SWITCHES
REPEAT 3,<
SOS (P)
>
SETZM SAVCHR ;[154] GET RID OF "/" OR ")"
JRST SCAN ;GET NEXT AND RETURN
COPYS1: MOVE T1,C ;GET "/"
PUSHJ P,TMPOUT ;OUTPUT IT
PUSHJ P,GETCH ;GET NEXT CHAR
MOVE T1,C
PUSHJ P,TMPOUT ;OUTPUT SWITCH
JRST COPYSR ;RETURN
IFN SFDSW,<
OUTSFD: SKIPN SVPPN(SVPT) ;STICKY SFD MARKER?
JRST OUTSFP ;YES
X==0 ;INITIAL CONDITION
REPEAT SFDLEN,<
SKIPE T2,SVSFD+X(SVPT)
PUSHJ P,SFDOUT
X==X+NFILE
>
POPJ P, ;RETURN TO PRINT "]"
OUTSFP: X==0 ;INITIAL CONDITION
REPEAT SFDLEN,<
SKIPE T2,SVSFP+X
PUSHJ P,SFDOUT
X==X+1
>
POPJ P, ;RETURN TO PRINT "]"
SFDOUT: MOVEI T1,"," ;SEPARATOR
PUSHJ P,TMPOUT ;OUTPUT IT
PJRST OUTSIX ;FOLLOWED BY SFD
CHKSFD: MOVSI T1,-SFDLEN ;AOBJN POINTER
MOVE T2,SVPPN
CAME T2,SVPPP ;CHECK PPN FIRST
JRST CPOPJ1 ;SKIP IF DIF
MOVE T2,SVSFD(T1) ;GET SFD
CAME T2,SVSFP(T1)
JRST CPOPJ1
ADDI T1,NFILE-1 ;LENGTH APPART
AOBJN T1,.-4 ;LOOP FOR ALL SFD'S
POPJ P, ;NON-SKIP IF IDENTICAL
>
SUBTTL TMP FILE ROUTINES
;USEFUL SYMBOLS
TMPFST==0 ;POINTER TO FIRST BUFFER
TMPCUR==1 ;POINTER TO CURRENT BUFFER
TMPPTR==2 ;BYTE POINTER
TMPCNT==3 ;BYTE COUNT (LEFT TO FILL)
TMPHDR==4 ;SIZE OF BUFFER "HEADER"
TMPBUF==^D128+2 ;SIZE OF DATA BUFFER
TMPIOW==0 ;IOWD FOR DUMP MODE
TMPLNK==1 ;LINK TO NEXT BLOCK (GOTO WORD)
TMPDAT==2 ;FIRST DATA WORD
;ENTER WITH OUTPUT BYTE IN T1
;INDEX TO TABLE IN T3
;USES T5 AS ADDRESS OF "BUFFER HEADER"
TMPOUT: JUMPL T3,CPOPJ ;[230] DO NOT DEPOSIT IF -1
SKIPN T5,TMPCHN(T3) ;ALREADY SET UP "HEADER AND BLOCK"?
PUSHJ P,TMPINI ;NO, DO SO
SOSG TMPCNT(T5) ;ANY ROOM
PUSHJ P,TMPOU1 ;NONE LEFT
IDPB T1,TMPPTR(T5) ;YES, DUMP BYTE
POPJ P, ;AND RETURN
TMPINI: PUSH P,[EXP TMPRET] ;WHERE TO RETURN TO ON POPJ
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;AND T2
MOVEI T1,TMPHDR ;LENGTH WE NEED
PUSHJ P,GETSPC ;GET IT, OR ABORT
HLL T1,FL3 ;GET NEW!OLD!SYS!SELF
TLZ T1,-1-DEVSWS ;BUT ONLY THOSE
MOVEM T1,TMPCHN(T3) ;STORE INFO
HRRZ T5,T1 ;AND INTO T5
MOVEI T1,TMPBUF ;LENGTH OF DATA BLOCK
PUSHJ P,GETSPC ;GET 1 BLOCK TO START WITH
MOVEM T1,TMPFST(T5) ;STORE IN HEADER BLOCK
PJRST TMPOU2 ;AND CLEAR BUFFER
TMPRET: AOS TMPCNT(T5) ;SET COUNT TO ^D<5*128>
POPJ P,
TMPOU1: PUSH P,T1 ;SAVE T1
PUSH P,T2 ;AND T2
MOVEI T1,TMPBUF ;LENGTH OF DATA BLOCK
PUSHJ P,GETSPC ;GET 1 BLOCK
MOVE T2,TMPCUR(T5) ;LINK THIS TO CURRENT
HRRZM T1,TMPLNK(T2)
TMPOU2: MOVEM T1,TMPCUR(T5) ;STORE IN HEADER BLOCK
HRRZ T2,T1 ;GET ANOTHER COPY
ADDI T1,TMPDAT ;POINT TO DATA AREA
HRLI T1,(POINT 7,) ;FORM BYTE POINTER
MOVEM T1,TMPPTR(T5) ;STORE BYTE POINTER
MOVEI T1,^D<5*128>-1 ;BYTE COUNT
MOVEM T1,TMPCNT(T5) ;PER BUFFER
HRRZ T1,T2 ;START OF DATA
HRL T1,T1 ;FORM XWD
SETZM (T1) ;ZERO FIRST WORD
ADDI T1,1 ;FORM BLT WORD
BLT T1,TMPBUF-1(T2) ;CLEAR ALL BUFFER
POP P,T2
POP P,T1
POPJ P, ;NOW DO STORE BYTE
;HERE TO CLOSE THE TMP AREA AND WRITE OUT FILES
TMPCHK: SKIPN T5,TMPCHN(T3) ;THERE BETTER BE ONE
POPJ P, ;NO, SO GIVE UP
PUSH P,T1 ;SAVE T1 JUST INCASE
PUSH P,T2 ;T2 ALSO
HLLZ T1,T5 ;GET RUN DEV: BITS
JUMPE T1,.+3 ;NO
JFFO T1,.+1 ;GET INDEX
MOVE T1,PRCDEV(T2) ;GET DEVICE
MOVEM T1,PCDEV ;SET TO LINK TO IT
MOVE T1,TMPCUR(T5) ;POINT TO LINK IN LAST BLOCK
ADDI T1,TMPDAT-1 ;POINT TO DATA-1
HRRZM T1,@TMPCUR(T5) ;STORE START ADDRESS
MOVEI T1,^D<5*128>+4 ;BYTE COUNT INITIALLY (PLUS REMAINDER)
SUB T1,TMPCNT(T5) ;MINUS WHAT'S LEFT IS WHAT'S USED
IDIVI T1,5 ;GET WORD COUNT
POP P,T2
MOVN T1,T1 ;NEGATE
HRLM T1,@TMPCUR(T5) ;IOWD IS SET UP
MOVE T5,TMPCHN(T3) ;GET POINTER TO HEADER AGAIN
MOVE T1,TMPFST(T5) ;POINT TO LINK IN FIRST BLOCK
SKIPE TMPLNK(T1) ;ONLY ONE BLOCK
JRST TMPDSK ;NO SUCH LUCK, USE DSK
HLLZ T1,PROCTB(T3) ;GET NAME
CAMN T1,['LIN '] ;IS THIS LINK-10
MOVSI T1,'LNK' ;BETTER 3 LETTER NAME
MOVEM T1,TMPFIL ;INTO TMPCOR BLOCK
MOVE T1,@(T5) ;PICK UP SINGLE IOWD
MOVEM T1,TMPFIL+1 ;STORE IT
MOVE T1,[3,,TMPFIL] ;SET UP FOR WRITE
IFN SNOBOL,<
CAIE T3,CHNSNO ;SNOBOL CAN'T READ TMP:
>
TMPCOR T1, ;TRY IT
JRST TMPDS2 ;YOU LOSE, TRY DSK
TMPXIT: SETZM TMPCHN(T3) ;ONLY DO IT ONCE
POP P,T1
POPJ P,
TMPDSK: MOVE T5,(T5) ;POINT TO FIRST DATA BLOCK
TMPDS1: SKIPGE (T5) ;IOWD SET UP YET?
JRST TMPDS2 ;YES, REACHED END
MOVSI T1,-^D128 ;NO, USE 128 WORD BLOCKS
HRRI T1,1(T5) ;POINT TO DATA
MOVEM T1,(T5) ;STORE IOWD
SKIPE T5,1(T5) ;GET NEXT POINTER
JRST TMPDS1 ;NOT DONE YET
TMPDS2: HLRZ T1,PROCTB(T3) ;GET PROCESSOR
CAIN T1,'LIN' ;CHANGE LINK-10
MOVEI T1,'LNK' ;AS THIS IS BETTER
HLL T1,JOBNAM ;GET JOB NUMBER IN SIXBIT
MOVEM T1,NAME
MOVE T1,@TMPCHN(T3) ;MOVE IO LIST POINTER TO
MOVEM T1,TMPFIL ;A COMMON TEMP CELL
PUSHJ P,TMPDS0 ;USE COMMON ROUTINE, FROM "DONE" TOO
JRST TMPXIT ;WRAP UP USE OF THIS CHANNEL
TMPDS0: MOVSI T1,'TMP'
MOVEM T1,NAME+1
SETZM NAME+2
SETZM NAME+3
IFE TENEX,<
IFE FASTFS,<
SKIPN FSNAME ;DO WE HAVE FASTEST F/S
PUSHJ P,FNDFST ;NO, GET IT>
MOVEI T1,16 ;DUMP RECORD
MOVEM T1,FSINIT
SETZM FSBHD ;CLEAR BUFFER HEADER
TRYAGN: OPEN LOOK,FSINIT ;INIT THE F/S
JRST DOEND ;[206] ERROR
ENTER LOOK,NAME
JRST [PUSHJ P,TRYDSK ;[276] TRY GENERIC DSK (ONLY RETURN IS YES) ?
JRST TRYAGN] ;[276] YES--TRY AGAIN
MOVE T1,@TMPCHN(T3) ;GET ADDRESS OF IOWD LIST
OUTPUT LOOK,(T1) ;OUTPUT THE DATA
CLOSE LOOK,20 ;SAVE THE NAME BLOCKS
JRST TRYDS1 ;[276] PROCEED
TRYDSK: HRRZ T1,LEXT ;[276] GET ERROR CODE
CAIE T1,0 ;[276] NON-EXISTANT FILE
CAIN T1,1 ;[276] OR UFD ?
JRST DODSK ;[276] YES--GO TRY GENERIC DSK
CAIE T1,23 ;[276] NON-EXISTANT SFD ?
JRST FIU ;[276] NO--GIVE ERROR
DODSK: MOVSI T1,'DSK' ;[276]
CAMN T1,FSNAME ;[276] LAST DEVICE GENERIC DSK ?
JRST FIU ;[276] YES--OH WELL WE TRIED
MOVEM T1,FSNAME ;[276] NO
SETZM LPPN ;[276] RESET PPN
SETZM LDAT ;[276] AND OTHER GOOD
HLRM T1,LEXT ;[276] STUFF
POPJ P, ;[276] SO TRY IT
TRYDS1:
>
IFN TENEX,<
PUSH P,T3 ;SAVE THE CHANNEL NUMBER
MOVE T4,[POINT 7,GJFNST];WHERE NAME WILL GO
MOVE T2,NAME ;JOB NUMBER AND PROCESSOR
MOVEI T1,0 ;CLEAR AC FOR ASCII CHAR
LSHC T1,6 ;PUT A SIXBIT CHAR IN IT
ADDI T1,40 ;MAKE ASCII
IDPB T1,T4 ;TO NAME
JUMPN T2,.-4 ;BUILD 6 CHARS OF NAME
MOVE T1,T4 ;APPEND FOLLOWING STRING TO IT
HRROI T2,[ASCIZ /.TMP;0/]
MOVEI T3,0
SOUT
POP P,T3 ;RECOVER CHANNEL NUMBER
MOVSI T1,401001 ;OUTPUT SHORT STRING IGNR DEL
HRROI T2,GJFNST ;STRING STORAGE
GTJFN
JRST FIU
PUSH P,T1 ;SAVE THE JFN
MOVE T2,[440000,,100000];WRITE 36 BIT MODE
OPENF
JRST [POP P,T1
CLOSF
JFCL
JRST FIU]
MOVE T1,(P) ;JFN
MOVEM T3,(P) ;CHANNEL INDEX
MOVEI T4,TMPFIL ;GET INITIAL IO LIST POINTER
MOVE T2,[1,,1] ;UNDELETE THE FILE
MOVEI T3,T3 ;GET CONTROL BITS
GTFDB ; ..
HRLI T1,1 ;CHANGE WORD 1
MOVSI T2,(1B3) ;THIS BIT
TLZ T3,(1B3) ;TO THIS VALUE (0)
CHFDB
HRRZS T1 ;GET JFN BACK
TMPDSL: SKIPN T2,(T4) ;END?
JRST TMPDS3 ;YES
JUMPG T2,[HRRZ T4,T2 ;NO. IF PLUS, A JUMP WORD
JRST TMPDSL] ;GO TO IT
HLRE T3,T2 ;NEGATIVE COUNT
HRLI T2,4400 ;BYTE POINTER WILL COUNT TO FIRST WD
SOUT ;SEND IT
AOJA T4,TMPDSL ;LOOP THRU IO LIST
TMPDS3: POP P,T3 ;RESTORE CHANNEL NUMBER
CLOSF ;CLOSE FILE IN T1
JFCL
U (GJFNST,4) ;FOR JFN STRING STORAGE
>
POPJ P,0 ;END OF TMPDS0 ROUTINE
;HERE TO GET SPACE FROM FREE CORE, ENTER WITH T1 CONTAINING
; SPACE REQUIRED, EXIT WITH ADDRESS IN T1
GETSPC: ADD T1,SVJFF ;GET ADDRESS OF NEXT FREE WORD
CAMGE T1,CORTOP ;ENOUGH SPACE?
JRST GOTSPC ;YES
PUSH P,T1 ;SAVE ACCS
PUSH P,T2
MOVEI T1,2000 ;INCREMENT BY 1K
ADDM T1,CORTOP
ADDM T1,CORT1
ADD T1,.JBREL ;NEW TOP
CORE T1,
JRST NOCOR ;LOSE
MOVE T1,.JBREL
MOVE T2,-2000(T1) ;MOVE CORE UP
MOVEM T2,(T1)
CAMLE T1,CORTOP ;DONE?
SOJA T1,.-3 ;NO
POP P,T2
POP P,T1
GOTSPC: MOVEM T1,.JBFF ;STORE HIGHEST LOC IN USE
EXCH T1,SVJFF ;AND HERE ALSO
POPJ P,
SUBTTL TABLE OF PROCESSOR NAMES
DEFINE X (A,B,C,D,E,F,G)<
IFDIF <A><MACY11>,<
<SIXBIT /A/>>
IFIDN <A><MACY11>,<
<SIXBIT /B/>>
>
PROCTB: PROCESS
REPEAT MXPROC-NPROCS,<0> ;FILL IN MISSING ONES
XPROCESS ;AND THESE
SUBTTL DATA STORAGE ASSIGNMENTS
SALL
WORDS <PCNAM,PCDEV,LODDEV,SAVPPN,SVSWP,PCNUM,OLDEXT,SDAT,STIM,SAVCHR>
;**;[303] ADD LOCATION DEFPRO AS FLAG TO INDICATE DEFAULT PROCESSOR USED
WORDS <ACCUM,DINPT,DINCT,SVJFF,CORTOP,CORT1,SVRPP,NUMAT,DFPROC,DEFPRO>
WORDS <SVIND,SVPDL,JOBNAM,BROCNT,LODSP2,LODCT2,LODSP,LODCTR,EXTEND>
U (LODSBK,<LODSCT/5+1>)
U (LODSB2,<LODSCT/5+1>)
WORDS <SWBKB,SWBKL>
U (SWBKS,NFILE)
U (ODEV,1)
U (ONAM,1)
U (OEXT,1)
U (OPPN,1)
IFN SFDSW,<U (OSFD,SFDLEN)>
U (SVDEVV,1) ;[254] SAVE AREA FOR DEVICE
U (SVDEV,NFILE)
U (SVNAM,NFILE)
U (SVEXT,NFILE)
U (SVPPN,NFILE)
U (SVPPP,1)
IFN SFDSW,<U (SVSFD,<NFILE*SFDLEN>)
U (SVSFP,SFDLEN)>
U (TTYPT,1)
U (LOOKBF,3)
U (PDLB,PDL+1)
U (SWBLK,SWBK+1)
U (OPENB,3)
U (IOPD,<<NESTDP+1>*3+1>)
U ERRBUF,22 ;FOR TYPEOUTS
U BUFTAB,<NESTDP+1> ;WHERE THE BUFFERS ARE FOR FILES
U FREBUF,<NESTDP+1> ;FREED BUFFERS
U (TMPFIL,2)
U (TMPCHN,<MXPROC+XTPROC>) ;NUMBER OF "CHANNELS" REQUIRED
WORDS <FSINIT,FSNAME,FSBHD>
WORDS <MAPSW,FDGFLG,DEBFL,EXECFL,DDTFL,FORLIB,RUNCOR,MYPPN,SPDLPT,CPU>
IFN FORTRAN,<U (FORPRC,1)>
U (GOTPST,1) ;-1 WHEN PAST SWITCH SCANNER
U (PARLVL,1) ;[221] LEVEL OF PAREN NESTING IN COMPILER SWITCHES
U (DEBPRM,DEBSIZ) ;[221] AREA TO HOLD PERM SWITCHES
U (DEBTMP,DEBSIZ) ;[221] DITTO FOR TEMP
U (SAVSW,1) ;[234] EITHER /SAVE OR /SSAVE FOR THIS FILE
U (NSWTCH,1) ;[236] -1 IF /L SEEN LAST
;THIS IS THE PART THAT MUST BE INITIALIZED IF PURE.
;JUST USED AS IS IF IMPURE
;[240] FCOMD -15
WORDS(<EBLK,EPPN,NAME,LEXT,LDAT,LPPN>) ;[240]
U(EVER,<.RBTIM-.RBSIZ>) ;[240] EXTENSION TO LOOKUP BLOCK
LNAM=NAME
;[246] FCOMD-15,JNG,12/15/74
U(PTHBLK,3) ;[246] ARG,FLAGS,PPN
IFN SFDSW,<
WORDS <LSFDAD,LSFDSC,LSFDPP>
U (LSFD,SFDLEN)>
IFN PURESW,<
INIDAT:
U (INILOW,0) ;WHERE IT GOES IN THE LOW SEGMENT
PHASE INILOW>
LOKINT: 1
LOKNAM: 0
XWD LOOKBF,LOOKBF
DSKLK: 1
SIXBIT /DSK/
XWD LOOKBF,LOOKBF
FCOMD: ASCII /@***SVC.TMP
/
BYTE (7) 177,177 ;MARK EOF
FCOMD2: ASCII /@***EDS.TMP
/
BYTE (7) 177,177
CRFRDR: ASCII /@***CRE.TMP/
BYTE (7) 177,177
INLFLG: BLOCK 1 ;[305] -1 = CURRENTLY NOT AT BEGINNING OF LINE
FAKEOL: BLOCK 1 ;[305] -1 = ROUTINE POPFIL FAKED A LF FOR PIP
IFN PURESW,<
DEPHASE
INITOP==. ;END OF INITIALIZED DATA
INILEN==INITOP-INIDAT ;LENGTH OF DATA
U (INILOW,INILEN) ;BLOCK OF STORAGE FOR DATA
>
U (LOWTOP,0)
IFN DEBSW,<
PATCH:
PAT: BLOCK 40 ;PATCH AREA FOR DEBUGGING>
END STPT
>