Trailing-Edge
-
PDP-10 Archives
-
BB-F493Z-DD_1986
-
10,7/compil.mac
There are 5 other files named compil.mac in the archive. Click here to see a list.
TITLE COMPIL 22F(576) CCL CONTROL CUSP
SUBTTL OWNER HISTORY
; WEIHER/CLEMENTS/RCC/PMH/NGP/DMN/HPW/JNG
; /SMM/JMT/WCL/BCM/GAT 9-AUG-85
SUBTTL PROGRAM TO COMPILE LOAD EXECUTE AND DEBUG USER PROGRAMS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1978,1983,1984,1985,1986.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH UUOSYM
VCOMPIL==22
VUPDATE==6 ;DEC UPDATE LEVEL
VEDIT==576 ;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
INTERN VCOMPILE,.JBVER ;FOR LOADER MAP AND LIBRARY
LOC <.JBVER==137>
<VCUSTOM>B2+<VCOMPIL>B11+<VUPDATE>B17+VEDIT
RELOC 0
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 FASTFS,<FASTFS=0> ;FASTEST FILE STRUCTURE
;IF ZERO COMPIL WILL FIND IT AT RUN TIME
IFNDEF SIMULA,<SIMULA==1> ;[452] ACCEPT SIMULA AS A COMPILER
IFNDEF PASCAL,<PASCAL==1> ;[463] ACCEPT PASCAL AS A COMPILER
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 FORTRAN,<FORTRAN==1> ;NON-ZERO IF BOTH F40 AND FORTRAN-10 ALLOWED
IFNDEF DFORTRAN,<DFORTRAN==1> ;DEFAULT VALUE 0=F40, 1=FORTRAN-10
IFNDEF DCOBOL,<DCOBOL==1> ;[324] DEFAULT VALUE 0=COBOL-68, 1=COBOL-74
;[451] MAKE COBOL-74 DEFAULT COBOL COMPILER
IFNDEF EDITOR,<EDITOR=='DTECO '>;EITHER LINED OR EDITS [441] DEF IS DTECO
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
;START OF VERSION 22D
;310 (SPR 10-21464)PASSES INVALID TMP FILE TO LINK IF
; A PREVIOUS COMMAND ALSO CONTAINED A MAP OR LMAP
; SWITCH AREAS AFFECTED: SETMAP,SETMPL
;311 (SPR 10-21882) SKIP MTA: NUM FILES DOESN'T WORK
; AREA AFFECTED: TAPESP
;312 (SPR 10-22043) WRONG AND INVALID DEBUG AID SWITCH BEING
; PASSED TO LINK FOR FORTRAN. IF F40 USE DDT AND IF
; FORTRAN-10 USE FORDDT. AREAS AFFECTED: PROCESS MACRO,
; GETDD1, FOR
;313 (SPR 10-21981) IF SFDSW=0 THEN GOTSTK UNDEFINED.
; MOVED LABEL OUTSIDE OF CONDITIONAL. AREA AFFECTED:GOTSTK
;314 (SPR 10-22084) COBOL PROGRAMS CANNOT BE LISTED TO LPT:
; WITH /LIST. BUG INTRODUCED WITH EDIT 251. AREA
; AFFECTED: DOCOM2+5
;315 (SPR 10-22658) STOP TRYING TO FIND FILES IN USER'S AREA
; IF EXPLICIT DEVICE OR PPN IS GIVEN. ONLY LOOK ON USER'S
; AREA FOR .REL FILES IF SOURCE FILE IS FOUND ON THE SPECIFIED
; AREA. AREA AFFECTED: OKREL
;316 (SPR 10-22369) CORRECT RECOMPILATION LOGIC WHERE
; STRUCTURE NAME IS SPECIFIED. CORRECTS EDIT 240.
; AREAS AFFECTED: OKLOOK, ELOOK, ALTDAT
;317 (SPR 10-22181) PREVENT UNNECESSARY RECOMPILE WHICH OCCURS
; IF A SOURCE FILE IS MOVED.
; AREAS AFFECTED: ONSET,REREL2,EREL,DNLOK1,SETDT
;320 CLEAN UP CODE AND COMMENTS
;321 PROVIDE PROPER OUTPUT IF LISTING SWITCHES FOR A PROCESSOR
; ARE SPECIFIED WITHOUT A COMPIL LISTING SWITCH.
; AREAS AFFECTED: DOCOM2
;322 (SPR 10-24292) DON'T PASS PPN OF SOURCE TO LINK IF
; RECOMPILE IS NECESSARY AND /SEARCH OR /LIBRARY IS GIVEN
; AREA AFFECTED: LODR2
;323 (SPR 10-24597) WHEN SCANNING TAPE OPTIONS (...), CHECK
; FOR VALID BREAK CHARACTER. IF FOUND BEFORE ")" THEN ERROR.
; AREAS AFFECTED: COPYSW
;324 REMOVE MANTIS CODE (NEED TO REUSE THE FLAG BITS)
; ADD SUPPORT FOR COBOL-74
; MAKE /OPT PASS /O TO COBOL
;START OF VERSION 22(E)
;424 SAVE 100 EDITS FOR DEVELOPMENT
;425 SPR # 10-26362 WCL 10-0CT-78
; FIX CHARACTER COUNTING WHEN FILLING BLOCK; HAS BEEN PUTTING NULL
; AS FINAL CHARACTER
; AREAS AFFECTED: TMPOUT
;426 (SPR 10-25452) COMPIL HANGS ON COMMAND SPECIFYING
; A DEVICE WHEN ASSEMBLED WITH SFDLEN=1
; AREA AFFECT: NODEV
;427 SPR # 10-26000 WKV 11-JAN-79
; KEEP COMPIL FROM LEAVING CREF TEMP FILE ON DSK AFTER TMPCOR
; OPENS UP. AREA AFFECTED: POPFIL
;430 NO SPR # WCL 05-MAR-79
; REMOVE CORE REQUIREMENT IN RUN UUO FOR COPY/RENAME TO ALLOW
; DEBUGGING
; AREA AFFECTED: DOCOPY
;431 SPR # 27558 WCL 05-MAR-79
; IGNORE EXTRA VERBIAGE IN COPY SWITCHES; STOP SCAN AFTER ONE CHARACTER
; (WAS INTERPRETING FOLLOWING CHARACTERS AS FILE NAME)
; AREA AFFECTED: NXTNM0
;432 SPR # 26360 + 27526
; SETNAM UUO CAUSES CLEARING OF JB.LSY; BATCON CHECKS THIS TO
; SEE IF IT SHOULD SEARCH FOR %ERR OR %CERR; SINCE IT'S CLEAR,
; BATCON INCORRECTLY SEARCHES FOR %ERR; FIX: REMOVE SETNAM
; AREA AFFECTED: DOEND
;433 SPR #29039 TARL 22-MAR-80
; FIX EDIT 322 - REMEMBER WHEN WE HAVE DECIDED THAT THIS IS A REL FILE
; AREA AFFECTED : LBCOMP+13.4
;434 SPR #29593 RKB 23-MAY-80
; FIX COMMAND SCANNER SO IT WILL ACCEPT EXTRANEOUS SPACES
; AREA AFFECTED : SCNS2+2
;435 SPR #29887 RKB 5-AUG-80
; GET RID OF BIZARRE EXTRA CHARACTER SEEN AFTER SOME ERROR MESSAGES
; AREA AFFECTED : ERRCOM
;436 NO SPR RKB 5-AUG-80
; CLEAN UP SOME ERROR MESSAGES AT ERRCOM
;437 SPR #29807 BCM 22-JUL-80
; FIX PROTECT COMMAND LINE PARSER FOR DOUBLE EXTENSION
; AREA AFFECTED: PROT1+16
;440 SPR #29975 BCM 16-SEP-80
; PASS LINK "COBOL" AS THE COBOL-74 DEBUGGING AID
;441 NO SPR BCM 19-SEP-80
; EXTENSIVE EDITS TO FEATURE TEST MOST OF OLD CODE
; ALSO MAKE USEFUL MODS
;442 NO SPR TARL 11-DEC-80
; MAKE THE EDIT COMMAND RETAIN THE DEVICE NAME - THIS WAY IT CAN
; RUN DTECO INSTEAD OF LINED.
;443 NO SPR BCM 19-FEB-81
; FIX PROCESSOR vs. SWITCH PROBLEM INTRODUCED BY EDIT 441
;444 10-30513 BCM 24-Mar-81
; MAKE /SAVE AND /SSAVE WORK RIGHT
;445 10-05955 BCM 28-Apr-81
; FIX /NOCOMP SWITCH FOR "DEBUG A.MAC/NOCOMP"
;446 10-30567 BCM 16-Jun-81
; INCREASE BUFFER SIZE FOR NUMBER OF LINK SWITCHES
;447 QAR 10-05958 BCM 8-Aug-81
; implement global processor switches
;450 NO SPR BCM 11-Aug-81
; Fix an assumption that processors can still parse parenthesis.
;451 QAR 10-05959 BCM 12-Aug-81
; make COBOL-74 the default COBOL compiler
;452 QAR 10-05957 BCM 25-Aug-81
; add code to support SIMULA compiler
;453 SPR 10-31944 BCM 5-Jan-82
; Fix edit 444 to not overlay the extension as the output extension.
;
;454 SPR #32066 BCM 2-JAN-82
; Reinsert the code at IDENT which was removed incorrectly
; by a zealous edit 441.
;455 SPR #30256 BCM 15-Mar-82
; We output an "S" as the first chacracter in the TMPCOR file
; that is passed to LINED or TECO. Since we removed the LINED
; support we will gradually remove this from crock from COMPIL.
; Change the "S" to "<space>" since TECO skips it anyway.
;456 SPR #31279 BCM 15-Mar-82
; Replace code removed by edit 430. Makes PIP run faster
; on copies.
;457 SPR #31693 BCM 16-Mar-82
; Allow compiler selection switches (/C74,/C68,/F10,/F40) to
; imply compiler type. A long overdue correction.
;460 SPR #32659 BCM 28-Sep-82
; Edit 454 incomplete. Add LABEL to command table.
;461 SPR #32416 BCM 22-Apr-82
; Increase the core argument to optimal size.
;462 SPR #31449 BCM 29-Sep-82
; Always LOOKUP the REL file if the processor is unknown. This
; avoids debugging with DDT, when the link block type is Fortran.
; Made new routine SETPTH which should always be called to set
; up path for DOLOOK. Changed all LOOKUP's to call DOLOOK.
;463 NO SPR BCM 19-Apr-83
; Add the PASCAL compiler to compiler list and add new compiler
; attribute flag word.
;
;START OF VERSION 22(F)
;
;564 SPR 10-32178/32177 GAT 4-JAN-84
; Fix ADDRESS CHECKS/ILL MEM REFS which were not thoroughly
; eliminated by edits 176/241.
;
;565 10-32625 GAT 19-JAN-84
; GIVE APPROPRIATE ERROR MESSAGE IF SOURCE FILES ARE NOT FOUND OR
; .REL FILES ARE SPECIFIED IN THE "+" CONSTRUCTION.
;566 10-31613 GAT 14-FEB-84
; DELETE TMPCOR FILE IF WRITING .TMP FILE ONTO DISK.
;567 SPR 10-32007 GAT 10-FEB-84
; CORRECT PARSING OF COMMAND FILES THAT START WITH A COMMENT LINE(S).
;570 10-34129 GAT 22-MAR-84
; ALLOW "MINUS SIGN" IN PROCESSOR SWITCHES NEEDED FOR COBOL-74.
;571 33631 GAT 21-MAR-84
; USE ALGDDT AS DEFAULT DEBUGGER INSTEAD OF DDT FOR ALGOL
;572 10-32034 GAT 8-MAY-84
; GIVE ERROR IF TRYING TO DEFAULT SFD(S).
;573 SPR 10-31549 GAT 14-MAY-84
; DON'T PASS EXPLICIT SOURCE DEVICE TO LINK IF A /LIB FILE NEEDS
; TO BE RECOMPILED (INTO OUR DIRECTORY).
;574 10-34735 GAT 9-AUG-84
; MAKE GFLOAT AND F66 SWITCHES KNOWN TO COMPIL.
;575 10-34994 GAT 10-DEC-84
; INCREASE SIZE OF SWITCH BLOCK (SWBK) TO ALLOW LONGER
; PROCESSOR SWITCH STRINGS. THIS NOW ALLOWS UP TO 150
; CHARS TO BE PASSED INSTEAD OF JUST 25 CHARS.
;576 None LEO 9-AUG-85
; CHANGE COPYRIGHT STATEMENTS
;
;;;END OF REVISION HISTORY
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
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==30 ;[575] NUMBER OF WORDS FOR SWITCHES TO PROCESSOR
LODSCT==^D200 ;[446] # OF CHRS IN LINK 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
;[463] FLAG WORD
SCANCH==000001 ;[463] USE SCAN CHAINING ARG CONVENTIONS
;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 LINK [441]
PERF==200 ;PERMANENT TYPE FLAGS
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
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
NOCMPL==2000 ;[445] NOCOMPLE REGARDLESS OF DATES
NOBINSW==40 ;DON'T DO A REL FILE
C68SW==100 ;[324] COMPIL COBOL WITH COBOL-68
C74SW==200 ;[324] COMPIL COBOL WITH COBOL-74
F40SW==400 ;COMPILE FORTRAN WITH F40
F10SW==1000 ;COMPILE FORTRAN WITH FORTRAN-10
F66SW==2000 ;[574] F66 CODE
GFLSW==4000 ;[574] GFLOATING CODE
OPTSW==10000 ;OPTIMIZED CODE
NOPTSW==20000 ;NON-OPTIMIZED CODE
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 "_"
H COMPILER ATTRIBUTE FLAGS, USED FOR SCAN VS. BANG CHAINING
>
DEFINE PROCESS<
IFN DFORTRAN,<X FORTRAN,FOR,FORTRAN,,,FORDDT,=,SCANCH>
IFE DFORTRAN,<X FORTRAN,FOR,F40,,,,=>
IFN PASCAL,<X PASCAL,PAS,PASCAL,,,PASDDT,=,SCANCH>;[462] PASCAL USES SCAN ARGS
X MACRO,MAC,MACRO,,,,=
IFN SIMULA,<X SIMULA,SIM,SIMULA,,,SIMDDT,=> ;[452] SW,EXT,PROC,,,DEBUG
IFE DCOBOL,<X COBOL,CBL,COBOL,,,COBDDT,=>
IFN DCOBOL,<X COBOL,CBL,CBL74,,,COBDDT,=>
X ALGOL,ALG,ALGOL,,,ALGDDT,=
IFN SNOBOL,<X SNOBOL,SNO,SNOBOL,,,,_>
IFN MACY11,<X MACY11,P11,MACY11,,OBJ,,_>
IFN BLISS,<X BLISS,BLI,BLIS10,,,,=>
IFN FAIL,<X FAIL,FAI,FAIL,,,SDDT,_>
IFN SAIL,<X SAIL,SAI,SAIL,,,SDDT,_>
IFN PAL10,<X PAL10,PAL,PAL10,,,,=>
>
DEFINE XPROCESS<
X LINK,LNK,LINK ;[441] FT 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,H)<
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,H)<
CHN'B==MXPROC+XTPROC
XTPROC==XTPROC+1>
XPROCESS
IFE SIMULA,<SIMSW==0> ;[452] FOR LATER TESTS
IFE BLISS,<BLISW==0> ;MAKES TESTS EASIER AND NEATER
UNKSW==0 ;[462] AN UNKNOWN PROC TYPE
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>
;[324] LINK BLOCK TYPE 6 COMPILER CODES
L%F40==1 ;F40
L%C68==2 ;COBOL-68
L%F10==10 ;FORTRAN
L%C74==16 ;COBOL-74
SUBTTL MACROS
EXTERN .JBFF,.JBREL,.JBERR,.JBSA
%LOREL:! ;RELOCATABLE BEGINNING OF LOW SEGMENT
IFN PURESW,< TWOSEGMENTS
.ZZ:
RELOC 400000>
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
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 LABEL,<JRST IDENT> ;[460] REINSERT COMMAND
>
DEFINE STABLE<
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
SWITCH N,LISTSW
SWITCH COMPILE,<XWD COMPLS,0>
SWITCH NOCOMPILE,<NOCMPL,,0> ;;[445] MAKE A SEPERATE BIT FOR NOCOMP
SWITCH NOBINARY,<NOBINSW,,0>
SWITCH BINARY,NOBINSW
SWITCH NODEBUG,DEBUGSW
SWITCH C68,<C68SW,,C74SW>
SWITCH C74,<C74SW,,C68SW>
SWITCH F40,<F40SW,,F10SW>
SWITCH F10,<F10SW,,F40SW>
SWITCH F66,<F66SW,,0> ;[574]
SWITCH GFLOATING,<GFLSW,,0> ;[574]
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 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
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,%RUNT2 ;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,LRUN3 ;NO, ONLY ONE [441] use LRUN3
ADDI T1,"0" ;MAKE ASCII
OUTCHR T1 ;OUTPUT IT
LRUN3: ADDI T2,"0" ;[441] loop out
OUTCHR T2
OUTSTR RUNER2 ;REST OF MESSAGE
MOVE T2,%RNBLK ;PICK UP DEVICE
LRUN4: SETZ T1, ;CLEAR OUT JUNK [441] label LRUN4
LSHC T1,6 ;MOVE LEADING CHARACTER INTO T1
MOVEI T1,40(T1) ;FORM ASCII
OUTCHR T1 ;PRINT IT
JUMPN T2,LRUN4 ;MORE TO GO [441] use LRUN4
MOVEI T1,":" ;USUAL SEPARATOR
OUTCHR T1
MOVE T2,%RNBLK+1 ;FILE NAME
LRUN5: SETZ T1, ;[441] label LRUN5
LSHC T1,6
MOVEI T1,40(T1)
OUTCHR T1
JUMPN T2,LRUN5 ;[441] use LRUN5
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 "]"
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
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
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
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
IFG SFDLEN-1,< ;[426]
MOVE T1,[SVSFP,,SVSFP+1]
BLT T1,SVSFP+SFDLEN-1>> ;[425]
NODEV: POP P,SVNAM(SVPT)
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: ;[313]
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
TRNN FL,IDF ;[572] MUST SEE IDENTIFIER HERE
JRST SFDER2 ;[572] NO, GIVE SFD ERROR AND ABORT
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
CAMN T1,[-1] ;[434] FOUND A SPECIAL CHARACTER?
JRST SCNS2 ;NO, LOOP BACK
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,CONSN ;IGNORE BLANKS [441] and loop
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
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
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
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?
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 LNST1] ;[226] TRY TMPCOR ONLY [441] use LNST1
JUMPN C,NSTDV1 ;[243] DEVICE SPECIFIED
LNST1: MOVE C,.JBFF ;GET START OF BUFFER [441] label LNST1
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
SETZM INLFLG ;[305] CLEAR IN-LINE FLAG
PUSHJ P,CHKTRM ;[567] EAT ANY TERMINATORS
CAMN CS,COMMA ;[567] IF COMMA, DON'T BACKUP POINTER
JRST NEXT2A ;[567] PRESERVE OLD WORK AROUND
MOVSI T1,70000 ;[567]
ADDM T1,@GETB3(IOPNT);[567] AND BACK UP BYTE POINTER
AOS @GETB1(IOPNT) ;[567] ALSO BACKUP COUNT
NEXT2A: SETZB CS,SAVCHR ;[567] DON'T SAVE ANY CHARS
MOVEI C," " ;[567] SUPPLY A FREE BLANK SO COM@FOO WORKS
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)
SETOM FAKEOL ;[305] SET FAKE EOL FLAG
POPJ P,] ;AND RETURN IT
;END OF "FIX"
TRNN FL,INCRF ;[427] DOING CREF?
JRST POPFL0 ;[427] NO, SKIP THIS
MOVE T2,[RENAME 0,0] ;[427] GET RENAME INSTRUCTION
LDB T1,[POINT 4,RELTAB(IOPNT),12] ;[427] GET CHANNEL NUMBER
JUMPE T1,POPFL0 ;[427] CAREFUL OF CHANNEL ZERO
DPB T1,[POINT 4,T2,12] ;[427] PUT CHANNEL IN
SETZM LNAM ;[427] CLEAR NAME
SETZM LEXT ;[427] '' EXT
SETZM LDAT ;[427] '' DATE
SETZM LPPN ;[427] '' PPN
HRRI T2,NAME ;[427] FINISH SET UP
XCT T2 ;[427] DO THE RENAME(DELETE)
OUTSTR [ASCIZ/%CMLNDC -- Could not Delete CREF temp file
/]
POPFL0: XCT RELTAB(IOPNT) ;RELEASE HIM
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
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: OUTSTR [ASCIZ / detected before: /] ;[435] TELL USER WHAT THE STORY IS
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
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
TRNE C,400000 ;[435] IS THIS A BREAK CHARACTER?
JRST NOFIL0 ;[435] STOP TYPING CHARACTERS
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
RLFERR: STRING [ASCIZ .?CMLRLF Problem with REL file and /REL was specified.]
JRST ABORT ;[462] DIE GRACEFULLY
RLFER1: STRING [ASCIZ .?CMLRLS Problem with REL file and no source specified.]
JRST ABORT ;[462] DIE GRACEFULLY
SAVERR: STRING [ASCIZ .?CMLNFS No file on SAVE or SSAVE.] ;[256]
JRST ABORT ;[256]
SAVER2: STRING [ASCIZ .?CMLASF Ambiguous /SAVE or /SSAVE usage on files.]
JRST ABORT ;[444] THIS IS ON USING THE SWITCH TWICE
NOSRCS: STRING [ASCIZ .?CMLMSF Must have source files for "+" contruction.]
JRST ABORT ;[565]
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
RESET
DOEND: SETZB 0,.JBSA ;SO START FAILS
EXIT 1,
JRST .-1 ;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
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
SETZM FAKEOL ;[305] CLEAR FAKE EOL FLAG
POPJ P, ;RETURN AND HOPE IT MAKES SENSE
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
SFDER2: STRING [ASCIZ .?CMLISS Illegal SFD specification.] ;[572]
CAIE C,","
CAIN C,"]"
MOVEM CS,SAVCHR
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,CHNLNK ;START WITH LINK
TRNN FL,DOLOD ;ARE WE LOADING?
JRST ALDN1 ;NO
SKIPN T2,EXECFL ;WANT EXECUTION?
JRST ALDN0 ;NO [441] use ALDN0
PUSHJ P,OUTSIX ;YES, /E
PUSHJ P,OUTSPC ;NEEDS SEPARATOR
ALDN0: SKIPN T2,MAPSW ;SKIP IF MAP REQUIRED [441] label ALDN0
MOVSI T2,'/G ' ;SET UP FOR TERMINATE LOADING
PUSHJ P,OUTSIX ;YES, PUT IT OUT
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
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
SKIPN T1,PRCFLG(T3) ;[463] ARE THERE ANY FLAGS FOR THIS PROC
JRST NOTSCN ;[463] NONE, DO THE BANG PROCESSING BY DEFAULT
TLNN T1,SCANCH ;[463] DOES THIS PROCESS USE SCAN CHAINING?
JRST NOTSCN ;[463] NOPE, USE OLD STYLE BANG STUFF
MOVE T2,['/RUN: '] ;AS IT USES SCAN
PUSHJ P,OUTSIX
SKIPE T2,PCDEV ;USE DEVICE IF GIVEN
PUSHJ P,OUTDEV
MOVE T2,PCNAM ;NAME WE WANT TO RUN
PUSHJ P,OUTSIX
PUSHJ P,OUCRLF
JRST NONAM
NOTSCN: SKIPE T2,PCDEV ;GET DEVICE IF GIVEN
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
CAIN T3,CHNLNK ;[443] IS THIS LINK-10?
SKIPA T1,PROCTB(T3) ;[443] YES, ITS SPECIAL
MOVE T1,PRCNAM(T3) ;[443] NO, SO GET THE PROCESSOR NAME
IFN FORTRAN,< ;WE HAVE A CHOICE OF FORTRAN COMPILERS
CAIE T3,CHNFOR ;BUT ONLY IF THIS IS FORTRAN
JRST LNFTN ;[441] NOT
SKIPE FORPRC ;USE DEFAULT
MOVE T1,FORPRC ;USE WHATEVER IS SET
LNFTN:
>
;[324] WE HAVE A CHOICE OF COBOL COMPILERS
CAIE T3,CHNCBL ;[324] BUT ONLY IF THIS IS COBOL
JRST LNTCB ;[441] NOT
SKIPE COBPRC ;[324] USE DEFAULT
MOVE T1,COBPRC ;[324] USE WHATEVER IS SET
LNTCB: ;[441] not cobol
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
HRLZM T1,TMPFIL ;SAVE NAME IN TMPFIL
MOVE T1,TTYPT ;GET BYTE POINTER
MOVNI T2,4 ;SET UP FOR CHARACTER COUNT
LDN1: ILDB T3,T1 ;GET NEXT CHARACTER
CAIE T3,177 ;IS IT A EOF CHARACTER
SOJA T2,LDN1 ;[441] NO, JUMP BACK TO 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
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
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
CKRM1: SKIPN T2,FREBUF(T1)
AOBJN T1,CKRM1 ;[441] JUMP BACK AND 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: 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
; 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
>
RESET ;[241]STOP THE WORLD
JUMPL T4,RPGSET
RESCAN 1 ;[205] RESET POINTER TO START OF COMMAND
JRST LINBF ;[441] something in input buffer
SKIPN .JBDDT## ;[211] WAIT FOR USER IF DEBUGGING
GOTO SYNRR2 ;[205] INPUT BUFFER EMPTY
LINBF: ;[441] come here when something in buffer
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 LFITY ;YES [441] jrst to LFITY
CORE T4, ;NO, GET MORE
JRST NOCOR ;YOU LOSE
LFITY: ;[441] when it will fit
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,RP1 ;[441] SET UP PDL
RP1: IOWD PDL,PDLB ;[441] label as RP1
MOVNI T1,1 ;STANDARD KA/KI TEST
AOBJN T1,.+1
SKIPN T1
AOS CPU ;KA=0, KI=1
MOVEI T1,3
PJOB T2,
LSOJ1: IDIVI T2,12 ;[441] label is LSOJ1
ADDI T3,20 ;TO SIXBIT
LSHC T3,-6
SOJG T1,LSOJ1 ;[441] THREE DIGITS
HLLZM T4,JOBNAM ;SAVE TO MAKE UNIQUE NAMES
TLO T4,404040 ;NOW TO ASCII FOR ASCIZ'S
MOVEI T1,3 ;THREE CHARS
LSOJ2: LSH T3,1 ;[441] label is LSOJ2
LSHC T3,6 ;BRING IN A CHAR
SOJG T1,LSOJ2 ;[441] use LSOJ2
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
TRO FL,DOLOD ;LOAD USING LINK-10
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
HRRZ T1,.JBFF ;[564] DISK BUFFERS WILL GET PUT HERE
MOVEM T1,DSKBUF ;[564] SAVE BUFFER ADDRESS
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
SETZM SWGKB ;[447]
SETZM SWGKL ;[447]
SETZM SWGKS ;[447]
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
TRNA ;[441] a much faster single skip
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
CAIN C,"(" ;[447]
JRST PROCSX ;[447]
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,","
TRNA ;[441] "," AND TERMF ARE OK SO SKIP
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)
;**;[457] after SMATCH + 6L, insert
TLNN FL3,C74SW!C68SW!F10SW!F40SW ;[457] IMPLY COMPILER?
JRST SMATC1 ;[457] NO, CONTINUE NORMALLY
TLNE FL3,C74SW!C68SW ;[457] IMPLY COBOL?
TRZA FL2,ALPROC-CBLSW ;[457] YES, TURN OFF ALL BUT COBOL
TRZA FL2,ALPROC-FORSW ;[457] NO, TURN OFF ALL BUT FORTRA
TROA FL2,CBLSW ;[457] YES, SET PROC TYPE
TRO FL2,FORSW ;[457] NO, MUST FOR FORTRA
TRNE FL,PERF ;[457] WAS IT PERMANENT?
HRRZM FL2,DFPROC ;[457] YES, STORE DEF PROC
SMATC1: ANDI T1,DEVSWS ;SEE IF FIRST DEVICE SWITCH
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,H)<
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: SKIPE MAPSW ;[310] ALREADY SEEN ONE MAP
JRST MPTWIC ;[310] YES DON'T PROCESS THIS ONE
TRNN FL,DOLOD ;[441] are we loading?
SKIPA T3,[-1] ;[441] NO, DON'T STORE ANYTHING
SKIPA T3,[CHNLNK] ;[441] yes, load link chan. no.
JRST SETMP ;[441] not loading so jump
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: SKIPE MAPSW ;[310] ALREADY SEEN ONE MAP
JRST MPTWIC ;[310] YES DON'T PROCESS THIS ONE
TRNN FL,DOLOD ;[441] are we loading?
SKIPA T3,[-1] ;[441] NO, DON'T STORE ANYTHING
SKIPA T3,[CHNLNK] ;[441] yes, load link chan. no.
JRST SETMP ;[441] not loading so jump
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
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
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?
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
SETMP1:
MOVSI T2,'/M ' ;YES
PUSHJ P,OUTSIX
SETMP2: MOVEI T1,"=" ;NEW STANDARD
PUSHJ P,TMPOUT
TRZ FL,LODOUT ;DO NOT NEED A COMMA FOR NEXT FILE
POPJ P,
MPTWIC: PUSHJ P,SCAN ;[310] GET NEXT CHARACTER
CAIE C,":" ;[310] OUTPUT FIL SPEC GIVEN
POPJ P, ;[310] NO CONTINUE
AOBJP SVPT,NESTTD ;[310] MAKE SPACE FOR FIELDS
TRO FL,F.STKY ;[310] NO STICKINESS
PUSHJ P,SCANAM ;[310] GOBBLE FIL SPEC
TRZ FL,F.STKY ;[310] CLEAR FLAG
SUB SVPT,[1,,1] ;[310] BACK TO WHERE IT WAS
PUSHJ P,SCAN ;[310]
POPJ P, ;[310] CONTIUE
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
LINKIT: SKIPN TMPCHN+CHNLNK ;MAKE SURE NO 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]
SKIPN SVNAM(SVPT) ;[256] IS THERE A SAVE NAME?
JRST SAVERR ;[256] NO, THAT IS AN ERROR
;**; [444] at SSAVE plus 3
SKIPE SAVSW ;[444] IS THIS THING ALREADY SET?
JRST SAVER2 ;[444] YES, YOU CAN'T SAVE TWO DIF FILES
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,CHNLNK ;[441] load chan no. for link
PJRST SCAN ;[234]
;here on "(" as first char of ident, i.e. perm proc sw
PROCSX: PUSH P,SWPT ;[447] save switch pointer
MOVE SWPT,[POINT 7,SWGLK]
PUSHJ P,PROCS0 ;[447] get switches
POP P,SWPT ;[447] restore switch pointer
MOVE T1,SWBKB ;[447] transfer binary switch ptr.
MOVEM T1,SWGKB ;[447]
SETZM SWBKB ;[447]
MOVE T1,SWBKL ;[447] listing switch ptr.
MOVEM T1,SWGKL ;[447]
SETZM SWBKL ;[447]
MOVE T1,SWBKS(SVPT) ;[447] source switches
MOVEM T1,SWGKS ;[447]
SETZM SWBKS(SVPT) ;[447]
JRST ILP0
;here on "(" after a file name
PROCSW: TROE FL,PROCS ;HAVE WE ALREADY SEEN SOME?
GOTO SYNERR ;YES, I DEFINE THIS AS ILLEGAL
PUSHJ P,PROCS0 ;[447] get switches
JRST ILP2A
PROCS0:
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
CAIN C,"-" ;[570] ALLOW "-"
JRST PROCS2 ;[570] FOR COBOL-74
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
POPJ P,] ;[447]
MOVEI C,0
IDPB C,SWPT ;MARK
SOJLE SWCNT,ETMS
POPJ P, ;[447] 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
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
;HERE FOR LINK-10 SWITCHES
;THEY ARE IN FORM %'SWITCH:ARG'
;
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 LSET1 ;[240] NO, ASSUME DISK
DEVCHR T1, ;[240] FIND OUT WHAT IT IS
TLNN T1,DV.DSK ;[240] A DISK?
JRST ONSET1 ;[240] NO.
LSET1: MOVSI T1,-NFILE ;[240] SETUP TO CHECK ALL INPUTS
DSKLUP: SKIPN T2,SVDEV(T1) ;[240] DEVICE GIVEN?
JRST LDSK1 ;[240] NO, ASSUME A DISK
DEVCHR T2, ;[240] WHAT IS IT?
TLNN T2,DV.DSK ;[240] A DISK?
JRST ONSET1 ;[240] NOPE.
LDSK1: 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
SETZM ETIM ;[317] INTERNAL CREATION DATE AND TIME
TLZ FL2,-1 ;NO PROCESSOR YET
PUSHJ P,GETPRO ;GO FIND DATE AND PROCESSOR
SKIPE SAVSW ;[444] IS THIS A SAVE FILE REQUEST
PUSHJ P,OUTSAV ;[444] YES, PUT OUT OUTPUT FILENAME NOW
TLNE FL2,RELSW ;IF A REL FILE
JRST LKREL ;[462] SETUP THE PROCESSOR TYPE FROM REL FILE
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
MOVE T1,SVPT ;[462] USE THE CURRENT FILE POINTER
PUSHJ P,SETPTH ;[462] SETUP THE LOOKUP PATH
TRNA ;[462] SKIP THE FIRST TIME
REREL: SETZ T2, ;[462] CLEAR THE FLAG
MOVEM T2,LPPN ;[462] SAVE THE PATH POINTER OR 0
MOVEM T2,SVRPP ;[462] STORE RESULT SO WE KNOW IF SECOND TIME
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
PUSHJ P,DOLOOK ;[462] LOOKUP THE REL FILE
JRST LBCOMP ;[462] COULD NOT FIND IT, RECOMP
REREL2: PUSHJ P,CHKAGE ;[317] COMPARE THE AGE OF THE FILE
JRST DOCOMP ;[317] OLDER - RECOMPILE
NOCOM1: TLNN FL2,FORSW!CBLSW ;[324] FORTRAN OR COBOL 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
;GENERAL ROUTINE TO SEE IF CURRENT FILE IS NEWER OR OLDER THAN THAT
;SPECIFIED BY SDAT, STIM, ETIM. EXTENDED LOOKKUP INFO IS USED IF AVAILABLE
CHKAGE: PUSH P,T1 ;[317] SAVE A COUPLE OF AC'S
PUSH P,T2 ;[317]
LDB T2,[POINT 12,LDAT,35] ;[317] GET LOW 12 BITS OF DATE
LDB T1,[POINT 3,LEXT,20] ;[317] GET HIGH 3 BITS OF DATE
DPB T1,[POINT 3,T2,23] ;[317] MERGE THE TWO PARTS
CAMGE T2,SDAT ;[317] CURRENT FILE EARLIER?
JRST CHKAG2 ;[317] YES, NO NEED TO CHECK FURTHER
CAME T2,SDAT ;[317] SAME DAY?
JRST CHKAG1 ;[317] NO, MUST BE NEWER
LDB T2,[POINT 11,LDAT,23] ;[317] GET TIME
CAMGE T2,STIM ;[317] CURRENT FILE EARLIER?
JRST CHKAG2 ;[317] YES
CAME T2,STIM ;[317] SAME MINUTE?
JRST CHKAG1 ;[317] NO, MUST BE NEWER
SKIPN EXTEND ;[317] EXTENDED INFO AVIALABLE?
JRST CHKAG2 ;[317] NO, TREAT AS OLDER TO BE SAFE
MOVE T2,EBLK+.RBTIM ;[317] GET INTERNAL DATE/TIME
CAMLE T2,ETIM ;[317] NEWER FILE?
CHKAG1: AOS -2(P) ;[317] YES, SET FOR SKIP RETURN
CHKAG2: POP P,T2 ;[317] NO, SET FOR NON-SKIP RETURN
POP P,T1 ;[317] RESTORE AC'S
POPJ P, ;[317] RETURN
;
; This routine does not decide wether to COMPILE or not but
; simply sets the processor type from the REL file if it is
; as yet, unknown.
;
LKREL: SKIPGE DEBFL ;[462] IF NOT DEBUG, DON'T WASTE TIME ON REL
TLNE FL2,ALPROC-RELSW ;[462] SEE IF ANY PROCESSORS ALREADY SET
JRST LDREL ;[462] YES, GO LOAD REL FILE NOW!
SKIPN T1,LOKNAM ;[462] PICK UP A DEVICE IF THERE
SKIPA T1,['DSK '] ;[462] ELSE USE DSK:
TRNA ;[462] SKIP STORAGE IF ALREADY THERE
MOVEM T1,LOKNAM ;[462] STORE IT AWAY
OPEN LOOK,LOKINT ;[462] OPEN FOR INPUT
JRST DEVNA ;[462] NOT THERE
MOVE T1,SVPT ;[462] USE CURRENT FILE POINTER
PUSHJ P,SETPTH ;[462] SET UP THE LOOKUP BLOCK
MOVE T1,ONAM ;[462] SEE IF REL IS THERE
MOVEM T1,LNAM ;[462]
SKIPN T1,OEXT ;[462] OUTPUT EXTENSION ALREADY SPECIFIED?
SKIPE T1,SVEXT(SVPT) ;[462] NO, GET INPUT SPECIFIED
SKIPN T1 ;[462] DO WE HAVE SOMETHING?
MOVSI T1,'REL' ;[462] NO USE REL
MOVEM T1,LEXT ;[462] STORE LOOKUP EXTENSION
PUSHJ P,DOLOOK ;[462] IS IT THERE?
JRST FIU ;[462] NO, GIVE ERROR SINCE /REL IS SET
PUSHJ P,INSREL ;[462] GET THE LINK BLOCK TYPE FROM REL FILE
JRST LKRER ;[462] PROBLEM, TRY TO ISOLATE THE ERROR
PUSHJ P,SETPRC ;[462] SET THE PROC TYPE FROM TABLE
JRST LDREL ;[462] CONTINUE LOADING
;
; There are two cases for falling through here:
; 1) user type /REL
; 2) we only found a .REL file
;
LKRER: HLRZ T1,SVEXT(SVPT) ;[462] GET THE USERS SPECIFIED EXTENSION
JUMPN T1,RLFER1 ;[462] PROB WITH REL FILE SPECIFIED
JRST RLFERR ;[462] ASSUME /REL WAS SPECIFIED
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
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
DOCOM1: TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKB ;[447] yes, get them
MOVE T2,SWGKB ;[447] get global switches
SKIPE T2 ;[447] anything ?
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
DOCOMA: TLNN FL3,OPTSW!NOPTSW ;OPTIMIZER INFO?
JRST DOCOMB ;[574] NO, TAKE DEFAULT
MOVE T2,['/OPT ']
TLNN FL3,OPTSW ;OPTIMIZE?
MOVE T2,['/NOPT '] ;NO
PUSHJ P,OUTSIX
DOCOMB: TLNN FL3,F66SW ;[574] /F66 SEEN?
JRST DOCOMC ;[574] NO, TAKE DEFAULT
MOVE T2,['/F66 '] ;[574] OUTPUT SWITCH
PUSHJ P,OUTSIX ;[574]
DOCOMC: TLNN FL3,GFLSW ;[574] /GFLOAT SEEN?
JRST DOCOMD ;[574] NO, TAKE DEFAULT
MOVE T2,['/GFLO '] ;[574] OUTPUT SWITCH
PUSHJ P,OUTSIX ;[574]
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: MOVSI T2,'/O' ;[324] GET READY FOR /OPT
CAIN T3,CHNCBL ;[324] IS IT COBOL?
TLNN FL3,OPTSW ;[324] AND /OPT?
CAIA ;[324] NO
PUSHJ P,OUTSIX ;[324] YES
IFN PASCAL,<
CAIE T3,CHNPAS ;[463] IS IT PASCAL?
JRST DOCM2B ;[463] NO, SKIP THIS JUNK
MOVE T2,['/DEBUG'] ;[463] GET READY FOR /DEBUG
TLNN FL3,DEBUGSW ;[463] AND /DEBUG?
SKIPGE DEBFL ;[463] OR DEBUG COMMAND?
PUSHJ P,OUTSIX ;[463] YES, SO TELL THE COMPILER
DOCM2B:
>
TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKL ;[447] yes, get them
MOVE T2,SWGKL ;[447] get global switches
SKIPN T2 ;[447] any switches ?
TLNE FL3,LISTSW ;[321] OR LISTING REQUESTED?
JRST DOCM2A ;[321] YES, OUTPUT THE NAME AND SWITCHES
MOVSI T2,',- ' ;NO
CAIN T3,CHNCBL ;TEST FOR COBOL
PUSHJ P,OUTSIX ;YES
JRST NOLST
DOCM2A: MOVEI T1,"," ;[321] YES, NEED A COMMA
PUSHJ P,TMPOUT
TLNN FL2,CBLSW!BLISW ;SKIP /CREF IF COBOL OR BLISS (SPECIAL)
TLNN FL3,CRSW ;[314]USE DSK: IF /CREF
TRNA ;[314] CHECK FOR /LIST SWITCH IF COBOL
JRST DOCOM3 ;[251]
SKIPGE T2,SPDLPT ;[321] 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
;**; at DOCOM3 plus 16 lines change 1 line
TLNN FL2,CBLSW!BLISW!SIMSW ;[452] DON'T WRITE /CREF IF
;[452] COBOL, BLISS OR SIMULA
PUSHJ P,ENTCRF ;PUT IT IN THE ###CREF FILE
POP P,T3
NOLST1: TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKL ;[447] yes, get them
MOVE T2,SWGKL ;[447] get global switches
SKIPE T2 ;[447] anything ?
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
TRNE FL,PROCS ;[447] local switches ?
SKIPA T2,SWBKS(SVPT) ;[447] yes, get them
MOVE T2,SWGKS ;[447] get global switches
SKIPE T2 ;[447] anything ?
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
TLNN FL3,F40SW ;WHICH ONE?
SKIPA T1,['FORTRA'] ;FORTRAN-10 WANTED
MOVSI T1,'F40' ;F40 WANTED
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:
>
;[324] CHOICE OF COBOL COMPILERS
TLNE FL2,CBLSW ;[324] IGNORE IF NOT COBOL
TLNN FL3,C68SW!C74SW ;[324] AND IF NOTHING OF INTEREST
JRST ENDCOB ;[324] IGNORE IF NOT COBOL
TLNN FL3,C74SW ;[324] WHICH ONE?
SKIPA T1,['COBOL '] ;[324] COBOL-68 WANTED
MOVE T1,['CBL74 '] ;[324] COBOL-74 WANTED
SKIPN COBPRC ;[324] SETUP ALREADY?
MOVEM T1,COBPRC ;[324] NO, DO SO NOW
CAMN T1,COBPRC ;[324] SAME VALUE, OR FIRST TIME?
JRST ENDCOB ;[324] YES
STRING [ASCIZ /%CMLOCC Only one COBOL compiler allowed, /]
MOVEI T1,[ASCIZ /COBOL-68/] ;[324]
TLNN FL3,C68SW ;[324] SEE WHICH WE WANTED, USE OTHER
MOVEI T1,[ASCIZ /COBOL-74/] ;[324]
STRING (T1) ;[324] TYPE ONE WE WILL USE
STRING [ASCIZ / used
/]
ENDCOB:
IFN SPRC,<
TLNN FL2,SPRC
>
JRST NOCOMP ;GO LOAD
IFN SPRC,<
MOVSI SVPT,-NFILE ;RESET POINTER
MOVE T1,ONAM ;AND FAKE WORLD
;**; [444] at ENDCOB plus 9 lines
MOVEM T1,SVNAM(SVPT) ;PUT IT AS CURRENT FILENAME
MOVE T3,PCNUM ;GET BACK PROCESSOR NUMBER
MOVE T1,INTEXT(T3) ;GET EXTENSION
MOVEM T1,SVEXT(SVPT) ;AND PUT IT AS CURRENT EXTENSION
SETZM SVPPN(SVPT)
SETZM SWBKS(SVPT)
SETZM SWBKB(SVPT)
SETZM SWBKL(SVPT)
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
TLO FL2,RELSW ;[433] REMEMBER THIS IS A REL FILE
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,LSFP1 ;ZERO IS JUST
PUSHJ P,OUTOCT
LSFP1: MOVEI T1,"," ;[441] output a comma
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 NOSRCS ;[565] 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,CHNLNK ;[441] SET FOR LINK
;**; [444] at NOCOMP plus 7
TRZE FL,LODOUT ;IS THERE ALREADY OUTPUT THERE?
PUSHJ P,[
MOVEI T1,"," ;YES
PJRST TMPOUT] ;YES, ALL ON SAME LINE SAVES TIME
;**; [444] at NOCOMP plus 9
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 COMP TYPE
MOVSI T2,'/D ' ;DDT BY DEFAULT
JRST ND2] ;[441] go out everything
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
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
USEDEF: PUSH P,DEBAID(T2) ;STORE NAME
skipn (p) ;[220] if no debug aid
jrst NDBA ;[220] then return
move t1,prcnam(t2) ;[220] else get process name
movem t1,0(p) ;[220] to replace debug aid
NDBA: ;[441] no debug aid
CAIN T2,^L<CBLSW>-22 ;COBOL IS A LOSER
JRST [SOS DEBFL ;AS IT MUST LOAD COBDDT
JRST NODDT1] ;AFTER MAIN PROG
GETDD1: 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
CAMN T2,[SIXBIT/FORTRA/] ;[303] FORDDT ?
JRST FOR ;[303] YES--PROCESS DIFFERENTLY
TLNE FL3,F10SW ;[312] F10 SWITCH SEEN
JRST [MOVE T2,[SIXBIT/:/] ;YES INCLUDE FORDDT
PUSHJ P,OUTSIX ;[312]
MOVE T2,[SIXBIT/FORTRA/] ;[312]
JRST ND2] ;[441] go output everything
JUMPE T2,ND2P1 ;[165] IGNORE IF 0
JRST ND2 ;[441] output everything
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/L '] ;[441] LINK-10 switches & separators
JRST ND2 ;[441] output everything
NODDT1: MOVE T2,[SIXBIT/COBOL/] ;[440] COBDDT IS DEBUGGING AID
MOVEM T2,0(P) ;[440] USE INSTEAD OF PROCESS
MOVE T2,['/E/L '] ;[441] LINK-10 switches for COBOL
JRST ND2 ;[441] output it all
FOR: TLNE FL3,F40SW ;[312] F40 SWITCH SEEN
JRST [MOVE T2,[SIXBIT/DDT/] ;[312] USE DDT ONLY
JRST ND2] ;[441] output everything
PUSH P,T2 ;[312] 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] . .
ND2: PUSHJ P,OUTSIX ;[441] common code for most of the above
ND2P1: PUSHJ P,OUTSPC ;[441]
NODDT: MOVE T2,[POINT 7,LODSBK] ;OUTPUT FIRST SWITCHES
PUSHJ P,OUTSW
MOVSI T2,'DSK'
TLNE FL2,RELSW ;[573] DO WE HAVE A REL FILE?
LODR0: SKIPE T2,LOKNAM ;ON NON-DISK DEVICE?
LODR3: PUSHJ P,OUTDEV ;YES. OUTPUT DEVICE
LODR1: MOVE T2,ONAM ;[444] IN WHICH CASE USE ONAM
PUSHJ P,OUTSIX
TLNN FL2,RELSW ;REL
JRST [SKIPE T2,OEXT ;[444] OUTPUT EXTENSION GIVEN?
PUSHJ P,OUTEXT ;YES
TLNN FL3,LIBSW ;IF LIBRARY
JRST ELOD3 ;NO, CONTINUE
JRST LODR2] ;YES
SKIPE T2,SVEXT(SVPT) ;ALSO USE EXT IF GIVEN
PUSHJ P,OUTEXT
LODR2: TLNE FL2,RELSW ;[322] DO WE HAVE THE REL FILE?
SKIPN T2,SVPPN(SVPT) ;[322] YES, THEN OUTPUT PPN IF SPECIFIED
TRNA ;[322] EITHER RECOMPILING OR NO PPN
PUSHJ P,OUTPPN
MOVSI T2,'/S ' ;USES SEARCH
TLNN FL3,LIBSW ;LIBRARY?
JRST ELOD ;NO
PUSHJ P,OUTSIX
PUSHJ P,OUTSPC ;NEEDS SPAC
SETOM NSWTCH ;[236] SIGNAL /L LAST
ELOD: MOVE T2,[POINT 7,LODSB2] ;[174] OUTPUT SECOND SET OF SWITCHES
PUSHJ P,OUTSW
SKIPN T2,FORLIB ;FORSE/FOROTS SWITCH SET?
JRST ELOD2 ;NO
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
PUSHJ P,OUTSPC
ELOD2: TRO FL,LODOUT ;MARK AS HAVING OUTPUT THERE
AOSL DEBFL ;ARE WE FINISHED WITH DDT?
JRST NXFILP
TRNN FL,DOLOD ;[441] are we loading?
JRST ELCBL ;[441] no, must be COBOL
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
ELCBL: 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,L%F10-1 ;[324] MAKE SURE ITS FORTRAN-10
JRST CHKCBL ;[324] NO, TRY COBOL
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,
CPOPJ1: AOS (P) ;[176] SKIP RET, THIS REL WILL DO
POPJ P,
CHKF40: ;HERE IF FOUND REL WAS F40 STYLE
IFE DFORTRAN,< ;IF DEFAULT IS F40
TLNN FL3,F10SW ;RECOMPILE ONLY IF DEFINITELY WANTS F10
>
IFN DFORTRAN,< ;BUT IF DEFAULT IS F10
TLNE FL3,F40SW ;RECOMPILE UNLESS DEFINITELY WANTS F40
>
AOS (P) ;SKIP RET, THIS FILE WILL DO
POPJ P,
;[324] HERE FOR COBOL REL FIL
CHKCBL: SOJE T3,CHKC68 ;[324] 2=COBOL-68
CAIE T3,L%C74-2 ;[324] MAKE SURE ITS COBOL-74
JRST CPOPJ1 ;[324] NO, SO LEAVE ALONE
;[324] HERE IF REL FILE WAS COBOL-74
IFE DCOBOL,< ;[324] IF DEFAULT IS COBOL-68
TLNE FL3,C74SW;[324] RECOMPILE UNLESS DEFINITELY WANTS COBOL-74
>
IFN DCOBOL,< ;[324] BUT IF DEFAULT IS COBOL-74
TLNN FL3,C68SW;[324] RECOMPILE ONLY IF DEFINITELY WANTS COBOL-68
>
AOS (P) ;[324] SKIP RET, THIS FILE WILL DO
POPJ P, ;[324] RECOMPILE
;HERE IF REL FILE WAS COBOL-68
CHKC68:
IFE DCOBOL,< ;[324] IF DEFAULT IS COBOL-68
TLNN FL3,C74SW;[324] RECOMPILE ONLY IF DEFINITELY WANTS COBOL-74
>
IFN DCOBOL,< ;[324] BUT IF DEFAULT IS COBOL-68
TLNE FL3,C68SW;[324] RECOMPILE UNLESS DEFINITELY WANTS COBOL-68
>
AOS (P) ;[324] SKIP RET, THIS FILE WILL DO
POPJ P, ;[324] RECOMPILE
;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: SKIPGE LOOKBF ;[564] DO WE HAVE BUFFERS?
JRST INSRIN ;[564] YES, CONTINUE
MOVE T1,DSKBUF ;[564] GET DISK BUFFER ADDRESS
EXCH T1,.JBFF ;[564] SET .JBFF TO DSKBUF ADDRESS
INBUF LOOK,2 ;[241]SETUP THE BUFFERS
EXCH T1,.JBFF ;[564] RESTORE .JBFF TO ORIGINAL VALUE
INSRIN: IN LOOK, ;YES, MUST CHECK FOR DEBUGGER DATA
JRST INSRL3 ;IN OK, PICKUP BUFFER ADDRESS
POPJ P, ;[564] ERROR - FORCE RECOMPILE
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 INSERR ;[462] IF NOT A REL FILE, THEN 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
HRRZ T2,T3 ;AND COPY FOR CPU INFO
ANDI T3,7777 ;BITS 6-17
LSH T2,-^D12 ;BITS 0-5
TRNA ;[462] SKIP THE ERROR JUMP ENTRY
INSERR: SETZ T3, ;[462] CLEAR TYPE IF NOT REL FILE
CLOSE LOOK, ;[564] CLOSE FILE
AOS 0(P) ;[176] SET SKIP RETURN
POPJ P,
;[462]
; This routine sets up for a DOLOOK call by setting up
; LPPN and associated locations for lookups.
; T1/ contains file pointer
; Returns:
; T2/ pointer to LSFDAD or SVPPN if SFDSW is 0
; Always returns with POPJ, no skip return.
;
SETPTH: MOVE T2,SVPPN(T1) ;[462] GET USER SPECIFIED PPN
IFN SFDSW,<
SKIPN SVSFD(T1) ;[462] ANY SFD'S?
JRST NXSFD ;[462] NO
MOVEM T2,LSFDPP ;[462] SAVE PPN
X==<Y==0> ;[462] INITIAL CONDITION
REPEAT SFDLEN,<
MOVE T2,SVSFD+X(T1)
MOVEM T2,LSFD+Y
X==X+NFILE
Y==Y+1
>
MOVEI T2,LSFDAD ;[462] POINTER TO PATH
NXSFD:
> ;[462] END OF IFN SFDSW
MOVEM T2,LPPN ;[462] STORE THE POINTER OR PPN
POPJ P, ;[462] RETURN
;
;[462] This routine will set the processor type from the REL file.
; It will also recognize processor conflicts and take an error
; path if necessary. The compiler codes in table CMPCOD are
; expanded from the macro CMPTBL. These codes are taken from the
; LINK version 5 manual, page A-13. Those compiler types that
; COMPIL does not know, have zero entries which cause no action.
;
; Assumes:
; T3/ contains compiler type, usually set by INSREL
; Returns: +1
; T3/ contains processor flags
;
SETPRC: SKIPLE T3 ;[462] CHECK LOW RANGE
CAMLE T3,CMPLEN ;[462] CHECK HIGH RANGE
POPJ P, ;[462] DO NOTHING IF BAD
SKIPN T3,CMPCOD(T3) ;[462] GET THE PROC CODE
POPJ P, ;[462] IF ZERO, DO NOTHING
TLO FL2,(T3) ;[462] SET THE FLAG FOR THIS PROC
POPJ P, ;[462] AND RETURN
;
; The X macro takes two arguments:
; A = compiler type code
; B = processor flags to set in FL2
;
DEFINE CMPTBL,<
X 0,UNKSW ;;Code 0, unknown
X 1,FORSW ;;Code 1, F40
X 2,CBLSW ;;Code 2, COBOL-68
X 3,ALGSW ;;Code 3, ALGOL
X 6,BLISW ;;Code 6, BLISS
X 7,SAISW ;;Code 7, SAIL
X 10,FORSW ;;Code 10, FORTRAN-10
X 11,MACSW ;;Code 11, MACRO
X 12,FAISW ;;Code 12, FAIL
X 15,SIMSW ;;Code 15, SIMULA
X 16,CBLSW ;;Code 16, COBOL-74
X 24,PASSW ;;Code 24, PASCAL-36
>
SALL
GETPRO: MOVSI T1,-NFILE ;NUMBER OF FILES
TRNN FL2,-1 ;[303] LOCAL PROCEESOR SET ?
SETOM DEFPRO ;[303] SET FLAG SAYING DEFAULT PROC USED
TRNN FL2,-1 ;LOCAL PROCESSOR SET?
HRR FL2,DFPROC ;NO, SET FROM GLOBAL
TRNE FL2,RELSW ;IF USER SAID /REL
TRNE FL3,COMPLS ;AND NOT /COMP
JRST GETPR1 ;NOT TRUE
TLO FL2,RELSW ;DON'T WASTE TIME ON LOOKUPS
PUSH P,SVDEV(T1) ;AND COPY "SOURCE" DEVICE
POP P,LOKNAM ;TO OUTPUT DEVICE
POPJ P, ;JUST SET PROCESSOR=LOADER
GETPR1: SETOM PTHBLK ;[246] SETUP TO FIND THIS JOB'S PATH
MOVE T3,[3,,PTHBLK] ;[246] POINT TO 3 WORD PATH BLOCK
PATH. T3, ;[246] FIND USER'S DEFAULT PATH
SETZM PTHBLK+1 ;[246] NO LIB: IF NO PATH
MOVE T3,PTHBLK+1 ;[246] GET PATH FLAGS
TRNN T3,20 ;[246] DOES USER HAVE A LIBRARY?
SETZM PTHBLK+2 ;[246] NO, ONLY 1 PASS NEEDED.
SKIPE T3,SVPPN(T1) ;[246] DID USER TYPE A PPN?
SKIPN PTHBLK+2 ;[246] AND HAS HE A LIBRARY?
SKIPA ;[246] NO, FORGE AHEAD
MOVEM T3,PTHBLK+2 ;[246] YES, PUT "MUST MATCH" PPN IN
GETPR2: MOVEI T3,1 ;[246] SET UP LOOK OF EXTENSION POINTER
NFIL: MOVE T2,SVNAM(T1) ;SET UP NAME AND PPN
MOVEM T2,LNAM
HLLZ T2,SVEXT(T1)
NXEXT: MOVEM T2,LEXT ;START WITH ORIGINAL EXT
MOVEM T2,OLDEXT ;SAVE FOR RAS SYSTEM
PUSHJ P,SETPTH ;[462] SET UP LOOKUP BLOCK
SKIPN T2,SVDEV(T1) ;A DEVICE?
SKIPE T2,LOKNAM ;OR SAVING ONE UP
JRST ALTDEV
OKLOOK: PUSHJ P,DOLOOK ;[316] DO THE LOOKUP
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)
DNLOK1: PUSHJ P,CHKAGE ;[317] CHECK AGE OF CURRENT FILE
JRST OLDAT ;[317] OLDER FILE
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
MOVEM T2,SDAT ;[317] STORE THE DATE
LDB T2,[POINT 11,LDAT,23]
SETTM: MOVEM T2,STIM ;MARK WITH LATER ONE
MOVE T2,EBLK+.RBTIM ;[317] GET THE INTERNAL CREATION DATE/TIME
MOVEM T2,ETIM ;[317] STORE IT
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 LOLD1] ;AND PROCCESS IT [441] use LOLD1
CAME T2,PXTAB(T3)
AOBJN T3,.-1
LOLD1:
IFE BLISS,<
JUMPGE T3,SETCP ;NOT THERE
>
IFN BLISS,<
JUMPL T3,LBLS1 ;JUMP IF FOUND SOMETHING
CAME T2,B10 ;IS IT ALTERNATIVE BLISS EXT
JRST SETCP ;NO
HRROI T3,CHNBLI+1 ;YES, SET FOR BLISS
LBLS1:
>
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
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
SKIPN PTHBLK+2 ;[246] WAS THIS ONLY PASS 1?
JRST LNTY1 ;[246] NO, FORGET IT
SETZM PTHBLK+2 ;[246] YES, RETRY WITH LIBRARY
JRST GETPR2 ;[246] AND TRY AGAIN
LNTY1: 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?
JRST NOFIL ;[441] OUT OF THINGS TO TRY
SETZM PTHBLK+2 ;[250] NO, SEARCH IT NOW
JRST GETPR2 ;[250] ...
;ROUTINE TO DO LOOKUPS EITHER NORMAL OR EXTENDED
DOLOOK: SKIPE EXTEND ;[316] IS FILE ON DISK?
JRST ELOOK ;[316] YES, DO EXTENDED LOOKUP
LOOKUP LOOK,LNAM ;[316] NO, USE SHORT FORM
POPJ P, ;[316] NOT FOUND - NON SKIP RETURN
JRST ELOOK1 ;[316] FOUND - SKIP RETURN
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
POPJ P, ;[316] NOT FOUND - NON SKIP RETURN
SKIPE T2,PTHBLK+2 ;[246] FORCING PPNS TO MATCH?
CAMN T2,EPPN ;[246] AND DO THEY?
ELOOK1: AOS (P) ;[316] GOOD LOOKUP, SET UP TO SKIP
POPJ P, ;[316] RETURN
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
PUSHJ P,DOLOOK ;[316] DO THE LOOKUP
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
MOVE T2,LOKNAM ;[316] GET DEVICE NAME
DEVCHR T2, ;[316] GET CHARACTERISTICS
TLNN T2,100 ;[316] 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
>
;
;[450] Routine to output a set of switches. This routine defines a
; switch as a string of non-blank characters delimited by a
; blank. A set of switches is a series of multiple switches
; delimited by a null.
;
OUTSW: MOVEM T2,SVSWP ;SAVE THE POINTER
OUTSW2: ILDB T1,SVSWP ;GET 1ST CHAR
JUMPE T1,OUTSW5 ;ALL DONE IF NULL
CAIN T1," " ;IGNORE LEADING BLANKS
JRST OUTSW2 ;AND MULTIPLE BLANKS
MOVEI T1,"/" ;A SLASH SAYS THIS IS A SWITCH
PUSHJ P,TMPOUT ;SO TELL WHOMEVER
LDB T1,SVSWP ;GET FIRST NON-BLANK CHAR AGAIN
CAIA ;AND PROCESS IT
OUTSW3: ILDB T1,SVSWP ;GET NEXT CHAR
JUMPE T1,OUTSW5 ;IS THIS NULL? (IF YES, DONE)
PUSHJ P,TMPOUT ;NON-NULL SO OUTPUT THIS CHAR
CAIN T1," " ;WAS THAT A BLANK?
JRST OUTSW2 ;YES, END OF SWITCH SO GET A NEW ONE
JRST OUTSW3 ;NO, LOOP UNTIL DONE
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
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,H)<
<SIXBIT /C/>>
PRCNAM: PROCESS
DEFINE X (A,B,C,D,E,F,G,H)<
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,H)<
B'SW>
ISPTAB: RELSW
PROCESS
DEFINE X (A,B,C,D,E,F,G,H)<
SIXBIT /E/>
INTEXT: PROCESS
IFN SPRC,< DEFINE X (A,B,C,D,E,F,G,H)
<D'SW>
NXPC: PROCESS
SW==0>
DEFINE X (A,B,C,D,E,F,G,H)<
SIXBIT /F/>
DEBAID: PROCESS
DEFINE X (A,B,C,D,E,F,G,H)<
"G">
SEPTAB: PROCESS
;[463] SETUP PROCESS FLAGS IF ANY
DEFINE X (A,B,C,D,E,F,G,H)<
IFNB "H",< XWD H,0> ;;put flags in left half(arbitrary)
IFB "H",< EXP 0 > ;;no process flags
>
PRCFLG: PROCESS
DEFINE X (A,B)<
< SIXBIT /B/>>
PRCDEV: DEVICE
SALL
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,<<^D29+^D11>*1000>-1 ;[461] USE 29P LOW WITH 11P HIGH
MOVEM T2,RUNCOR ;[461] STORE CORE ARGUMENT
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
SKIPN SVNAM(SVPT) ;[431] CHECK IF FILE NAME ALREADY SCANNED
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 "^"
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
CAIE C,"." ;[237] EXTENSION WITHOUT FILENAME?
JRST PROT5 ;[237] NO.
SKIPE SVEXT ;[437] IS EXT ALREADY SEEN?
JRST SYNERR ;[437] OOPS! 2 "."'S SEEN IN FILE SPEC
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
TRNE FL,TECOF ;[455] DO WE WANT TECO?
MOVEI T1," " ;[455] YES, PASS A SPACE
PUSHJ P,TMPOUT ;OUTPUT THE S
SKIPE T2,SVDEV ;[441] AND A DEVICE SEEN ELSE SKIP
PUSHJ P,OUTDEV ;OUTPUT THE DEVICE
LDE2: 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
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,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: SKIPE T2,SVNAM ;[311] ANY ARGUMENTS
JRST TAPSP1 ;[311] YES PROCESS
SKIPE SAVCHR ;[311] TAB OR BLANK
GOTO SYNERR ;[311] NO ERROR
PUSHJ P,SCAN ;[311] GET ARGUMENT
MOVE T2,ACCUM ;[311] PUT IN AC
TAPSP1: SETO T1, ;FIND THE MASK
LTPS1: LSH T1,-6 ;MUST BE AT LEAST ONE CHAR. ANYWAY
TDNE T2,T1 ;DON'T MASK REAL CHAR.
JRST LTPS1 ;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?
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
;**;[323] @COPYSW+2 1/2, KPY, 3-JAN-78
TLNE CS,TERMF ;[323] SEE IF END
GOTO SYNERR ;[323] YES--ERROR
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
>
;
; This routine will output ONAM with a /SAVE (/SSAVE)
; and check to see where in the flow it is. If it is the
; first output out to the LNK tmpcor file, then it puts a
; comma after. If there is already output there, it prefixes
; a comma.
;
OUTSAV: PUSH P,T3 ;[444] PUSH THE CURRENT CHAN NO. DOWN
MOVEI T3,CHNLNK ;[444] SET CHAN NO. FOR LINK
TRNE FL,LODOUT ;[444] IS OUTPUT THERE?
SKIPA T1,[","] ;[444] YES, SO PREFIX WITH A COMMA
TRNA ;[444] A PSUEDO SKIP TO KEEP FLOW
PUSHJ P,TMPOUT ;[444] OUTPUT THE COMMA AND CONTINUE
SKIPE T2,ODEV ;[444] OUTPUT DEVICE THERE?
PUSHJ P,OUTDEV ;[444] YES, OUTPUT IT
MOVE T2,SVDEV(SVPT) ;[444] GET THE CURRENT DEV NAME
MOVEM T2,ODEV ;[444] AND MAKE IT THE OUTPUT DEV
MOVE T2,ONAM ;[444] GET OUTPUT FILENAME
PUSHJ P,OUTSIX ;[444] PUT IT OUT THERE
MOVE T2,SVNAM(SVPT) ;[444] GET CURRENT FILENAME
MOVEM T2,ONAM ;[444] STORE IT AS OUTPUT NAME
SKIPE T2,OEXT ;[444] GET OUTPUT EXTENSION
PUSHJ P,OUTEXT ;[444] PUT IT OUT IF THERE
SETZM OEXT ;[453] CLEAR OUTPUT FILE EXTENSION
MOVE T2,SAVSW ;[444] GET THE SWITCH AGAIN
PUSHJ P,OUTSIX ;[444] OUTPUT IT
MOVEI T1,"," ;[444] THIS IS THE OUTPUT FILE
TRNN FL,LODOUT ;[444] IS THERE ALREADY OUTPUT THERE?
PUSHJ P,TMPOUT ;[444] NO, SO OUTPUT A COMMA, ELSE DON'T
POP P,T3 ;[444] PUT THE ORIGINAL CHAN NO. BACK
POPJ P, ;[444] AND RETURN
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
SOSGE TMPCNT(T5) ;[425] 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: HLLZ T1,PROCTB(T3) ;[566] GET TMPCOR FILE
MOVEM T1,TMPFIL ;[566] TO DELETE
SETZM TMPFIL+1 ;[566] ZERO I/O WORD
MOVE T1,[2,,TMPFIL] ;[566] DELETE TMPCOR FILE
TMPCOR T1, ;[566]
JFCL ;[566] MUST NOT BE ONE
HLRZ T1,PROCTB(T3) ;GET PROCESSOR
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 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
POPJ P, ;[441] faster than JRSTing to it
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
;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,H)<
IFDIF <A><MACY11>,<
<SIXBIT /A/>>
IFIDN <A><MACY11>,<
<SIXBIT /B/>>
>
PROCTB: PROCESS
REPEAT MXPROC-NPROCS,<0> ;FILL IN MISSING ONES
XPROCESS ;AND THESE
SUBTTL COMPILER TYPE TABLE
;[462] EXPAND CMPTBL MACRO INTO COMPILER TYPES AND PROCESSOR FLAGS
; A = compiler type code
; B = processor flags to set in FL2
;
DEFINE X(A,B),<
IFLE A,< .CMPTD==1 ;;crock it once
> ;;ENDIFE
IFG A,< .CMPTD==A-.CMPTC ;;calc dif in entries
> ;;ENDIFG
IFLE .CMPTD,<
PRINTX ?CMPTBL IS OUT OF ORDER
.CMPTD==1
>;;ENDIFLE ;;make a best guess at this point
REPEAT .CMPTD-1,<
XWD 0,UNKSW ;;not used
>;;END REPEAT
IFDEF B,<
XWD 0,B ;;Code A
> ;;ENDIFDEF
IFNDEF B,<
XWD 0,UNKSW ;;Zero entry, not defined here
> ;;ENDIFNDEF
.CMPTC==A ;;set our counter
>;;ENDDEF X
CMPCOD: CMPTBL
CMPLEN: .-CMPCOD-1 ;[462] length of table
SUBTTL DATA STORAGE ASSIGNMENTS
WORDS <PCNAM,PCDEV,LODDEV,SAVPPN,SVSWP,PCNUM,OLDEXT,SDAT,STIM,SAVCHR,ETIM>
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 <SWGKB,SWGKL,SWGKS> ;[447]
U (SWGLK,SWBK+1) ;[447]
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 (DSKBUF,1) ;[564] DISK BUFFER ADDRESS
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)
> ;NAME OF FORTRAN COMPILER
U (COBPRC,1) ;[324] NAME OF COBOL COMPILER
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
WORDS(<EBLK,EPPN,NAME,LEXT,LDAT,LPPN>) ;[240]
U(EVER,<.RBTIM-.RBSIZ>) ;[240] EXTENSION TO LOOKUP BLOCK
LNAM=NAME
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 0,LOOKBF ;[462] NO NEED FOR OUTPUT BUFFER
DSKLK: 1
SIXBIT /DSK/
XWD 0,LOOKBF ;[462] DON'T USE UNNECESSARY OUTPUT BUFFER
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