mirror of
https://github.com/PDP-10/stacken.git
synced 2026-01-31 13:52:00 +00:00
4635 lines
142 KiB
Plaintext
4635 lines
142 KiB
Plaintext
TITLE COMPIL 22G(605) CCL CONTROL CUSP
|
||
SUBTTL OWNER HISTORY
|
||
; WEIHER/CLEMENTS/RCC/PMH/NGP/DMN/HPW/JNG
|
||
; /SMM/JMT/WCL/BCM/GAT/RCB/MEM 9-SEP-87
|
||
SUBTTL PROGRAM TO COMPILE LOAD EXECUTE AND DEBUG USER PROGRAMS
|
||
|
||
|
||
|
||
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1978,1983,1984,1985,1986,1987.
|
||
;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==7 ;DEC UPDATE LEVEL
|
||
VEDIT==605 ;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 SFDLEN,<SFDLEN==0> ;[601] MAKE SURE SYMBOL ALWAYS DEFINED
|
||
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 [442] 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
|
||
;577 QAR 868774 DRB 3-FEB-86
|
||
; NEST IS DESTROYING T1 WHEN IT SHOULDN'T. PUSH IT SOONER AND POP IT
|
||
; LATER.
|
||
;
|
||
;START OF VERSION 22(G)
|
||
;
|
||
;600 NO SPR RCB 6-FEB-86
|
||
; EXTEND 442 TO ALLOW THE PATHOLOGICAL DEVICE EDITOR: TO BE WHAT
|
||
; THE CREATE AND EDIT COMMANDS WILL RUN. IF EDITOR: IS NOT DEFINED,
|
||
; THEN DEFAULT TO THE EDITOR SYMBOL OF 442 (RUN FROM SYS:).
|
||
;
|
||
;601 10-35493 RCB 22-JUL-86
|
||
; ALLOW [-] AS A PATH SPEC.
|
||
;
|
||
;602 10-35500 MEM 16-JAN-87
|
||
; ONLY PUT OUT EXT AND PPN IF /REL WAS SPECIFIED
|
||
;
|
||
;603 10-35688 9-SEP-87
|
||
; EXPLICIT "DSK" ON A FILESPEC DOESN'T OVERRIDE STICKY DEVICE NAME
|
||
; FROM A PREVIOUS FILESPEC.
|
||
;
|
||
;604 10-35708 9-SEP-87
|
||
; EDIT 567 WENT TOO FAR. DON'T SPECIAL CASE COMMA SEPARATORS WHEN
|
||
; TERMINATING INDIRECT COMMAND FILESPECS UNLESS THEY IMMEDIATELY
|
||
; FOLLOW A TERMINATOR.
|
||
;
|
||
;605 10-35989 9-SEP-87
|
||
; EDIT 602 WAS TOO RESTRICTIVE. TRIED TO SUPPRESS THE OUTPUT OF
|
||
; EXTENSIONS, BUT OMITTED THE PPN AS WELL.
|
||
;
|
||
;;;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)
|
||
CAIE C,"-" ;[601] MIGHT IT BE [-]?
|
||
JRST GETPP2 ;[601] NO, CONTINUE WITH [,,] CASE
|
||
PUSHJ P,SCAN ;[601] YES, SKIP PAST THE "-"
|
||
SETOM PTHBLK ;[601] SETUP TO READ DEFAULT PATH
|
||
MOVE T1,[.PTPPN+SFDLEN,,PTHBLK]
|
||
PATH. T1, ;[601] FETCH IT
|
||
JRST GETPP3 ;[601] NON-SFD MONITOR? TRY FOR END.
|
||
MOVE T1,PTHBLK+.PTPPN ;[601] GET PTHPPN
|
||
MOVEM T1,SVPPN(SVPT) ;[601] SAVE
|
||
IFN SFDSW,<
|
||
X==0 ;[601] FIRST SFD
|
||
.X==0 ;[601] MONITOR'S FIRST SFD
|
||
REPEAT SFDLEN,<
|
||
MOVE T1,PTHBLK+.PTSFD+.X ;[601] GET NEXT SFD TO STORE
|
||
MOVEM T1,SVSFD+X(SVPT) ;[601] SAVE AWAY
|
||
X==X+NFILE
|
||
.X==.X+1 ;[601] ADVANCE POINTERS
|
||
> ;[601] END REPEAT SFDLEN
|
||
> ;[601] END IFN SFDSW
|
||
JRST GETPP3] ;[601] LOOK FOR END OF PATH
|
||
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,T1 ;[577] SAVE TEMP AC
|
||
PUSH P,ACCUM ;SAVE STATE OF SCANNER
|
||
PUSH P,FL ;SAVE THE FLAGS (AS IDF?)
|
||
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,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
|
||
MOVE T1,SAVCHR ;[604] GET PREVIOUS CHARACTER AND BITS
|
||
TLNE T1,TERMF ;[604] LAST CHARACTER A LINE TERMINATOR?
|
||
CAME CS,COMMA ;[604] AND COMMA AT START OF NEW LINE?
|
||
SKIPA T1,[70000,,] ;[604] RE-EAT CHARACTER
|
||
JRST NEXT2A ;[604] ELSE IGNORE LEADING COMMA
|
||
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
|
||
POP P,T1 ;[577] RESTORE TEMP AC
|
||
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 [TRNE FL,EDITF ;WAS THIS FOR EDIT?
|
||
TRNE FL,TECOF ;AND NOT TECO?
|
||
JRST DOEND ;[206] NO, EXIT
|
||
SKIPN PCDEV ;IS THERE ANOTHER TO RUN?
|
||
JRST DOEND ;NOPE
|
||
JRST NUNDO] ;YES, DO IT
|
||
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
|
||
TRNN FL2,RELSW ;[602] ONLY PUT OUT EXT IS /REL GIVEN
|
||
JRST LODR4 ;[605] ON TO THE PPN
|
||
SKIPE T2,SVEXT(SVPT) ;ALSO USE EXT IF GIVEN
|
||
PUSHJ P,OUTEXT
|
||
LODR4: SKIPE T2,SVPPN(SVPT) ;[605] OUTPUT PPN IF SPECIFIED
|
||
PUSHJ P,OUTPPN
|
||
LODR2: MOVSI T2,'/S ' ;[602]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
|
||
OPEN LOOK,DSKLK ;[603] SET LOOK BACK TO DSK
|
||
SKIPA ;[603] SHOULD NEVER HAPPEN
|
||
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,['EDITOR']
|
||
TRNE FL,TECOF
|
||
JRST ISTECO ;TECO OR MAKE COMMAND
|
||
MOVEM T1,PNMBLK+2 ;SAVE AS NAME FOR INFO
|
||
MOVSI T2,(PT.RCN) ;RETURN CURRENT NAME
|
||
MOVEM T2,PNMBLK+1 ;SET FLAG FOR UUO
|
||
MOVEI T2,.PTFRN ;READ NAME
|
||
MOVEM T2,PNMBLK+0 ;SET FUNCTION CODE
|
||
MOVE T2,[5,,PNMBLK];UUO ARG POINTER
|
||
PATH. T2, ;SEE IF EDITOR: IS DEFINED
|
||
JRST [MOVE T1,[EDITOR] ;NO, GET DEFAULT VALUE
|
||
JRST ENDED] ;AND DO IT THE OLD WAY
|
||
MOVEM T1,PCDEV ;YES, USE AS DEVICE
|
||
SETZ T1, ;AND NOT NAME
|
||
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+SFDLEN) ;[601] ARG,FLAGS,PPN,SFDS
|
||
U(PNMBLK,5) ;PATHOLOGICAL NAME BLOCK
|
||
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
|