Trailing-Edge
-
PDP-10 Archives
-
bb-y390o-bm_tops20_v41_atpch_20
-
autopatch/scan.x18
There are 2 other files named scan.x18 in the archive. Click here to see a list.
UNIVERSAL $SCNDC -- DECLARATIONS FOR COMMAND SCANNER
IF1,< ;DEFINE ONLY DURING PASS 1
;DEFINE MACRO TO PASS DECLARATIONS ON TO EACH SUB-MODULE
DEFINE $SCNDC,<
SUBTTL P.CONKLIN/DJB/DMN/DAL/PFC/LLN/JNG/LCR/WCL/BBE/PY/JBS/HD/MRB/RCB -- %7E(665) 26-Aug-87
LALL
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1978,1982,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.
SALL ;;SUPPRESS MACRO LISTINGS
SCNDC1 ;;GET REST OF DECLARATIONS
> ;END OF $SCNDC
CUSTVR==0 ;CUSTOMER VERSION
DECVER==7 ;DEC VERSION
DECMVR==5 ;DEC MINOR VERSION
DECEVR==665 ;DEC EDIT VERSION
;ASSEMBLY INSTRUCTIONS:
;MAKE A FILE, U.MAC, CONTAINING JUST %.C==-3
;.COMPILE U+SCNMAC,SCAN,HELPER
;THEN LOAD THE .REL FILE WITH ANY PROGRAM
SEARCH MACTEN,UUOSYM,SCNMAC ;SEARCH PARAMETERS FOR THIS FILE
;AC NAMES
T1=1 ;TEMPORARIES
T2=2
T3=3
T4=4
P1=5 ;PRESERVED ACS FOR CALLING ROUTINES
P2=6
P3=7
P4=10
P=17 ;PUSH-DOWN POINTER
SUBTTL PARAMETERS AND DEFAULTS
;ASSEMBLY PARAMETERS
ND DEBUG$,1 ;1=INCLUDE DEBUGGING FEATURES
ND ECHO$C,0 ;1=ECHO COMMAND STRING AS CHARACTER PROCESSED
ND ECHO$P,0 ;1=ECHO COMMAND STRING AS PHRASE PROCESSED
ND ECHO$W,0 ;1=ECHO COMMAND STRING AS WORD PROCESSED
ND FT$ALT,0 ;1=CONVERT 175,176 TO 033
ND FT$SFD,-1 ;SUB-FILE DIRECTORIES
ND FT$SDP,0 ;[610] (*TEMPORARY*) 1=SFD'S DEFAULT FROM PATH
ND FT$TNX,0 ;TENEX
ND FT$UEQ,1 ;1=UNDERLINE SAME AS EQUALS
ND LN$ABF,200 ;LENGTH OF INDIRECT BUFFER
ND M$INDP,^D10 ;MAX. INDIRECT DEPTH (-1=INF., 0=NONE)
DM MSG,77777,0,7 ;MESSAGE
DM PRO,777,0,277 ;PROTECTION
DM RNC,777777,0,0 ;RUN CORE
DM RUN,7,-1,1 ;RUN OFFSET
VRBADX==10 ;/MESSAGE:ADDRESS
;COMPLETE DEFINITION OF DECLARATIONS MACRO
DEFINE SCNDC1,<
SEARCH MACTEN,UUOSYM,SCNMAC ;;[621] GET SYMBOLS
IFN FT$TNX, <SEARCH STENEX> ;GET SYMBOLS FROM STENEX.UNV
XP %%SCAN,<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+DECEVR
%%%SCN==:DECVER ;PROTECTIVE VERSION NUMBER [546]
....==%%UUOS ;[621]
PURGE CUSTVR,DECVER,DECMVR,DECEVR,....
TWOSEG
RELOC 400000
> ;END OF SCNDC1
; TABLE OF CONTENTS FOR SCAN
;
;
; SECTION PAGE
; 1. PARAMETERS AND DEFAULTS................................... 2
; 2. REVISION HISTORY.......................................... 4
; 3. DEFINITIONS FOR THIS SUB-MODULE........................... 13
; 4. INITIALIZE................................................ 15
; 5. TRADITIONAL COMMAND SCANNER............................... 21
; 6. MAIN LOOP FOR TRADITIONAL COMMAND SCANNING................ 24
; 7. VERB FORM COMMAND SCANNER................................. 28
; 8. OPTION FILE SCANNER....................................... 31
; 9. PARTIAL SCANNER........................................... 35
; 10. INDIRECT FILE SETUP AND FINISH............................ 39
; 11. RUN COMMAND PROCESSING.................................... 43
; 12. SUBROUTINES FOR COMMAND INPUT
; 12.1 FILE SPECIFICATION................................ 45
; 12.2 SWITCH OR VERB PROCESSING......................... 55
; 12.3 GET DATE/TIME..................................... 77
; 12.4 GET WORD/STRING................................... 87
; 12.5 GET NEXT CHARACTER................................ 102
; 13. INDIRECT FILE HANDLING.................................... 112
; 14. ROUTINE TO CONVERT SCAN BLOCKS............................ 121
; 15. SUBROUTINES FOR ERROR MESSAGE OUTPUT...................... 122
; 16. STORAGE................................................... 128
; 17. .VERBO MODULE............................................ 133
; 18. .TNEWL MODLUE............................................. 136
; 19. .TTYIO MODULE............................................. 137
; 20. .TOUTS MODULE............................................. 145
; 21. .STOPB MODULE............................................. 160
; 22. .CNTDT MODULE............................................. 163
; 23. .GTPUT MODULE............................................. 168
; 24. .SAVEn MODULE............................................. 172
SUBTTL REVISION HISTORY
;%1 (SCANER) -- 6/71 WITH 5.03 MONITOR
;A) MOVE MACROS TO C.MAC AND SCNMAC.MAC. USE ALL BIT AND
; BYTE DEFINITIONS FROM C.MAC. DEFINE FILE SPEC AREA
; IN SCNMAC.MAC.
;B) RESTRICT AC USAGE TO 1-10 (1-4 TEMPS, 5-10 PRESERVED).
; FLAGS AND MASK MOVED TO CORE. NAME MOVED TO 7, CHARACTER
; TO 10.
;C) INDIRECT I/O REDUCED TO CHANNEL 0 AND READ ONE BLOCK AT A TIME.
;D) CHARACTER CODING CHANGED TO FOLLOWING: ESCAPE=0, END OF LINE=-1,
; END OF FILE=-2. OCCASIONALLY 200 IS END OF LINE (SAVCHR).
;E) ALL UUOS AND THEIR BITS, BYTES, AND FUNCTIONS ARE SYMBOLIZED WITH
; C.MAC.
;F) CALLING SEQUENCES CHANGED TO BE A BLOCK POINTED TO FROM AC1 TO GIVE
; UPWARD GROWTH COMPATIBLY. MANY PARAMETERS ARE OPTIONAL.
;G) INDIRECT/CCL CODE PLACED UNDER CONDITIONAL.
;H) TYPEOUT CHARACTER ROUTINE SEPARATED. CAN BE ARGUMENT.
;I) ALLOW PROGRAM TO SPECIFY A PRESET INDIRECT FILE.
;J) CHANGE ALL INTERNALS TO INCLUDE PERIOD IN NAME.
;K) WHEN SKIPPING OVER RESCANNED LINE, AVOID POSSIBLE TT IN WAIT.
;L) RECODE EOF HANDLING TO COVER ALL CASES.
;M) ADD TSCAN ARGS TO GIVE USER CONTROL AT KEY POINTS IN SCAN.
;N) CHANGE MESSAGE FROM "ILLEGAL COMMAND SYNTAX CHARACTER" TO
; "ILLEGAL CHARACTER". TYPEOUT ASCII 7,11-15,33 MNEMONICALLY.
;O) IMPLEMENT MULTIPLE OUTPUT SPECS FOR COMPILERS. IF MULT. OUTPUT,
; THE = (OR _) IS MANDATORY.
;P) ADD WORDS FOR /BEFORE/SINCE. SWITCH SCAN WILL BE IMPLEMENTED
; LATER. ALSO ADD .GTNOW (INTERNAL DATE FORMAT CONVERTER).
;Q) ADD MESSAGE "?PROTECTION SWITCH ILLEGAL IN INPUT FILE".
; REMOVE "? TOO MANY INPUT FILES".
;R) IMPLEMENT /RUN/RUNOFFSET SWITCHES.
;S) IN VERB MODE, PERIOD BEFORE VERB SETS STICKY DEFAULTS.
; CHANGE LOGIC SO VERBS FOR A FILE APPEAR AFTER THE
; FILES DEFINITION.
;T) DEFEAT ^O BEFORE TYPING * / OR #.
;U) IN VERB MODE, ADD NEW MESSAGE
; ? EXCESS ARGUMENTS STARTING WITH ....
;V) IN VERB MODE, IGNORE LEADING /. THIS ALLOWS /HELP TO
; WORK IN ANY PROGRAM.
;W) .VSCAN WILL RETURN ONLY AT TOP LEVEL EOF.
;X) GENERALIZE /HELP ARGUMENT TO GIVE SIXBIT PROGRAM NAME
; (-1 FOR GETTAB 3) TO USE AS ARGUMENT TO HELPER.
;Y) PUT LIMIT OF 10 ON INDIRECT FILES (ASSEMBLY PARAM)
; ADD MESSAGES:
; ? INDIRECT SPECIFICATION INCOMPLETE
; ? TOO MANY INDIRECT FILES
; ? WILDCARD ILLEGAL IN INDIRECT SPECIFICATION
;Z) IN FILE SCAN, FORCE NAME TO LEFT HALF.
;AA) IN /RUN, DON'T ALLOW SWITCHES.
;AB) IF NO FILE NAME, MAKE FILE SPEC STICKY.
;AC) DETECT NULL DEVICE PROPERLY.
;AD) IMPLEMENT PATH SPECIFICATION. ALSO NOTATIONS [,] [P,]
; [,P] AND [-].
;AE) ADD ROUTINE .GTSPC TO MOVE FILE SPEC TO STORAGE.
;AF) ADD DEFAULT DEVICE 'DSK:' IF USER TYPES PART OF A SPEC BUT
; OMITS THE DEVICE.
;AG) ADD INTERNAL (STANDARD) SWITCHES WHICH COMPETE EQUALLY
; FOR ABBREVIATIONS, BUT ON EXACT EQUIVALENCE THE CALLER'S
; SWITCHES OVERRIDE.
;AH) ADD MESSAGE: ? AMBIGUOUS SWITCH.
;AI) IF SWITCH TABLES GIVE NO MAX, THEN ALWAYS GO TO PROCESSOR.
; IF SWITCH TABLES OMIT POINTER (LH=0), CALL ROUTINE
; POINTED TO BY RH.
;AJ) ALLOW KEYWORD SWITCHES TO GET VALUE "0" TO CLEAR INDEX.
;AK) EXPAND TWO WORD SIXBIT SCAN TO BE MULTIWORD.
;AL) ADD /HELP:SWITCHES TO LIST ACTUAL SWITCH TABLE.
;AM) ADD SWITCH TABLE PREFIX '*' TO MEAN ALL ABBREVIATIONS ARE
; EXACT MATCHES.
;AN) ADD STANDARD SWITCHES /DENSITY,/OKNONE,/PARITY,/PHYSICAL,
; /PROTECTION,/STRS.
;AO) ADD MESSAGES:
; ? IMPROPER PROJECT NUMBER
; ? IMPROPER PROGRAMMER NUMBER
; ? SFD DEPTH GREATER THAN 5
; ? NULL SFD ILLEGAL
; ? NO SWITCH SPECIFIED
; ? SWITCH VALUE NEGATIVE
;AP) CORRECT LOGIC WHICH MEMORIZED STICKY SWITCHES.
;AQ) # PREFIX ON DECIMAL INPUT IMPLIES OCTAL INPUT.
;AR) ALLOW - ON DECIMAL/OCTAL INPUT.
;AS) RECODE ALGORITHM WHICH HANDLES CONTINUATION, COMMENTS, AND
; MULTIPLE SPACES TO HANDLE ALL CASES CORRECTLY.
;AT) ADD CHKACC UUO ON INDIRECT FILES LOOKUPS IN CASE CALLER
; HAS JACCT ON.
;AU) IF NO . IN @, CHECK .(NUL) AFTER .CCL.
;AV) SKIP SEQUENCE NUMBERS IN @ FILE.
;AW) RECODE END/ERROR LOGIC ON @ FILES TO ALWAYS HANDLE CCL
; FILES CORRECTLY. IN PARTICULAR, DELETE .TMP FILES
; AFTER SUCCESSFUL CCL CALL.
;AX) CHANGE OCTAL FATAL MESSAGE TO RH(N) FOR CONSISTENCY.
;AY) ON ERROR IN INDIRECT FILE, SKIP TO END OF LINE.
;AZ) ON VERB @ ERROR, TERMINATE @ FILE.
;BA) WHEN DOING MONRT., RESET ALL I/O. IF NOT LOGGED IN,
; EXCLUDE THE ^D IN PREVIOUS VERSIONS.
;BB) ADD NEW ROUTINE (.TFBLK) TO TYPE SCAN STYLE FILESPEC AREA.
;BC) ADD NEW ROUTINE (.TDIRB) TO TYPE DIRECTORY IN SINGLE WORD,
; SFD, OR SCAN FORMATS.
;BD) ADD NEW ROUTINE (.TFCHR) TO TYPE POSSIBLE FUNNY CHARS.
; IT HANDLES CONTROL AND LOWER CASE FLAGGING.
;BE) EXPAND ALL P,PN HANDLING TO ALLOW ONE SIXBIT WORD INSTEAD
; OF TWO OCTAL HALF WORDS.
;BF) CHANGE CALLS TO ALL TYPEOUT ROUTINES TO PASS ARGS IN T1.
;BG) REMOVE ALL OUTSTR/OUTCHR CALLS EXCEPT PROMPTS.
;BH) HANDLE SIGNED NUMBERS IN RADIX TYPER.
;BI) CHANGE SAVEN CALL TO BE PUSHJ.
;BJ) INTERN F.NAM AS FLAG FOR SWITCH SCANNERS.
;%2(127) -- 5/72 WITH DIRECT %2.
;130 REMOVE INTERNS. MAKE ALL DOT SYMBOLS INTERN WITH ::.
;131 REMOVE # OUTPUT ON INDIRECT CONTINUATIONS (SPR 10-7212).
;132 BAN MULTIPLE BUFFER INDIRECT FILE ONLY ON DTA (SPR 10-7212).
;133 SPLIT .TICHT FROM .TICHE
;134 FIX BUG IN .CNVDT
;135 ADD .CNTDT (INVERSE OF .CNVDT)
;136 CREATE .PSCAN FOR PEOPLE WITH PARTIAL SCAN NEEDS
;137 CHANGE ALLDON TO .ALDON
;140 CLEAR SCANPC ON .CLRBF
;141 ADD PROTECTIVE TESTS TO CNVDAT
;142 ADD TTY INPUT AND MONRET ROUTINES IN ISCAN CALL
;143 CHANGE RUNXYZ TO N.XYZ; USE .FX SYMBOLS
;144 ADD /BEFORE/SINCE SWITCHES
;145 ALLOW / BETWEEN PROJ AND PROG IN DIRECTORIES
;146 DON'T FLUSH NULL FILE SPECS
;147 ADD DATE/TIME SCANNERS.
;150 ADD .OSCAN ROUTINE.
;151 ADD /OPTION SWITCH TO SELECT OPTIONS FROM SWITCH.INI FILE.
;152 ADD .SWFIL TO HANDLE FILE SWITCHES
;153 CANCEL 145 AS A BAD IDEA.
;154 HANDLE MISSING DIRECTORIES IN OPTIONS LOOKUPS. CORRECT BUG
; WHICH DECREMENTED START ADDRESS ON OPTIONS NOT FOUND.
;155 CREATE ROUTINE .TERRP (WAS FMADDR)
;156 SPLIT INTO 4 SUB-MODULES--SCAN, OUTPUT, DATE, SAVE
;157 CREATE UNIVERSAL .SCNDC TO PASS PARAMETERS TO EACH SUB-MODULE
;160 HANDLE NUMBERS IN ILL.CHAR MESSAGE
;161 UPDATE LASCHR ON STRING INPUT (.TIGET)
;162 DEFINE .SCANZ AND .SCANL FOR SEGMENT SHUFFLERS
;163 CLEAN UP EXTERNS WITH GLOB.SNO
;164 GIVE USER EXIT ONLY ON HIS OWN SWITCHES
;165 ADD .TTABC ROUTINE TO TYPE A TAB, ETC.
;166 ALLOW FOR PARTIAL WORD IN LAST WORD OF IND. FILE BUFFER
;167 ADD .TTIME, .TDATE TO TYPE OUT DATE AND TIME
;170 MAKE MULTIWORD AREA HANDLE WORST CASE (30. WORDS)
;171 FIX .TRDXW TO HANDLE 1B0 CORRECTLY
;172 FIX .NAME ON SIX LETTER * SWITCHES
;173 CORRECT PDL ERROR IN .FMSGX ROUTINE IF .TSCANNING
;%3(173) -- 12/72 WITH DIRECT%3 AND DUMP%4
;174 ADD /NOSTRS /NOPHYSICAL AND /ERNONE
;175 ADD /NOOPTION
;176 FIX .PSCAN BUG IF <EOL> AFTER MONITOR COMMAND
;177 ADD DEFENSIVE HALT TO ENSURE THAT .OSCAN IS CALLED ONLY AT <EOL>
;200 (10-SEVERAL) DETECT USER ERROR OF "0" AS PROJECT OR PROGRAMMER
;201 CLEAR STICKY DEFAULTS EACH LINE OF .VSCAN AND .PSCAN
;202 E.INCL, E.ILSC INTERN
;203 FIX BUG IN HANDLING OF [] IN /RUN:
;204 CLEAR .NMUL AREA ON EACH SWITCH
;205 FIX /H:S IF NO SWITCHES. MAKE .SWHLP INTERNAL
;206 (10-9709) PRINT WILD PPNS WITH ? INSTEAD OF 7.
;207 (10-10004) ALLOW /RUN IN OPTION FILE; HANDLE AT END (AFTER
; COMMAND); HANDLE /SW:FILE LIKE OTHER SWITCHES.
; MAKE N.ZER AND N.EZER INTERN FOR .PSCAN CALLERS.
;210 MULTI-WORD STORE WAS MISCHECKING DUPLICATE SWTICHES
;211 DISTINGUISH AMBIGUOUS FROM UNKNOWN SWITCH VALUES
;212 REMOVE 175, 176 CHECKS. CAN BE RESTORED BY FT$ALT==1
;213 SET FX.NDV EVEN IF NO DEVICE SET
;214 (10-10123) REMOVE PURESW SINCE IT DOESN'T WORK
;215 CREATE A DUMMY FILE "SCANDM.MAC" WHICH CAN BE LOADED
; WITH OTHER OVERLAYS OF MULTI-SEGMENT PROGRAMS TO RESERVE
; SCAN'S LOW SEG AREA.
;216 SUPPORT FS.NFS
;217 SUPPORT FS.LRG
;220 CHANGE U.MOUT TO FS.MOT
;221 ADD .CKNEG, .SENEG
;222 IMPLEMENT .STOPN. SUPPORT SFDS ON @ AND /RUN. SUPPORT
; /DENSITY/PARITY/PHYSICAL ON @.
;223 HANDLE MONITOR COMMANDS R, RUN, AND START. IF ONE OF
; THESE, AND LINE HAS "-" OR "(", THEN DO ONLY ONE COMMAND,
; THAT WHICH IS AFTER THE "-" OR BETWEEN "(" AND ")".
;224 ACCEPT TMPXXX: FOR INDIRECT FILES. IF THE DEVICE DOES NOT
; EXIST, TRY TMPCOR USING FIRST THREE CHARS OF FILE
; NAME. IF THAT FAILS, TRY DSKXXX:NNNAAA.TMP WHERE NNN
; IS THE JOB NUMBER IN DECIMAL WITH LEADING
; ZEROS AND AAA IF THE FIRST THREE CHARS OF THE
; FILE NAME.
;225 ADD .PSH4T AND .POP4T ROUTINES
;226 ADD /RUNCORE:CORE AND .SWCOR AND .COREW/.COREC
;227 ADD FS.NUE TO SUPPRESS USER EXIT ON SOME SWITCHES
;230 ADD .TICQT/.TISQT TO CONTROL/SUPPORT QUOTED STRINGS. ALLOW
; .NAMEW (FILE NAMES, ETC.) TO HAVE QUOTED STRINGS
; WITHOUT WILD-CARDS. ADD .SIXQW/C, .ASCQW/C, .SWASQ,
; .SWSXQ TO HANDLE SIXBIT AND ASCII POSSIBLY QUOTED
; STRINGS. (QUOTE IS ' AND ").
;231 ADD .KLIND TO KILL INPUT FOR LINK-10 (/GO). CALL IT
; FROM /RUN PROCESSING FOR FORTRAN-10, ETC.
;232 ADD MULTIPLE SWITCH VALUES IN TSCAN/PSCAN MODES.
; EXCERCIZED BY /SWITCH:(VAL1,VAL2,...,VALN)
; REQUIRES USER EXIT SWITCH STORAGE TO AVOID DUPLICATE
; VALUE MESSAGE.
;233 HANDLE LOWER CASE IN .TICAN
;234 ADD ROUTINE .REEAT
;235 REQUIRE THAT SWITCH VALUES END WITH A NON-ALPHANUMERIC
;236 ADD /OKPROT/ERPROT
;237 SUPPORT FS.VRQ
;240 MAKE OPTION ERRORS APPEAR AS WARNINGS
;241 HANDLE VSCAN STICKY (PXXXX) ON MULTI-WORDS BUT NOT FILES
;242 FIX USER APPLY STICKY FOR TSCAN TO BE CALLED BEFORE ALLOC.
;243 ADD .CLRFL
;244 FIX BUG IN * HANDLING FOR PROJECTS
;245 RECOGNIZE @ ONLY AT START OF .TSCAN LINE
;246 ADD PROMPT ROUTINE SET BY .ISCAN; REMOVE ALL OUTCHR/OUTSTRS
;247 STORE ALL TERMINATORS OF CONCATENATED SPEC
;250 CORRECT BUG IN DATE DEFAULTER WHICH (AT 21:00) GAVE
; FOR /AFTER:21, <DAY>:22:00 INSTEAD OF <DAY+1>:21:00
;251 CORRECT NOT-LOGGED IN BUG WHEN DOING A MONRT. TO CALLER
;252 FOR THE CONVENIENCE OF 2741 USERS, ALLOW <> AS == TO []
;253 ON INDIRECT FILE, TRY .CMD AFTER .CCL ON NULL EXTENSION
;254 FIX BUG IN EDIT 200 WHICH CAUSES .<NUL> TO BE .*
;255 (10-11399,11423) /SINCE/BEFORE DID NOT DEFAULT ACROSS FILES
;256 GET ALL FIVE SFDS IN .TDIRB
;257 HANDLE YEARS GE 2000 IN .TDATE
;260 FIX BUG IN CCL MODE IF GT 1 BLOCK IN TMP FILE
;261 (10-11663) ALLOW JAN-1-64 IN DATES
;262 (QAR 1400) PRINT . AFTER "KJOB"
;263 ADD ROUTINE .MNRET
;264 CHANGE .PSCAN TO NOT HANDLE /RUN IMMEDIATELY
; ADD .RUNCM TO HANDLE /RUN SWITCH
;265 REMOVE ' AS A QUOTING CHARACTER TO AGREE WITH DEC
; COMMAND STANDARD
;266 CORRECT PSCAN BUG IN MIDDLE OF LINE
;267 (QAR 1396) PROMPT CONTINUATIONS IN COMMAND MODE
;270 REMOVE THE - OPTION ON RUN COMMANDS
;271 CANCEL 247 UNTIL STANDARD LANGUAGE IS DEFINED
;272 ADOPT ! AS AN ALTERNATE COMMENT CHARACTER
;273 HAVE TRAILING "." FORCE DECIMAL NUMBER
;274 SPIFF UP MESSAGE IF MISSING DATE/TIME VALUE
;275 BUG INTRODUCED SINCE VERSION 3
;%4(275) DEC, 1973
;276 MOVE .PTWRD HERE FROM .WILD; PUT INTO NEW SUBMODULE
; MOVE .MKMSK TO THAT ALSO
;277 SUPPORT FS.OBV
;300 ADD /MESSAGE, .FLVRB,.VERBO AS SEPARATE MODULE
;301 ADD ARG TO CLRFL
;302 SUPPORT FS.MIO
;303 OUTPUT SCN PREFIX SUPPORTING /MESSAGE
;304 ALLOW DEV:NAME ON RESCAN
;305 ADD YESTERDAY, TODAY, TOMORROW
;306 ADD .TVERW
;307 IMPLEMENT D.TODD'S LATEST .SAVEN
;310 USE GETTAB FOR .GTNOW IF AVAILABLE
;311 INCLUDE CLEANER DATE CONVERSION
;312 MAKE .MYPPN INTERNAL
;313 FIX ^Z IN .PSCAN; ALSO FIX RUN ()
;314 IMPROVE MESSAGES "FOLLOWING WORD"
;315 ADD .TDTYM
;316 SUPPORT "NO" SWITCHES
;317 (10-12400) FIX /RUN WHEN NOT LOGGED IN
;320 FIX @ LOGIC FOR NON-DIRECTORY DEVICES TO HANDLE MULTIPLE
; BUFFERS.
;321 ADD OPTION /MESSAGE:ADDRESS TO INCLUDE ADDRESSES OF
; ERROR ROUTINES
;322 HANDLE EOF CORRECTLY ON MULTIPLE PSCAN.
;323 FIX 312
;324 (10-12439) AVOID ERROR MESSAGES IF CCL FILE MISSING
;325 CONSIDER DUPLICATE SWITCH OF SAME VALUE NOT AN ERROR
;326 (10-12416) DETECT TIME GT 24 HOURS
;327 ADD .QSCAN
;330 (10-12344) IMPROVE MESSAGE IF JUNK AFTER IND FILE
;331 DETECT /BEFORE/SINCE DON'T OVERLAP
;332 ADD .STOPB AS SEPARATE MODULE
;333 ADD .ERMSG
;334 CHANGE .SCND? TO $SCND?
;335 HAVE .OSCAN CALL .QSCAN NOT .PSCAN
;336 ADD .TCORW, ALLOW W AT END OF CORE INPUT FOR WORDS AND
; ALLOW B FOR BLOCKS
;337 ADD .TBLOK, .BLOKW/C (SAME AS .COREW/C) WHICH INVOKES .TBLOK
;340 ADD .TOLEB
;341 ON OR-KEYS, ALLOW ALL AND NONE
;342 SN SWITCHES CAN TAKE :0,1,NO,YES,OFF,ON
;343 CALL SW PROCESSORS RET+1=DPB, +2=DON
;344 LIST OF NAMES TO .OSCAN
;345 DO ALL LINES IN SWITCH.INI
;346 ADD /LENGTH/ABEFORE/ASINCE/ERSUPERSEDE/ESTIMAT/VERSION. ERROR LVI.
;347 RECOMPUTE LOGGED IN STATUS FOR LOGIN.
;350 FIX EOF ON @ LINE
;351 (10-13045) CORRECT ERROR IF DEBUG$=0
;352 (QAR 1975) FIX BUG IN 316
;353 (QAR 1975) ALLOW DEFAULT OPTION IN VSCAN
;354 (QAR 1975) CLEAR ^O ON FIRST ? MESSAGE
;355 (QAR 1975) DEFINE .TNEWL IF CALLER DIDNt
;356 MOVE OPTION TEST TO E.DSI; MAKE E.DSI AND E.SVR GLOBAL
;357 ALLOW SWITCH ON FILE SPEC IN VSCAN IF FILE MODIFIER;
; FILE MODIFIERS AT VERB LEVEL SET STICKY DEFAULTS
;360 HANDLE R..(....) IN VSCAN WITH "/"=EOL
;361 MORE OF 352
;362 (WITHDRAWN)
;363 USE SCNMAC EDIT 77
;%5(363) JUNE, 1974
;364 DON'T CLOBBER FLVERB ON OSCAN/QSCAN
;365 ALLOW PSCAN RESCAN WITH JUST CUSP NAME TO HAVE MULT. LINES
;366 FIX EOF LOGIC FOR PSCAN FOR LOGIN
;367 REMOVE SPURIOUS NO-OPTION MESSAGE
;370 CLEANUP .OSCAN ERROR RECOVERY
;%6(370) JULY, 1974
;401 (QAR 2424) FIX 365 TO NOT FOUL UP TSCAN
;402 SAME AS 530
;501 (10-13597) MAKE .TSTRG REENTRANT
;502 (QAR 2384) LET @ WORK TO DTA:
;503 MAKE /MESS:(ALL,NOXX) WORK
;504 (QAR 2439) FIX .FOO/RUN
;505 ADD LOGIN AS A MNEMONIC TIME
;506 ADD /EXIT
;507 ADD GUIDE WORD CONCEPT
;510 RECOGNIZE FILE SEPARATORS 'AND', 'OR', 'NOT'
;511 PREPARE TO REMOVE UNDERLINE AS SAME AS EQUALS (UNDER FT$UEQ)
;512 ALLOW * AT END OF NAME (IN FUT., ? NOT MATCH NULL)
;513 ADD .OSDFS
;514 ADD NON-FILE SWITCHES BEFORE @ (ONLY FIRST LINE OF IND FILE)
;515 (QAR 1975) ALLOW A=B,C=D
;516 DON'T SET DSK: IF ONLY GLOBAL SWITCHES
;517 REMOVE DIALOGUE MODE INTRODUCTION
;520 ADD MNEMONIC DATE-TIME OF NOON AND MIDNIGHT
;521 IMPROVE SAVEN ROUTINES EVEN MORE
;522 ADD % ATTRIBUTES AND IGNORE THEM
;523 ADD GUIDES 4002-4011
;524 AVOID HALT ON @ ERRORS
;525 (10-13,818) FIX TO PROMPT ON CONTINUATION OF COMMAND
;526 (10-13,818) REMOVE FLSPRP AS REDUNDANT
;527 (10-13,817) DON'T DISCARD LEADING SPACE OF CONT. LINE
;530 (10-13,999) FIX BUG IN 313 WHICH DISALLOWED CONT. OF MONITOR COMMAND
;531 ALLOW /MESSAGE TO DEFAULT TO :(PREFIX,FIRST,CONT)
;532 ADD /TMPFILE SWITCH TO WRITE TMPCOR
;533 (10-13,943) DETECT A,B ERROR ON FS.MOT
;534 ADD (...) TO SET CLEAR DEFAULTS
;535 ALLOW @A,@B
;536 ADD DENSITIES OF 1600 AND 6250 FOR 5.07 AND 6.02.
;537 REMOVE NON-SWITCHES FROM .OSDFS LOGIC.
;540 FIX 535
;541 DON'T RECOGNIZE GUIDE WORDS IN QUOTES
;%7(541) OCT, 1974
;542 (10-15001) DETECT ILLEGAL DATE-TIME FORMATS BEFORE DEFAULTS
; ARE FILLED IN
;543 (10-15220) REMEMBER DEFAULTS AT ) INSTEAD OF CLEARING THEM
;544 (10-15135) ADD PREEMPTIVE TTY INPUT ROUTINE FOR LINK
;545 CLEAR CORE AT VERY START OF ISCAN
;546 ADD %%%SCN FOR MODULE STANDARD
;547 CORRECT BUG IN EDIT 357: ALSO ALLOW SWITCHES WITHOUT VALUES
;550 IF MULTIPLE OUTPUT AND MIX IN/OUT, DON'T REQUIRE =
;551 CLEAR DEVICE, ETC., BETWEEN LINES IN VERB MODE
;552 CORRECT BUG IN EDIT 551: CLEAR NON-SWITCH FLAGS BETWEEN LINES
;553 MAKE ROUTINE TO CLEAR STICKY PATH DEFAULTS INTERNAL (.CLSNS)
;554 CLEAR NEGATIVE FLAG FLNEG WHEN COMPLETED READING AN OCTAL FIELD
;%7A(554) MARCH, 1975 WITH BACKUP%1
;555 MEMORIZE SWITCH.INI DEFAULTS BY CALLING FILSTK BEFORE EXITING .OSCAN
;556 SET VERB MODE FLAG IN .VSCAN BEFORE CALLING SETPR4
;557 STORE FIRST VALUE FOR /LENGTH IN P.XXX AREA
;560 IF UFD APPEARS AS -1, TYPE IT AS [*,*]
;561 PREVENT OSCAN FROM COPYING REMAINING STICKY SWITCHES TO ALL
; FILES IN T-MODE
;562 (10-15,267) EDIT 515 FAILS AT MONITOR LEVEL
;563 (10-16,159) PSCAN SOMETIMES TYPES TOO MANY PROMPTS
;564 USE 6.02 TABLE IF AVALABLE TO GET LOGIN TIME
;565 (10-15,694) CORRECT USE OF .PTMAX
;566 ALLOW SPACES AFTER COMMA ON MULTIPLE VALUES FOR SWITCHES
;567 ADD TENEX FEATURE TEST CODE
;570 CORRECT LENGTH OF BLT TRANSFER IN FILSTK SO DATE SWITCHES
; WILL NOT GET CLOBBERED WHEN A DIRECTORY IS TYPED.
;571 DO NOT DEFEAT ^O WHEN PROMPTING IF CALLING USER PROMPT ROUTINE.
;572 ALWAYS IGNORE CCL OR INDIRECT MODE IF PRE-EMPTIVE INPUT.
;%7B(572) DEC, 1975 WITH BACKUP%2 AND LINK%2B
;573 (10-18959) RESTORE .RBPPN AFTER INDIRECT FILE LOOKUP FOR SFD'S.
;574 MAKE .CNVDT ROUTINES ROUND TIME INSTEAD OF TRUNCATING.
;575 (10-19065) SINCE /XYZ:(A , B ) IS LEGAL, ALLOW /XYZ:( A , B )
;576 (10-19852) WHEN SPECIFYING DATE/TIMES WITH WEEKDAYS,
; ALLOW TIMES A FULL WEEK INTO THE FUTURE, AND NOT MORE
; THAN A FULL WEEK INTO THE PAST.
;577 (10-21716) DISALLOW MULTIPLE ='S ON THE SAME LINE (CANCEL EDIT
; 515), SINCE THEY DON'T WORK AND CAN'T BE FIXED (LOCAL SWITCHES).
;600 SPR # 10-21465 LCR 21-JAN-77.
; Stop SCAN from resetting the starting address stored in .JBSA
; when running a program from the CCL entry point. The MONITOR
; no longer offsets the address at .JBSA when the offset is 0 or 1.
; NOTE: C was changed to MACTEN.
; areas affected: RESTRT:, E.IFL.
;
;601 SPR # 10-21869 CLRH 17-MAR-77
; Correction to edit 570 to not wipe out /BEFORE switch.
;602 (10-24777) REMOVE A USELESS HALT IN .QSCAN ROUTINE
;603 SPR # 10-24773 WCL JUNE-27-78
; Fix command scanning for SFD's; avoid use of quoting
; Areas affected: FILDR3
;604 SPR # 10-26448 WCL AUG-24-78
; Rethink Edit 603; it broke error reporting of non-existant
; SFD's if * or ? specified
; Areas affected: FILDR3, .TISQT
;
;605 GMU 09-Oct-78
; If new bit FS.IFI is set in flags word of .ISCAN call,
; make indirect file invocations illegal. Used by the
; File Daemon.
;
;
;606 BBE 12/16/78
; LAST SFD SPEC GETTING DROPPED WITH MULTIPLE LEVEL SEARCHES
; WITH CMD LINE OF THE FORM DIR [A,B,C,D] E.F,G.H,I.J
; SPR 10-25056
;607 GMU 3/3/80
; FIX OFF-BY-ONE BUG IF .TRDXW WAS CALLED WITH A RADIX
; GREATER THAN 10.
;610 RKB 8/19/80
; ALLOW NULL SFD SPECS TO BE FILLED IN WITH PATH. UUO
; CHANGE "?NULL SFD ILLEGAL" TO "?NULL SFD BEYOND DEPTH OF PATH"
; CURRENTLY UNDER A CONDITIONAL UNTIL PROPERLY FIELD-TESTED
; SUGGESTED BY SPR 10-29905 ; AFFECTS FILDR3
;611 Change version scheme to allow customer edits greater than 3.
;
;612 SPR# NONE PY 17-Mar-81
; Remove the FS.NCM flag from /MESSAGE, /OPTION, and /NOOPTION
;613 TARL 30/MAY/81
; ADD ENTRY POINT .TOFEB TO PERFORM SAME FUNCTION AS .TOLEB, BUT
; USING A POINTER TO A FILOP BLOCK
;614 SPR # 10-31175 PY 29-Jun-81
; Fix problem with [-] if edit 610 is installed.
;615 SPR # 10-30948 PY 29-Jul-81
; Remove the SCNNFT and SCNNPS errors. If a future date
; is requested and the date typed is really in the past
; or vice versa, allow the date as there are many cases
; where it is useful to do so.
;616 SPR # 10-31381 PY 5-Aug-81
; Fix TYIIGC to keep B.INDC accurately as the number of
; characters. This fixes an off by one bug with TMPCOR
; files which lose the last character if they end on a
; work boundary.
;617 PY 7-Aug-81
; Fix sequence numbers and page marks in indirect files to
; work even if they span a block.
;620 SPR # 10-31399 PY 18-Aug-81
; Fix bug in edit 610 which affects five deep SFDs and
; /BEFORE or /SINCE.
;7C Never Shipped
;621 PY 18-Aug-81
; Search UUOSYM, MACTEN instead of C. Update compilation
; instructions.
;622 PY 19-Aug-81
; If CCL, check the left half of the name if the right half
; is zero. This prevents COMPIL class commands from getting
; lost if TMP is assigned or a path.
;623 PY 20-Aug-81
; When using a byte pointer for a switch, check for
; exact match with the value instead of the mask.
;624 PY 24-Sep-81
; Fix edit 623 so that switches with multi-word byte
; pointers are compared properly.
;625 PY 19-Oct-81
; Once more with multi-word byte pointers. Either zero
; or minus one is acceptable to indicate that a switch
; has not been seen. Seperate out the multi-word tests
; so the code is shorter and less complex.
;626 PY 24-Nov-81
; With edit 622 installed, the TMPCOR file name may be
; in the left half of .RBPPN instead of the right half.
; Check for this case when deleting the TMPCOR file.
;627 PY 27-Dec-81
; Add the global symbol .OPTN, same value as local symbol
; OPTION.
;630 PY 28-Dec-81
; Fix bug when printing out numbers in .TRDXW with a radix
; greater than ten.
;%7D(630) JAN, 1982
;631 SPR# 10-32611 PY 25-May-82
; Do not output a CRLF to the TTY when reading an altmode
; from an indirect file.
;632 SPR# 10-32639 PY 8-Jun-82
; Ignore extra bits when comparing switch values.
;633 SPR# 10-33131 JBS 13-May-83
; Fix /OPTION:foo in OSCAN for BACKUP. /NOEXEMPT couldn't be used in
; SWITCH.INI.
;634 SPR-10-33447 HD 13-May-83
; Give an error message if input command line exceeds the buffer.
;635 SPR-10-34061 MRB 18-Aug-83
; Use correct file spec block length in routine .OSDFS
;636 SPR-10-34062 MRB 18-Aug-83
; Use correct block size in routine APLSTK.
;637 SPR-10-33081 MRB 19-Sep-83
; If improper programmer number error check to see if
; programmer number appears to be in SIXBIT for type-out.
;640 DPM 30-Dec-84
; Add WSM's /HELP:ARGUMENTS.
;641 DPM 2-Jan-85
; Make .TNEWL use new TRMOP .TOFLM to force left margin.
;642 DPM 4-Jan-85
; Add support for a new .ISCAN bit (FS.INC) to suppress the CORE UUO
; done at RESTRT. This enable programs to have discontiguous low
; segments preserved across SCAN restarts.
;643 DPM 11-Jan-85
; Change routine .ASCQW to allow a dash as well as alpha-numerics.
; LOGIN requires this if SCAN is going to parse user names.
;644 DPM 14-Jan-85
; Add support for Control-V quoting and 8-bit typeout.
;645 RCB 16-Jan-85
; Generalize the support for Control-V quoting and allowing dashes
; as alphanumerics. Also fixes continuation lines in quoted strings.
;646 RCB 20-Jan-85
; Fix /OPTION to be different from /NOOPTION for /OPTION on
; LOGIN line.
;647 DPM 21-Jan-85
; Add new module .TTYIO for some useful (but optional) enhancements to
; doing terminal I/O.
;650 DPM 21-Jan-85
; Add .TFRFS to type out a FILOP. block's returned filespec for showing
; which file is really read or written.
;651 DPM 24-Jan-85
; Fix problems with Control-V quoting and indirect file/SWITCH.INI
; input.
;652 DPM 29-Jan-85
; Add .T7STR/.T8STR to output 7 or 8-bit ASCIZ strings and .MKPTR to
; make a possibly global byte pointer. Add .AS8QW/.AS8QC to input a
; possibly quoted 8-bit ASCIZ string. Add .SWCHR/.CHRQW/.CHRQC to
; input a single possibly quoted 8-bit character or octal constant.
;653 DPM 7-May-85
; Add more typeout routines from WSM's private SCAN. These include:
; .TOCTJ/.TDECJ/.TRDXJ - Right justified numeric output
; .TOCTZ/.TDECZ/.TRDXZ - Zero padded numeric output
; .TSIXJ/.TSIXS - Left justified sixbit output
; .TSPAN - Type 'n' leading spaces
;654 NT 14-Aug-85
; Change the /RUN processing to avoid high-seg overlapping low-seg
; error. In general, make the routine conform to recommended
; practices for using the RUN UUO, as outlined in the
; Monitor Calls Manual Volume 1. This involves shrinking the
; high and low segs to as small possible, and doing th UUO from
; the ACs.
;655 QAR #868548 DPM 4-Dec-85
; Fix bug in .MKPTR routine which builds byte pointers. Also fix
; up .LASWD when parsing 8-bit ASCIZ strings.
;656 No SPR DPM 28-Jul-86
; Correct byte pointer test in routine .AS8QW to use 8-bit pointer
; instead of 7-bit.
;657 No SPR DPM 28-Jul-86
; Correct routine .TFRFS to type entire path instead of just PPN.
;660 No SPR RCB 2-Dec-86
; Persuant to MCO 13170, allow single-character SIXBIT commands to
; be successfully RESCAN'ed even if not alphanumeric.
;661 No SPR RCB 24-Mar-87
; For user convenience, allow hyphens in the default switch name and
; keyword SIXBIT parse scanners. This adds .SIXKW/.SIXKC to parse
; possibly hyphenated SIXBIT words.
;662 No SPR RCB 24-Mar-87
; Change the KEYS list for standard switch /DENSITY to allow consistency
; with the MOUNT command. This also changes the internal KEYS lists to
; use blank fillers rather than $$, %%, etc.
;663 No SPR RCB 09-Jun-87
; Fix the blank compressor when PSCAN after ISCAN. "CAN M 219" returns
; "M219" to QUEUE's CANCEL processor.
;664 SPR #10-35748 DPM 19-Aug-87
; Fix code at RESTRT to only do CORE UUOs when necessary.
;665 No SPR RCB 26-Aug-87
; Fix 664. Any use of .JBFF to check .JBREL is wrong. The original
; design of SCAN's CORE UUO is to restore .JBREL to its initial value,
; so remember what it was and use a .JBREL value to compare against the
; current .JBREL. Note that most programs will not need the CORE UUO
; at all and should probably be setting FS.INC when calling .ISCAN, but
; that's another story.
; While I'm here, fix .OSCAN to preserve SAVCHR so that the usual
; sequence of .ISCAN/.OSCAN/.VSCAN will work correctly. Before now,
; it would only work with "command ..." (note the space not at EOL).
; Also fix RESCAN not just of command name followed by PSCAN.
; (Broken by 401?)
> ;END OF IF1 FROM FIRST PAGE
PRGEND
TITLE .SCAN -- GENERALIZED USER MODE COMMAND SCANNER
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .ISCAN ;ONLY INITIALIZER SINCE THAT MUST BE CALLED
SUBTTL DEFINITIONS FOR THIS SUB-MODULE
.BCOPY
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1987. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
.ECOPY
;AC NAMES
N=P3 ;NUMBER OR NAME ACCUMULATION PRESERVED ONLY AT TOP LEVEL
C=P4 ;CHARACTER INPUT PRESERVED ONLY AT TOP LEVEL
;WITH THE FOLLOWING ENCODING:
; -2 =EOF
; -1 =EOL
; 0 =ESCAPE OR ALTMODE
; 1-177=ASCII CHARACTER
;THUS, TO TEST FOR END OF COMMAND LINE,
; JUMPLE C,...JUMP ON EOL...
PURGE P3,P4 ;NOT USED IN THIS SUB-MODULE
;I/O CHANNELS
IFN M$INDP,<
IND==0 ;INDIRECT FILE (TEMPORARY; ONLY OPEN WHEN PC IS IN SCAN)
>
;CHARACTERS
C.TE==7777 ;TEMPORARY EOL CODE FOR SAVCHR FLAG [507]
;TEMPORARY DEFS UNTIL DEFINED LATER ON
IF1,< FXNOTO==1,,1
FXNOTI==1,,0
FXNOTD==1,,0>
;M$FAIL (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR
DEFINE M$FAIL ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSG
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$FAIN (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N IN SIXBIT
DEFINE M$FAIN ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGN
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$FAID (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N IN DECIMAL
DEFINE M$FAID ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGD
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$FAIO (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N IN OCTAL
DEFINE M$FAIO ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGO
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$MAIF (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N=ADDR OF FILE DESCRIPTOR
DEFINE M$FAIF ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGF
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
SUBTTL INITIALIZE
;.ISCAN--SUBROUTINE TO INITIALIZE COMMAND SCANNER
;CALL AC1=XWD LENGTH,BLOCK
; BLOCK+0=0 OR IOWD PTR TO A LIST OF LEGAL MONITOR COMMANDS
; IF 0, NO RESCAN IS DONE
; BLOCK+1=RH 0 OR SIXBIT CCL NAME
; IF 0, NO CCL MODE
; LH 0 OR ADDRESS OF STARTING OFFSET
; BLOCK+2=RH 0 OR ADDRESS OF CHARACTER TYPEOUT ROUTINE
; IF 0, OUTCHR WILL BE DONE FROM T1
; LH 0 OR ADDRESS OF CHARACTER INPUT ROUTINE
; MUST SAVE ALL ACS, CHAR IN P4
; BLOCK+3=0 OR POINTER (XWD LEN,BLOCK) TO INDIRECT FILE BLOCK
; A.DEV NE 0 TO USE BLOCK
; BLOCK+4=RH 0 OR ADDRESS OF MONRET ROUTINE
; LH 0 OR ADDRESS OF PROMPT ROUTINE
; CALLED WITH CHAR IN RH(T1), LH(T1) HAS
; 0 FOR FIRST LINE, -1 FOR CONTINUATION LINES
; BLOCK+5=LH FLAGS
; RH (FUTURE)
;VALUE AC1=INDEX IN TABLE OF COMMANDS IF FOUND(0,1,...), ELSE -1
.ISCAN::STORE T4,ZCOR,EZCOR,0 ;CLEAR ALL MEMORY [545]
MOVEM P,SAVPDP ;PRESET PDL MEMORY
SETZM SAVCAL ;CLEAR CALL MEMORY
PUSHJ P,.SAVE4## ;SAVE P1-P4
HLRZ T2,T1 ;GET ARGUMENT COUNT
PUSHJ P,.GTWRD## ;GET BLOCK+0
MOVEM T3,SWTPTR ;STORE POINTER TO COMMAND NAMES
PUSHJ P,.GTWRD## ;GET BLOCK+1
IFN M$INDP,<
HRRZM T3,CCLNAM ;SAVE CCL NAME
TRNE T3,-1 ;IF SETUP, CHECK OFFSET
HLRZ T3,T3 ;GET ADDRESS OF OFFSET
TRNE T3,-1 ;SKIP FETCH IF 0
MOVE P1,(T3) ;GET OFFSET
>
PUSHJ P,.GTWRD## ;GET BLOCK+2
HLRZM T3,TYPIN ;SAVE CHARACTER TYPEIN ROUTINE
HRRZS T3 ;CLEAR TYPEIN NAME
PUSH P,T3 ;SAVE CHARACTER TYPEOUT ROUTINE
PUSHJ P,.GTWRD## ;GET BLOCK+3
IFN M$INDP,<
SKIPN .FXDEV(T3) ;SEE IF DEVICE
MOVEI T3,0 ;NO--CLEAR POINTER
MOVEM T3,USRIND ;SET FLAG OF USER SUPPLIED IND. FILE
JUMPE T3,ISCANI ;PROCEED IF NO FILE
HRLZ T4,T3 ;SETUP BLT
HRRI T4,A.ZER ; FROM USER
HLRZ T3,T3 ; TO A.ZER
CAILE T3,A.EZER-A.ZER+1
MOVEI T3,A.EZER-A.ZER+1
BLT T4,A.ZER-1(T3) ;BUT NOT TOO FAR
>
ISCANI: PUSHJ P,.GTWRD## ;GET BLOCK+4
HLRZM T3,PROMPT ;SAVE USER PROMPT ROUTINE
HRRZM T3,MONRT ;SAVE USER MONRET
PUSHJ P,.GTWRD## ;GET BLOCK+5 [366]
MOVEM T3,INIFLG ;STORE FLAGS [366]
HRREI C,.CHEOL ;PRESET EOL JUST IN CASE
;DELETED [545]
SETOM OPTION ;CLEAR OPTION [353]
GETPPN T1, ;GET OUR PPN
JFCL ;(IN CASE OF JACCT)
MOVEM T1,.MYPPN ;SAVE FOR LATER USE [312]
IFN M$INDP,<
CAIE P1,1 ;SEE IF OFFSET IS ONE
JRST ISCANR ;NO--SKIP ON
AOS FLCCL ;YES--INDICATE CCL (WITH FLAG FOR TMPCOR POSSIBLE)
SETOM FLCCMD ;ALSO INDICATE CCL OR COMMAND
ISCANR: SETOM N.OFFS ;CLEAR RUN OFFSET
SETOM N.CORE ;CLEAR RUN CORE
IFG M$INDP,<
MOVEI T1,M$INDP ;PRESET INDIRECT FILE
SKIPN A.DEV ; COUNT TO CORRECT
CAIN P1,1 ; VALUE IF OFFSET ONE
MOVEM T1,INDCNT ; OR IND. FILE POINTER
>
>
POP P,T1 ;RESTORE NAME OF TYPEOUT ROUTINE
PUSHJ P,.TYOCH## ;INITIALIZE TYPEOUT ROUTINES
SETOM CALCNT ;PRESET CALL COUNTER
PJOB T1, ;GET THIS JOB'S NUMBER
IFN M$INDP,<
PUSHJ P,.MKPJN ;MAKE INTO SIXBIT
HRLM T1,CCLNAM ; STORE JOB NUMBER
>
MOVE T1,.JBREL ;SAVE CURRENT CORE
HRL T1,.JBFF ;ALSO SAVE .JBFF
MOVEM T1,SAVCOR ; FOR LATER TO RESTORE
IFN M$INDP,<
HRROI T1,.GTJLT ;GET LOGIN TIME [564]
GETTAB T1, ; ... [564]
SKIPA ;TRY IT THE HARD WAY [564]
JRST ISCAN8 ;GO SAVE LOGIN TIME [564]
SETZB T1,T3 ;GET "LOGIN"
MOVSI T2,'DSK' ; TIME
OPEN IND,T1 ; ..
JRST ISCAN9 ;CAN'T!
MOVE T1,.MYPPN ;GET
MOVSI T2,'UFD' ; MY
MOVX T4,%LDMFD ; UFD
GETTAB T4, ; (IN
MOVE T4,[1,,1] ; MFD)
LOOKUP IND,T1 ; ..
JRST ISCAN9 ;CAN'T!
LDB T1,[POINTR (T3,RB.CRT)] ;GET CREATION
IMULI T1,^D60000 ; TIME INTO MILLI-SEC.
LSH T2,-3 ;POSITION EXTENDED DATE
ANDI T2,70000 ;REMOVE JUNK
ANDX T3,RB.CRD ;GET MAIN PART OF DATE
IOR T2,T3 ;GET ENTIRE CREATION DATE
PUSHJ P,.CNVDT## ;CONVERT TO INTERNAL FORM
ISCAN8: MOVEM T1,LOGTIM ;SAVE AS "LOGIN" TIME
ISCAN9: SKIPE A.DEV ;SEE IF PRESET INDIRECT
PUSHJ P,INDGT1 ;YES--FINISH SETUP
SKIPN FLCCL ;SKIP IF CCL ENTRY
JRST COMND ;NO, LOOK FOR MONITOR COMMAND
MOVSI T1,'TMP' ;CCL DEVICE IS TMP:
MOVEM T1,A.DEV
PUSHJ P,INDGT1 ;COMPLETE SETUP
PJRST COMND2 ;RETURN INDICATING NOT A COMMAND
;.MKPJN--SUBROUTINE TO MAKE CCL JOB NUMBER
;CALL: MOVE T1,JOB NUMBER
; PUSHJ P,.MKPJN
;RETURNS VALUE IN RH(T1)
;CHANGES T2, T3, T4
.MKPJN::MOVEI T4,3 ;MAKE TEMP FILE NAME
MAKPJ1: IDIVI T1,^D10 ; BY TRIED AND
ADDI T2,'0' ; TRUE CCL
LSHC T2,-6 ; TECHNIQUE
SOJG T4,MAKPJ1 ; ..
HLRZ T1,T3 ;POSITION ANSWER
POPJ P,
>
;HERE ON A NORMAL START
COMND: SKIPN SWTPTR ;SEE IF ANY COMMANDS
JRST COMND2 ;NO--IGNORE RESCAN
RESCAN 1 ;BACK UP TTY INPUT TO SEE IF COMMAND
SKPINC ;SEE IF ANYTHING THERE
JRST COMND2 ;NO--MUST HAVE COME FROM CUSP LEVEL
SETOM P1 ;SET PREFIX COUNTER [304]
PUSHJ P,.TIALT ;[660] GET POSSIBLE SIXBIT LEADIN
JUMPLE C,COMND2 ;[660] SHOULD HAVE BEEN ONE
PUSHJ P,.REEAT ;[660] PUT IT BACK IN CASE NOT SPECIAL
PUSHJ P,.TICAN ;[660] SEE IF SPECIAL
JRST COMNDI ;[660] YES, HANDLE WITH CARE
COMNDG: PUSHJ P,.SIXSW ;GET SIXBIT WORD
JUMPLE C,.+2 ;IF END OF LINE, GIVE UP GRACEFULLY
JUMPE N,COMNDG ;IF NULL, LOOP BACK FOR MORE
JUMPE N,COMND2 ;SKIP TESTS IF NO COMMAND ON LINE
CAIN C,":" ;SEE IF DEVICE [304]
AOJE P1,COMNDG ;IF FIRST ONE, TRY AGAIN [304]
MOVE T1,[IOWD 2,['RUN '
'START '] ]
SKIPGE P1 ;UNLESS DEVICE STARTER, [304]
PUSHJ P,.NAME ;SEE IF R, RUN, OR START
JRST COMNDU ;NO--GO CHECK FOR NAME
COMNDL: JUMPLE C,COMND2 ;IF END OF LINE, GIVE UP
CAIN C,"(" ;SEE IF (...) FORMAT [270]
JRST COMNDR ;YES--GO HANDLE
SKPINC ;SEE IF MORE TO COME
TLOA C,-1 ;NO--SET END OF LINE
PUSHJ P,.TIALT ;YES--GET IT
JRST COMNDL ;LOOP UNTIL DONE
COMNDR: SETOM FLRCMD ;FLAG (...) INSTEAD [270]
HRRZ T1,SWTPTR ;GIVE ERROR RETURN
HRREI C,.CHEOL ;INDICATE START OF LINE [360]
MOVEM C,LASCHR ; IN CASE OSCAN CALLED NEXT [360]
JRST COMNDC ;AND FINISH SETUP OF COMMAND
COMNDI: CAIL C,40 ;[660] RANGE-CHECK
CAILE C,137 ;[660] FOR SIXBIT VALUES
JRST COMNDG ;[660] NOT FOR US AFTER ALL
MOVEI N,-40(C) ;[660] YES, CONVERT TO SIXBIT
LSH N,^D30 ;[660] JUSTIFY
MOVEM N,.NMUL ;[660] SAVE FOR ERRORS
MOVEI T1,.TSIXN## ;[660] ERROR TYPER
MOVEM T1,.LASWD ;[660] SET THAT UP AS WELL
PUSHJ P,.TIALT ;[660] GET OUR CHARACTER AGAIN
PUSHJ P,.TIALT ;[660] GET TERMINATOR
;[660] FALL INTO COMNDU
COMNDU: MOVE T1,SWTPTR ;POINTER TO LIST OF LEGAL SWITCHES
PUSHJ P,.NAME ;SEE IF ON LIST
JRST COMND1 ;NO--SKIP OVER COMMAND
SETOM FLJCNM ;INDICATE NAME [365]
; [365,401]
CAIE C," " ;IF NOT A SPACE,
PUSHJ P,.REEAT ; REEAT CHARACTER
COMNDC: MOVX T2,FS.ICL ;SEE IF NEED TO IGNORE COMMAND [366]
TDNN T2,INIFLG ; LINE MODE FURTHER DOWN [366]
SETOM FLCCMD ;FLAG AS SUCH AND REEAT SEPARATOR
SKIPG C ;SEE IF END OF LINE
SETZM SCANPC ;YES--CLEAR SCANNER SINCE C.TE WILL
; BE PICKED UP AGAIN
HRRZ T2,SWTPTR ;ADDR OF LIST -1
HRRZI T1,-1(T1) ;1=ADDRESS-1 OF COMMAND
SUB T1,T2 ;1=INDEX INTO TABLE
POPJ P, ;END INITIALIZATION (.ISCAN)
COMNDS: SKPINC ;SEE IF ANYTHING STILL THERE
TLOA C,-1 ;NO--SET END-OF-LINE
PUSHJ P,.TIALT ;GET NEXT CHARACTER
COMND1: JUMPG C,COMNDS ;LOOP FOR END OF LINE
COMND2: SETO T1,
MOVEM C,LASCHR ;SAVE FOR REUSE LATER
POPJ P, ;END OF .ISCAN
SUBTTL TRADITIONAL COMMAND SCANNER
;.TSCAN--SUBROUTINE FOR TRADITIONAL COMMAND SCANNER
;ARGS AC1=XWD LENGTH,BLOCK
; BLOCK+0=0 OR IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
; BLOCK+4=LH 0 OR SUBROUTINE TO CLEAR ALL ANSWERS
; RH 0 OR SUBROUTINE TO CLEAR FILE ANSWERS
; BLOCK+5=LH SUBROUTINE TO ALLOCATE INPUT FILE AREA
; RH SUBROUTINE TO ALLOCATE OUTPUT FILE AREA
; BOTH RETURN T1=START OF AREA, T2=LENGTH
; BLOCK+6=LH 0 OR SUBROUTINE TO MEMORIZE STICKY DEFAULTS
; RH 0 OR SUBROUTINE TO APPLY STICKY DEFAULTS
; BLOCK+7=LH 0 OR SUBROUTINE TO CLEAR STICKY DEFAULTS
; RH FLAGS TO CONTROL SCAN:
; 1B18=MORE THAN ONE OUTPUT SPEC POSSIBLE
; 1B19=ALLOW INPUT SWITCHES ON OUTPUT AND VV
; BLOCK+10=LH (FUTURE)
; RH 0 OR ROUTINE TO STORE SWITCH VALUES
; ;ENTERRED WITH T1=VALUE, T2=POINTER
; ;NON-SKIPS IF SCAN SHOULD NOT STORE
; ;SKIPS IF SCAN SHOULD STORE (T1-2 OK)
.TSCAN::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
MOVE T2,(P) ;PRESERVE CALLING
MOVEM T2,SAVCAL ; LOCATION
MOVE T2,.JBREL ;GET SIZE OF CORE
HRL T2,.JBFF ; AND CURRENT USAGE
MOVEM T2,SAVCOR ; AND SAVE IT
PUSHJ P,.SAVE4## ;SAVE P1-P4
MOVE C,LASCHR ;RESTORE LAST CHARACTER
MOVEM P,SAVPDP ;SAVE PUSH DOWN LIST POINTER
PUSHJ P,SETPR4 ;SET STANDARD PARAMETERS
PUSHJ P,.GTWRD## ;GET BLOCK+4
HLRZM T3,CLRANS ;SUBROUTINE TO CLEAR ANSWER AREA
HRRZM T3,CLRFIL ;SUBROUTINE TO CLEAR FILE AREA
PUSHJ P,.GTWRD## ;GET BLOCK+5
TLNE T3,-1 ;(REQUIRED)
TRNN T3,-1 ;(REQUIRED)
HALT . ;PROTECTION
HLRZM T3,ALLIN ;SUBROUTINE TO ALLOCATE INPUT AREA
HRRZM T3,ALLOUT ;SUBROUTINE TO ALLOCATE OUTPUT AREA
PUSHJ P,.GTWRD## ;GET BLOCK+6
HLRZM T3,MEMSTK ;SUBROUTINE TO MEMORIZE STICKY DEFAULTS
HRRZM T3,APPSTK ;SUBROUTINE TO APPLY STICKY DEFAULTS
PUSHJ P,.GTWRD## ;GET BLOCK+7
HLRZM T3,CLRSTK ;SUBROUTINE TO CLEAR STICKY DEFAULTS
HRRZM T3,USRFLG ;STORE AWAY USER'S PARAMETER FLAGS
PUSHJ P,.GTWRD## ;GET BLOCK+10
HRRZM T3,STRSWT ;ADDRESS OF ROUTINE TO STORE RESULTS
HRRZM P,FLVERB ;SET FLVERB .GT. 0
AOSE CALCNT ;COUNT CALL
JRST RESTRT ;IF NOT FIRST, DO A RESTART
SKIPE FLCCMD ;SKIP IF NEITHER CCL OR COMMAND
SKIPE PREMPT ;ALWAYS PROMPT PREEMPTIVE INPUT [572]
JRST RESTRT ;GO DO THE PROMPTING [572]
JRST RESTRL ;THEY REQUIRE NO *
RESTRT:
IFN DEBUG$,<
CAME P,SAVPDP
JRST E$$PDL ;FAIL IF PDL PHASE ERROR
>
MOVE T1,SAVCOR ;RESTORE CORE
HLRM T1,.JBFF ;RESTORE FIRST FREE
MOVX T1,FS.INC ;BIT TO TEST
TDNE T1,INIFLG ;CALLER WANT US TO DO A CORE UUO?
JRST RESTR1 ;NO
HRRZ T1,SAVCOR ;GET FIRST FREE
CAME T1,.JBREL ; TO ITS INITIAL
CORE T1, ; SETTING IF IT
JFCL ; WAS CHANGED
RESTR1: SKIPE PREMPT ;IGNORE INDIRECT IF PREEMPTING [572]
JRST RESTRP ;SINCE WE WANT TO READ THE TTY [572]
IFN M$INDP,<
SKIPE A.DEV ;SEE IF INDIRECT
JRST RESTRC ;YES--SKIP END TEST
SKIPE N.DEV ;SEE IF /RUN
JRST RESTRL ;YES--PROCEED
>
SKIPE FLCCMD ;SEE IF IN TRADITIONAL MODE
PUSHJ P,.MONRT ;NO--RETURN TO MONITOR
RESTRC: CAMN C,[.CHEOF] ;SEE IF END OF FILE [504]
JRST [PUSHJ P,.ALDON ;YES--HANDLE EOF [504]
JUMPG C,RESTRL ;CONTINUE IF NOT DONE YET [535]
JRST RESTRT] ;RETURN TO MAIN LINE [504]
RESTRP: SKIPG C ;IF END OF LINE, [540,572]
HRREI C,.CHEOL ; SET REAL END OF LINE [540]
HRRZI T1,"*" ;SET PROMPT CHARACTER
PUSHJ P,DOPRMP ;GO DO IT
SUBTTL MAIN LOOP FOR TRADITIONAL COMMAND SCANNING
;HERE TO START ONE PASS THROUGH THE CUSP (ONE COMMAND LINE)
RESTRL: PUSHJ P,.CCLRB ;CONDITIONALLY CLEAR TYPEAHEAD [524]
SETOM FLOUT ;FLAG THAT NOT TO = YET
SETZM FLSOME ;NOTE SOMETHING FOUND
SETZM .FLVRB## ;RESET /MESSAGE [300]
SKIPE CLRANS ;SEE IF USER WANTS CONTROL
PUSHJ P,@CLRANS ;YES--CLEAR ANSWERS
SKIPE PREMPT ;IGNORE /RUN IF PREEMPT [572]
JRST RESTRI ;SINCE WE REALLY WANT INPUT [572]
IFN M$INDP,<
PUSHJ P,.RUNCM ;HANDLE /RUN IN NEEDED [264]
JUMPN T1,RESTRT ;IF DID SOMETHING, START OVER [506]
>
RESTRI: PUSHJ P,INILIN ;INITIALIZE LINE [572]
;HERE TO SCAN ONE SIDE OF COMMAND LINE
RESTRS: PUSHJ P,INILIM ;INITIALIZE AT START OF LINE
PUSHJ P,CLERST ;CLEAR STICKY DEFAULTS [534]
;HERE TO SCAN ONE FILE SPECIFICATION
RESTRF: PUSHJ P,.FILIN ;GET NEXT FILE SPECIFICATION
MOVEI P2,0 ;CLEAR FLAG [522]
IFN M$INDP,<
CAIE C,"@" ;SEE IF INDIRECT REQUESTED [514][605]
JRST RSTRF1 ;NO, CONTINUE [605]
JUMPL T1,RSTRF1 ;SYNTAX ERRORS CAUGHT BELOW [605]
MOVX T2,FS.IFI ;FS.IFI MEANS @ ILLEGAL [605]
TDNE T2,INIFLG ;IS IT ILLEGAL? [605]
JRST E$$IFI ;YES, TELL USER [605]
JRST INDFIL ;NO, GO HANDLE IT [514][605]
RSTRF1:
>
MOVE P1,T1 ;APPSTK CLOBBERS T1 [275]
SKIPE APPSTK ;SEE IF APPLY STICKY [271]
PUSHJ P,@APPSTK ; REQUESTED BY CALLER [271]
JUMPLE C,INFILX ;IF END OF LINE OR
SETOM FLSOME ;NOTE SOMETHING FOUND
LDB T1,[POINTR (F.MOD,FX.TRM)] ;GET TERMINATOR [247,510]
JUMPN T1,INFIL ;MUST BE INPUT [247,510]
MOVSI T2,-BREAKL ;SET LENGTH OF BREAK TABLE [522]
HLRZ T3,BREAKT(T2) ;GET NEXT BREAK [522]
TRZ T3,(1B0) ;CLEAR FLAG [522]
CAIE T3,(C) ;SEE IF MATCH [522]
AOBJN T2,.-3 ;NO--LOOP [522]
MOVE P2,BREAKT(T2) ;GET DISPATCH [522]
JRST (P2) ;GO HANDLE IT [522]
;TABLE OF BREAK,,ADDRESS
DEFINE ZZ(A,B,C),<
BYTE (1) C (17) A (18) B
>
BREAKT: ZZ 054,INOFIL, ;","
ZZ "=",OUTFIL,1
IFN FT$UEQ,<ZZ "_",OUTFIL,1>
ZZ .CHFRM,OUTFIL,1
ZZ .CHSRC,OUTFIL,1
ZZ .CHINP,OUTFIL,1
BREAKL==.-BREAKT
0,,E.ILSC ;FOR ERROR
;HERE TO SEE IF INPUT OR OUTPUT FILE JUST FOUND
INOFIL: MOVX T1,FS.MOT ;SEE IF MULTIPLE OUTPUT POSSIBLE
TDNE T1,USRFLG ;TEST USER'S FLAGS
SKIPL FLOUT ;YES--SEE IF = SEEN YET
JRST INFIL ;GO DO INPUT FILE
JRST OUFIL ;GO DO OUTPUT FILE
;HERE WHEN A SPECIFICATION FOR OUTPUT SIDE IS FOUND
OUTFIL: AOSE FLOUT ;SET/TEST IF ALREADY PAST THIS POINT
JRST E$$DEQ ;[577] YES--DOUBLE EQUAL SIGN IS ILLEGAL
OUFIL: MOVX T1,FS.MIO ;SEE IF [302]
TDNE T1,USRFLG ; LEGAL FOR SWITCHES [302]
JRST OUFIL1 ; TO BE ON WRONG SIDE [302]
MOVE T1,F.MODM ;GET FILE MODIFIERS
TXNE T1,FXNOTO ;CHECK ILLEGAL ONES
JRST E.FMO ;ERROR IF WRONG ONES
SKIPG F.ABF ;SEE IF /ABEFORE [346]
SKIPLE F.ASN ; OR IF /ASINCE [346]
JRST E.FMO ;YES--ERROR [346]
SKIPG F.FLI ;SEE IF MIN LENGTH [346]
SKIPLE F.FLM ; OR IF MAX LENGTH [346]
JRST E.FMO ;YES--ERROR [346]
SKIPG F.BFR ;SEE IF /BEFORE
SKIPLE F.SNC ;OR /SINCE
JRST E.FMO ;YES--ERROR
OUFIL1: PUSHJ P,@ALLOUT ;ALLOCATE SOME OUTPUT SPACE
JRST INFIL2 ;GO COPY SPEC AND LOOP
;HERE WHEN A SPECIFICATION FOR INPUT SIDE FOUND
INFILX: JUMPE P1,INFIL3 ;IF NOTHING, SKIP ON [275]
MOVE T1,USRFLG ;GET CALLER'S FLAGS [533,550]
TXNN T1,FS.MIO ;IF MIXED IN/OUT SPECS, [533,550]
TXNN T1,FS.MOT ; OR IF SINGLE OUTPUT [533,550]
JRST INFILY ;YES--OK TO HAVE INPUTS [533,550]
SKIPGE FLOUT ;NO--SEE IF = YET [533,550]
JRST E$$ESM ;NO =--ERROR [533,550]
INFILY: SETOM FLSOME ;OTHERWISE FLAG SOMETHING
INFIL: AOS FLOUT ;FORCE ANY OUTPUT SPEC ILLEGAL
MOVX T1,FS.MIO ;SEE IF LEGAL FOR SWITCHES ON WRONG SIDE [302]
TDNE T1,USRFLG ;SEE IF MIXUP OK [302]
JRST INFIL1 ;OK--JUST GO AHEAD [346]
MOVE T1,F.MODM ;GET FILE MODIFIERS
TXNE T1,FXNOTI ;CHECK ILLEGAL ONES
JRST E.FMI ;ERROR IF WRONG ONES
SETCM T1,F.VER ;SEE IF /VERSION [346]
SKIPN T1 ; SKIP IF SET [346]
SKIPL F.EST ;SEE IF /ESTIMATE [346]
JRST E.FMI ;YES--ERROR ON INPUT [346]
INFIL1: PUSHJ P,@ALLIN ;ALLOCATE SOME INPUT SPACE
INFIL2: PUSHJ P,.GTSPC ;AND COPY RESULTS TO IT
;HERE AFTER HANDLING ANY FILE SPEC
INFIL3: JUMPL P2,INDFI1 ;GO SET SAFE CHARACTER [515]
JUMPG C,RESTRF ;IF NOT END, LOOP BACK FOR MORE
SKIPLE FLFLLP ;SEE IF HAD ( BUT NO ) [543]
JRST E.UOP ;YES, ERROR [543]
SKIPE FLSOME ;SEE IF ANYTHING YET
POPJ P, ;YES--RETURN TO USER
;HERE WHEN NO ARGUMENTS TYPED, DO APPROPRIATE THING
IFN M$INDP,<
SKIPE A.DEV ;SEE IF INDIRECT
JRST RESTRT ;YES--JUST LOOP BACK
>
SKIPE PREMPT ;SEE IF PREEMPTIVE INPUT [572]
JRST RESTRT ;YES--IGNORE COMMAND MODE [572]
SKIPE FLCCMD ;SEE IF COMMAND MODE
POPJ P, ;YES--RETURN TO USER
JRST RESTRT ;IF ALL ELSE FAILS, TRY AGAIN
;HERE WHEN INDIRECT FILE SPECIFIER COMING
IFN M$INDP,<
INDFIL: PUSHJ P,.GTIND ;SET UP NAME OF INDIRECT FILE
SETZM SCANPC ;CLEAR COMPRESSOR (NEW FILE)
>
INDFI1: MOVEI C,"," ;SET TO SAFE CHARACTER [515]
JRST RESTRS ;AND GO BACK THROUGH THE LOOP
SUBTTL VERB FORM COMMAND SCANNER
;.VSCAN --SUBROUTINE FOR VERB ARGS FORM OF COMMAND SCANNER
; RETURNS CPOPJ IF EOF DURING COMMAND OR CCL AT TOP LEVEL
;ARGS AC1=XWD LENGTH,BLOCK
; BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
; BLOCK+4=LH LENGTH OF FXXX AND PXXX AREAS
; RH START OF FXXX (PER FILE SWITCHES)
; BLOCK+5=LH (FUTURE)
; RH START OF PXXX (STICKY FORM OF FXXX)
; BLOCK+6=NAME OF OPTION LINES (0 IF THIS PROGRAM'S NAME)
.VSCAN::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
MOVEM P,SAVPDP ;SAVE PUSH DOWN LIST POINTER
SETOM FLVERB ;NOTE VERB FORM [556]
PUSHJ P,SETPR4 ;SET STANDARD PARAMETERS
PUSHJ P,.GTWRD## ;GET BLOCK+4
MOVE P1,T3 ;SAVE POINTER TO FXXX
PUSHJ P,.GTWRD## ;GET BLOCK+5
TLZ T3,-1 ;GET START OF PXXX
SUBI T3,(P1) ;GET OFFSET TO PXXX FROM FXXX
MOVEM T3,SWTPFO ;STORE FOR LATER
HRRZM P1,SWTPFF ;STORE START OF FXXX
HLRZ T3,P1 ;GET LENGTH OF FXXX
ADDI T3,(P1) ;GET END [357]
MOVEM T3,SWTPFL ;SAVE END FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+6
IFN M$INDP,<
MOVEM T3,VOPTN ;SAVE AS OPTION FILE LINE NAME
>
MOVE C,SAVCHR ;RESTORE RESCANNED CHARACTER
CAIE C,C.TE ;[665] UNLESS THIS IS THE FUNNY ALTMODE,
JUMPGE C,VRSTRT ;[665] SKIP THIS UNLESS HAD A SAVED EOL
SETZM FLCCMD ;[665] PUNT COMMAND MODE IF "COMMAND<CR>"
SETZM SAVCHR ;[665] DITTO
CAIN C,C.TE ;[665] WHAT WAS THIS?
MOVX C,.CHALX ;[665] FIX THE FUNNY ALTMODE
VRSTRT: PUSHJ P,.CCLRB ;CONDITIONAL CLEAR BUFFER
IFN DEBUG$,<
CAME P,SAVPDP
JRST E$$PDL
>
PUSHJ P,INILIN ;INITILIZE LINE
CAMG C,[.CHEOF] ;SKIP IF NOT AT EOF
PUSHJ P,.ALDON ;AT END--GO DO EOF PROCESSING
CAMG C,[.CHEOF] ;SKIP IF NOT STILL AT EOF
POPJ P, ;GO HANDLE FINAL END [313]
HRRZI T1,"/" ;SET PROMPT CHARACTER
SKIPN PREMPT ;ALWAYS TYPE IT IF PREEMPT [572]
SKIPN FLCCMD ;UNLESS COMMAND MODE, [360]
PUSHJ P,DOPRMP ;GO DO IT
HRREI C,.CHEOL ;CLEAR ALT FLAG
VRSTRL: PUSHJ P,.KEYWD ;PROCESS THE VERB
JRST VRSTNL ;GO HANDLE NO VERB YET
MOVE C,LASCHR ;RESTORE CHARACTER JUST IN CASE
;HERE AT END OF COMMAND
PJUMPG C,E.INCL ;IF NOT EOL, ISSUE ERROR MESSAGE
IFN M$INDP,<
PUSHJ P,.RUNCM ;HANDLE /RUN IF NEEDED [264]
AOSE OPTION ;SEE IF /OPTION
SOSN OPTION ;YES--CORRECT FOR AOS
JRST VRSTRT ;NO--LOOP
MOVE T3,VOPTN ;GET OPTION NAME
PUSHJ P,.OSCAN ;ENTER MIDDLE OF OSCAN [370]
>
JRST VRSTRT ;LOOP
;HERE BEFORE VERB SEEN
VRSTNL: CAIN C,"/" ;SEE IF /
JRST VRSTRL ;YES--LET USER PRECEDE VERBS THIS WAY
IFN M$INDP,<
CAIE C,"@" ;SEE IF INDIRECT FILE [605]
JRST VRSTN1 ;NO, CONTINUE [605]
MOVX T2,FS.IFI ;FS.IFI MEANS @ ILLEGAL [605]
TDNE T2,INIFLG ;IS IT ILLEGAL? [605]
JRST E$$IFI ;YES, TELL USER [605]
PUSHJ P,.GTIND ;YES--GET SPECIFICATION
VRSTN1:
>
JUMPLE C,VRSTRT ;LOOP IF NULL LINE
PJRST E.ILSC ;ELSE, GO TO ERROR MESSAGE
SUBTTL OPTION FILE SCANNER
;.OSCAN -- SUBROUTINE TO SCAN OPTIONS FILE (DSK:SWITCH.INI[,])
; RETURNS CPOPJ AFTER UPDATING GLOBAL SWITCHES FROM FILE
; THIS ROUTINE SHOULD BE CALLED AFTER TSCAN OR PSCAN
; BUT BEFORE DEFAULTING.
; CALL THIS ONLY AT END OF LINE.
; IT SHOULD BE CALLED BETWEEN ISCAN AND VSCAN FOR VERBS.
;ARGS: AC1=XWD LENGTH,BLOCK
; BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
; BLOCK+4=NAME OF OPTIONS TO SELECT IN FILE (0 IF NAME OF PROGRAM)
; OR LENGTH,,LIST OF OPTION NAMES
;IF CALL FROM VSCAN, C(T3)= SAME AS BLOCK+4 ABOVE
IFN M$INDP,<
.OSCAN::PUSHJ P,.SAVE4## ;SAVE P1-4
PUSH P,PREMPT ;SAVE PREEMPTIVE INPUT ROUTINE [572]
SETZM PREMPT ;SINCE WE DON'T WANT TTY: [572]
PUSH P,SCANPC ;SAVE STATE OF [515]
PUSH P,SCANCH ; COMPRESSOR [515]
PUSH P,SAVCHR
SETZM SCANPC ;CLEAR [515]
SETZM SCANCH ; COMPRESSOR [515]
SETZM SAVCHR
PUSH P,LASCHR ;SAVE ORIGINAL LAST-CHAR
HRRZM P,LASCHR ;FAKE OUT QSCAN
PUSH P,SAVCAL ;PRESERVE STACK [366]
PUSH P,SAVPDP ; AND CALL POINT [366]
MOVEI T2,OPTNSX ;SET TO [366]
MOVEM T2,SAVCAL ; RE-ENTER HERE [366]
MOVE T2,P ;COPY PDL POINTER [366]
PUSH T2,T2 ;INCREMENT STACK ONCE [366]
MOVEM T2,SAVPDP ; WITH A GOOD PDL [366]
SKIPGE FLVERB ;[633] SEE IF VSCAN CALL
JRST OSCANV ;YES--SKIP RE-INITIALIZE [370]
MOVE P1,OPTION ;SAVE /OPTION TO FAKE QSCAN
MOVE P2,N.DEV ;SAVE /RUN TO FAKE QSCAN
SETZM N.DEV ; ..
PUSHJ P,.QSCAN ;SETUP FOR QSCAN [335]
JRST OPTNSX ;HERE ONLY IF ERROR IN FILE
MOVEM P1,OPTION ;RESTORE OPTION
MOVEM P2,N.DEV ;RESTORE /RUN TO PREVENT ERRORS
PUSHJ P,.GTWRD## ;GET BLOCK+4
;STILL UNDER M$INDP
OSCANV: JUMPN T3,OSCAN1 ;OK IF NAME
HRROI T3,.GTPRG ;ELSE, GET
GETTAB T3, ; PROGRAM NAME
JRST OPTNSY ;GIVE UP IF WE CAN'T
TLNN T3,(77B5) ;PROTECT AGAINST JUNK NAME [344]
JRST OPTNSY ;RIGHT--IGNORE OPTION FILE [344]
OSCAN1: SKIPE A.DEV ;SEE IF IND FILE OPEN
JRST OPTNSY ;YES--GIVE UP UNTIL IND FILES NEST
MOVEM T3,OPTNAM ;SET OPTION NAME
SKIPGE FLVERB ;UNLESS VERB MODE, [561]
PUSHJ P,CLERST ; CLEAR STICKY STUFF [561]
MOVE T1,[OPTSPC,,F.ZER]
BLT T1,F.DIRM ;COPY PRESET SPEC
SETZM F.DIR+2 ;CLEAR DIRECTORY
MOVE T1,[F.DIR+2,,F.DIR+3]
BLT T1,F.EZER ; AND REST OF SPEC
SETOM F.MZER ;CLEAR SWITCHES [346]
MOVE T1,[F.MZER,,F.MZER+1]
BLT T1,F.EMZR
PUSHJ P,GTINDF ;SET INDIRECT FILE SPEC
PUSHJ P,.CLRFL ;CLEAR OUT FILE SPEC AREA [513]
SKIPN OPTION ;SEE IF /NOOPTION
JRST OPTNSW ;YES--RETURN IMMEDIATELY
;STILL UNDER M$INDP
AOSE OPTION ;IF OPTION IS -1,
SOS OPTION ; MAKE IT 0
SOSE OPTION ;[646] IF OPTION IS 1,
AOS OPTION ;[646] MAKE IT 0
MOVEI P1,0 ;CLEAR FLAG OF MATCHES [345]
;HERE TO LOOP OVER LINES IN FILE LOOKING FOR OUR SET OF OPTIONS
OPTNSF: AOJL C,OPTNSW ;SEE IF END OF FILE
SETOB C,LASCHR ;CLEAR CHARACTER
SETZM SCANPC ;INDICATE START OF LINE
PUSHJ P,.SIXKW ;GET SIXBIT WORD
MOVE T1,OPTNAM ;GET OPTION NAME NEEDED [344]
TLNE T1,(77B5) ;SEE IF LIST [344]
JRST [CAME T1,N ;NO--SEE IF MATCH [344]
JRST OPTNSD ;WRONG--IGNORE LINE [344]
JRST OPTNSG] ;MATCH--GO DO IT [344]
TLC T1,-1 ;LIST--CHANGE TO AOBJN [344]
AOBJN T1,.+1 ;FIX FOR 2-COMPL [344]
CAME N,-1(T1) ;SEE IF MATCH [344]
AOBJN T1,.-1 ;ADVANCE LOOP [344]
JUMPGE T1,OPTNSD ;IF NO MATCH, FAIL [344]
OPTNSG: SKIPN OPTION ;SEE IF /OPTION
CAIN C,":" ;NO--SEE IF SPECIAL OPTION LINE
JRST .+2 ;NO--CHECK FOR USER WANTING SPECIAL
JRST OPTNSL ;NOT /OPTION AND NO COLON--OK
SKIPE OPTION ;SEE IF /OPTION
CAIE C,":" ;YES--SEE IF COLON IN FILE
JRST OPTNSD ;NO--GIVE UP ON THIS LINE
PUSHJ P,.SIXKW ;YES--GET OPTION NAME IN FILE
CAMN N,OPTION ;SEE IF IT MATCHES REQUEST
JRST OPTNSL ;YES--GO DO THIS ONE
;HERE TO LOOP OVER LINE DISCARDING IT
OPTNSD: JUMPLE C,OPTNSF ;BACK TO MAIN LOOP AT END OF LINE
PUSHJ P,.TICHR ;GET ONE CHARACTER
JRST OPTNSD ;LOOP
;HERE TO LOOP OVER SWITCHES IN LINE
OPTNSL: SETOM P1 ;INDICATE FOUND A LINE [345]
JUMPLE C,OPTNSF ;GO AGAIN IF DONE [345]
CAIE C,"/" ;LOOK FOR SLASH
CAIN C,"," ;OR COMMA
MOVEI C," " ;YES--OK
CAIE C," " ;SEE IF OK CHAR OR SPACE
JRST E.ILSC ;NO--IMPROPER CHARACTER
PUSHJ P,.KEYWD ;GET NEXT SWITCH
JRST OPTNSL ;SKIP EXTRA SEPARATORS
MOVE C,LASCHR ;RESTORE CHARACTER
JRST OPTNSL ;LOOP UNTIL DONE
;HERE WHEN OPTION NOT FOUND OR NO FILE
OPTNSW: JUMPN P1,OPTNSX ;EXIT IF FOUND AT LEAST ONE LINE [345]
MOVE N,OPTION ;SEE IF OPTION SPECIFIED
SKIPL FLVERB ;[633] IF ORIGINALLY VERB, ERROR
JUMPE N,OPTNSX ;ELSE, IF NAME THEN ERROR
E$$NON: MOVE T1,['NON',,[ASCIZ /No option /] ]
PUSHJ P,.TERRP ;GIVE USER WARNING
TXNN T1,JWW.FL ;SEE IF /MESSAGE:NOFIRST
JRST OPTNSU ;YES--KILL REST
MOVE T1,N ;POSITION OPTION
PUSHJ P,.TSIXN## ;TYPE IT
OPTNSU: PUSHJ P,.TCRLF## ;TYPE END OF LINE
;HERE WHEN DONE WITH OPTIONS FILE
OPTNSX: PUSHJ P,FILSTK ;MEMORIZE STICKY DEFAULTS [555]
PUSHJ P,.KLIND ;KILL INDIRECT FILE
OPTNSY: POP P,SAVPDP ;RESTORE ORIGINAL ERROR PDL [366]
POP P,SAVCAL ; AND ORIGINAL ERROR RETURN POINT [366]
POP P,LASCHR ;RESTORE LAST CHAR FOR REGULAR FILES
POP P,SAVCHR ;RESTORE RESCANNED DELIMITER FOR VSCAN
POP P,SCANCH ;RESTORE STATE OF [515]
POP P,SCANPC ; COMPRESSOR [515]
POP P,PREMPT ;RESTORE USER'S PREEMPT ROUTINE [572]
SETZM OPTNAM ;CLEAR OPTIONS MODE
POPJ P, ;RETURN TO CALLER
;FILE SPEC FOR DSK:SWITCH.INI[,]/PHYSICAL/OKNONE
OPTSPC: 'DSK '
'SWITCH'
-1
'INI',,-1
<FX.DIR!FX.NOM!FX.PHY>
<FX.DIR!FX.NOM!FX.PHY>
0
-1
> ;END M$INDP
SUBTTL PARTIAL SCANNER
;.PSCAN --SUBROUTINE TO INITIALIZE PARTIAL MODE SCANNER
;.QSCAN -- DITTO BUT ONLY INITIALIZA THIS LINE
; RETURNS CPOPJ AFTER INITIALIZING. IN CASE OF ANY
; FATAL ERRORS (.FMSGE/X), WILL RESTORE CONTROL AND PDP
; AT RETURN FROM THIS PSCAN CALL.
; THIS SHOULD BE CALLED BEFORE EACH PROMPT OR LINE
; OF INPUT.
; SKIP RETURNS IF NO PROMPT NEEDED
;ARGS AC1=XWD LENGTH,BLOCK
; BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
.PSCAN::SETZM .FLVRB## ;CLEAR /MESSAGE [327]
SETZM FLVERB ;INDICATE .PSCAN [364]
MOVE T2,(P) ;GET RETURN POINT [364]
MOVEM T2,SAVCAL ;SAVE FOR ERROR [364]
MOVEM P,SAVPDP ;SAVE PUSH-DOWN POINTER [364]
MOVE T2,SAVCHR ;GET SAVED CHARACTER [401]
CAIE T2,C.TE ;[665] IF SPECIAL EOL,
JUMPGE T2,PSCAN2 ;[665] OR OTHER EOL
SKIPGE FLJCNM ; AND JUST COMMAND LINE [401]
SETZM SAVCHR ; THEN CLEAR RE-EAT OF EOL [401]
JRST PSCAN1 ;[665] AND DON'T ADVANCE THE COUNTER
PSCAN2: MOVMS FLJCNM ;[665] NOT EOL--MAKE SURE WE EXIT AFTER ONE LINE
PSCAN1: SKIPLE FLJCNM ;IF SECOND TIME TO PSCAN, [365]
SETZM FLJCNM ; CLEAR MULTI-LINE OK FLAG [365]
MOVMS FLJCNM ;YES--INDICATE PSCAN RESCAN JUST NAME [365]
; THIS ALLOWS MORE LINES FOR COMMAND [365]
;FALL INTO QSCAN
;FALL HERE FROM ABOVE
.QSCAN::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
;***DELETED HANDLING OF /RUN [264]
MOVEI T2,0 ;CLEAR FLAG [313]
MOVE C,LASCHR ;GET LAST CHARACTER [313]
SKIPL FLRCMD ;IF .RUN, OR [563]
CAMN C,[.CHEOF] ;SEE IF END OF FILE [313]
MOVEI T2,1 ;YES--FLAG NO PROMPT [313]
SKIPN A.DEV ;SEE IF INDIRECT
SKIPLE C ;OR IN MIDDLE OF LINE
MOVEI T2,1 ;YES--FLAG NO PROMPT [313]
ADDM T2,(P) ;UPDATE RETURN IF NEEDED [313]
SKIPG C ;SEE IF AT EOL
SETZM SAVCHR ;YES--CLEAR COMMAND MEMORY
HRRE T2,SCANCH ;GET SAVED CHARACTER [266]
; [602] DELETED UNECESSARY HALT
SKIPLE T2 ;IF USEFUL, [266]
MOVEM T2,SAVCHR ; SAVE IT [266]
CAME C,[.CHEOF] ;UNLESS AT END OF FILE, [313]
SETOB C,LASCHR ; PRESET TO NEW LINE
;FALL INTO SETPR4
;FALL HERE FROM ABOVE
;SETPR4 -- SUBROUTINE TO STORE STANDARD PARAMETERS FROM GLOBAL CALLS
; HANDLES ARGUMENT BLOCK THROUGH BLOCK+3
;CALL: MOVE T1,[LENGTH,,BLOCK]
; PUSHJ P,SETPR4
;USES T1-4
SETPR4: JUMPE T1,INILIN ;IF NO POINTER, DON'T CHANGE [370]
HLRZ T2,T1 ;SETUP COUNTER FOR .GTWRD
PUSHJ P,.GTWRD## ;GET BLOCK+0
MOVEM T3,SWTPTR ;SAVE POINTER FOR SCANNING
ADDI T3,1 ;ADVANCE TO TABLE POINTER
HRLI T3,P1 ;INCLUDE INDEX POINTER
MOVEM T3,SWTCHN ;SET ADDRESS FOR MESSAGES
PUSHJ P,.GTWRD## ;GET BLOCK+1
HLRZ T4,T3 ;GET DEFAULT TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,P1 ;INCLUDE INDEX
MOVEM T4,SWTCHD ;STORE FOR LATER
HRRZ T4,T3 ;GET MAX,PROCESSOR TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,P1 ;INCLUDE INDEX
MOVEM T4,SWTCHM ;STORE FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+2
HRRZ T4,T3 ;GET STORAGE POINTER TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,P1 ;INCLUDE INDEX
MOVEM T4,SWTCHP ;STORE FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+3
CAME T3,[-1] ;SEE IF DEFAULT NAME
JRST STRPRH ;NO--GO STORE AWAY
HRROI T3,.GTPRG ;YES--GET CURRENT
GETTAB T3, ; PROGRAM'S NAME
MOVEI T3,0 ;CLEAR IF NOT AVAILABLE
STRPRH: MOVEM T3,SWTHLP ;STORE HELP POINTERS
;FALL INTO INILIN
;FALL HERE
;INILIN/INILIM -- ROUTINES TO INITIALIZE START OF LINE
;USE T3
INILIN: SKIPG LASCHR ;SEE IF AT START
SETZM SCANPC ;YES--CLEAR BLANK COMPRESSOR
SETZM FLFLLP ;CLEAR L.PAREN COUNT [534]
IFN M$INDP,<
SETOM OPTION ;CLEAR /OPTION
>
INILIM: PUSHJ P,.PSH4T## ;SAVE SOME AC'S [534]
SKIPL FLVERB ;SEE IF VERB MODE [357]
PUSHJ P,CLERST ;NO--CLEAR STICKY DEFAULTS [534]
SKIPGE FLVERB ; OR [551]
PUSHJ P,.CLSNS ;YES--CLEAR STICKY DEVICE, ETC. [551]
SETZM SWTCNT ;CLEAR RECURSION COUNTER
SETZM .LASWD ;CLEAR LAST WORD TYPE [314]
PUSHJ P,.POP4T## ;RESTORE TEMPS [534]
POPJ P, ;RETURN
SUBTTL INDIRECT FILE SETUP AND FINISH
;.ALDON -- SUBROUTINE TO HANDLE EOF WHEN READING COMMANDS
;IF INDIRECT MODE, IT CLEARS IND AND EOF AND RETURNS
;ELSE, IT GOES TO MONITOR AND RETURNS ON A CONTINUE
.ALDON::HRREI C,.CHEOL ;CLEAR EOF
MOVEM C,LASCHR ;UPDATE LAST CHARACTER [313]
IFN M$INDP,<
SKIPN USRIND ;SEE IF USER SUPLIED INDIRECT
SKIPN A.DEV ;IF INDIRECT, GO BACK TO NORMAL MODE
PJRST .MONRT ;NO INDIRECT--GO HANDLE
PUSHJ P,.KLIND ;CLEAN UP INDIRECT PROCESSING
>
POPJ P, ;NO--CLEAR OUT INDIRECT FILE AND BACK TO TTY
IFN DEBUG$,<
E$$PDL: OUTSTR [ASCIZ /?
?SCNPDL PDL phase error
/]
CLRBFI ;CLEAR ANY TYPE-AHEAD
MONRT. ;DIE WITHOUT TOUCHING ANY AC OR CORE
JRST .-1 ;LOOP HOPELESSLY
>
;FILE SCANNING ERRORS
IFN M$INDP,<
M$FAIL (IFI,Indirect file illegal in this context)
>
M$FAIL (ESM,Equal sign missing)
M$FAIL (DEQ,Double equal sign illegal)
E.FMO:: M$FAIL (FMO,File switches illegal in output file)
E.FMI:: M$FAIL (FMI,Output switch illegal in input file)
E.INCL::
E$$EXA: SKIPA T1,['EXA',,[ASCIZ /Excess arguments starting with "/] ]
E.ILSC::
E$$ILC: MOVE T1,['ILC',,[ASCIZ /Illegal character "/] ]
PUSH P,T1 ;SAVE TEXT [314]
TRZ T1,-1 ;REMOVE TEXT [314]
PUSHJ P,.TERRP ;ISSUE MESSAGE PREFIX [314]
MOVE T2,T1 ;COPY /MESSAGE [314]
POP P,T1 ;RESTORE TEXT [314]
TXNN T2,JWW.FL ;SEE IF FIRST LINE
JRST .FMSGE ;NO--JUST GO FINISH UP
PUSHJ P,.TSTRG## ;YES--ISSUE TEXT [314]
MOVE T1,C ;GET CHARACTER IN ERROR
PUSHJ P,.TFCHR## ;OUTPUT CHARACTER
SKIPE .LASWD ;IF UNKNOWN LAST WORD [314]
SKIPN .NMUL ; OR NO VALUE [314]
JRST ILSC1 ;JUMP IF NO WORD [314]
MOVEI T1,[ASCIZ /" following word "/]
PUSHJ P,.TSTRG## ;TYPE STRING
MOVE T1,.NMUL ;POSITION WORD [314]
SKIPGE T2,.LASWD ;SEE IF STRING MODE [314]
MOVEI T1,.NMUL ;YES--SET POINTER TO STRING [314]
PUSHJ P,(T2) ;AND ISSUE RESULT [314]
ILSC1: MOVEI T1,"""" ;DOUBLE QUOTE
PUSHJ P,.TCHAR## ;AND TYPE IT
JRST .FMSGE ;AND BOMB USER
;.GTIND--SUBROUTINE TO READ INDIRECT FILE SPECIFIER
;STORED IN AUXILIARY BLOCK STARTING AT A.ZER
IFN M$INDP,<
.GTIND::PUSHJ P,.FILIN ;GET FILE SPECIFIER
JUMPGE T1,E.JFI ;ERROR IF NO FILE SPECIFIED [516]
GTINDF:
IFG M$INDP,<
MOVEI T1,M$INDP ;IF FIRST, RESET COUNTER
SKIPN A.DEV ; ..
MOVEM T1,INDCNT ;TO LIMIT DEPTH
; THIS IS NEEDED TO PROTECT
; THE USER FROM INFINITE
; INDIRECT LOOPS (PARTICULARLY
; IF JACCT IS ON)
>
SKIPN A.DEV ;SEE IF TOP LEVEL [350]
MOVEM C,INDSVC ;YES--SAVE CHARACTER [350]
SKIPGE C ;SEE IF EOF [350]
HRROI C,.CHEOL ;YES--TURN INTO EOL FOR NOW [350]
SKIPE B.IND+1 ;IF ALREADY ONE OPEN,
PUSHJ P,.KLIND ; GO BIND IT OFF
MOVEI T1,A.ZER ;POINT TO @ AREA
MOVEI T2,A.EZER-A.ZER+1 ; ..
PUSHJ P,.GTSPC ;GO COPY SPEC
INDGT1: SKIPN T1,A.EXT ;SKIP IF EXT SPECIFIED
HRLOI T1,'CCL' ;DEFAULT IS CCL
MOVEM T1,A.EXT
SKIPN A.NAM ;SEE IF NAME
SETOM A.NAMM ;NO--DEFAULT TO NO WILD
SKIPN T1,A.NAM ;SKIP IF NAME SPECIFIED
HRLZ T1,CCLNAM
MOVEM T1,A.NAM
SKIPN T1,A.DEV
JRST E.JFI ;ERROR IF NO DEVICE
DEVCHR T1, ;GET CHARACTERISTICS
TXNE T1,DV.TTA ;SKIP IF NOT AN INTERACTIVE DEVICE
SETOM FLIIND ;NOTE INTERACTIVE
IFG M$INDP,<
SOSGE INDCNT ;DECREMENT COUNT TO PROTECT USER
JRST E.TMI ;TOO FAR--BOMB OUT
>
HRROI T1,"#" ;SETUP PROMPT [515]
JUMPLE C,INDGT2 ;EXIT IF END OF LINE
SKIPGE FLVERB ;IF VERB MODE, [515]
JRST E.JFI ; ERROR IF NOT END OF LINE [515]
CAIN C,"," ;ELSE, MUST BE COMMA [515]
INDGT2: PJRST DOPRMP ;DO PROMPT AND RETURN [515]
E.JFI: MOVEI N,A.ZER ;POINT TO FILE SPEC
SETOB T2,FLKLIN ;NO ERROR CODE
M$FAIF (JFI,Junk after indirect command)
IFG M$INDP,<
E.TMI: MOVEI N,A.ZER ;POINT TO FILE SPEC JUST READ IN
SETOB T2,FLKLIN ;SET FLAG FOR NO ERROR CODE TO PRINT
M$FAIF (TMI,Too many indirect files)
>
>
SUBTTL RUN COMMAND PROCESSING
;.RUNCM -- ROUTINE TO HANDLE /RUN SWITCH IF ANY
;CALL: PUSHJ P,.RUNCM
;RETURNS T1=0 IF NO /RUN SWITCH
;RETURNS T1.NE.0 IF CONTINUE FROM /EXIT SWITCH
;ELSE, TRIES TO DO THE RUN
;IF FAILURE, IT WILL RESTART THIS PROGRAM AT .JBSA
IFN M$INDP,<
.RUNCM::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF ERROR
SKIPN T1,N.DEV ;SEE IF /RUN [264,506]
POPJ P, ;NO--RETURN [264]
CAIN T1,1 ;SEE IF /EXIT [506]
JRST [SETZM N.DEV ;YES--CLEAR IN CASE OF CONT. [506]
SETOM T1 ;FLAG RETURN FOR LATER [506]
PJRST .MONRT] ;GO EXIT TO MONITOR [506]
PUSHJ P,.ISLGI## ;SEE IF LOGGED IN [347]
PJUMPL T1,.MONRT ;NO--EXIT ASAP INSTEAD OF /RUN [317,347]
SKPINL ;DEFEAT ^O
JFCL ; ..
MOVEI T1,N.ZER ;POINT TO /RUN
MOVEI T2,N.OPEN ;POINT TO DUMMY OPEN BLOCK
MOVEI T3,N.LOOK ;POINT TO DUMMY LOOKUP BLOCK
PUSHJ P,.STOPN ;SETUP OPEN/LOOKUP
JRST E.RWI ;ERROR IF WILD
PUSHJ P,.KLIND ;KILL CCL INDIRECT FILE TO
; CLEAN UP TMP: IF LAST LINE
; IS /RUN:
MOVE T1,N.LOOK+.RBPPN ;MOVE DIRECTORY
MOVEM T1,N.LOOK+5 ; FOR RUN UUO
MOVE T2,N.OPEN+1 ;GET DEVICE
MOVX T1,FX.NDV ;GET NULL DEVICE MASK
TDNE T1,N.MOD ;TEST SPECIFICATION
MOVSI T2,'SYS' ;YES--CHANGE TO 'SYS:'
MOVEM T2,N.LOOK+1 ;SET INTO RUN UUO BLOCK
SKIPGE T1,N.CORE ;GET /N.CORE:XX
MOVEI T1,0 ;DEFAULT TO 0
CAIG T1,777 ;SEE IF AT LEAST 1P
LSH T1,^D10 ;NO--ASSUME K
MOVEM T1,N.LOOK+6 ;STORE IN ARG BLOCK
HRLZ T1,N.OFFS ;GET OFFSET
HRRI T1,N.LOOK+1 ;POINT TO BLOCK
SKIPL N.OFFS ;SEE IF DEFAULT
JRST RUNCM2 ;NO--PROCEED
TLZ T1,-1 ;YES--CLEAR OFFSET
SKIPE FLCCL ;SEE IF CCL MODE
TLO T1,1 ;YES--SET CCL MODE OFFSET
RUNCM2: MOVE 0,[XWD RUNCM0,T2] ;GET A BLT POINTER TO ACS FOR CODE
BLT 0,T2+RUNCML ;MOVE THE CODE THAT WILL 'RUN' INTO THE ACS
JRST T2 ;AND GO RUN THE PROGRAM
RUNCM0: PHASE T2 ;RELOCATE TO THE ACS
HRRZ 0,.JBREL ;GET RID OF HIGH SEG AND SHRINK LOW
CORE 0, ;SHRINK
JFCL ;IGNORE THIS ERROR
RUN T1, ;TRY TO RUN THE USER'S PROGRAM
OUTSTR E$$RLF ;OUTPUT FATAL MESSAGE
EXIT ;AND STOP NOW
E$$RLF: ASCIZ /
?SCNRLF Run failure -- "E 1" for code/
DEPHASE
RUNCML==.-RUNCM0 ;LENGHT OF TRANSFER BLOCK
E.RWI: MOVEI N,N.ZER ;POINT TO SPEC
SETOM T2 ;FLAG FOR NO ERROR CODE
M$FAIF (RWI,Wildcard illegal in /RUN specification)
>
SUBTTL SUBROUTINES FOR COMMAND INPUT -- FILE SPECIFICATION
;.FILIN -- INPUT WHAT USER TYPES AS THE NEXT FILE SPECIFICATION
;REMEMBER PERMANENT ("STICKY") DEFAULTS
;APPLY STICKY (USER SUPPLIED) DEFAULTS
;PROCESSES SWITCHES, DEVICE, NAME, EXT., AND DIRECTORY
;RETURN ON FIRST BREAK NOT LEGITIMATELY PART OF A FILE SPEC.
; (ALSO ON SOME SYNTAX ERRORS LIKE "*X")
;
;A FILE SPECIFICATION IS CRUDELY DESCRIBED AS FOLLOWS:
; NOT MORE THAN ONE EACH OF
; DEVICE:
; FILENAME
; .EXTENSION
; [PROJECT,PROGRAMMER]
; [,PROG] [PROJ,] [,] IMPLY DEFAULT TO LOGGED IN NUMBER.
; ANY OF ABOVE EXTENDED FOR SFDS: [P,PN, SFD1,SFD2,...]
; [-] FOR DEFAULT DIRECTORY
; ANY NUMBER OF NON-OBVIOUSLY CONFLICTING SWITCHES
; /NAME
; /NAME:VALUE
; WHERE VALUE CAN BE A NUMBER, A NAME, A TIME, ETC.
;SOME SWITCHES APPLY TO FILE NAMES, OTHERS ARE GLOBAL TO THE COMMAND.
;THE DEVICE, EXTENSION, DIRECTORY, AND FILE SWITCHES ARE STICKY
;IF THEY APPEAR BEFORE A FILE NAME, AND LOCAL IT AFTER OR IF
;NO FILE NAME APPEARS. SPACES MAY BE INSERTED FREELY WHERE NEEDED
;OR DESIRED BETWEEN WORDS, BUT MAY NOT SEPARATE THE PARTS OF A WORD.
;FOR EXAMPLE, "/SWITCH:VALUE" IS OK, BUT "/ SWITCH : VALUE" LOSES.
;
;CALL: SET ZEROES OR DEFAULTS INTO P.XXX AREA
; PUSHJ P,.FILIN
; RETURN WITH TYPE-INS IN F.XXX AREA, P.XXX UPDATED
; T1 =0 IF NULL, =-1 IF FILE TYPED, =+1 IF JUST GLOBAL SWITCHES
;USES T2, T3, T4, N UPDATES C (SEPARATOR)
.FILIN::PUSHJ P,.SAVE1## ;PRESERVE P1
FILIN0: MOVE T1,SWTCNT ;GET RECURSION COUNTER [301]
PUSHJ P,.CLRFL ;GO CLEAR FXXX AREA
JRST FILIN2 ;GO START THE READ
;HERE WHEN SOMETHING FOUND
FILIN1: SETOM FLFSP ;SET SOMETHING FOUND FLAG
;HERE TO READ ANOTHER WORD
FILIN2: PUSHJ P,.TIAUC ;START THE READ
;HERE WITH WORD, SEE WHAT KIND OF SEPARATOR
FILIN3: PUSHJ P,.NAMEC ;READ REST OF WORD
CAIN C,":" ;SEE IF DEVICE
JRST FILDEV ;YES
JUMPE N,FILIN4 ;IF NULL, NOT A FILE NAME
SKIPE F.NAM ;FILE NAME--SEE IF SECOND TIME
JRST E$$DFN ;YES--ISSUE DUPL. ERROR
PUSHJ P,FILSTK ;GO MEMORIZE STICKY DEFAULTS
PUSHJ P,.LEFTX ;GUARANTEE LH=0
MOVEM N,F.NAM ;OK--SAVE NAME
MOVEM T1,F.NAMM ;AND MASK
SETOM FLFSP ;FLAG THAT SOMETHING FOUND
FILIN4: CAIN C,"." ;SEE IF EXTENSION
JRST FILEXT ;YES
CAIE C,"<" ;SEE IF 2741 DIRECTORY [252]
CAIN C,"[" ;SEE IF DIRECTORY
JRST FILDIR ;YES
CAIN C,"%" ;SEE IF ATTRIBUTE [522]
JRST FILATR ;YES--GO HANDLE [522]
CAIN C,"(" ;SEE IF OPEN PAREN [534]
JRST FILLPR ;YES--GO HANDLE [534]
SKIPLE FLFLLP ;IF INSIDE PAREN, [543]
CAIE C,")" ; AND CLOSE PAREN, [534]
SKIPA ;NO--PROCEED [534]
JRST FILRPR ;YES--GO HANDLE [534]
SKIPE SWTCNT ;SEE IF ALREADY SWITCH
SKIPGE FLVERB ; AND NOT VERB [357]
SKIPA ;OK--ALLOW SWITCHES [357]
JRST FILIN5 ;YES
CAIN C,"/" ;SEE IF SWITCH
JRST FILSW ;YES
CAIN C," " ;SEE IF WORD SEPARATOR
JRST FILIN2 ;YES--LOOP BACK FOR MORE WORK
FILIN5: SKIPN F.NAM ;SKIP IF FILE NAME SPECIFIED
PUSHJ P,FILSTK ;NO, SAVE STICKY DEFAULTS
MOVX T3,FX.TRM ;PREPARE TO SEE IF CONCATENATOR [247]
IORM T3,F.MODM ;INDICATE THAT WE WORRIED
MOVEI T3,0 ;PRESET FOR NO CONCATENATION [247]
CAIN C,"+" ;SEE IF "CONCATENATE" [247]
MOVEI T3,.FXTRC ;YES--SET CODE [247]
CAIN C,.CHAND ;SEE IF 'AND' [510]
MOVEI T3,.FXTRA ;YES--INDICATE [510]
CAIN C,.CHOR ;SEE IF 'OR' [510]
MOVEI T3,.FXTRO ;YES--INDICATE [510]
CAIN C,.CHNOT ;SEE IF 'NOT' [510]
MOVEI T3,.FXTRN ;YES--INDICATE [510]
DPB T3,[POINTR (F.MOD,FX.TRM)] ;STORE [247]
IFN ECHO$P,<
OUTSTR [ASCIZ /BEFORE DEFAULTS: /]
PUSHJ P,TFILE ;TYPE OUT F.XXX FOR DEBUGGING
>
MOVE T1,FLFSP ;RETURN FLAG
POPJ P, ;RETURN
;.CLRFL -- ROUTINE TO CLEAR FXXX AREA IN SCAN
;CALL: T1/0 IF TOP LEVEL, 1 IF NO SWITCHES ALLOWED
; PUSHJ P,.CLRFL
;USES T1-4
.CLRFL::SETZM F.ZER ;ZERO FILE RESULT AREA
MOVE T2,[F.ZER,,F.ZER+1] ; [301]
BLT T2,F.EZER ; [301]
SETOM F.MZER ;CLEAR SWITCHES [346]
MOVE T2,[F.MZER,,F.MZER+1]
BLT T2,F.EZER-1
SKIPE CLRFIL ;SEE IF USER WANTS CONTROL
SKIPE T1 ;SEE IF TOP LEVEL [301]
SKIPA ;NO--DON'T CLEAR USER'S SWITCHES [301]
PUSHJ P,@CLRFIL ;YES--GO TO HIM
MOVX T1,FX.NDV ;GET NULL DEVICE BIT
IORM T1,F.MOD ;SET IN MOD WORD
IORM T1,F.MODM ;SET IN MASK
POPJ P, ;RETURN
;HERE WHEN SLASH -- SWITCH COMMING
FILSW: PUSHJ P,.KEYWD ;PROCESS SWITCH
JRST E$$NSS ;ERROR IF NO SWITCH
PUSHJ P,.TICAN ;SEE IF SEPARATOR
SKIPA ;YES--OK
JRST E.SENS ;NO--ERROR
JUMPGE T1,FILINR ;IF END, FLAG SPEC
....==FS.NFS
TXNE T1,FS.NCM ;SEE IF NOT IN COMMAND [516]
JRST FILINN ;GO LOOK AT BREAK CHAR
SKIPN FLFSP ;NOT A COMMAND SWITCH, [516]
AOS FLFSP ;IF ONLY THING, INDICATE SAME [516]
JRST FILINN ; AND NOTHING ELSE [516]
;HERE WHEN COLON SEEN -- PREVIOUS WORD IS DEVICE
FILDEV: SETCM T1,MASK ;GET COMPLEMENT OF WILDCARD MASK
JUMPE N,E$$NDV ;ERROR IF NO DEVICE
JUMPN T1,E$$WDV ;WILDCARD ERROR
SKIPE F.DEV ;VERIFY NOT SECOND ONE
JRST E$$DDV ;ERROR IF TWO
MOVEM N,F.DEV ;SAVE
MOVX T1,FX.NDV ;NOTE THAT
ANDCAM T1,F.MOD ; DEVICE SPECIFIED
JRST FILIN1 ;GO READ SOME MORE
;HERE WHEN PERIOD SEEN -- NEXT WORD IS EXTENSION
FILEXT: PUSHJ P,.NAMEW ;GO GET THE EXTENSION
PUSHJ P,.LEFTX ;PUT INTO LEFT HALF-WORD
SKIPE F.EXT ;VERIFY NOT SECOND ONE
JRST E$$DEX ;ERROR IF TWO
HLR N,MASK ;PUT MASK IN RIGHT HALF
MOVEM N,F.EXT ;SAVE
JRST FILINR ;GO PROCESS NEW BREAK
;HERE ON LEFT PAREN -- OPEN OF DEFAULT REGION
FILLPR: SKIPE FLFLLP ;SEE IF TOO MANY [534]
JRST E$$PND ;YES--ERROR [534]
AOS FLFLLP ;NO--SET IT ON [534]
PUSHJ P,FILSTK ;REMEMBER STICKY DEFAULTS [534]
JRST FILIN0 ;START FILE SPEC OVER [534]
;HERE ON RIGHT PAREN -- CLOSE OF DEFAULT REGION
FILRPR: SETOM FLFLLP ;RESET COUNTER TO TELL APLSTK TO CALL CLERST [543]
JRST FILIN2 ;AND CONTINUE THIS SPEC [534]
;HERE WHEN % SEEN -- NEXT WORD IS AN ATTRIBUTE OR GENERATION
;IGNORED ON TOPS-10 SINCE NOT IMPLEMENTED IN FILE SYSTEM
FILATR: PUSHJ P,.NAMEW ;GO GET WORD [522]
JRST FILINR ;GO GET MORE OF SPEC [522]
;HERE WHEN LEFT SQUARE BRACKET SEEN -- DIRECTORY COMING
FILDIR: MOVX P1,FX.DIR ;GET DIRECTORY FLAG
TDNE P1,F.MODM ;SEE IF SET ALREADY
JRST E.DDR ;YES--DOUBLE DIRECTORY ERROR
IORM P1,F.MOD ;NO--SET IT
IORM P1,F.MODM ; AND IN MASK
PUSHJ P,.NOCTW ;GET OCTAL NAME
PUSHJ P,.LEFTX ;MOVE TO LEFT HALF-WORD
IFN FT$SFD,<
CAIE C,"-" ;SEE IF DEFAULT CODE
JRST FILDR1 ;NO--PROCEED
SKIPE FLNULL ;YES--VERIFY NULL NUMBER
JRST E.CDR ;NO--ERROR
ANDCAM P1,F.MOD ;CLEAR FLAG
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST FILDR5 ;[614] AND FINISH BELOW
>
FILDR1: TLNE T1,(1B0) ;SEE IF WILD-CARD OFF
JUMPL N,[MOVEM N,F.DIR ;AND SIXBIT TYPEIN
MOVEM T1,F.DIRM
JRST FILDR2]
CAIE C,"," ;MUST HAVE COMMA NOW
JRST E.CDR ;ERROR IF NOT
SKIPE FLNULL ;SEE IF SOMETHING
TLNE N,-1 ;YES--MAKE SURE NOT 0
TRNE N,-1 ;MAKE SURE THAT
JRST E.IPJ ;YES--NAUGHTY USER
HLLZM N,F.DIR ;SAVE
HLLZM T1,F.DIRM ;AND MASK
PUSHJ P,.NOCTW ;GET PROGRAMMER
PUSHJ P,.LEFTX ;PUT INTO LEFT HALF-WORD
SKIPE FLNULL ;SEE IF SOMETHING
TLNE N,-1 ;YES--MAKE SURE NOT 0
TRNE N,-1 ;MAKE SURE THAT PROGRAMMER
JRST E.IPG ;BAD--NAUGHTY USER
HLRM N,F.DIR ;SAVE
HLRM T1,F.DIRM ;AND MASK
FILDR2:
IFN FT$SFD,<
IFN FT$SDP,<
MOVE T1,[XWD STOPTH,STOPTH+1];[610] ZERO OUT TEMPORARY PATH BLOCK
SETZM STOPTH ;[610]
BLT T1,STOPTH+.PTMAX-1 ;[610] .PTMAX WORDS OF IT
MOVE T1,[.PTFRD] ;[610] WANT TO READ DEFAULT PATH
MOVEM T1,STOPTH+.PTFCN ;[610] STORE FUNCTION CODE
MOVE T1,[XWD .PTMAX,STOPTH] ;[610] SET UP CALL
PATH. T1, ;[610] DO THE UUO
HALT . ;[610] SOMETHING WENT CRAZY!
MOVEI T1,.PTMAX-.PTSFD;[610] COPY DATA OVER INTO F.DIR AREA
MOVEI T2,F.DIR+2*.PTMAX-2*.PTSFD ;[610]
FLDR20: SOSG T1 ;[610] RUN A LOOP FOR EACH SFD DEPTH
JRST FLDR21 ;[610] DONE?
SUBI T2,2 ;[610] BUMP POINTER TO SFD OUTPUT BLOCK
MOVE T3,STOPTH+.PTSFD-1(T1) ;[610] GET DEFAULT SPEC
MOVEM T3,(T2) ;[610] PUT IT INTO PROPER PLACE
SKIPE T3 ;[610] NEED MASK?
SETOM 1(T2) ;[610] MAKE MASK INCLUDE ALL BITS
JRST FLDR20 ;[610] GET NEXT SFD
FLDR21: > ;[610] END OF FT$SDP CONDITIONAL
MOVEI P1,F.DIR ;PRESET TO ACCUMULATE SUB-DIRECTORIES
FILDR3: CAIE C,"," ;SEE IF SFD NEXT
JRST FILDR4 ;NO--EXIT DIRECTORY CODE
ADDI P1,2 ;ADVANCE ACCUMULATION POINTER
CAIL P1,F.DIR+2*.FXLND ;PROHIBIT OVERFLOW
JRST E.SFD ;NO--BOMB USER
SETOM .NOQTE ;[604] DISABLE QUOTING W/I SFD
PUSHJ P,.NAMEW ;GET WILD NAME
SETZM .NOQTE ;[604] RE-ENABLE QUOTING
PUSHJ P,.LEFTX ;FORCE TO LEFT END
IFN FT$SDP, SKIPE N ;[610] USE DEFAULT?
MOVEM N,(P1) ;STORE NAME
MOVEM T1,1(P1) ;AND MASK
IFE FT$SDP, JUMPE N,E$$NSF ;NULL FIELD--ERROR
IFN FT$SDP,<
SKIPN (P1) ;[610] DOES THE FIELD EXIST IN DEFAULT PATH?
JRST E$$NSF > ;[610] NO, ERROR
JRST FILDR3 ;AND LOOP FOR MORE
FILDR4:
IFN FT$SDP,< ;[610] USE SFD DEFAULTS?
CAILE P1,F.DIR+2*.FXLND-4 ;[620] WHOLE BLOCK IN USE?
JRST FILDR5 ;[620] YES - DON'T ZERO ANYTHING
ADDI P1,2 ;[610] NOW ZERO OUT REST OF F.DIR BLOCK
SETZM (P1) ;[610] FROM P1 ON DOWN TO LAST SFD
HRL T1,P1 ;[610] GET LOWEST ADDR IN LEFT HALF
HRR T1,P1 ;[610] AND P1+1 IN RIGHT HALF
ADDI T1,1 ;[610]
BLT T1,F.DIR+2*.PTMAX-2*.PTSFD-1 ;[610] DO THE CLEAR OPERATION
>;[610] END OF FT$SDP
FILDR5: ;[614]
>
CAIE C,"]" ;MUST HAVE END NOW
CAIN C,">" ;ALSO CHECK END OF 2741 DIRECTORY [252]
SKIPA ;OK [252]
JUMPG C,E.RDR ;CATCH IMPROPERLY FORMATTED DIRECTORY
JUMPG C,FILIN1 ;PROCESS SEPARATOR UNLESS EOL
;FALL INTO FILINR
;HERE WHEN NEXT BREAK CHARACTER TO BE ANALYZED
FILINR: SETOM FLFSP ;NOTE THAT SOMETHING HAS HAPPENED
FILINN: JRST FILIN3 ;AND GO PROCESS SEPARATOR
;.GTSPC -- ROUTINE TO BLT THE FILE SPEC ACCUMULATED
; TO SOME MORE PERMANENT PLACE
; CALLER MUST APPLY HIS STICKY DEFAULTS FIRST.
; THIS WILL SUPPLY SCAN'S DEFAULTS.
;CALL: MOVEI T1,START OF AREA
; MOVEI T2,LENGTH OF AREA
; PUSHJ P,.GTSPC
;USES T1, T2, T3, T4
.GTSPC::CAIGE T1,.JBDA ;PROTECT AC'S
HALT . ;AGAINST JUNK CALL
MOVEI T3,APLSTD ;SET DSK: DEFAULTER
SKIPE SWTCNT ;IF TOP LEVEL
SKIPGE FLVERB ;OR VERB
MOVEI T3,APLSTK ;SET FULL DEFAULTER
PUSHJ P,(T3) ;GO SET DEFAULTS
CAILE T2,.FXLEN ;MAKE SURE NOT TOO LONG
MOVEI T2,.FXLEN ;SHRINK IF SO
ADDI T2,(T1) ;COMPUTE END PLUS ONE
HRLI T1,F.ZER ;COPY FROM F.XXX
BLT T1,-1(T2) ; TO END OF AREA
POPJ P, ;RETURN
;APLSTK -- APPLY USER'S STICKY DEFAULTS
;APLSTD -- APPLY DEFAULT DEVICE IF INDICATED
;CALL: PUSHJ P,APLSTK/D
;USES T3, T4
APLSTK: MOVE T3,P.DEV ;APPLY DEVICE--PICK UP STICKY
SKIPN F.DEV ;SEE IF USER TYPED SOMETHING
MOVEM T3,F.DEV ;NO--SUPPLY HIS STICKY DEVICE
MOVE T3,P.NAMM ;GET NAME MASK [534]
SKIPN F.NAM ;IF NO NAME YET [534]
MOVEM T3,F.NAMM ; APPLY STICKY NAME MASK [534]
MOVE T3,P.NAM ;GET NAME [534]
SKIPN F.NAM ;IF NO NAME YET, [534]
MOVEM T3,F.NAM ; APPLY STICKY NAME [534]
SKIPE F.EXT ;SEE IF EXTENSION
JRST APLST1 ;YES--GO ON
MOVX T3,FX.NUL ;NO--SET NULL EXT. BIT
IORM T3,F.MOD ;FOR LATER
IORM T3,F.MODM ;AND IN MASK
MOVE T3,P.EXT ;APPLY EXTENSION
MOVEM T3,F.EXT ; ..
APLST1: MOVE T4,[P.DIR,,F.DIR]
MOVX T3,FX.DIR ;GET DIRECTORY FLAG
TDNN T3,F.MODM ;SEE IF DIRECTORY SPECIFIED
;
;[606] BBE REMOVE NEXT LINE AND REPLACE WITH NEW BLT
;
;
; BLT T4,F.DIR+.FXLND-1 ;NO--COPY DEFAULT
BLT T4,F.MZER-1 ;[606] N0--COPY DEFAULT
MOVE T3,P.MOD ;APPLY ALL FILE SWITCHES
ANDCM T3,F.MODM ;MASK HERE USED TO INDICATE WHICH WERE TYPED
IORM T3,F.MOD ; ..
MOVE T3,P.MODM ; ..
IORM T3,F.MODM ; ..
MOVSI T4,P.MZER-P.EZER+1 ;LENGTH OF SWITCHES [346,636]
APLST2: MOVE T3,F.MZER(T4) ;GET CURRENT VALUE [346]
CAMN T3,[-1] ;SEE IF SET [346]
MOVE T3,P.MZER(T4) ;NO--GET THIS STICKY SWITCH [346]
MOVEM T3,F.MZER(T4) ;STORE RESULT [346]
AOBJN T4,APLST2 ;LOOP OVER ALL SWITCHES [346]
;FALL INTO APLSTD
;FALL HERE FROM ABOVE
SKIPGE FLFSP ;SEE IF SOME FILE HERE [516]
APLSTD: SKIPE F.DEV ;YES--SEE IF DEVICE SPECIFIED
JRST APLST5 ;YES--SKIP DEFAULTING
MOVSI T3,'DSK' ;NO--SPECIFY DSK:
MOVEM T3,F.DEV ; AS DEVICE
APLST5: SKIPLE T4,F.BFR ;IF /BEFORE, [331]
CAML T4,F.SNC ; MAKE SURE AFTER /SINCE [331]
JRST APLST6 ;OK--PROCEED [331]
M$FAIL (BSO,/BEFORE and /SINCE don't overlap)
APLST6: SKIPLE T4,F.ABF ;IF /ABEFORE, [346]
CAML T4,F.ASN ; MAKE SURE AFTER /ASINCE [346]
JRST APLST9 ;OK--PROCEED [346]
M$FAIL (ABO,/ABEFORE and /ASINCE don't overlap)
APLST9: PUSH P,T1 ;SAVE T1 FOR .GTSPC [513]
SKIPGE FLFLLP ;SEE IF WERE IN () [543]
PUSHJ P,CLERST ;YES, CLEAR STICKIES [543]
POP P,T1 ;RESTORE T1 [543]
IFN ECHO$P,<
OUTSTR [ASCIZ /AFTER USER DEFAULTS: /]
PUSHJ P,TFILE
>
POPJ P, ;RETURN
;.OSDFS--APPLY OSCAN DEFAULT FILE SWITCHES
;MUST BE CALLED AFTER CALLING OSCAN. CALL ONCE FOR EACH
;FILE SPEC TSCAN SETUP. THIS WILL TAKE ANY FILE SWITCHES
;SET IN SWITCH.INI AND USE THEM AS DEFAULTS FOR
;THE FILES TYPED BY THE USER.
;CALL: 1/ LOCATION OF SPEC
; 2/ LENGTH OF SPEC
; PUSHJ P,.OSDFS
;USES T1-4
.OSDFS::MOVE T3,F.MOD ;GET MOD WORD SWITCHES
TXZ T3,FXNOTD ;REMOVE ALL BUT SWITCHES [537]
ANDCM T3,.FXMOM(T1) ;REMOVE ANY USER SET
IORM T3,.FXMOD(T1) ;SET DEFAULT VALUES
MOVE T3,F.MODM ;GET MASK OF DEFAULTS
TXZ T3,FXNOTD ;REMOVE ALL BUT SWITCHES [537]
IORM T3,.FXMOM(T1) ;INDICATE SET
MOVEI T4,-.FXBFR(T2) ;COUNT OF EXTRA WORDS
CAILE T4,F.EMZR-F.MZER+1 ;SEE IF MORE THAN WE UNDERSTAND [635]
MOVEI T4,F.EMZR-F.MZER+1 ;YES--SET TO OUR LIMIT [635]
MOVNS T4 ;MAKE NEGATIVE
HRLZS T4 ;SET IN LEFT HALF AS COUNT
OSDFS1: MOVE T3,.FXBFR(T1) ;GET EXISTING VALUE
CAMN T3,[-1] ;SEE IF DEFAULT
MOVE T3,F.MZER(T4) ;YES--GET OSCAN VALUE
MOVEM T3,.FXBFR(T1) ;STORE VALUE
AOS T1 ;ADVANCE POINTER
AOBJN T4,OSDFS1 ;LOOP UNTIL DONE
POPJ P, ;RETURN
;SUBROUTINE TO TYPE OUT F.XXX AREA
IFN ECHO$P,<
TFILE: PUSHJ P,.PSH4T##
MOVE T2,F.DEV
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /:/]
MOVE T2,F.NAM
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /./]
HLLZ T2,F.EXT
PUSHJ P,.TSIXN##
MOVE T1,F.DIR
PUSHJ P,.TPPNW
MOVE T1,F.MOD
PUSHJ P,.TXWDW
OUTSTR [ASCIZ /
MASKS: /]
MOVE T2,F.NAMM
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /./]
HRLZ T2,F.EXT
PUSHJ P,.TSIXN##
MOVE T1,F.DIRM
PUSHJ P,.TPPNW
MOVE T1,F.MODM
PUSHJ P,.TXWDW
PUSHJ P,.TCRLF##
PJRST .POP4T##
>
;CLERST -- CLEAR STICKY DEFAULTS
;.CLSNS -- DITTO EXCLUDING SWITCHES
CLERST: SETOM P.MZER ;CLEAR SWITCHES [346]
MOVE T1,[P.MZER,,P.MZER+1]
BLT T1,P.EZER
SETZM FLFLLP ;CLEAR ( SWITCH [543]
SKIPE CLRSTK ;SEE IF USER WANTS CONTROL [534]
PUSHJ P,@CLRSTK ;YES--GO TO HIM [534,551]
SETZM P.MOD ;CLEAR [551]
SETZM P.MODM ; SMALL SWITCHES [551]
.CLSNS::PUSH P,P.MOD ;SAVE SWITCHES [551,553]
PUSH P,P.MODM ; .. [551]
SETZM P.ZER ;CLEAR STICKY DEFAULTS [551]
MOVE T1,[P.ZER,,P.ZER+1]
BLT T1,P.MZER-1
POP P,P.MODM ;RESTORE SMALL [551]
POP P,P.MOD ; SWITCHES [551]
MOVX T1,FX.NDV!FX.NUL!FX.DIR!FX.DFX!FX.TRM
ANDCAM T1,P.MOD ;CLEAR NON-SWITCH [552]
ANDCAM T1,P.MODM ; INFORMATION [552]
POPJ P, ;NO--JUST RETURN [534]
SUBTTL SUBROUTINES FOR COMMAND INPUT -- SWITCH OR VERB PROCESSING
;.KEYWD -- SWITCH/VERB SCANNER
;CALL: PUSHJ P,.KEYWD
;NON-SKIP RETURN IF NO KEYWORD PRESENT
;SKIP RETURN IF KEYWORD AFTER ARGUMENTS ARE SCANNED
; WITH LH(T1)=SWITCH SPECIFIC FLAGS, RH(T1)=0
;USES T1-4
;GLOBAL USAGE-- P1=SWITCH OFFSET
; P2=POINTER FOR INTERNAL VS. EXTERNAL
.KEYWD::PUSHJ P,.SAVE2## ;SAVE P1 (SWITCH INDEX)
; AND P2 (LOCAL/REMOTE INDEX)
PUSHJ P,.SIXKW ;GET NAME
JUMPE N,.POPJ ;RETURN IF NO KEYWORD
AOS SWTCNT ;COUNT RECURSION
;THIS NEXT CODE SEARCHES USER AND STANDARD SWITCH TABLES TO
;FIND A POSSIBLY ABBREVIATED MATCH. USER OVERRIDES STANDARD.
;IN ANY TABLE, SEVERAL MATCHING CAUSES DUPLICATE MESSAGE,
;AS DOES ONE ABBREV. IN EACH TABLE.
;EXACT IN EITHER TABLE WINS.
AOS (P) ;SET FOR SKIP RETURN (WE FOUND A KEYWORD)
PUSHJ P,SWTNAM ;GO LOOK UP NAME [316]
SKIPA ;CAN'T FIND, TRY HARDER [316]
JRST KEYWDG ;GOT IT--PROCEED [316]
JUMPG T1,E$$ABS ;AMBIGUOUS IF MORE THAN ONE [316]
TLC N,'NO ' ;SEE IF /NOXYZ [316]
TLNE N,(7777B11) ; .. [316]
JRST [TLC N,'NO ' ;NO--RESTORE WORD [316]
JRST E$$UKS] ;ISSUE ERROR [316]
TLC N,'NO ' ;RESTORE WORD [316]
PUSH P,N ;SAVE WORD [316]
LSH N,^D12 ;STRIP "NO" [316]
PUSHJ P,SWTNAM ;AND TRY AGAIN [316]
JRST [POP P,N ;ERROR--RESTORE WORD [316]
JUMPG T1,E$$ABS ;GIVE AMBIGUOUS [316]
JRST E$$UKS] ;OR UNKNOWN MESSAGE [316]
POP P,N ;RESTORE NAME [316]
MOVX T1,FS.OBV!FS.NOS ;SEE IF BIT VALUE [316]
TDNN T1,@SWD(P2) ; IN WHICH CASE, MEANS "NONE" [316]
JRST E$$UKS ;ELSE, PRETEND UNKNOWN [316]
HRLI P2,-1 ;SET FLAG /NOXYZ [316]
KEYWDG: SETZM FLMULS ;CLEAR MULTIPLE SWITCH FLAG
MOVE T1,SWTCNT ;GET SWITCH DEPTH [357]
CAIG T1,1 ;IF TOP LEVEL, [357]
JRST KEYWDM ; GO PROCESS SWITCH [357]
HRRZ T1,@SWP(P2) ;ELSE, MUST BE VERB MODE [357]
CAIL T1,F.ZER ; ALLOW ONLY [357]
CAILE T1,F.EMZR ; IF LOCAL OR [357]
SKIPA ; NO--TRY REMOTE [357]
JRST KEYWDM ;LOCAL FILE MODIFIER SO OK [357]
CAML T1,SWTPFF ; OR IF [357]
CAMLE T1,SWTPFL ; REMOTE FILE MODIFIER [357]
JRST E$$UKS ;NEITHER--UNKNOWN [357]
;BACK HERE ON MULTIPLE SWITCH VALUES
; I.E., IF /SWITCH:(VAL1,VAL2,VAL3,...VALN)
; THEN, THE SWITCH DISPATCH WILL NOTICE
; THE LEFT PAREN. THEN AT EACH SWDONE, THE COMMA
; WILL BE NOTICED AND IT WILL LOOP BACK HERE. WHEN
; THE RIGHT PAREN IS SEEN AT SWDONE, THE NORMAL EXIT
; WILL BE TAKEN WITH THE BREAK SET TO SPACE.
KEYWDM: MOVE T2,@SWD(P2) ;GET SWITCH FLAGS
HRRZ N,T2 ;GET DEFAULT VALUE
TXNE T2,FS.LRG ;SEE IF LARGE VALUES
TRNN N,-1 ; AND SOMETHING THERE
SKIPA ;NO--LEAVE ALONE
MOVE N,(N) ;YES--GET IT
TXNE T2,FS.OBV ;SEE IF OR-BITS [531]
HRLI N,1 ;YES--SET SPECIAL FLAG [531]
MOVEM N,.NMUL ;SET ALSO INTO MULTI-WORD AREA
SETZM .NMUL+1 ;AND CLEAR REST
MOVE T1,[.NMUL+1,,.NMUL+2]
BLT T1,.NMUE
MOVE T1,@SWM(P2) ;GET PROCESSOR OR TABLE POINTER
TXNE T2,FS.NOS ;SEE IF "NO" SWITCH
JRST [HLRZ N,P2 ;IF SN STYLE, GET NO INDICATOR [316]
MOVEI N,1(N) ;SET N=0 IF NO, 1 IF NOT NO [316]
JRST KEYWDA] ;GO STUFF RESULT [316,342]
JUMPL P2,KEYWD7 ;ELSE, NOXYZ IS BIT VALUE [316]
TXNE T2,FS.LRG ;SEE IF LARGE MODE
HRLI T1,1 ;YES--NOTE A VALUE (ONLY A FLAG HERE)
SKIPE FLMULS ;SEE IF INSIDE (,,,,)
JRST KEYWD3 ;YES--GO DISPATCH
CAIN C,":" ;SEE IF VALUE SPECIFIED
JRST KEYWD2 ;YES--GO CHECK INTO IT
SKIPL FLVERB ;SEE IF VERB MODE
JRST KEYWD1 ;NO--PROCEED
JUMPLE C,KEYWD1 ;YES--IF NULL, PROCEED
MOVE T3,SWTCNT ;GET ITERATION COUNT [547]
CAIE T3,1 ;SEE IF NESTED [547]
JRST KEYWD1 ;NO--DON'T REEAT [547]
CAIE C," " ;UNLESS SPACE,
PUSHJ P,.REEAT ; CAUSE RESCAN OF CHARACTER
JRST KEYWD2 ;THEN GO GET ARGS
;HERE WHEN DEFAULT NEEDED
KEYWD1: TXNE T2,FS.VRQ ;SEE IF VALUE REQUIRED
JRST E.SVR ;YES--GIVE ERROR
TLNN T1,-1 ;SEE IF MAX SET
JUMPN T1,KEYWDJ ;NO--DIRECT ACTION [343]
JUMPGE T1,SWDPBE ;YES--GO STORE DEFAULT [343]
JUMPE N,E.UDS ;IF NO DEFAULT, ERROR
JRST KEYWD8 ;ELSE, STORE IT [316]
;HERE WHEN VALUE SPECIFIED BY USER (MAY BE NULL)
KEYWD2: JUMPE T1,E.NMA ;IF NO VALUE LEGAL, GIVE ERROR
SKIPGE FLVERB ;IF VERB MODE,
JRST KEYWD3 ; GO HANDLE VALUE
MOVE T4,C ;SAVE EXISTING BREAK
PUSHJ P,.TIALT ;ELSE, LOOK AT NEXT CHAR
PUSHJ P,.REEAT ;AND SET TO REEAT IT
EXCH T4,C ;RESTORE ORIGINAL CHAR
CAIE T4,"(" ;SEE IF MULTIPLE VALUE COMING
JRST KEYWD3 ;NO--GO HANDLE SINGLE VALUE
SETZM SAVCHR ;YES--GOBBLE PAREN
PUSHJ P,.TIALT ;[575] GET 1ST CHAR AFTER "("
CAIE C," " ;[575] BLANK(S) TO COMPRESS?
PUSHJ P,.REEAT ;[575] NO--REEAT FOR PROCESSOR
SETOM FLMULS ;AND SET MULTIPLE VALUE FLAG
;HERE WHEN USER GIVES VALUE AND SWITCH CAN HANDLE IT
; THERE ARE TWO KINDS: SPECIAL STYLE VALUE (DECIMAL, STRING, ETC.)
; AND KEYWORD FROM A LIST WHICH CAN BE ABBREVIATED.
KEYWD3: JUMPG T1,KEYWDJ ;IF SPECIAL PROCESSOR, GO DO IT [343]
PUSHJ P,.SIXKW ;VALUE IS ANOTHER KEYWORD--GET IT
JUMPE N,KEYWD6 ;IF BLANK, GO HANDLE [361]
MOVE T1,@SWM(P2) ;REFETCH SUB-KEY POINTER
PUSHJ P,.NAME ;LOOK IT UP
JRST KEYWD4 ;NOT FOUND
SUB T1,@SWM(P2) ;DETERMINE INDEX AS VALUE
MOVEI N,(T1) ;PLACE IN VALUE (1,2,...)
JRST KEYWD8 ;AND GO STORE IT AWAY [316]
KEYWD4: JUMPGE T1,E$$ASV ;ERROR IF AMBIGUOUS [352]
MOVEI T1,0 ;CLEAR ACCUMULATOR [316]
MOVE T2,N ;COPY WORD [316]
LSHC T1,^D12 ;SPLIT "NO" [316]
MOVX T4,FS.OBV ;SEE IF OR-STYLE [316]
TDNN T4,@SWD(P2) ; OF BIT VALUES [316]
JRST KEYWD6 ;NO--NO MORE POSSIBILITIES [341]
CAMN N,['NONE '] ;YES--SEE IF :NONE [341]
JRST [MOVSI N,-1 ;RIGHT--INDICATE THAT [341]
JRST KEYWD8] ;GO DISPATCH [341]
CAMN N,['ALL '] ;SEE IF :ALL [341]
JRST [MOVEI N,-1 ;RIGHT--INDICATE THAT [341]
JRST KEYWD8] ;GO DISPATCH [341]
CAIE T1,' NO' ;AND "NO" [316]
JRST KEYWD6 ;IF NOT, GO TRY SIMPLE CASE [316]
PUSH P,N ;YES--SAVE NAME [316]
MOVE N,T2 ;COPY XYZ OF NOXYZ [316]
MOVE T1,@SWM(P2) ;GET LIST AGAIN [316]
PUSHJ P,.NAME ;TRY TO FIND [316]
JRST KEYWD5 ;NO LUCK--RESTORE N AND TRY SIMPLE CASES [316]
POP P,N ;RESTORE NAME [316]
SUB T1,@SWM(P2) ;DETERMINE INDEX AS VALUE [316]
HRROI N,(T1) ;INDICATE NO,,(1,2,...) [316]
JRST KEYWD8 ;AND GO STORE [316]
;HERE IF SN SWITCH TO LOOK FOR VALUES
KEYWDA: JUMPE N,KEYWD8 ;IF NO, PROCEED (NO VALUES) [342]
CAIN C,":" ;SEE IF VALUE COMING [342]
JRST KEYWDB ;YES--GO HANDLE [342]
SKIPGE FLVERB ;SEE IF VERB MODE [342]
CAIE C," " ;YES--SEE IF ANOTHER WORD [342]
JRST KEYWD8 ;NO--THAT'S IT [342]
KEYWDB: PUSHJ P,.SIXKW ;GET VALUE AS NAME [342]
MOVE T1,[IOWD YNTABL,YNTAB] ;TRY YES-NO TABLE [342]
PUSHJ P,.NAME ;LOOK UP NAME [342]
JRST E.UKK ;UNKNOWN VALUE [342]
MOVEI N,(T1) ;GET LOCATION OF MATCH [342]
SUBI N,YNTAB ;GET OFFSET IN TABLE [342]
ANDI N,1 ;GET YES/NO SETTING [342]
JRST KEYWD8 ;RETURN THAT VALUE [342]
KEYWD5: POP P,N ;RESTORE N [316]
KEYWD6: CAME N,['0 '] ;SEE IF 0
JUMPN N,E$$USV ;NO--ERROR IF NOT BLANK [352]
MOVEI N,0 ;YES--SET ZERO
MOVX T2,FS.OBV ;CHECK FOR OR BIT VALUE [316]
TDNE T2,@SWD(P2) ; SWITCH, IF SO [316]
KEYWD7: MOVSI N,-1 ;/NOXYZ ON BIT VALUES [316]
KEYWD8: MOVE T1,@SWP(P2) ;LOOK AT POINTER
TLC T1,(7777B11) ;COMPLEMENT BYTE INDICATOR
TLCN T1,(7777B11) ;SEE IF SET
JUMPN T1,KEYWDJ ;NO--GO PROCESS DIRECTLY [343]
JRST SWDPBE ;AND GO STORE
;HERE TO GO TO SWITCH PROCESSOR
KEYWDJ: PUSHJ P,(T1) ;GO DO IT [343]
JRST SWDPBE ;GO STORE [343]
JRST SWDONE ;HE STORED--JUST CLEAN UP [343]
;TABLE OF YES/NO VALUES--MUST BE NO/YES PAIRS
YNTAB: SIXBIT /0/
SIXBIT /1/
SIXBIT /NO/
SIXBIT /YES/
SIXBIT /OFF/
SIXBIT /ON/
YNTABL==.-YNTAB
;SWTNAM -- ROUTINE TO LOOK UP NAME IN USER AND LOCAL SWITCH TABLES
;BEHAVIOUR IS JUST LIKE .NAME ROUTINE
;USES T1-4
;SUCCESSFUL RETURN WITH P1, P2 SETUP
; P1=INDEX IN CORRECT TABLE
; P2=INDICATOR OF WHICH TABLE
SWTNAM: MOVEI P1,0 ;FLAG NOTHING FOUND YET [316]
MOVE T1,SWTPTR ;POINTER TO USER'S SWITCHES
PUSHJ P,.NAME ;SEE IF USER'S SWITCH
JRST [JUMPL T1,SWTNMU ;IF NO MATCH, JUST SEARCH STANDARD ONES
SETOM P1 ;IF SEVERAL, SET FLAG
JRST SWTNMU] ; AND SEARCH STANDARD
MOVEI P2,SWTCHC ;POINT TO USER'S SWITCH TABLES
MOVE P1,T1 ;SAVE SOLUTION
JUMPL T1,SWTNMR ;DONE IF EXACT MATCH ON USER
SWTNMU: MOVE T1,[IOWD STSWTL,STSWTN] ;IOWD PTR TO LIST OF SWITCHES
PUSHJ P,.NAME ;LOOK-UP NAME IN TABLE
JRST [JUMPG T1,.POPJ ;IMPRECISE--GIVE UP
JUMPL P1,RETONE ;FIRST TIME WAS IMPRECISE--GIVE UP
JUMPE P1,RETMIN ;NOT FOUND--IF NOT USER EITHER, GIVE UP
MOVE T1,P1 ;IF USER, GET HIS POINTER BACK
JRST SWTNMR] ; AND GO PROCESS IT
SKIPL T1 ;IF EXACT, GO PROCESS IT
JUMPN P1,RETONE ;IF ABBR OF BOTH TABLES, AMBIGUOUS
MOVE P1,T1 ;SET INDEX IN TABLE
MOVEI P2,STDSWC ;POINT TO STANDARD SWITCH TABLES
;HERE TO RETURN SUCCESSFULLY
SWTNMR: MOVEI P1,0 ;CLEAR INDEX
MOVEI T2,@SWN(P2) ;GET START OF NAME TABLE
MOVEI P1,(T1) ;GET ADDRESS OF SWITCH
SUBI P1,(T2) ;GET OFFSET OF SWITCH
JRST .POPJ1 ;AND RETURN SUCCESSFULLY
;RETURN WITH T1=1
RETONE: MOVEI T1,1 ;SET VALUE 1
POPJ P, ;RETURN
;RETURN WITH T1=-1
RETMIN: SETOM T1 ;SET VALUE -1
POPJ P, ;RETURN
;HERE WHEN SWITCH VALUE IS A DECIMAL NUMBER
.SWDEC::PUSHJ P,.DECNW ;GET THE NUMBER
JRST .SWMAX ;AND STORE IT
;HERE WHEN SWITCH IS AN OCTAL NUMBER
.SWOCT::PUSHJ P,.OCTNW ;GET OCTAL WORD
JRST .SWMAX ;AND STORE AWAY
;HERE WHEN SWITCH IS A CORE VALUE
.SWCOR::PUSHJ P,.COREW ;GET CORE WORD
JRST .SWMAX ;AND STORE AWAY
;[652] HERE WHEN SWITCH VALUE IS AN 8-BIT ASCII STRING
.SWAS8==:.AS8QW
;[652] HERE WHEN A SWITCH VALUE IS A POSSIBLY QUOTED CHARACTER OR OCTAL NUMBER
.SWCHR::PUSHJ P,.CHRQW ;GET A POSSIBLY QUOTED CHARACTER
JRST .SWMAX ;CHECK AGAINST MAXIMUM VALUE AND STORE
;HERE WHEN SWITCH VALUE IS AN ASCII STRING
.SWASQ==:.ASCQW
;HERE WHEN SWITCH VALUE IS A SIXBIT STRING
.SWSXQ==:.SIXQW
;HERE WHEN SWITCH VALUE IS A MULTIPLE WORD SIXBIT QUANTITY
; OF ONLY ALPHA-NUMERICS (NO SPECIAL SYMBOLS, NO QUOTING)
.SWSXM==:.SIXMW
;HERE WHEN SWITCH VALUE IS A ONE WORD SIXBIT QUANTITY
.SWSIX==:.SIXSW
;HERE WHEN SWITCH VALUE IS A DATE/TIME FIELD IN THE PAST
.SWDTP==:.DATIP
;HERE WHEN SWITCH VALUE IS A DATE/TIME FIELD IN THE FUTURE
.SWDTF==:.DATIF
;HERE WHEN SWITCH VALUE IS A DATE/TIME FIELD
.SWDTM==:.DATIM
;HERE WHEN SWITCH TAKES A FILE SPECIFICATION AS ITS VALUE
.SWFIL::MOVE T1,[F.ZER,,G.ZER]
BLT T1,G.EZER ;SAVE CURRENT SPEC
PUSHJ P,.FILIN ;GO GET FILE SPEC
MOVE T2,@SWP(P2) ;GET POINTER AS STARTING POINT
SKIPE STRSWT ;SEE IF USER'S
CAIN P2,STDSWC ;AND HE WANTS CONTROL
SKIPA
JRST [MOVE T3,@SWD(P2) ;GET FLAGS
TXNE T3,FS.NUE ;SEE IF NO EXIT
JRST .+1 ;RIGHT--PROCEED
PUSHJ P,@STRSWT ;YES--GO TO HIM(T1=0 IF NULL,T2=LOC,T3=FLAGS)
PJRST SWFILX ;ALL DONE
JRST .+1]
HRRZ T1,T2 ;USE POINTER AS STARTING POINT
HLRZ T2,@SWM(P2) ;USE MAX AS LENGTH
SKIPL FLVERB ;SEE IF VERB
SKIPN .FXDEV(T1) ;NO--SEE IF ALREADY SET
JRST SWFIL1 ;NO--OK TO STORE
IFN M$INDP,<
SKIPE OPTNAM ;BAD--SEE IF IN OPTION FILE
JRST SWFILX ;YES--SKIP STORE
>
JRST E.DSI ;ERROR--DUPLICATE SWTICH
SWFIL1: PUSHJ P,.GTSPC ;COPY RESULTS
SWFILX: MOVE T1,[G.ZER,,F.ZER]
BLT T1,F.EZER ;RESTORE ORIGINAL SPECIFICATION
PJRST .POPJ1 ;GO FINISH UP [343]
;HERE TO HANDLE /LENGTH SWITCH
;FORMAT OF VALUE IS TWO BLOCK SIZES SEPARATED BY COLON
;FIRST IS THE MINIMUM FILE SIZE
;SECOND IS THE MAXIMUM FILE SIZE
;IF FIRST IS NULL, DEFAULTS TO 0
;IF SECOND IS NULL, DEFAULTS TO UNSET (+INFINITY)
0,,[ASCIZ /Minsize:maxsize/]
SWLEN: PUSHJ P,.BLOKW ;GET MINIMUM FILE SIZE
SKIPL F.FLI ;SEE IF ALREADY SET
CAMN N,F.FLI ; TO A DIFFERENT VALUE
JRST SWLEN1 ;NO--OK TO USE
SKIPL FLVERB ;YES--SEE IF VERB MODE
JRST [SKIPE OPTNAM ;NO--SEE IF OPTION FILE
JRST SWLEN2 ;YES--IGNORE ENTRY
JRST E.DSI] ;NO--DUPLICATE
SWLEN1: MOVEM N,F.FLI ;OK--STORE MINIMUM
MOVE T4,SWTCNT ;GET DEPTH [557]
SKIPGE FLVERB ;SEE IF VERB MODE [557]
CAIE T4,1 ;SEE IF TOP LEVEL [557]
JRST SWLEN2 ;NO [557]
MOVEM N,P.FLI ;STORE IN P.XXX AREA ALSO [557]
SWLEN2: CAIE C,":" ;SEE IF SECOND ARGUMENT
JRST .POPJ1 ;NO--RETURN WITH NO STORE
PUSHJ P,.BLOKW ;YES--GET MAXIMUM FILE SIZE
CAMGE N,F.FLI ;SEE IF GREATER THAN MINIMUM
JRST E$$LVI ;NO--ERROR
POPJ P, ;YES--RETURN AND STORE
;HERE TO HANDLE /EXIT SWITCH
0,,[ASCIZ /Exit program/]
SWEXIT: MOVE T1,@SWP(P2) ;GET POINTER [506]
SKIPN .FXDEV(T1) ;IF NOT SET, [506]
SETOM .FXDEV(T1) ; INDICATE FOR STORE ROUTINE [506]
MOVEI N,1 ;SET VALUE [506]
POPJ P, ;RETURN--INDICATE STORE NEEDED [506]
;HERE TO HANDLE /TMPFILE SWITCH
;ARGUMENTS ARE MANDATORY /TMPFILE:NAM:"ASCII STRING"
0,,[ASCIZ /Nam:"ASCII string"/]
SWTMP: PUSHJ P,.SIXKW ;GET TMP FILE NAME IN SIXBIT
TRZ N,-1 ;TRUNCATE TO 3CHARS
JUMPE N,E$$ITF ;ERROR IF BLANK
CAIE C,":" ;ERROR IF NO STRING
JRST E$$ITF ; ..
PUSH P,N ;SAVE NAME
PUSHJ P,.ASCQW ;GET ASCII STRING
POP P,T1 ;GET BACK NAME
MOVEI T3,376 ;SET MASK
MOVSI T2,.NMUL-.NMUE-1 ;SET LENGTH
TDNE T3,.NMUL(T2) ;LOOK FOR END
AOBJN T2,.-1 ; ..
SKIPL T2 ;IF NOT FOUND,
SOS T2 ; JUST USE LENGTH
MOVNI T2,1(T2) ;COMPUTE LENGTH
HRLZS T2 ;POSITION
HRRI T2,.NMUL-1 ;POINT TO ASSEMBLY AREA
MOVE T3,[.TCRWF,,T1] ;INDICATE WRITE
TMPCOR T3, ;WRITE TO TMPCOR
SKIPA ;CAN'T--TRY DISK
JRST .POPJ1 ;OK--RETURN WITHOUT STORE
IFN M$INDP,<
PUSH P,T2 ;SAVE IOWD
INIT IND,.IODMP ;OPEN
SIXBIT /DSK/ ; FILE
0,,0 ; ..
JRST E$$CWT ;ERROR
MOVSS T1 ;POSITION NAME
HLL T1,CCLNAM ;GET JOB NUMBER
MOVSI T2,'TMP' ;STANDARD EXTENSION
SETZB T3,T4 ;CLEAR REST OF ENTER
ENTER IND,T1 ;ENTER FILE
JRST E$$CWT ;ERROR IF CAN'T
POP P,T1 ;GET IOWD
MOVEI T2,0 ;CLEAR IOWD LIST
OUTPUT IND,T1 ;WRITE FILE
CLOSE IND, ;COMPLETE
RELEAS IND, ;CLEAR CHANNEL
JRST .POPJ1 ;RETURN WITHOUT STORE
>
M$FAIL (CWT,Can't write tmpfile)
M$FAIL (ITF,Incorrect tmpfile argument format)
;HERE ON A HELP SWITCH
; ARG TO SCAN IS TYPE AND ADDRESS OF HELP PROCESSOR
; LH CONTAINS TYPE OF PROCESSOR, RH CONTAINS VALUE
; TYPE 0=NO HELP AVAILABLE
; TYPE 1=ASCIZ STRING, RH=ADDR OF STRING
; TYPE 2=SUBROUTINE TO BE CALLED, RH=ADDR OF SUBROUTINE
.SWHLP::CAIN N,HELPSWITCHES ;SEE IF /HELP:SWITCHES
JRST FILHLS ;YES--GO LIST THEM
CAIN N,HELPARGUMENTS ;SEE IF /HELP:ARGUMENTS
JRST [PUSHJ P,ARGHLP;YES, LIST SWITCHES AND ARGUMENTS
JRST FILSHX] ;FINISH UP
SKIPN T1,SWTHLP ;SKIP IF HELP PROCESSOR SPECIFIED
JRST FILNOH ;NO, CANT HELP HIM
HLRZ T2,T1 ;YES, GET CODE
CAIN T2,1 ;SKIP IF NOT ASCIZ STRING
JRST FILTXH ;GO TYPE STRING
CAIN T2,2 ;SKIP IF NOT SUBROUTINE TO BE CALLED
PJRST (T1) ;CALL SUBROUTINE
CAILE T2,77 ;SEE IF NAME CODE
JRST FILHLP ;YES--GO DO IT
HALT FILSHX ;UNKNOWN TYPE
FILTXH: TLZA T1,-1 ;WORD=ADDR OF TEXT STRING
FILNOH: MOVEI T1,[ASCIZ /% I can't help you, please read the manual/]
PUSHJ P,.TSTRG## ;TYPE STRING
PUSHJ P,.TCRLF## ;AND TOP OFF WITH CRLF
JRST FILSHX
FILHLP: PUSHJ P,.HELPR## ;GO CALL HELPER TO READ SYS: FILE
JRST FILSHX ;AND RESTART
;HERE WHEN /HELP:SWITCHES TYPED TO LIST THE SWITCHES
FILHLS: MOVEI P2,2 ;SET COUNTER
FILHLA: MOVEI T1,[ASCIZ /Switches are:/]
CAIN P2,1 ;SEE IF SECOND PASS
MOVEI T1,[ASCIZ /Standard ones:/]
PUSHJ P,.TSTRG## ;TYPE HEADER
MOVE P1,SWTPTR ;GET POINTER
CAIN P2,1 ;UNLESS SECOND SHOT
MOVE P1,[IOWD STSWTL,STSWTN]
JUMPE P1,FILHLD ;JUMP IF NULL LIST
MOVEI N,7 ;PRESET COUNT FOR FIRST LINE
JRST FILHLC ;GO START TYPEOUTS
FILHLB: PUSHJ P,.TCOMA## ;SEPARATE SWITCHES BY A COMMA
SOJG N,FILHLC ;COUNT OFF SWITCHES IN LINE
MOVEI T1,[ASCIZ /
/]
PUSHJ P,.TSTRG## ;START NEW LINE
MOVEI N,^D8 ;RESET COUNTER
FILHLC: PUSHJ P,.TSPAC## ;PRECEDE EACH SWITCH BY A SPACE
MOVE T1,1(P1) ;GET NEXT SWITCH
PUSHJ P,.TSIXN## ;TYPE IT
AOBJN P1,FILHLB ;LOOP UNTIL DONE
FILHLD: PUSHJ P,.TCRLF## ;TYPE END OF LINE
SOJG P2,FILHLA ;LOOP FOR TWO SHOTS
;HERE AT END OF HELP OUTPUT
FILSHX: PUSHJ P,CLRBFN ;SKIP TO EOL ON INPUT
JRST .FMSGX ;GO CLEAN UP AND RESTART
;HERE WHEN /HELP:ARGUEMENT TYPED TO LIST SWITCH TYPES
ARGHLP: PUSHJ P,.SAVE4## ;SAVE 4
MOVEI P2,2 ;SETUP FOR TWO PASSES
PUSHJ P,.TCRLF## ;START NEW LINW
MOVEI T1,[ASCIZ/Flags are:/] ;LOAD HEADER
PUSHJ P,.TSTRG## ;TYPE
PUSHJ P,.TCRLF##
MOVSI T2,-LN$FLG ;GET LENGTH OF FLAGS
TLOOP: PUSHJ P,.TTABC## ;SPACE OVER
HLRZ T1,FLGSYM(T2) ;GET PREFIX CHAR
PUSHJ P,.TCHAR## ;TYPE
MOVEI T1,[ASCIZ/ - /] ;SPACE
PUSHJ P,.TSTRG## ;..
HRRZ T1,FLGSYM(T2) ;GET STRING ADDR
PUSHJ P,.TSTRG## ;TYPE
PUSHJ P,.TCRLF## ;NEW LINW
AOBJN T2,TLOOP ;AND LOOP
ARGTYP: PUSHJ P,.TCRLF## ;START NEW LINE
MOVEI T1,[ASCIZ/Switches are:/] ;HEADER
CAIN P2,1 ;SEE IF PASS 2
MOVEI T1,[ASCIZ/Standard ones:/] ;YES, CHANGE NAME
PUSHJ P,.TSTRG## ;TYPE
PUSHJ P,.TCRLF## ;NEW LINE
PUSHJ P,.TCRLF## ;..
MOVE P1,SWTPTR ;GET USER SWITCH POINTER
CAIN P2,1 ;SEE IF PASS2
MOVE P1,[IOWD STSWTL,STSWTN] ;YES, GET SCANS DEFAULT POINTER
MOVE P3,P1 ;SAVE IT
JUMPE P1,TYPNXT ;NULL=END
LOOP: HRRZ T1,P1 ;GET INDEX INTO TABLE
SUBI T1,(P3) ;SUUBTRACT OFF START
HRRZ T3,SWTCHM ;GET USER M TABLE
ADD T3,T1 ;ADD IN OFFSET
CAIN P2,1 ;SEE IF DOING USER TABLE
MOVE T2,STSWTM(T1) ;NO--GET FROM STANDARD TABLE
CAIE P2,1 ;SEE IF UUSER TABLE
MOVE T2,(T3) ;YES--GET FROM HIS TABLE
HRRZ T3,SWTCHD ;GET USER D TABLE
ADD T3,T1 ;ADD IN OFFSET
CAIN P2,1 ;SEE IF DOING USER TABLE
MOVE T4,STSWTD(T1) ;NO--GET FROM STANDARD TABLE
CAIE P2,1 ;SEE IF USER TABLR
MOVE T4,(T3) ;YES--GET FROM USER TABLE
PUSH P,T2 ;SAVE T2 (PROCESSOR)
PUSH P,T4 ;SAVE T4 (FLAGS)
MOVSI T2,-LN$FLG
MOVEI T3,0 ;CLEAR COUNT
FLOOP: HLRZ T1,FLGSYM(T2) ;GET SYMBOL
TDNE T4,FLGBIT(T2) ;TEST BIT
PUSHJ P,.TCHAR## ;SET--OUTPUT SYMBOL
TDNE T4,FLGBIT(T2) ;TEST BIT
ADDI T3,1 ;SET--COUNT
AOBJN T2,FLOOP
PUSHJ P,.TSPAC## ;GIVE A SPACE
CAIG T3,4 ;SEE IF 5 YET
AOJA T3,.-2 ;NO KEEP SPACING
MOVE T1,1(P1) ;GET SIXBIT NAME
PUSHJ P,.TSIXN## ;TYPE
MOVEI T1,[ASCIZ/: /] ;TAB
PUSHJ P,.TSTRG## ;..
POP P,T4
POP P,T2
JUMPG T2,SPTYPE ;>0 SP SWITCH
JUMPE T2,SSSN ;=0 SS OR SN SWITCH
TLNE T4,(FS.LRG) ;SEE IF LARGE VALUE
JRST SPTYPE ;YES, MUST BE SP SWITCH
JRST SLTYPE ;NO, MUST BE SL SWITCH
SSSN: TLNE T4,(FS.NOS) ;SEE IF INTERNAL FOR SN SWITCH
JRST SNTYPE ;YES
SSTYPE: MOVEI T1,[ASCIZ/Stand-alone/] ;NO, SS SWITCH
JRST PTYPE ;TYPE TYPE
SNTYPE: MOVEI T1,[ASCIZ\Yes/no\] ;SN SWITCH
JRST PTYPE
SPTYPE: HRRZ T1,T2 ;SP, GET PROCESSOR
TXNN T4,FS.HEL ;SPECIAL HELP TEXT?
JRST SPTY.1 ;NO
MOVE T1,-1(T1) ;YES--GET ADDR
TLNN T1,-1 ;LH=0?
JRST PTYPE ;YES--TYPE ASCIZ STRING
PUSHJ P,(T1) ;NO--CALL ROUTINE
JRST TYPNXT ;AND CONTINUE
SPTY.1: HLRZ T3,T2 ;GET MAX VALUE
TLNE T4,(FS.LRG) ;SEE IF LARGE
MOVE T3,(T3) ;YES, GET VALUE FROM LITERAL
MOVE T4,T3 ;SAVE MAX IN T4
MOVSI T2,-LN$SPN ;LENGTH OF WHAT WE KNOW
HLRZ T3,SPNAM(T2) ;GET ADDR
CAMN T3,T1 ;MATCH?
JRST SPMAT ;YES
AOBJN T2,.-3 ;NO, LOOP
MOVEI T1,[ASCIZ/Processor type/] ;COULDN'T FIND
JRST PTYPE ;TYPE
SPMAT: HRRZ T1,SPNAM(T2) ;LOAD ADDR OF PROCCESSOR TEXT
PUSHJ P,.TSTRG## ;TYPE STRING
JUMPE T4,TYPNXT ;IF NO MAX VALUE, FORGET
MOVSI T2,-LN$MAX ;GET LENGTH OF KNOWN MAX PROCESSORS
HRRZ T1,SPMAX(T2) ;GET PROCESSOR
CAMN T1,T3 ;SEE IF MATCH
JRST SPMATC ;YES!
AOBJN T2,.-3 ;NO, LOOP
JRST TYPNXT ;CAN'T FIND, GIVE UP
SPMATC: MOVEI T1,[ASCIZ/ (Max=/] ;LOAD MESG
PUSHJ P,.TSTRG## ;TYPE
HLRZ T2,SPMAX(T2) ;GET TYPER ADDR
MOVE T1,T4 ;AND MAX VALUE
PUSHJ P,(T2) ;GO TO IT
MOVEI T1,")" ;CLOSE PARA
PUSHJ P,.TCHAR## ;TYPE
JRST TYPNXT ;AND CONTINUE
SLTYPE: HRRZ T1,T2 ;SP, GET PROCESSOR
TXNN T4,FS.HEL ;SPECIAL HELP TEXT?
JRST SLTY.1 ;NO
MOVE T1,(T1) ;YESGET ADDR
TLNN T1,-1 ;ASCIZ STRING?
JRST PTYPE ;YES
PUSHJ P,(T1) ;CALL SUBROUTINE
JRST TYPNXT ;AND CONTINUE
SLTY.1: MOVE P4,T2 ;GET IOWD
MOVEI T1,"(" ;START W/ OPEN PARA
PUSHJ P,.TCHAR## ;TYPE
JRST NOCOMA ;SKIP COMMA FIRST TIME
SLLOP: PUSH P,C ;SAVE C
LDB C,[POINT 6,1(P4),5] ;GET FIRST CHAR
ADDI C," " ;MAKE ASCII
PUSHJ P,.TICAD ;SEE IF ALPHA-NUMERIC
JRST [POP P,C ;NO, GET C BACK
JRST NXYKEY] ;AND GO TO NEXT KEY
POP P,C ;YES, GET C BACK
PUSHJ P,.TCOMA## ;TYPE COMMA
NOCOMA: MOVE T1,1(P4) ;GET SIXBIT
PUSHJ P,.TSIXN## ;TYPE KEY
NXYKEY: AOBJN P4,SLLOP ;AND LOOP
MOVEI T1,")" ;CLOSE PARA
PUSHJ P,.TCHAR## ;..
SKIPA ;SKIP OVER
PTYPE: PUSHJ P,.TSTRG## ;TYPE THE STRING
TYPNXT: PUSHJ P,.TCRLF## ;START NEW LINE
AOBJN P1,LOOP ;ADVANCE TO NEXT SWITCH
SOJG P2,ARGTYP ;ALL DONE, ADVANCE TO NEXT SWITCH TABLE
POPJ P, ;HELP OOUTPUT DDONE
SPNAM: .SWDEC,,[ASCIZ/Decimal number/]
.SWOCT,,[ASCIZ/Octal number/]
.SWCOR,,[ASCIZ/Core value/]
.SWASQ,,[ASCIZ/"ASCII string"/]
.SWSXQ,,[ASCIZ/"SIXBIT string"/]
.SWSXM,,[ASCIZ/Multi-word SIXBIT string/]
.SWSIX,,[ASCIZ/SIXBIT word/]
.SWDTP,,[ASCIZ\Date/time past\]
.SWDTF,,[ASCIZ\Date/time future\]
.SWDTM,,[ASCIZ\Date-time\]
.SWFIL,,[ASCIZ/File specification/]
.VERSW,,[ASCIZ/Version expression/]
.BLOKW,,[ASCIZ/Block size word/]
LN$SPN==.-SPNAM
SPMAX: .TDECW##,,.SWDEC
.TOCTW##,,.SWOCT
.TBLOK##,,.BLOKW
.TCORW##,,.SWCOR
LN$MAX==.-SPMAX
DEFINE FBITS,<
XX C,FS.NCM,<Switch does not constitute a command>
; XX E,FS.NUE,<No user exit on this switch>
XX G,FS.NFS,<Switch is global>
XX O,FS.OBV,<Or bit values from switch>
XX V,FS.VRQ,<Switch value required>
>
DEFINE XX(A,B,C),<EXP B>
FLGBIT: FBITS
LN$FLG==.-FLGBIT
DEFINE XX(A,B,C),<XWD "A",[ASCIZ/C/]>
FLGSYM: FBITS
;HERE AFTER A NUMERIC SWITCH VALUE TO CHECK AGAINST MAX
.SWMAX::HLRZ T1,@SWM(P2) ;CHECK MAX
SKIPE T2,T1 ;SEE IF SET
MOVE T2,@SWD(P2) ;YES--GET FLAGS
TXNE T2,FS.LRG ;SEE IF LARGE
MOVE T1,(T1) ;YES--GET VALUE
TXNE T2,FS.OBV ;SEE IF OR-BIT VALUE [277]
JRST .SWDPB ;YES--JUST GO STORE [277]
JUMPE T1,.SWDPB ;IF NO MAX, LET IT PASS
JUMPL N,E.SVNG ;IF NEGATIVE, GIVE UP
CAMLE N,T1
JRST E.SVTL ;IF NOT IN BOUNDS, GIVE ERROR
.SWDPB::POPJ P, ;RETURN TO STORE VALUE [343]
;HERE WHEN READY TO STORE VALUE OF A SWITCH
SWDPBE: MOVE T2,@SWP(P2) ;GET POINTER TO STORAGE LOCATION
MOVE T3,@SWD(P2) ;GET FLAGS [277]
HLL P1,T3 ;SAVE IN SAFE PLACE [277]
TXNE P1,FS.OBV ;SEE IF OR OF BIT VALUES [277]
JRST [HRRZ T1,N ;YES--GET COPY OF JUST VALUE [277]
TLNN N,-2 ;SEE IF DEFAULT [531]
TLZN N,1 ; (VALUE IS ALREADY BITS) [531]
CAIN T1,-1 ;SEE IF ALL [341]
JRST .+1 ;YES--LEAVE INTACT [341]
JUMPE T1,.+1 ;SEE IF NONE, AND LEAVE INTACT [341]
CAIL T1,^D18 ;SEE IF FITS IN HALF WORD [277]
JRST E.SVTL ;NO--TOO LARGE [277]
MOVEI T1,1 ;GET A BIT TO POSITION [277]
LSH T1,-1(N) ;POSITION IT (1 AT 1B35, ETC.) [277]
HRR N,T1 ;PUT BIT VALUE BACK IN N [277]
JRST .+1] ;AND PROCEED [277]
TLZ P2,-1 ;CLEAR POSSIBLE JUNK [316]
SKIPE STRSWT ;SEE IF CALLER WANTS CONTROL
CAIN P2,STDSWC ;YES--SEE IF HIS SWITCH
JRST .+2 ;NO
JRST [TXNE P1,FS.NUE ;SEE IF NO EXIT
JRST .+1 ;RIGHT--PROCEED
PUSHJ P,@STRSWT ;YES--GO TO HIM(N=VAL,T2=PTR,T3=FLAGS)
PJRST SWDONE ;HE SAYS WE SHOULD NOT STORE
JRST .+1] ;HE SAYS STORE
TLNN T2,777700 ;SEE IF BYTE POINTER
TLO T2,(POINT 36,0,35) ;NO--MAKE INTO FULL WORD
LDB T4,[POINT 6,T2,11] ;GET BYTE SIZE
CAILE T4,^D36 ;[625] SEE IF MULTI-WORD
JRST FILSWC ;[625] YES, USE MULTI-WORD CODE
MOVE T3,T2 ;POINT TO FLAG FIELD
CAIE T4,^D36 ;[625] IF PARTIAL, THEN
AOS T3 ; IN NEXT WORD
LDB T1,T3 ;SEE IF ALREADY SOMETHING THERE
SKIPL FLVERB ;IN VERB, ALLOW CHANGES
CAMN T1,[-1] ;IF -1,
JRST FILSWN ; THEN NOTHING YET
CAIE T4,^D36 ;[625] SEE IF FULL WORD
JUMPE T1,FILSWN ;NO--OK IF MASK ABSENT
TXNE P1,FS.OBV ;SEE IF OR BIT VALUES [277]
JRST [HLRZ T1,(T2) ;YES--GET MASK FROM LH [277]
CAIE T1,-1 ;IF WAS ALL OR NONE, OK [503]
TRNN T1,(N) ;SEE IF THIS BIT SET [277]
JRST FILSWN ;NO--OK TO PROCEED [277]
HRRZ T1,(T2) ;GET BIT TO MODIFY [503]
TLNE N,-1 ;SEE IF NOT THIS TIME [503]
TRC T1,-1 ;YES--CHANGE VALUE [503]
TRNE T1,(N) ;SEE IF SET SAME LAST TIME [503]
JRST FILSWN ;YES--OK TO UPDATE [503]
JRST E.DSI] ;[623] NO--DUPLICATE SWITCH
SETO T1, ;[632] SET ALL BITS ON
LSH T1,(T4) ;[632] EXCEPT ENOUGH BITS FOR VALUE
ANDCM N,T1 ;[632] CLEAR BITS WE CAN'T STORE
LDB T1,T2 ;[623] GET OLD VALUE
CAME T1,N ;[623] SEE IF SAME VALUE
JRST E.DSI ;[623] NO--DUPLICATE SWITCH
FILSWN: TXNE P1,FS.OBV ;SEE IF OR BIT VALUE [277]
CAIE T4,^D36 ; WITH FULL WORD STORAGE [277]
JRST FILSWV ;NO--JUST GO DO STORE LOGIC [277]
MOVSS N ;YES--GET BIT TO LH [277]
CAIN N,-1 ;SEE IF NONE [316]
TLOA N,-1 ;RIGHT--SET TO -1,,0 [316]
TRNE N,-1 ;SEE IF "NO" VALUE [277]
TRZA N,-1 ;RIGHT--CLEAR JUNK [277]
HLRS N ;NOPE--COPY BIT TO SET IT ON [277]
IORM N,(T2) ;STORE VALUE AND MASK [277]
TRNE N,-1 ;SEE IF "NO" [503]
PJRST SWDONE ;NO--THAT'S ALL [503]
HLRZS N ;YES--GET BIT IN RH ONLY [503]
ANDCAM N,(T2) ;AND CLEAR IT OUT [503]
PJRST SWDONE ;END EXIT ROUTINE [277]
FILSWV: DPB N,T2 ;NO--LET HARDWARE STORE VALUE
SETOM T1 ;PREPARE TO UPDATE MASK
CAIGE T4,^D36 ;SEE IF LT FULL WORD
DPB T1,T3 ;YES--STORE MASK
MOVE T4,SWTCNT ;GET DEPTH [357]
SKIPGE FLVERB ;SEE IF VERB MODE [357]
CAIE T4,1 ;SEE IF TOP LEVEL [357]
PJRST SWDONE ;NO--RETURN TO CALLER
TLZ T2,-1 ;GET POINTER ADDRESS
CAIL T2,F.ZER ;SEE IF IN LOCAL [357]
CAILE T2,F.EMZR ; FILE SPEC AREA [357]
JRST FILSW1 ;NO--TRY BELOW
SUBI T2,F.MOD-P.MOD ;YES--SWITCH TO [357]
SUBI T3,F.MOD-P.MOD ; PXXX AREA [357]
JRST FILSW2 ;AND STORE THERE ALSO [357]
FILSW1: CAML T2,SWTPFF ;SEE IF
CAMLE T2,SWTPFL ; USER FXXX
PJRST SWDONE ;NO--JUST FINISH
ADD T2,SWTPFO ;SHIFT TO PXXX
ADD T3,SWTPFO ; ..
FILSW2: HLL T2,T3 ;RESTORE POINTER
DPB T1,T3 ;STORE MASK
DPB N,T2 ;STORE VALUE
PJRST SWDONE ;AND COMPLETE
;[624] HERE WHEN MUST COMPARE MULTIPLE WORDS
FILSWC: SKIPGE FLVERB ;[625] IN VERB MODE?
JRST FILSWW ;[625] YES, ALLOW CHANGE
MOVE T1,(T2) ;[625] GET FIRST WORD OF VALUE
JUMPE T1,FILSWW ;[625] IF ZERO, OK TO OVERWRITE
AOJE T1,FILSWW ;[625] ALSO OK TO OVERWRITE IF -1
HRLZI T4,-^D65(T4) ;[624] GET MINUS NUMBER OF WORDS IN LEFT HALF
HRRI T4,.NMUL ;[624] MAKE AN AOBJN WORD
HRRZ T3,T2 ;[624] GET ADDRESS OF PREVIOUS VALUE
FILSW3: MOVE T1,(T4) ;[624] GET WORD OF NEW VALUE
CAME T1,(T3) ;[624] SAME AS OLD?
JRST E.DSI ;[624] NO - DUPLICATE SWITCH ERROR
AOS T3 ;[624] BUMP POINTER TO OLD VALUE
AOBJN T4,FILSW3 ;[624] BUMP NEW POINTER, TRY NEXT WORD
;HERE WHEN STORE IS TO MULTIPLE WORDS
FILSWW: LDB T1,[POINT 6,T2,11] ;GET NUMBER OF WORDS
MOVN T1,T1 ;COMPLEMENT
HRLI T2,.NMUL ;GET SOURCE
ADDI T1,77+2-1(T2) ;SET LENGTH TO LAST ADDRESS (77 IS TWO WORDS)
MOVE T3,T2 ;MAKE COPY JUST IN CASE
BLT T2,(T1) ;TRANSFER DATA
MOVE T4,SWTCNT ;GET DEPTH [357]
SKIPGE FLVERB ;SEE IF VERB MODE [357]
CAIE T4,1 ;SEE IF TOP LEVEL VERB [357]
PJRST SWDONE ;NO--FINISH UP
CAML T1,SWTPFF ;YES--SEE IF
CAMLE T1,SWTPFL ; IN FXXX AREA
PJRST SWDONE ;NO--FINISH UP
ADD T3,SWTPFO ;YES--POINT TO
ADD T1,SWTPFO ; PXXX AREA
BLT T3,(T1) ;AND MAKE A COPY THERE
;HERE AT END OF SWITCH OR VERB PROCESS
SWDONE: SKIPN FLMULS ;SEE IF MULTIPLE VALUE
JRST SWDONX ;NO--FINISH UP
CAIN C," " ;SEE IF SPACE [566]
PUSHJ P,.TIALT ;GET COMMAND CHARACTER [566]
CAIN C,"," ;SEE IF ANOTHER VALUE
JRST [PUSHJ P,.TIALT;YES--CHECK NEXT COMMAND CHARACTER [566]
CAIE C," " ;SEE IF SPACE [566]
PUSHJ P,.REEAT;NO--RE-EAT [566]
JRST KEYWDM];LOOP TO GET VALUE
CAIE C,")" ;NO--SEE IF DONE YET
JUMPG C,E.MRP ;NO--ERROR
SETZM FLMULS ;YES--CLEAR FLAG
SKIPLE C ;IF NOT END OF LINE,
MOVEI C," " ; RETURN SPACE
MOVEM C,LASCHR ;UPDATE LAST CHARACTER [366]
SWDONX: HLLZ T1,@SWD(P2) ;GET SWITCH FLAGS
SOS SWTCNT ;BACK UP RECURSION
POPJ P, ;AND RETURN TO CALLER
.SWDON==:.POPJ1
;HERE WE DEFINE STANDARD SWITCHES PROCESSED IN SCAN
DEFINE SWTCHS,<
SP ABEFORE,F.ABF,.SWDTP,,FS.VRQ
SP ASINCE,F.ASN,.SWDTP,,FS.VRQ
SP BEFORE,F.BFR,.SWDTP,,FS.VRQ
SL DENSITY,<POINTR (F.MOD,FX.DEN)>,DENS,DENSIN
SS ERNONE,<POINTR (F.MOD,FX.NOM)>,0
SS ERPROTECTION,<POINTR (F.MOD,FX.PRT)>,0
SS ERSUPERSEDE,<POINTR (F.MOD,FX.SUP)>,1
SP ESTIMATE,F.EST,.BLOKW,,FS.VRQ
SP EXIT,N.DEV,SWEXIT,,FS.NFS!FS.NCM!FS.HEL
SL *HELP,<-1,,.SWHLP>,HELP,HELPTEXT,FS.NFS!FS.NCM
SP LENGTH,F.FLM,SWLEN,,FS.VRQ!FS.HEL
SL MESSAGE,<*F,.FLVRB##>,VRB,PD.MSG,FS.OBV!FS.NFS ;[612]
IFN M$INDP,<
SS NOOPTION,OPTION,0,FS.NFS ;[612]
>
SS OKNONE,<POINTR (F.MOD,FX.NOM)>,1
SS OKPROTECTION,<POINTR (F.MOD,FX.PRT)>,1
SS OKSUPERSEDE,<POINTR (F.MOD,FX.SUP)>,0
IFN M$INDP,<
SP OPTION,OPTION,.SWSIX,OPT,FS.NFS ;[612]
>
SL PARITY,<POINTR (F.MOD,FX.PAR)>,PAR,PARODD
SN PHYSICAL,<POINTR (F.MOD,FX.PHY)>
SP PROTECTION,<POINTR (F.MOD,FX.PRO)>,.SWOCT,PRO
IFN M$INDP,<
SP RUN,N.ZER,.SWFIL,RNL,FS.NFS!FS.NCM!FS.VRQ
SP RUNCORE,N.CORE,.SWCOR,RNC,FS.LRG!FS.NFS!FS.NCM
SP RUNOFFSET,N.OFFS,.SWOCT,RUN,FS.NFS!FS.NCM
>
SP SINCE,F.SNC,.SWDTP,,FS.VRQ
SN STRS,<POINTR (F.MOD,FX.STR)>
SP TMPFILE,,SWTMP,,FS.VRQ!FS.NFS!FS.NCM!FS.HEL
SP VERSION,F.VER,.VERSW,,FS.VRQ
>
;NOW BUILD THE TABLES FROM THE SWTCHS MACRO
MX.OPT==1
PD.OPT==1 ;[646]
MX.RNL==N.EZER-N.ZER+1
PD.RNL==0
DOSCAN (STSWT)
;HERE WE BUILD THE KEYS
KEYS (DENS,<200-BPI,556-BPI,800-BPI,1600-BPI,6250-BPI,,,INSTALLATION,,,,,,,,DEFAULT>)
IFN DENSIN-1-<FX.DEN_-<ALIGN. (FX.DEN)>>,<PRINTX ? DENSITY:INSTALLATION IS WRONG>
IFN <DENSDE/2>-DENSIN,<PRINTX ? DENSITY:DEFAULT IS WRONG>
KEYS (HELP,<SWITCHES,TEXT,ARGUMENTS>)
KEYS (PAR,<EVEN,ODD>)
; --DUMMIES-- [321]
KEYS (VRB,<PREFIX,FIRST,CONTINUATION,,,,,ADDRESS>)
IFN VRBADX-VRBADD,<PRINTX ? DEFINE VRBADX TO BE VRBADD VALUE>
;FILE SPECIFICATION ERROR MESSAGES
M$FAIN (DFN,Double file name illegal)
M$FAIN (WDV,Device wildcard illegal)
M$FAIL (NDV,Null device illegal)
M$FAIN (DDV,Double device illegal)
M$FAIN (DEX,Double extension illegal)
E.CDR: HLRZS N
M$FAIO (CDR,Comma required in directory)
E.DDR: PUSHJ P,.NOCTW ;GRAB PROGRAMMER NUMBER FOR MESSAGE
M$FAIO (DDR,Double directory illegal)
E.RDR: HLRZS N
M$FAIO (RDR,Right bracket required in directory)
E.IPJ: TRNN N,-1 ;DON'T POSITION IF OK
HLRZS N
M$FAIO (IPJ,Improper project number)
E.IPG: TRNN N,-1 ;DON'T POSITION IF OK
HLRZS N
TLNE N,400000 ;[637]TYPE OUT IN OCTAL?
JRST E.IPN ;[637]NO, SIXBIT
M$FAIO (IPG,Improper programmer number)
E.IPN: M$FAIN (IPN,Improper programmer name);[637]
IFN FT$SFD,<
E.SFD: MOVEI N,F.ZER
MOVEI T2,.FXLND-1
M$FAIF (SFD,SFD depth greater than)
IFE FT$SDP, M$FAIL (NSF,Null SFD illegal)
IFN FT$SDP, M$FAIL (NSF,Null SFD beyond depth of PATH) ;[610]
>
M$FAIN (UKS,Unknown switch)
M$FAIN (ABS,Ambiguous switch)
M$FAIL (NSS,No switch specified)
E.UKK:: JUMPGE T1,E$$ASV ;SEE IF AMBIGUOUS
M$FAIN (USV,Unknown switch value)
M$FAIN (ASV,Ambiguous switch value)
E.UDS: MOVE N,@SWN(P2)
M$FAIN (UDS,Unknown default for switch)
E.DSI::
IFN M$INDP,<
SKIPE OPTNAM ;SEE IF OPTION FILE
JRST SWDONE ;YES--JUST GIVE UP SINCE ALREADY SET
>
MOVE N,@SWN(P2)
M$FAIN (DSI,Double switch illegal)
E.NMA: MOVE N,@SWN(P2)
M$FAIN (NMA,No modifier allowed on switch)
E.SVTL::M$FAID (SVL,Switch value too large)
E.SVNG::M$FAID (SVN,Switch value negative)
E.MRP==E.ILSC ;GIVE ILLEGAL CHARACTER MESSAGE
E.SENS==E.ILSC ;GIVE ILLEGAL CHARACTER MESSAGE
E.SVR:: MOVE N,@SWN(P2)
M$FAIN (SVR,Switch value required on)
M$FAIL (LVI,<Length values inconsistent; specify min:max>)
M$FAIL (PND,Parenthesis nesting too deep)
E.UOP: SETZM FLFLLP ;CLEAR ( SWITCH AND GIVE ERROR [543]
M$FAIL (UOP,Unmatched open parenthesis)
;FILSTK -- MEMORIZE STICKY DEFAULTS
;CALL: PUSHJ P,FILSTK
; RETURNS AFTER NON-ZERO F.XXX COPIED TO P.XXX
;USES T1, T2
FILSTK: SKIPE SWTCNT ;SEE IF NESTED SWITCH
SKIPGE FLVERB ;NO--SEE IF VERB MODE
SKIPA
POPJ P, ;YES--DON'T SAVE
SKIPE T1,F.DEV ;COPY DEVICE
MOVEM T1,P.DEV
SKIPE T1,F.NAM ;GET DEFAULT NAME [534]
MOVEM T1,P.NAM ;IF SET, STORE FOR DEFAULTER [534]
MOVE T2,F.NAMM ;GET DEFAULT NAME MASK [534]
SKIPE T1 ;IF NAME SET, [534]
MOVEM T2,P.NAMM ; SET MASK ALSO [534]
SKIPE T1,F.EXT ;COPY EXTENSION
MOVEM T1,P.EXT
MOVE T2,[F.DIR,,P.DIR]
MOVX T1,FX.DIR ;SET DIRECTORY FLAG
TDNE T1,F.MODM ;SEE IF SET
BLT T2,P.MZER-1 ;YES--COPY DIRECTORY [570,601]
MOVE T1,F.MOD ;COPY FILE MODIFIERS
MOVE T2,F.MODM
ANDCAM T2,P.MOD
IORM T1,P.MOD
IORM T2,P.MODM
MOVSI T2,P.MZER-P.EZER ;GET LENGTH OF SWITCHES [346]
FILST1: MOVE T1,F.MZER(T2) ;GET CURRENT VALUE [346]
CAME T1,[-1] ;SEE IF SET [255,346]
MOVEM T1,P.MZER(T2) ;YES--UPDATE STICKY VALUE [346]
AOBJN T2,FILST1 ;LOOP OVER SWITCHES [346]
SKIPE MEMSTK ;SEE IF USER WANTS CONTROL
PJRST @MEMSTK ;YES--GO TO HIM
POPJ P, ;RETURN
SUBTTL SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME
;.DATIF -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN FUTURE
;.DATIG -- DITTO (CHARACTER ALREADY IN C)
;CALL: PUSHJ P,.DATIF/.DATIG
; RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4 UPDATES C (SEPARATOR)
.DATIF::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DATIG::SETZM FLFUTR ;CLEAR FUTURE RELATIVE
SETZM FLFUTD ;SET DEFAULT
AOS FLFUTD ; TO FUTURE
CAIE C,"+" ;SEE IF FUTURE RELATIVE
JRST DATIF1 ;NO--JUST GET DATE-TIME
AOS FLFUTR ;YES--SET FUTURE REL FLAG
PUSHJ P,.TIAUC ;GET ANOTHER CHARACTER
DATIF1: PJRST DATIM ;[615] GET DATE/TIME
;.DATIP -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN THE PAST
;.DATIQ -- DITTO (CHARACTER ALREADY IN C)
;CALL: PUSHJ P,.DATIP/.DATIQ
; RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4 UPDATES C (SEPARATOR)
.DATIP::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DATIQ::SETZM FLFUTR ;CLEAR PAST RELATIVE
SETOM FLFUTD ;SET DEFAULT TO PAST
CAIE C,"-" ;SEE IF PAST RELATIVE
JRST DATIP1 ;NO--JUST GET DATE-TIME
SOS FLFUTR ;YES--SET PAST REL FLAG
PUSHJ P,.TIAUC ;GET ANOTHER CHARACTER
DATIP1: PJRST DATIM ;[615] GET DATE/TIME
;.DATIM -- ROUTINE TO SCAN DATE AND TIME ARGUMENT
;.DATIC -- DITTO (CHARACTER ALREADY IN C)
;CALL: PUSHJ P,.DATIM/.DATIC
; RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4 UPDATES C (SEPARATOR)
.DATIM::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DATIC::SETZM FLFUTR ;CLEAR RELATIVE FLAG
SETZM FLFUTD ;CLEAR DEFAULT FLAG
CAIE C,"+" ;SEE IF FUTURE RELATIVE
JRST DATIC1 ;NO--PROCEED
AOS FLFUTR ;YES--SET FLAG
JRST DATIC2 ;AND PROCEED
DATIC1: CAIE C,"-" ;SEE IF PAST RELATIVE
PJRST DATIM ;NO--JUST GET ABS DATE
SOS FLFUTR ;YES--SET FLAG
DATIC2: PUSHJ P,.TIAUC ;GET NEXT CHAR
;AND FALL INTO DATE/TIME GETTER
;DATIM -- ROUTINE TO INPUT DATE/TIME
;CALL: SET FLFUTR TO -1 IF PAST RELATIVE, 0 IF ABSOLUTE, +1 IF FUTURE RELATIVE
; SIMILARLY FOR FLFUTD TO INDICATE DEFAULT DIRECTION IF FLFUTR=0
; GET NEXT CHARACTER IN C
; PUSHJ P,DATIM
;RETURN WITH TRUE DATE/TIME IN N IN INTERNAL SPECIAL FORMAT
; SETS NOW TO CURRENT DATE/TIME
;USES T1-4, UPDATES C
;
;TYPE-IN FORMATS:
; (THE LEADING +- IS HANDLED BY CALLER)
;
; [ [ DAY IN WEEK ] ]
; [ [ NNND ] ]
; [ [ [ MM-DD [-Y ] ] : ] [HH[:MM[:SS]]] ]
; [ [ [ MMM-DD [-YY ] ] ] ]
; [ [ [ DD-MMM [-YYYY] ] ] ]
; [ MNEMONIC ]
;WHERE:
; D LETTER D
; DD DAY IN MONTH (1-31)
; HH HOURS (00-23)
; MM MONTH IN YEAR (1-12)
; OR MINUTES (00-59)
; MMM MNEMONIC MONTH OR ABBREV.
; SS SECONDS (0-59)
; Y LAST DIGIT OF THIS DECADE
; YY LAST TWO DIGITS OF THIS CENTURY
; YYYY YEAR
; DAY IN WEEK IS MNEMONIC OR ABBREVIATION
; MNEMONIC IS A SET OF PREDEFINED TIMES
;DESCRIBED ABOVE
;FALL HERE FROM .DATIC
DATIM: SKIPE T1,FLFUTR ;SEE IF FORCED DIRECTION
MOVEM T1,FLFUTD ; YES--THAT IMPLIES DEFAULT
SETOM VAL1 ;CLEAR RESULT WORDS
MOVE T1,[VAL1,,VAL2]
BLT T1,VAL9 ; ..
PUSHJ P,.GTNOW## ;GET CURRENT DATE/TIME
MOVEM T1,NOW ;SAVE FOR LATER TO BE CONSISTENT
CAIL C,"0" ;SEE IF DIGIT
CAILE C,"9" ; ..
JRST .+2 ;NO--MNEMONIC FOR SOMETHING
JRST DATIMD ;YES--GO GET DECIMAL
;HERE IF STARTING WITH ALPHA, MIGHT BE DAY, MONTH, OR MNEMONIC
PUSHJ P,.SIXSC ;GET SIXBIT WORD
JUMPE N,E$$DTM ;ILLEGAL SEPARATOR IF ABSENT [274]
MOVE T1,MNDPTR ;POINT TO FULL TABLE
PUSHJ P,.NAME ;LOOKUP IN TABLE
JRST E$$UDN ;ERROR IF NOT KNOWN
MOVEI N,(T1) ;GET
SUBI N,DAYS ; DAY INDEX
CAIL N,7 ;SEE IF DAY OF WEEK
JRST DATIMM ;NO--LOOK ON
;HERE WHEN DAY OF WEEK RECOGNIZED
SKIPN T1,FLFUTD ;GET DEFAULT DIRECTION
JRST E$$NPF ;ERROR IF NONE
MOVEM T1,FLFUTR ;SET AS FORCED DIRECTION
HLRZ T2,NOW ;GET DAYS
IDIVI T2,7 ;GET DAY OF WEEK
SUB N,T3 ;GET FUTURE DAYS FROM NOW
SKIPGE N ;IF NEGATIVE,
ADDI N,7 ; MAKE LATER THIS WEEK
HLLZ T1,NOW ;CLEAR CURRENT
SKIPL FLFUTD ;SEE IF FUTURE
TROA T1,-1 ;YES--SET MIDNIGHT MINUS EPSILON
SUBI N,7 ;NO--MAKE PAST
HRLZ N,N ;POSITION TO LEFT HALF
ADD N,T1 ;MODIFY CURRENT DATE/TIME
DATIMW: PUSH P,N ;SAVE DATE
PUSHJ P,DATIC ;GO CHECK TIME
HRRZ N,(P) ;NO--USE VALUE IN DATE
POP P,T1 ;RESTORE DATE
HLL N,T1 ; TO ANSWER
SKIPG FLFUTR ;[576] SKIP IF FUTURE
JRST DATIMK ;[576] ADJUST PAST RESULT
CAMGE N,NOW ;[576] IF NOT FUTURE, MUST HAVE
;[576] WANTED A WEEK FROM TODAY,
;[576] BUT EARLIER IN THE DAY.
ADD N,[7,,0] ;[576] MAKE TIME NEXT WEEK
JRST DATIMX ;[576] CHECK AND RETURN
DATIMK: MOVE T2,N ;[576] SIMILAR TEST FOR PAST
ADD T2,[7,,0] ;[576] ADD A WEEK TO PAST TIME
CAMG T2,NOW ;[576] WAS TIME OVER A WEEK AGO?
MOVE N,T2 ;[576] YES, USE NEW ONE
JRST DATIMX ;[576] CHECK ANSWER AND RETURN
;HERE IF MONTH OR MNEMONIC
DATIMM: MOVEI N,(T1) ;GET MONTH
SUBI N,MONTHS-1 ; AS 1-12
CAILE N,^D12 ;SEE IF MONTH
JRST DATIMN ;NO--MUST BE MNEMONIC
MOVEM N,VAL6 ;YES--STORE MONTH
CAIE C,"-" ;MUST BE DAY NEXT
JRST E$$MDD ;NO--ERROR
PUSHJ P,.DECNW ;YES--GET IT
JUMPLE N,E$$NND ;ERROR IF NEGATIVE
CAILE N,^D31 ;VERIFY IN RANGE
JRST E$$DFL ;ERROR IF TOO LARGE
MOVEM N,VAL5 ;SAVE AWAY
JRST DATIY0 ;AND GET YEAR IF PRESENT
;HERE IF MNEMONIC
DATIMN: HRRZ T2,T1 ;GET COPY [305]
CAIN T2,SPLGTM ;SEE IF "LOGIN" [505]
SKIPG N,LOGTIM ;AND WE KNOW IT [505]
SKIPA ;NO--PROCEED [505]
JRST DATIMX ;YES--GO GIVE ANSWER [505]
CAIN T2,SPNOON ;SEE IF "NOON" [520]
JRST [HLLZ N,NOW ;YES--GET TODAY [520]
HRRI N,1B18 ;SET TO NOON [520]
JRST DATIMW] ;GO FINISH UP [520]
CAIN T2,SPMIDN ;SEE IF "MIDNIGHT" [520]
JRST [HLLZ N,NOW ;GET TODAY [520]
JRST DATIMO] ;GO SET TO MIDNIGHT [520]
SUBI T2,SPCDAY ;SUBTRACT OFFSET TO SPECIAL DAYS [305]
CAILE T2,2 ;SEE IF ONE OF THREE [305]
JRST E.MDS ;NO--UNSUPPORTED [305]
HLRZ N,NOW ;YES--GET TODAY [305]
ADDI N,-1(T2) ;OFFSET IT [305]
HRLZS N ;POSITION FOR ANSWER [305]
DATIMO: SKIPL FLFUTD ;SEE IF FUTURE [305]
TRO N,-1 ;YES--SET TO MIDNIGHT MINUS EPSILON [305]
JRST DATIMW ;AND GO FINISH UP [305]
;HERE IF UNSUPPORTED MNEMONIC
E.MDS: MOVE N,(T1) ;GET NAME OF SWITCH
M$FAIN (MDS,Mnemonic date/time switch not implemented)
;HERE IF STARTING WITH DECIMAL NUMBER
DATIMD: PUSHJ P,.DECNC ;YES--GO GET FULL NUMBER
JUMPL N,E$$NND ;ILLEGAL IF NEGATIVE
CAIE C,"D" ;SEE IF DAYS
JRST DATIN ;NO--MUST BE -
MOVE T1,FLFUTD ;YES--RELATIVE SO GET FORCING FUNCTION
MOVEM T1,FLFUTR ; AND FORCE IT
JUMPE T1,E$$NPF ;ERROR IF DIRECTION UNCLEAR
CAIL N,1B18 ;VERIFY NOT HUGE
JRST E$$DFL ;ERROR--TOO LARGE
MOVEM N,VAL5 ;SAVE RELATIVE DATE
PUSHJ P,.TIAUC ;GET NEXT CHARACTER (SKIP D)
PUSHJ P,DATIC ;GO CHECK FOR TIME
MOVEI N,0 ;0 IF NONE
HRL N,VAL5 ;INCLUDE DAYS IN LH
JRST DATITR ;GO DO RELATIVE RETURN
;HERE WHEN DIGITS SEEN WITHOUT A FOLLOWING D
DATIN: CAIE C,"-" ;SEE IF DAY/MONTH COMBO
JRST DATIT ;NO--MUST BE INTO TIME
CAILE N,^D31 ;MUST BE LESS THAN 31
JRST E$$DFL ;NO--ERROR
JUMPE N,E$$DFZ ;VERIFY NOT ZERO
MOVEM N,VAL5 ;SAVE VALUE
PUSHJ P,.TIAUC ;SKIP OVER MINUS
CAIL C,"0" ;SEE IF DIGIT NEXT
CAILE C,"9" ; ..
JRST DATMMM ;NO-- MUST BE MNEMONIC MONTH
PUSHJ P,.DECNC ;YES-- MUST BE MM-DD FORMAT
JUMPLE N,E$$NND ;BAD IF LE 0
CAILE N,^D31 ;VERIFY LE 31
JRST E$$DFL ;BAD
EXCH N,VAL5 ;SWITCH VALUES
CAILE N,^D12 ;VERIFY MONTH OK
JRST E$$DFL ;BAD
JRST DATMM1 ;GO STORE MONTH
;HERE WHEN TIME SEEN BY ITSELF
DATIT: PUSHJ P,DATIG ;GET REST OF TIME
HALT . ;CAN NOT GET HERE
SKIPN FLFUTR ;SEE IF RELATIVE
JRST DATIRN ;NO--GO HANDLE AS ABS.
;HERE WITH DISTANCE IN N
DATITR: SKIPGE FLFUTR ;IF PAST,
MOVN N,N ; COMPLEMENT DISTANCE
ADD N,NOW ;ADD TO CURRENT DATE/TIME
JRST DATIMX ;CHECK ANSWER AND RETURN
;HERE WHEN DD- SEEN AND MNEMONIC MONTH COMING
DATMMM: PUSHJ P,.SIXSC ;GET MNEMONIC
MOVE T1,MONPTR ;GET POINTER TO MONTH TABLE
PUSHJ P,.NAME ;LOOKUP IN TABLE
JRST E$$UDM ;NO GOOD
MOVEI N,(T1) ;GET MONTH
SUBI N,MONTHS-1 ; AS 1-12
;HERE WITH MONTH INDEX (1-12) IN T1
DATMM1: MOVEM N,VAL6 ;SAVE FOR LATER
DATIY0: CAIE C,"-" ;SEE IF YEAR NEXT
JRST DATIRA ;NO--GO HANDLE TIME
;HERE WHEN YEAR NEXT AS ONE, TWO, OR FOUR DIGITS
SETZB N,T1 ;CLEAR DIGIT AND RESULT COUNTERS
DATIY: PUSHJ P,.TIAUC ;GET NEXT DIGIT
CAIL C,"0" ;SEE IF NUMERIC
CAILE C,"9" ; ..
JRST DATIY1 ;NO--MUST BE DONE
IMULI N,^D10 ;ADVANCE RESULT
ADDI N,-"0"(C) ;INCLUDE THIS DIGIT
AOJA T1,DATIY ;LOOP FOR MORE, COUNTING DIGIT
DATIY1: JUMPE T1,E$$ILR ;ERROR IF NO DIGITS
CAIE T1,3 ;ERROR IF 3 DIGITS
CAILE T1,4 ;OK IF 1,2, OR 4
JRST E$$ILR ;ERROR IF GT 4 DIGITS
MOVE T2,N ;GET RESULT
IDIVI T2,^D100 ;SEP. CENTURY
IDIVI T3,^D10 ;SEP. DECADE
CAIG T1,2 ;IF ONE OR TWO DIGITS,
SETOM T2 ; FLAG NO CENTURY KNOWN
CAIN T1,1 ;IF ONE DIGIT,
SETOM T3 ; FLAG NO DECADE KNOWN
MOVEM T4,VAL7 ;SAVE UNITS
MOVEM T3,VAL8 ;SAVE DECADE
MOVEM T2,VAL9 ;SAVE CENTURY
;HERE WITH VAL5-9 CONTAINING DAY, MONTH, YEAR, DECADE, CENTURY
DATIRA: SOS VAL5 ;MAKE DAYS 0-30
SOS VAL6 ;MAKE MONTHS 0-11
PUSHJ P,DATIC ;GET TIME IF PRESENT
SKIPG FLFUTD ;IGNORE ABSENCE
JRST DATIRN ; UNLESS FUTURE
;HERE IF FUTURE WITHOUT TIME
MOVEI T1,^D59 ;SET TO
MOVEM T1,VAL2 ; 23:59:59
MOVEM T1,VAL3 ; ..
MOVEI T1,^D23 ; ..
MOVEM T1,VAL4 ; ..
;HERE WITH VAL2-9 CONTAINING PARSE OR -1 IF TO BE FILLED IN
; STRATEGY IS TO FILL-IN HOLES LESS SIGNIFICANT THAN
; MOST SIGN. FIELD WITH 0; AND TO FILL IN MORE SIGNIFICANT
; HOLES WITH CURRENT VALUE. THEN IF WRONG DIRECTION FROM
; NOW, ADD/SUB ONE TO FIELD JUST ABOVE MOST SIGNIFICANT DIFFERENT
; (FIELD CARRY NOT NEEDED SINCE IT WILL HAPPEN IMPLICITLY).
DATIRN: PUSHJ P,.TICAN ;MAKE SURE NEXT CHAR IS SEPARATOR [542]
SKIPA ;YES--OK [542]
JRST E$$ILC ;NO--FLAG ERROR BEFORE DEFAULTING [542]
MOVE T1,NOW ;GET CURRENT DATE/TIME
PUSHJ P,.CNTDT## ;CONVERT TO EASY FORMAT
MOVE T3,T1 ;SAVE MSTIME
IDIVI T3,^D1000 ; AS SECONDS
ADD T2,[^D1964*^D12*^D31] ;MAKE REAL
MOVEI T4,8 ;TRY 8 FIELDS [250]
DATIRB: MOVE T1,T2 ;POSITION REMAINDER
IDIV T1,[1
^D60
^D60*^D60
1
^D31
^D31*^D12
^D31*^D12*^D10
^D31*^D12*^D10*^D10]-1(T4) ;SPLIT THIS FIELD FROM REST [250]
SKIPL VAL1(T4) ;SEE IF DEFAULT [250]
JRST [TLNN T3,-1 ;NO--FLAG TO ZERO DEFAULTS [250]
HRL T3,T4 ; SAVING INDEX OF LAST DEFAULT [250]
JRST DATRIC] ;AND CONTINUE LOOP
SETZM VAL1(T4) ;DEFAULT TO ZERO [250]
TLNN T3,-1 ;SEE IF NEED CURRENT [250]
MOVEM T1,VAL1(T4) ;YES--SET THAT INSTEAD [250]
DATRIC: CAME T1,VAL1(T4) ;SEE IF SAME AS CURRENT [250]
JRST DATIRD ;NO--REMEMBER FOR LATER
CAIN T4,4 ;SEE IF TIME FOR TIME [250]
HRRZ T2,T3 ;YES--GET IT
SOJG T4,DATIRB ;LOOP UNTIL ALL DONE [250]
;HERE WHEN FILLED IN CURRENT FOR SIGNIFICANT DEFAULTS
DATIRD: SKIPGE VAL1(T4) ;SEE IF DEFAULT [250]
SETZM VAL1(T4) ;CLEAR DEFAULT [250]
SOJG T4,DATIRD ;LOOP UNTIL DONE [250]
HLRZ N,T3 ;RECOVER LAST SIGN. DEFAULT-1 [250]
JUMPE N,DATIRR ;DONE IF NONE [250]
PUSHJ P,DATIRM ;MAKE CURRENT DATE, TIME
MOVE T4,FLFUTD ;GET DEFAULT DIRECTION
XCT [CAMGE T1,NOW
JFCL
CAMLE T1,NOW]+1(T4) ;SEE IF OK
JRST DATIRR ;YES--GO RETURN
SKIPG FLFUTD ;NO--SEE WHICH DIRECTION
SOSA VAL2(N) ;PAST
AOS VAL2(N) ;FUTURE
DATIRR: PUSHJ P,DATIRM ;REMAKE ANSWER
MOVE N,T1 ;MOVE TO ANSWER
;HERE WITH FINAL RESULT, CHECK FOR OK
RADIX 10
DATIMX: MOVEI T1,.TDTTM## ;SET DATE-TIME [314]
MOVEM T1,.LASWD ; OUTPUTER [314]
CAML N,[<1964-1859>*365+<1964-1859>/4+<31-18>+31,,0] ;[261]
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
RADIX 8
M$FAIL (DOR,Date/time out of range)
;SUBROUTINE TO MAKE DATE/TIME
DATIRM: MOVE T1,VAL4 ;GET HOURS
IMULI T1,^D60 ;MAKE INTO MINS
ADD T1,VAL3 ;ADD MINS
IMULI T1,^D60 ;MAKE INTO SECS
ADD T1,VAL2 ;ADD SECS
IMULI T1,^D1000 ;MAKE INTO MILLISECS
MOVE T2,VAL9 ;GET CENTURIES
IMULI T2,^D10 ;MAKE INTO DECADES
ADD T2,VAL8 ;ADD DECADES
IMULI T2,^D10 ;MAKE INTO YEARS
ADD T2,VAL7 ;ADD YEARS
IMULI T2,^D12 ;MAKE INTO MONTHS
ADD T2,VAL6 ;ADD MONTHS
IMULI T2,^D31 ;MAKE INTO DAYS
ADD T2,VAL5 ;ADD DAYS
SUB T2,[^D1964*^D12*^D31] ;REDUCE TO SYSTEM RANGE
PJRST .CNVDT## ;CONVERT TO INTERNAL FORM AND RETURN
;SUBROUTINE TO GET TIME IF SPECIFIED
;RETURNS CPOPJ IF NO TIME, SKIP RETURN IF TIME
; WITH TIME IN RH(N) AS FRACTION OF DAY
;USES T1-4, N
DATIC: CAIE C,":" ;SEE IF TIME NEXT
POPJ P, ;NO--MISSING TIME
PUSHJ P,.DECNW ;GET DECIMAL NUMBER FOR TIME
;HERE WITH FIRST TIME FIELD IN N
DATIG: JUMPL N,E$$NND ;ERROR IF NEGATIVE [326]
CAIL N,^D24 ; AND GE 24,
JRST E$$DFL ;GIVE ERROR--TOO LARGE
MOVEM N,VAL4 ;SAVE HOURS
CAIE C,":" ;SEE IF MINUTES COMING
JRST DATID ;NO--DONE
PUSHJ P,.DECNW ;YES--GET IT
CAIL N,^D60 ;SEE IF IN RANGE
JRST E$$DFL ;NO--GIVE ERROR
JUMPL N,E$$NND ;ERROR IF NEG
MOVEM N,VAL3 ;SAVE MINUTES
CAIE C,":" ;SEE IF SEC. COMING
JRST DATID ;NO--DONE
PUSHJ P,.DECNW ;GET SECONDS
CAIL N,^D60 ;CHECK RANGE
JRST E$$DFL ;NO--GIVE ERROR
JUMPL N,E$$NND ;ERROR IF NEG
MOVEM N,VAL2 ;SAVE SECONDS
;HERE WITH TIME IN VAL2-4
DATID: SKIPGE T1,VAL4 ;GET HOURS
MOVEI T1,0 ; UNLESS ABSENT
IMULI T1,^D60 ;CONV TO MINS
SKIPL VAL3 ;IF MINS PRESENT,
ADD T1,VAL3 ; ADD MINUTES
IMULI T1,^D60 ;CONV TO SECS
SKIPL VAL2 ;IF SECS PRESENT,
ADD T1,VAL2 ; ADD SECONDS
MOVEI T2,0 ;CLEAR OTHER HALF
ASHC T1,-^D17 ;MULT BY 2**18
DIVI T1,^D24*^D3600 ;DIVIDE BY SECONDS/DAY
MOVE N,T1 ;RESULT IS FRACTION OF DAY IN RH
JRST .POPJ1 ;RETURN
;DATE/TIME ERRORS
M$FAIL (NND,Negative number in date/time)
M$FAIL (NPF,Not known whether past or future in date/time)
M$FAIL (DFL,Field too large in date/time)
M$FAIL (DFZ,Field zero in date/time)
M$FAIL (UDM,Unrecognized month in date/time)
M$FAIL (ILR,Illegal year format in date/time)
M$FAIL (UDN,Unrecognized name in date/time)
M$FAIL (MDD,Missing day in date/time)
M$FAIL (DTM,Value missing in date/time)
;MNEMONIC WORDS IN DATE/TIME SCAN
DEFINE XX($1),<
EXP <SIXBIT /$1/>>
DAYS: XX WEDNESDAY
XX THURSDAY
XX FRIDAY
XX SATURDAY
XX SUNDAY
XX MONDAY
XX TUESDAY
MONTHS: XX JANUARY
XX FEBRUARY
XX MARCH
XX APRIL
XX MAY
XX JUNE
XX JULY
XX AUGUST
XX SEPTEMBER
XX OCTOBER
XX NOVEMBER
XX DECEMBER
SPCDAY: XX YESTERDAY
XX TODAY
XX TOMORROW
SPLGTM: XX LOGIN
SPNOON: XX NOON
SPMIDN: XX MIDNIGHT
SPDATM: XX LUNCH
XX DINNER
LSPDTM==.-DAYS
;POINTERS
MONPTR: IOWD ^D12,MONTHS
MNDPTR: IOWD LSPDTM,DAYS
SUBTTL SUBROUTINES FOR COMMAND INPUT -- GET WORD/STRING
;.NOCTW -- INPUT AN OCTAL NAME FROM COMMAND STRING
;.NOCTC -- DITTO (CHARACTER ALREADY IN C)
;DIFFERS FROM .NAMEW IN THAT OCTAL IS NORMAL
;
;NAME IS OCTAL IF LEAD # OR ? OR 0-7, NAME IF LEAD A-Z
;
;CALL: PUSHJ P,.NOCTC/.NOCTW
; RETURN WITH VALUE IN N AND MASK
;NOTE--ON NULL FIELD, N=0 MASK=0 FLNULL=0
;USES T1-T4 UPDATES C (SEPARATOR)
.NOCTW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.NOCTC::SETZB N,FLNULL ;INITIALIZE MASK AND WORD
CAIE C,"*" ;LOOK FOR WILD-CARD
JRST NOCST ;NO--TRY THE HARD WAY
TRO N,377777 ;YES--FUDGE A SUITABLE NAME
PJRST NAMEWX ;AND GO FINISH UP
NOCST: SETOM T2 ;INITIALIZE MASK
CAIE C,.CHCNV ;[645] QUOTING FORCES NAME FORMAT
CAIL C,"A" ;SEE IF NUMBER
PJRST NAMST ;NO--GO GET NAME FORMAT
PJRST NAMNU1 ;YES--GO GET IT
;.NAMEW -- INPUT A SIXBIT NAME FROM COMMAND STRING
;.NAMEC -- DITTO (CHARACTER ALREADY IN C)
;NAME CAN BE:
; * MASK WILL BE 0
; #NN?N MASK WILL BE 0 FOR 3-BITS AT EACH ?
; AA?A MASK WILL BE 0 FOR 6-BITS AT EACH ?
; 'STRING' OR "STRING" OF SIXBIT CHARACTERS WITHOUT
; ANY WILD-CARDS
;# PRECEEDS AN OCTAL FIELD. OPTIONAL SINGLE SUFFIX OF
; K,M,G FOR 2**9,18,27
;
;CALL: PUSHJ P,.NAMEC/.NAMEW
; RETURN WITH WORD IN N AND MASK
;NOTE--ON NULL FIELD N=0, MASK=0, FLNULL=0
;USES T1, T2, T3, T4 UPDATES C (SEPARATOR)
.NAMEW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.NAMEC::SETZB N,FLNULL ;SET NULL TYPEIN FLAG
CAIE C,"*" ;LOOK FOR FULL WILD-CARD
JRST NAMST ;NO--GO GET NAME
HRLZI N,'* ' ;PUT IN NAME FOR THE RECORD
NAMEWX: MOVEI T2,0 ;SET WILD MASK
PUSHJ P,.TIAUC ;GO GET ANOTHER CHARACTER
SETOM FLNULL ;INDICATE NOT NULL
JRST NAMER ;AND GO FINISH UP
;HERE TO READ THE NAME IN
NAMST: SETOM T2 ;INITIALIZE TO FULL MASK
CAIE C,"#" ;SEE IF OCTAL SPECIFICATION
JRST NAMWD ;NO--GET ALPHANUMERIC
NAMNUR: SETOM FLNULL ;INDICATE SOMETHING FOUND
NAMNU: PUSHJ P,.TIAUC ;YES--GET NEXT ODGIT
NAMNU1: CAIE C,"?" ;SEE IF WILD CARD
JRST NAMNU2 ;NO--STUFF
LSH T2,3 ;YES--GET 0 INTO MASK
LSH N,3 ;UPDATE NAME
TRO N,7 ;FORCE NAME NON-ZERO
JRST NAMNUR ;LOOP BACK FOR MORE
NAMNU2: CAIL C,"0" ;SEE IF OCTAL
CAILE C,"7"
JRST NAMNUE ;NO--MUST BE AT END
ROT T2,3 ;ADVANCE MASK
TRO T2,7 ;FORCE THE BITS ON
LSH N,3 ;ADVANCE ACCUMULATOR
ADDI N,-"0"(C) ;ADD IN THIS ODGIT
JRST NAMNUR ;AND LOOP BACK FOR MORE
;HERE WHEN COMPLETED AN OCTAL FIELD
NAMNUE: SETZM FLNEG ;CLEAR NEGATIVE FLAG [544]
PUSHJ P,OCTMUL ;ALLOW OCTAL SUFFIX
SKIPE T1 ;SEE IF SOMETHING THERE
SETOM FLNULL ;YES--SET FLAG
SETOM T3
LSHC T2,(T1)
JRST NAMER ;RETURN
;HERE WHEN TIME TO READ AN ALPHA-NUMERIC FIELD
NAMWD: MOVEI T1,.TSIXN## ;INDICATE SIXBIT FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVEI T1,0 ;CONSTANT TO STORE IN MASK
MOVE T4,[POINT 6,N] ;INITIALIZE NAME POINTER
MOVE T3,[POINT 6,T2] ;INITIALIZE MASK POINTER
PUSHJ P,.TICQT ;CHECK FOR QUOTE
PUSHJ P,.TIMUC ;FORCE TO UPPER CASE
NAMWDC: SKIPE .QUOTE ;SEE IF QUOTE SET
JRST NAMWDS ;YES--JUST STORE
CAIE C,"?" ;SEE IF WILD CARD
JRST NAMWD1 ;NO--STUFF
TLNE T3,(77B5) ;YES--UPDATE MASK
IDPB T1,T3
JRST NAMWDS ;GO UPDATE NAME
NAMWD1: PUSHJ P,.TICAD ;[645] SEE IF ALPHA-NUMERIC
JRST [CAIE C,.CHCNV ;[645] IS IT THE SPECIAL QUOTE CHARACTER?
JRST NAMWDD ;[645] NO--FINISH OFF WORD
PUSHJ P,.TIAUC ;[645] YES--GET NEXT
CAIL C,40 ;[645] IS IT IN SIXBIT RANGE?
CAILE C,137 ;[645] BOTH WAYS?
JRST NAMWDD ;[645] NO--MAYBE ADD AN ERROR HERE?
JRST .+1] ;[645] WE GOT A GOOD ONE
TLNE T3,(77B5) ;PREVENT OVERFLOW
IBP T3 ;UPDATE MASK
NAMWDS: SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T4,(77B5) ;PREVENT OVERFLOW
IDPB C,T4 ;UPDATE NAME
ADDI C," "-' ' ;BACK TO ASCII
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
SETOM FLNULL ;FLAG THAT SOMETHING IS THERE
JRST NAMWDC ;LOOP BACK TO PROCESS
NAMWDD: CAIE C,"*" ;SEE IF ENDING WITH * [512]
JRST NAMER ;NO--JUST EXIT [512]
SUBI C," "-' ' ;YES--CONVERT TO SIXBIT [512]
TLNE T4,(77B5) ;IF ROOM, [512]
IDPB C,T4 ; STORE AWAY [512]
PUSHJ P,.TIAUC ;GET ANOTHER CHARACTER [512]
SETOM FLNULL ;INDICATE NOT NULL [512]
NAMWD2: TLNN T3,(77B5) ;SEE IF DONE WITH WORD YET [512]
JRST NAMER ;YES--FINISH UP [512]
IDPB T1,T3 ;NO--INSERT A WILD MASK [512]
JRST NAMWD2 ;LOOP [512]
NAMER: SKIPN FLNULL ;SEE IF SOMETHING PRESET
MOVEI T2,0 ;NO--CLEAR MASK
MOVEM T2,MASK
IFN ECHO$W,<
NAMER1: MOVE T2,N
PUSHJ P,.TSIXW
OUTSTR [ASCIZ / :: /]
HLRZ T1,MASK
PUSHJ P,.TOCTW##
OUTSTR [ASCIZ /,,/]
HRRZ T1,MASK
PUSHJ P,.TOCTW##
PUSHJ P,.TCRLF##
>
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
;.NAME -- LOOKUP NAME IN TABLE ALLOWING FOR UNIQUE ABBREVIATIONS
;ALWAYS CHECK FOR EXACT MATCH FIRST.
;CALL: MOVE N,NAME
; MOVE T1,[IOWD LENGTH,START OF TABLE]
; PUSHJ P,.NAME
; ERROR RETURN IF UNKNOWN OR DUPLICATE
; AND WITH T1.LT.0 IF NOT MATCH, .GT.0 IF SEVERAL MATCHES
; SKIP RETURN IF FOUND WITH T1 POINTING TO ENTRY
; AND WITH LH(T1)=0 IF ABBREVIATION, OR T1.LT.0 IF EXACT MATCH
;USES T2, T3, T4
.NAME:: MOVE T2,N ;SET NAME FOR ROUTINE
PJRST .LKNAM## ;GO HANDLE IT
;.VERSW -- INPUT A VERSION NUMBER FROM COMMAND STRING
;.VERSC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-VERSION CHARACTER
;GIVES ILLEGAL CHAR MESSAGE IF VERSION NUMBER NOT IN CORRECT FORMAT OR TOO LONG
;CALL: PUSHJ P,.VERSC/.VERSW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.VERSW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.VERSC::PUSHJ P,.TICQT ;SEE IF QUOTING STRING
SETZB N,T1 ;CLEAR VERSION #
VERMJR: CAIL C,"0" ;ONLY ALLOW OCTAL
CAILE C,"7"
JRST VERMIN ;MUST BE SOMETHING ELSE
TLNE N,(7B5) ;GONE TOO FAR?
JRST E$$VER ;YES
LSH N,3 ;MAKE SPACE FOR NEW CHAR
DPB C,[POINT 3,N,11] ;STORE
PUSHJ P,.TIAUC ;GET NEXT CHAR
JRST VERMJR ;SEE IF MORE FOR MAJOR FIELD
;HERE FOR MINOR FIELD, ALPHABETICS ONLY
VERMIN: PUSHJ P,.TICAN ;SEE IF ALPHA-NUMERIC
JRST VEREDT ;NO
CAIL C,"0" ;BUT NOT NUMERIC
CAILE C,"9"
CAIA ;EITHER UPPER OR LOWER CASE ALPHABETIC
JRST E$$VER ;DIGITS NOT ALLOWED HERE
PUSHJ P,.TIMUC ;MAKE LOWER CASE
MOVEI T2,1-"A"(C) ;RELATIVE TO "A"
JUMPE T1,[MOVEI T1,(T2) ;SAVE FIRST CHAR
DPB T2,[POINT 6,N,17] ;STORE IT
PUSHJ P,.TIAUC ;GET ANOTHER
JRST VERMIN] ;CONTINUE
IMULI T1,^D26 ;RADIX 26
ADD T1,T2 ;ADD IN NEW CHAR
CAIL T1,100 ;MAKE SURE NOT TOO LARGE
JRST E$$VER ;SOMETHING WRONG
DPB T1,[POINT 6,N,17]
PUSHJ P,.TIAUC ;GET NEXT
;AND FALL INTO EDIT FIELD
;FALL HERE FROM ABOVE
VEREDT: CAIE C,"(" ;CHECK FOR EDIT FIELD
JRST VERWHO ;NO, TRY CUST FIELD
SETZ T1, ;MULTIPLE DIGIT COUNTER
VEREVR: PUSHJ P,.TIAUC ;GET NEXT CHAR
PUSHJ P,.TICAN ;SEE IF ALPHA-NUMERIC
JRST [CAIE C,")" ;MUST END CORRECTLY
JRST E$$VER ;NO
PUSHJ P,.TIAUC ;YES, BYPASS
JRST VERWHO] ;AND SEE IF DONE
CAIL C,"0" ;ONLY OCTAL ALLOWED
CAILE C,"7"
JRST E$$VER ;ILC
MOVEI T2,-"0"(C) ;RELATIVE TO "0"
LSH T1,3 ;MAKE SPACE FOR NEW CHAR
ADD T1,T2 ;ADD NEW CHAR
TLNE T1,-1 ;TOO BIG?
JRST E$$VER ;YES
HRR N,T1 ;STORE NEW EDIT #
JRST VEREVR ;LOOP BACK
;HERE FOR CUSTOMER FIELD OR EXIT
VERWHO: CAIE C,"-" ;ONLY CHAR ALLOWED HERE
JRST VERXIT ;ALL DONE
PUSHJ P,.TIAUC ;GET RID OF IT
PUSHJ P,.TIMUC ;CONVERT LOWER CASE TO UPPER
CAIL C,"0" ;SEE IF OCTAL
CAILE C,"7"
JRST E$$VER ;ILC
DPB C,[POINT 3,N,2] ;STORE
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
VERXIT: MOVEI T1,.TVERW## ;INDICATE VERSION FORMAT
MOVEM T1,.LASWD ; FOR ERROR TYPER
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
;HERE FOR ILLEGAL CHAR ERROR
M$FAIL (VER,Illegal character or field too large in /VERSION)
;.LEFTX -- FORCE NAME AND MASK INTO LEFT HALF WORD IF NEEDED
;NEEDED BECAUSE OCTAL INPUT IS RIGHT ADJUSTED
;CALL: MOVE N,WORD
; PUSHJ P,.LEFTX
; RETURN WITH N,MASK UPDATED (RH JUNK)
; AND WITH T1=MASK
;USES NO ACS
.LEFTX::MOVE T1,MASK ;SETUP MASK
TLNE N,-1 ;SEE IF LH=0 (NEED TO SWITCH)
POPJ P, ;NO
SKIPN FLNULL ;YES--SEE IF NULL [254]
SETOM T1 ;YES--SET NO WILD IN MASK [254]
HRLZ N,N ;REVERSE NAME
HRLO T1,T1 ;REVERSE MASK ALSO
MOVEM T1,MASK ;AND STORE IT AWAY
POPJ P,
;.COREW/.BLOKW -- INPUT A DECIMAL OR OCTAL CORE OR FILE SIZE ARGUMENT
;.COREC/.BLOKC -- DITTO (CHARACTER ALREADY IN C)
;IF IT STARTS WITH #, THEN OCTAL TYPEIN
;CAN BE SUFFIXED WITH K OR P TO MULTIPLY BY 1024 OR 512
;CAN BE SUFFIXED WITH B TO MULTIPLY BY 128
;CAN BE SUFFIXED WITH W (DEFAULT) TI INDICATE WORDS
;RESULT IS IN WORDS
;ENDS WITH FIRST NON-DIGIT
;THROWS AWAY ANY DIGITS EXCEPT THE LAST 10 OR SO
;CALL: PUSHJ P,.COREW/.COREC/.BLOKW/.BLOKC
; RETURN WITH NUMBER OF WORDS IN N
;IF CORE, USUALLY THE SEMANTICS ROUTINES WILL CHECK IF RESULT
; IS .LT. ^D256 AND IF SO, MULT BY 1024.
;USES T1 UPDATES C (SEPARATOR)
.BLOKW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.BLOKC::PUSHJ P,.COREC ;GET ARGUMENT
SKIPN T1 ;SEE IF SUFFIX
LSH N,7 ;NO--ASSUME BLOCKS
MOVEI T1,.TBLOK## ;INDICATE FILE BLOCKS
MOVEM T1,.LASWD ; FOR ERROR PRINTER
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
.COREW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.COREC::MOVEI T1,^D10 ;SET DECIMAL MULTIPLIER
CAIN C,"#" ;SEE IF OCTAL FLAG
MOVEI T1,10 ;YES--USE OCTAL MULTIPLIER
CAIN C,"#" ;IF OCTAL FLAG,
PUSHJ P,.TIAUC ; GET NEXT CHAR
MOVEI N,0 ;CLEAR ACCUMULATOR
CORE1: CAIL C,"0" ;SEE IF DIGIT
CAIL C,"0"(T1) ; ..
JRST CORES ;NO--CHECK SUFFIX
IMULI N,(T1) ;YES--MULTIPLY ACCUMULATOR
ADDI N,-"0"(C) ;ADD DIGIT
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST CORE1 ;LOOP UNTIL DONE
;HERE AT END OF DIGIT STRING
CORES: MOVEI T1,.TCORW## ;INDICATE CORE ARGUMENT
MOVEM T1,.LASWD ; FOR ERROR TYPER
CAIN C,"P" ;SEE IF PAGES
LSH N,^D9 ;YES--MULT BY 512
CAIN C,"K" ;SEE IF K
LSH N,^D10 ;YES--MULT BY 1024.
CAIN C,"B" ;SEE IF B
LSH N,7 ;YES--MULT BY BLOCK SIZE OF 128
CAIE C,"B" ;IF BLOCKS,
CAIN C,"W" ; OR WORDS,
JRST CORES1 ; GO SKIP CHARACTER
CAIE C,"P" ;SEE IF EITHER
CAIN C,"K" ; ..
CORES1: SKIPA T1,. ;INDICATE SUFFIX
TDZA T1,T1 ;INDICATE NO SUFFIX
PUSHJ P,.TIAUC ;YES--GET NEXT CHAR
JRST STRNML ;STORE IN .NMUL AND RETURN [314]
;.DECNW -- INPUT A DECIMAL WORD FROM COMMAND STRING
;.DECNC -- DITTO (CHARACTER ALREADY IN C)
;IF IT STARTS WITH #, THEN OCTAL TYPEIN
;TERMINATES AT FIRST NON-DECIMAL CHARACTER
;THROWS AWAY ANY CHARACTERS BEFORE THE LAST 10 OR SO
;CALL: PUSHJ P,.DECNC/.DECNW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.DECNW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DECNC::CAIN C,"#" ;SEE IF OCTAL FLAGGED
PJRST .OCTNW ;YES--GO READ OCTAL FIELD
PUSHJ P,.CKNEG ;CHECK IF NEGATIVE
CAIN C,"#" ;NOW CHECK FOR OCTAL
PJRST OCTIN2 ;YES--GO READ CHAR AND GET OCTAL
DECIN1: CAIL C,"0" ;SEE IF DECIMAL
CAILE C,"9" ; ..
PJRST DECMUL ;NO--AT END, SO HANDLE SUFFIX
IMULI N,^D10 ;YES--MULTIPLY NUMBER
ADDI N,-"0"(C) ;INCORPORATE DIGIT
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST DECIN1 ;LOOP BACK FOR MORE
;DECMUL -- HANDLE DECIMAL SUFFIX MULTIPLIER
; K,M,G FOR 10**3,6,9
;CALL: MOVE N,NUMBER
; PUSHJ P,DECMUL
; RETURN WITH NUMBER MULTIPLIED BY SUFFIX
;USES T1 (MULTIPLIER--RETURNED) UPDATES C (SEPARATOR)
DECMUL: CAIN C,"." ;SEE IF FORCING DECIMAL [273]
PUSHJ P,.TIAUC ;YES--GET NEXT CHARACTER [273]
MOVEI T1,.TDECW## ;SET DECIMAL FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVEI T1,1 ;INITIALIZE SUFFIX MULTIPLIER
CAIN C,"K" ;K = 1 000
MOVEI T1,^D1000
CAIN C,"M" ;M = 1 000 000
MOVE T1,[^D1000000]
CAIN C,"G" ;G =1 000 000 000
MOVE T1,[^D1000000000]
IMUL N,T1 ;APPLY TO NUMBER
CAILE T1,1 ;SEE IF SUFFIX
PUSHJ P,.TIAUC ;YES--GET ONE MORE CHARACTER
PJRST .SENEG ;SEE IF NEGATIVE AND RETURN
;.OCTNW -- INPUT AN OCTAL WORD FROM COMMAND STRING
;.OCTNC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-DIGIT
;THROWS AWAY ANY CHARACTERS BEFORE THE LAST TWELVE
;CALL: PUSHJ P,.OCTNC/.OCTNW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.OCTNW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.OCTNC::PUSHJ P,.CKNEG ;CHECK IF NEGATIVE
PUSH P,P1 ;SAVE ACCUMULATOR [273]
MOVEI P1,0 ;CLEAR ACCUMULATOR FOR DECIMAL [273]
OCTIN1: CAIL C,"0" ;SEE IF OCTAL
CAILE C,"9" ; .. [273]
PJRST OCTIN3 ;NO--AT END, SO HANDLE SUFFIX [273]
LSH N,3 ;YES--MULTIPLY NUMBER
ADDI N,-"0"(C) ;INCORPORATE DIGIT
IMULI P1,^D10 ;ACCUMULATE IN DECIMAL [273]
ADDI P1,-"0"(C) ; .. [273]
OCTIN2: PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST OCTIN1 ;LOOP BACK FOR MORE
OCTIN3: CAIN C,"." ;SEE IF FORCING DECIMAL [273]
MOVE N,P1 ;YES--SAVE DECIMAL VALUE [273]
POP P,P1 ;RESTORE ACCUMULATOR [273]
CAIN C,"." ;SEE IF DECIMAL [273]
PJRST DECMUL ;YES--GO HANDLE DECIMAL WRAP-UP [273]
;OCTMUL -- HANDLE OCTAL SUFFIX MULTIPLIER
; K,M,G FOR 2**9,18,27
;CALL: MOVE N,NUMBER
; PUSHJ P,OCTMUL
; RETURN WITH NUMBER MULTIPLIED BY SUFFIX
;USES T1 (LEFT SHIFT--RETURNED) UPDATES C (SEPARATOR)
OCTMUL: MOVEI T1,.TOCTW## ;SET OCTAL FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVEI T1,0 ;INITIALIZE SUFFIX MULTIPLIER
CAIN C,"K" ;K = 1 000
MOVEI T1,^D9
CAIN C,"M" ;M = 1 000 000
MOVEI T1,^D18
CAIN C,"G" ;G = 1 000 000 000
MOVEI T1,^D27
LSH N,(T1) ;APPLY TO NUMBER
SKIPE T1 ;SEE IF SUFFIX
PUSHJ P,.TIAUC ;YES--GET SEPARATOR
;FALL INTO .SENEG
;FALL HERE FROM ABOVE
;.SENEG -- SEE IF NEGATIVE FOUND BY .CKNEG AND APPLY IT
;CALL: MOVE N,VALUE SO FAR
; PUSHJ P,.SENEG
;RETURNS WITH N COMPLEMENTED IF NUMBER PRECEEDED BY -
.SENEG::SKIPE FLNEG ;SEE IF NEGATIVE
MOVNS N ;YES--COMPLEMENT RESULT
IFN ECHO$W,<
PUSHJ P,NAMER
>
;HERE TO EXIT FROM MOST ONE WORD INPUT ROUTINES TO
;STORE A COPY OF THE RESULT IN .NMUL FOR LONG TERM STORAGE
;PURPOSES SUCH AS SOME ERROR MESSAGES
STRNML: MOVEM N,.NMUL ;STORE VALUE FOR ERROR PRINTER [314]
POPJ P, ;RETURN
;.CKNEG -- CHECK IF NEGATIVE NUMBER COMING
;ALSO CLEARS N
;CALL: MOVEI C,NEXT CHAR
; PUSHJ P,.CKNEG
;USES NO ACS
.CKNEG::SETZB N,FLNEG ;CLEAR N AND NEGATIVE FLAG
CAIE C,"-" ;CHECK IF NEGATIVE NUMBER
POPJ P, ;NO--RETURN
SETOM FLNEG ;YES--SET FLAG
PJRST .TIAUC ;GET NEXT CHAR AND RETURN
;[652]
;.CHRQW -- INPUT A SINGLE POSSIBLY QUOTED 8-BIT CHARACTER OR OCTAL CONSTANT
;.CHRQC -- DITTO (FULL CASE CHARACTER ALREADY IN C)
;CALL: PUSHJ P,.CHRQW/.CHRQC
; RETURN WITH CHARACTER IN N
;USES T1 UPDATES C (SEPARATOR)
.CHRQW::PUSHJ P,.TIALT ;PRIME THE PUMP
.CHRQC::CAIL C,"0" ;RANGE
CAILE C,"7" ; CHECK
SKIPA ;POSSIBLY QUOTED CHARACTER
PJRST .OCTNC ;ELSE GO GET AN OCTAL NUMBER
PUSHJ P,.AS8QC ;GET STRING
MOVE T1,[POINT 8,.NMUL] ;POINT TO STRING
ILDB N,T1 ;GET FIRST CHARACTER
CAIN N,.CHCNV ;SPECIAL QUOTE CHARACTER?
ILDB N,T1 ;GET NEXT CHARACTER
ILDB T1,T1 ;GET NEXT CHARACTER
JUMPE T1,.POPJ## ;RETURN IF ONLY A SINGLE CHARACTER
MOVE N,@SWN(P2) ;GET SWITCH NAME
M$FAIN (EXC,<Multiple characters illegal in switch>)
;[652]
;.AS8QW -- INPUT A POSSIBLY QUOTED 8-BIT ASCIZ MULTIPLE WORD
;.AS8QC -- DITTO (FULL CASE CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BETOND THE BUFFER
;CALL: PUSHJ P,.AS8QW/.AS8QC
; RETURN WITH STRING IN .NMUL
;USES T1 UPDATES C (SEPARATOR)
.AS8QW::PUSHJ P,.TIALT ;PRINT THE PUMP
.AS8QC::PUSHJ P,.TICQT ;CHECK FOR QUOTING
SETZM .NMUL ;CLEAR ACCUMULATOR
MOVE T1,[.NMUL,,.NMUL+1]
BLT T1,.NMUE
HRROI T1,.T8STR## ;SET ASCII STRING FORMAT
MOVEM T1,.LASWD ; FOR ERROR PRINTING
MOVE T1,[POINT 8,.NMUL] ;INITIALIZE BYTE POINTER
AS8M1: SKIPLE .QUOTE ;SEE IF IN QUOTED STRING
JRST AS8M2 ;YES--JUST GO STORE
CAIE C,.CHCNV ;IF SUPERQUOTE
SKIPN .VQUOT ;OR SUPER-QUOTED
JRST AS8M2 ;THEN PASS THE CHARACTER
PUSHJ P,.TICAD ;SEE IF LEGITIMATE ALPHA-NUMERIC
POPJ P, ;NO--DONE HERE
AS8M2: CAMN T1,[POINT 8,.NMUE,31] ;SEE IF OVERFLOW
JRST E$$OVF ;YES--ISSUE A MESSAGE
IDPB C,T1 ;NO--STORE
PUSHJ P,.TIALT ;GET NEXT CHARACTER
JRST AS8M1 ;LOOP BACK TO PROCESS IT
;.ASCQW -- INPUT A POSSIBLY QUOTED ASCII MULTIPLE WORD
;.ASCQC -- DITTO (FULL CASE CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE BUFFER
;CALL: PUSHJ P,.ASCQW/.ASCQC
; RETURN WITH STRING IN .NMUL
;USES T1 UPDATES C (SEPARATOR)
.ASCQW::PUSHJ P,.TIALT ;PRIME THE PUMP
.ASCQC::PUSHJ P,.TICQT ;CHECK FOR QUOTING
SETZM .NMUL ;CLEAR ACCUMULATOR
MOVE T1,[.NMUL,,.NMUL+1]
BLT T1,.NMUE ; ..
HRROI T1,.TSTRG## ;SET ASCII STRING FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVE T1,[POINT 7,.NMUL] ;INITIALIZE BYTE POINTER
ASCM1: SKIPLE .QUOTE ;SEE IF IN QUOTED STRING
JRST ASCM2 ;YES--JUST GO STORE
CAIE C,.CHCNV ;[645] IF SUPERQUOTE
SKIPN .VQUOT ;[645] OR SUPER-QUOTED
JRST ASCM2 ;[645] THEN PASS THE CHARACTER
PUSHJ P,.TICAD ;[645] SEE IF LEGITIMATE ALPHA-NUMERIC
POPJ P, ;[645] NO--DONE HERE
ASCM2: CAMN T1,[POINT 7,.NMUE,34] ;[634] SEE IF OVERFLOW
JRST E$$OVF ;[634] YES--ISSUE A MESSAGE
IDPB C,T1 ;NO--STORE
PUSHJ P,.TIALT ;GET NEXT CHARACTER
JRST ASCM1 ;LOOP BACK TO PROCESS IT
M$FAIL(OVF,Input string exceeds the size of input buffer);[634]
;.SIXSW -- INPUT A SIXBIT WORD FROM COMMAND STRING
;.SIXSC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE FIRST SIX
;CALL: PUSHJ P,.SIXSC/.SIXSW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.SIXSW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.SIXSC::MOVEI N,0 ;CLEAR NAME
MOVEI T1,.TSIXN## ;SET SIXBIT FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVE T1,[POINT 6,N] ;INITIALIZE BYTE POINTER FOR WORD
SIXS1: PUSHJ P,.TICAN ;SEE IF CHARACTER IS ALPHA-NUMERIC
JRST [CAIE C,.CHCNV ;IS IT THE SPECIAL QUOTE CHARACTER?
JRST STRNML ;NO--STORE IN .NMUL AND RETURN
PUSHJ P,.TIAUC ;YES--GET NEXT
CAIL C,40 ;IS IT IN SIXBIT RANGE?
CAILE C,137 ;BOTH WAYS?
JRST STRNML ;NO--MAYBE ADD AN ERROR HERE?
JRST .+1] ;WE GOT A GOOD ONE
SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;DON'T OVERFLOW
IDPB C,T1 ;STORE CHARACTER
PUSHJ P,.TIAUC ;GO GET ANOTHER CHARACTER
JRST SIXS1 ;LOOP BACK TO PROCESS IT
;.SIXKW -- INPUT A SIXBIT WORD FROM COMMAND STRING
;.SIXKC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC/NON-HYPHEN CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE FIRST SIX
;CALL: PUSHJ P,.SIXKC/.SIXKW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.SIXKW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.SIXKC::MOVEI N,0 ;CLEAR NAME
MOVEI T1,.TSIXN## ;SET SIXBIT FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVE T1,[POINT 6,N] ;INITIALIZE BYTE POINTER FOR WORD
SIXK1: PUSHJ P,.TICAD ;SEE IF CHARACTER IS ALPHA-NUMERIC
JRST [CAIE C,.CHCNV ;IS IT THE SPECIAL QUOTE CHARACTER?
JRST STRNML ;NO--STORE IN .NMUL AND RETURN
PUSHJ P,.TIAUC ;YES--GET NEXT
CAIL C,40 ;IS IT IN SIXBIT RANGE?
CAILE C,137 ;BOTH WAYS?
JRST STRNML ;NO--MAYBE ADD AN ERROR HERE?
JRST .+1] ;WE GOT A GOOD ONE
SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;DON'T OVERFLOW
IDPB C,T1 ;STORE CHARACTER
PUSHJ P,.TIAUC ;GO GET ANOTHER CHARACTER
JRST SIXK1 ;LOOP BACK TO PROCESS IT
;.SIXQW -- INPUT A POSSIBLY QUOTED SIXBIT MULTIPLE WORD
;.SIXQC -- DITTO (CHARACTER ALREADY IN C)
;.SIXMW -- INPUT A SIXBIT MULTIPLE WORD FROM COMMAND STRING
;.SIXMC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE BUFFER
;CALL: PUSHJ P,.SIXMC/.SIXMW/.SIXQW/.SIXQC
; RETURN WITH STRING IN .NMUL
;USES T1 UPDATES C (SEPARATOR)
.SIXQW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.SIXQC::PUSHJ P,.TICQT ;CHECK FOR QUOTING
PUSHJ P,.TIMUC ;CONVERT TO UPPER CASE
PJRST .SIXMC ;PROCEED
.SIXMW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.SIXMC::SETZM .NMUL ;CLEAR ACCUMULATOR
MOVE T1,[.NMUL,,.NMUL+1]
BLT T1,.NMUE ; ..
MOVEI T1,.TSIXN## ;SET SIXBIT FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVE T1,[POINT 6,.NMUL] ;INITIALIZE BYTE POINTER
SIXM1: SKIPLE .QUOTE ;SEE IF IN QUOTED STRING
JRST SIXM2 ;YES--JUST GO STORE
PUSHJ P,.TICAD ;[645] SEE IF LEGITIMATE ALPHA-NUMERIC
JRST [CAIE C,.CHCNV ;[645] NO--IS IT THE SPECIAL QUOTE?
POPJ P, ;[645] NO--MUST BE DONE
JRST SIXM2] ;[645] YES--KEEP GOING
SIXM2: CAIN C,.CHCNV ;[645] SEE IF SPECIAL QUOTING CHARACTER
PUSHJ P,.TIAUC ;[645] YES--GET NEXT (AND FORCE ALPHANUMERIC)
CAIL C,40 ;[645] SEE IF IN RANGE
CAILE C,137 ; ..
JRST E.QSX ;NO--GIVE ERROR
SUBI C," "-' ' ;CONVERT TO SIXBIT
CAME T1,[POINT 6,.NMUE,35] ;SEE IF OVERFLOW
IDPB C,T1 ;NO--STORE
ADDI C," "-' ' ;BACK TO ASCII
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST SIXM1 ;LOOP BACK TO PROCESS IT
E.QSX==E.ILSC ;GIVE ILL CHAR MESSAGE
SUBTTL SUBROUTINES FOR COMMAND INPUT -- GET NEXT CHARACTER
;**;[645] ADD NEW ROUTINE .TICAD
;.TICAD -- CHECK CHARACTER FOR ALPHA-NUMERIC OR DASH
;ALPHA-NUMERIC IS A-Z OR 0-9
;CALL: MOVEI C,ASCII CHARACTER
; PUSHJ P,.TICAD
; RETURN IF NOT ALPHA-NUMERIC OR DASH
; SKIP RETURN IF ALPHA-NUMERIC OR DASH
;PRESERVES ALL ACS
.TICAD::PUSHJ P,.TICAN ;IS IT ALPHANUMERIC?
CAIN C,"-" ;OR OUR OTHER SPECIAL?
AOS (P) ;YES, WIN
POPJ P, ;NO, FAIL
;.TICAN -- CHECK CHARACTER FOR ALPHA-NUMERIC
;ALPHA-NUMERIC IS A-Z OR 0-9
;CALL: MOVEI C,ASCII CHARACTER
; PUSHJ P,.TICAN
; RETURN IF NOT ALPHA-NUMERIC
; SKIP RETURN IF ALPHA-NUMERIC
;PRESERVES ALL ACS
.TICAN::CAIL C,"A"+40 ;SEE IF
CAILE C,"Z"+40 ; LOWER CASE ALPHA
SKIPA ;NO--CONTINUE CHECKS
JRST .POPJ1## ;YES--GIVE ALPHA RETURN
CAIL C,"0" ;SEE IF BELOW NUMERICS
CAILE C,"Z" ;OR IF ABOVE ALPHABETICS
POPJ P, ;YES--RETURN
CAILE C,"9" ;SEE IF NUMERIC
CAIL C,"A" ;OR IF ALPHABETIC
AOS (P) ;YES--SKIP RETURN
POPJ P, ;RETURN
;.TIAUC -- INPUT ONE COMMAND CHARACTER HANDLING LOWER CASE CONVERSION
;CALL: PUSHJ P,.TIAUC
; RESULT IN C
;USES NO ACS
.TIAUC::PUSHJ P,.TIALT ;GO GET NEXT CHAR
;.TIMUC -- CONVERT LOWER CASE CHARACTER TO UPPER CASE
;CALL: MOVEI C,CHARACTER
; PUSHJ P,.TIMUC
; RETURN WITH UPDATED C
;USES NO ACS
.TIMUC::CAIGE C,"A"+40 ;SEE IF LOWER CASE
POPJ P, ;NO--RETURN
CAIG C,"Z"+40
SUBI C,40 ;YES--CONVERT
POPJ P, ;RETURN
;.TICQT -- CHECK FOR " AND SET QUOTING
;CALL: MOVEI C,CHARACTER
; PUSHJ P,.TICQT
;RETURN WITH NEXT CHARACTER (UPPER OR LOWER CASE) IN C
;USES NO ACS
.TICQT::CAIN C,"""" ;SEE IF " [265]
SKIPE .QUOTE ;YES--SET QUOTE UNLESS SET
POPJ P, ;NO--JUST RETURN
;FALL INTO .TISQT
;.TISQT -- SET ARBITRARY QUOTE CHARACTER
;CALL: MOVEI C,QUOTE CHARACTER
; PUSHJ P,.TISQT
;RETURN WITH NEXT CHARACTER (UPPER OR LOWER CASE) IN C
;USES NO ACS
.TISQT::SKIPE .NOQTE ;[604] IF QUOTING DISABLED, RETURN
POPJ P,
MOVEM C,.QUOTE ;SET CHARACTER
;FALL INTO .TIALT
;.TIALT -- INPUT ONE COMMAND CHARACTER HANDLING ALT-MODES
;CALL: PUSHJ P,.TIALT
; RESULT IN C
;USES NO ACS
.TIALT::SKIPN C ;SEE IF IN ALT-MODE
POPJ P, ;YES--RETURN
;NO--FALL INTO .TICHG
;FALL HERE FROM .TIALT
;.TICHG -- GET CHARACTER, CONVERTING GUIDE WORDS TO SINGLE CHARACTER
;CALL: PUSHJ P,.TICHG
; RESULT IN C
;USES NO ACS
;GUIDE WORDS ARE ENCLOSED IN SINGLE ' AND ARE FROM A PREDEFINED LIST
.TICHG::PUSHJ P,.TICHR ;GET NEXT CHARACTER
SKIPN .QUOTE ;UNLESS IN A QUOTE, [541]
CAIE C,"'" ;SEE IF START OF GUIDE
POPJ P, ;NO--JUST RETURN TO CALLER
PUSHJ P,.PSH4T## ;YES--SAVE SOME TEMPS
MOVE T1,[POINT 6,T2] ;SET POINTER FOR WORD
MOVEI T2,0 ;CLEAR WORD
TICHG1: PUSHJ P,.TICHR ;GET NEXT LETTER OF GUIDE
JUMPLE C,TICHG2 ;EXIT IF END OF LINE
CAIN C,"'" ;SEE IF END OF GUIDE YET
JRST TICHG2 ;YES--EXIT
PUSHJ P,.TIMUC ;FORCE UPPER CASE
CAIL C,"A" ;SEE IF
CAILE C,"Z" ; ALPHABETIC
JRST TICHGI ;NO--USER ERROR
SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;SEE IF OVERFLOW
IDPB C,T1 ;NO--STORE IN RESULT
JRST TICHG1 ;LOOP OVER WORD
TICHG2: CAIE C,"'" ;UNLESS CLOSE QUOTE,
PUSHJ P,.REEAT ; SET TO GET AGAIN
MOVSI T1,GUIDM.## ;NEG COUNT OF GUIDE WORDS
HRRI T1,GUIDT.##-1 ;LOC-1 OF GUIDE WORDS
PUSHJ P,.LKNAM## ;LOOKUP NAME IN TABLE
JRST TICHGB ;ERROR
SUBI T1,GUIDT.## ;DETERMINE ORDINAL OF GUIDE WORD
MOVEI C,4000(T1) ;CONVERT TO META REPRESENTATION
PUSHJ P,.POP4T## ;RESTORE TEMPS
POPJ P, ;RETURN
TICHGB: MOVE N,T2 ;POSITION WORD FOR ERROR MESSAGE
JUMPGE T1,E$$AGW ;JUMP IF AMBIGUOUS
M$FAIN (UGW,Unknown guide word)
M$FAIN (AGW,Ambiguous guide word)
TICHGI: MOVE N,T2 ;COPY WORD FOR MESSAGE
M$FAIN (IGW,Incorrectly formatted guide word)
;.TICHR -- INPUT ONE COMMAND CHARACTER HANDLING SPACING, CONTINUATION,
;AND CONTROL CHARACTERS
;ALT-MODE AND LINE-FEED ARE KEPT DISTINCT
;CALL: PUSHJ P,.TICHR
; RESULT IN C
;USES NO ACS
.TICHR::PUSH P,T1 ;SAVE TEMP
;TYI--COROUTINE TO HANDLE SPECIAL BLANK COMPRESSION,
; HYPHENATION, AND COMMENTS
;THE TRICK IS TO :
; 1-COMPRESS MULTIPLE SPACES
; 2-IGNORE LEADING SPACES ON EACH LINE
; 3-IGNORE TRAILING SPACES ON EACH LINE
; 4-IGNORE COMMENTS ON EACH LINE (;FOO)
; 5-IGNORE LINE FEEDS PRECEEDED BY HYPHEN (CONTINUATION)
;
;ONE SPECIAL STORAGE AREA IS USED--SCANCH
; RH CONTAINS THE LAST CHARACTER IN SOME CASES
;THE COROUTINE PC IS IN SCANPC
; THIS IS 0 UNTIL A NON-SPACE IS SEEN IN A LINE
; IT IS RESET TO 0 AT THE TOP LEVEL
;BY CONVENTION, T1 IS USED FOR CALLS AND IS PRESERVED ACROSS
; THE ENTIRE ROUTINE
SKIPE SAVCHR ;SEE IF ANYTHING SAVED
JRST [MOVE C,SAVCHR ;YES--RE-USE IT
SKIPN SCANPC ;[663] UNLESS AT BEGINNING OF LINE,
JRST .+1 ;[663] THEN SHOW IT TO THE COMPRESSOR
SETZM SAVCHR ;CLEAR VALUE
CAIN C,C.TE ;SEE IF EOL
MOVEI C,0 ;YES--CHANGE
JRST TYIX] ;RETURN TO CALLER
SKIPE SCANCH ;SEE IF SOMETHING LEFT [322]
HRRE C,SCANCH ;YES--PICKUP PREVIOUS CHAR
SETZM SCANCH ;CLEAR MEMORY [266]
SKIPE T1,SCANPC ;RESTORE COROUTINE PC
JRST (T1) ;DISPATCH
SKIPLE C ;ELSE, IF NOT ALREADY END MARKER, [322]
HRREI C,.CHEOL ;START NEW LINE
;HERE AT START OF LINE--REMOVE LEADING BLANKS
TYIF: JSP T1,TISCN ;GET NEXT CHAR AND DISPATCH
JRST TYIX ;EOL--RETURN INDICATING NULL LINE
JRST TYIF ;SPACE--STRIP IT
JRST TYIM ;MINUS--POSSIBLE CONTINUATION LINE
;HERE TO RETURN CURRENT CHARACTER
TYIR: JSP T1,TYIP ;RETURN C
;HERE AFTER RETURNING SOMETHING
TYIN: JSP T1,TISCN ;GET
JRST TYIE ;EOL--GIVE END
JRST TYIS ;SPACE--MAY NEED TO COMPRESS IT
JRST TYIM ;MINUS--MAYBE CONTINUATION
JRST TYIR ;ELSE--GIVE TO CALLER
;HERE WHEN SPACE SEEN
TYIS: JSP T1,TISCN ;GET
JRST TYIE ;EOL--THROW AWAY SPACE AND RETURN EOL
JRST TYIS ;SPACE--COMPRESS
JRST .+2 ;MINUS--PROCEED
JRST TYIQ ;ELSE--GIVE SPACE THEN THIS CHAR
HRLI C," " ;RETURN SPACE
JSP T1,TYIL ;GO ISSUE SPACE
;HERE WHEN HYPHEN SEEN
TYIM: JSP T1,TISCN ;GET
JRST TYID ;EOL--CONTINUATION LINE COMING
JRST TYIU ;[645] SPACE--MAYBE IRRELEVANT SPACE
JRST .+1 ;MINUS--NOT CONTINUATION
HRLI C,"-" ;ELSE--RETURN MINUS
JRST TYII ; AND THEN RE-DISPATCH
;HERE WHEN HYPHEN THEN SPACE SEEN
TYIU: SKIPN .QUOTE ;[645] IF NOT QUOTING,
JRST TYIT ;[645] THEN COMPRESS SPACES
HRLI C,"-" ;[645] NO, GET HYPHEN-SPACE RETURN
JRST TYII ;[645] AND RETURN IT
TYIT: JSP T1,TISCN ;GET
JRST TYID ;EOL--CONTINUATION LINE
JRST TYIT ;SPACE--COMPRESS
JRST .+1 ;MINUS--FALSE CALL
HRLI C,"-" ;RETURN FIRST MINUS
JSP T1,TYIL ; TO CALLER
;HERE WHEN TIME TO RETURN SPACE
TYIQ: HRLI C," " ;RETURN SPACE
TYII: JSP T1,TYIL ; TO CALLER
CAIN C,"-" ;SEE IF MINUS
JRST TYIM ;YES--POSSIBLE HYPHEN
JRST TYIR ;NO--REGULAR CHARACTER
;HERE AT END OF LINE TO BE CONTINUED
TYID: MOVSI T1,-1 ;SET FOR CONTINUATION PROMPT
PUSHJ P,DOPRMP ;DO THE PROMPT
SKIPN A.DEV ;UNLESS INDIRECT FILE, [530]
HRREI C,.CHEOL ; REMOVE ANY EOF COMING [530]
JRST TYIN ;DON'T DISCARD LEADING SPACE OF NEXT LINE [527]
;HERE WITH LITERAL TO GIVE USER IN LH(C)
; RH(C) HAS LAST CHAR READ FROM INPUT
TYIL: HRROM C,SCANCH ;SAVE LAST CHAR FOR LATER
HLRES C ;GET LITERAL FOR CALLER
PJRST TYIP ;RETURN CHARACTER TO USER
;HERE AT END OF NON-NULL LINE
TYIE: JSP T1,TYIP ;RETURN IT TO USER
SKIPE SAVCHR ;SEE IF REEATING
JRST TYIN ;YES--GO REAT IT
IFN DEBUG$,<
HALT TYIF ;ERROR IF USER SCREWS UP
>
;HERE WITH CHARACTER TO GIVE USER
; T1=PLACE TO RETURN TO ON NEXT ENTRY TO COROUTINE
TYIP: MOVEM T1,SCANPC ;SAVE COROUTINE PC FOR NEXT TIME
MOVEM C,LASCHR ;SAVE AS LAST CHARACTER
;HERE TO RETURN FROM THE TYI COROUTINE
TYIX: POP P,T1 ;RESTORE TEMP
IFN ECHO$C,<
OUTCHR C
>
POPJ P,
;TISCN--SUBROUTINE USED BY TYI TO STRIP COMMENTS AND DISPATCH
;ALSO HANDLES QUOTED STRINGS (UP TO END-OF-LINE)
; DOUBLE OCCURANCE OF QUOTE RETURNS ONE; END RETURNS SPACE
;CALL: JSP T1,TISCN
; HERE IF EOL
; HERE IF SPACE
; HERE IF HYPHEN
; HERE FOR ALL ELSE
;ALWAYS GIVES CHARACTER IN C
;USES NO ACS
TISCN: SKIPE SAVCHR ;SEE IF CHAR LEFT FROM BEFORE
JRST [MOVE C,SAVCHR ;YES--GET IT
SETZM SAVCHR ;CLEAR OUT REMEMBERED CHARACTER
CAIN C,C.TE ;SEE IF FUNNY EOL CODE
HRREI C,.CHEOL ;YES--SET REAL CODE
JRST .+2] ;AND PROCEED
PUSHJ P,.TICHT ;NO--GET ONE FROM INPUT
;HERE TO SEE IF QUOTING
SKIPG .VQUOT ;[645] IS THIS CHARACTER SUPER-QUOTED?
JRST 3(T1) ;[645] YES--RETURN LITERALLY
SKIPG .QUOTE ;SEE IF QUOTING IN EFFECT
JRST TISCNQ ;NO--PROCEED
JUMPG C,TISCNL ;[645] GO IF NOT AT EOL
HRRZS T1 ;[645] ISOLATE CALLING PC
CAIE T1,TYIM+1 ;[645] ARE WE HERE FOR MINUS?
JRST TISCNE ;[645] NO--EOL ENDS QUOTE
JRST (T1) ;[645] YES--RETURN CONTINUATION
TISCNL: CAMN C,.QUOTE ;[645] YES--SEE IF QUOTE CHAR
JRST TISCNN ;[645] YES--SEE IF DOUBLED
CAIN C,"-" ;[645] NO--SEE IF MINUS
JRST 2(T1) ;[645] YES--RETURN POSSIBLE CONTINUATION
JRST 3(T1) ;[645] NO--RETURN LITERALLY
TISCNN: PUSHJ P,.TICHT ;[645] YES--GET NEXT CHAR
CAMN C,.QUOTE ;SEE IF QUOTE AGAIN
JRST 3(T1) ;YES--RETURN ONE
JUMPLE C,TISCNE ;NO--IF END OF LINE, RETURN IT
PUSHJ P,.REEAT ;NO--SAVE FOR LATER
MOVEI C," " ;SET A SPACE
;HERE AT END OF QUOTED STRING
TISCNE: SETZM .QUOTE ;CLEAR QUOTE FLAG
;HERE TO DETERMINE CHARACTER HANDLING
TISCNQ: JUMPLE C,(T1) ;GIVE EOL RETURN
CAIN C," " ;TRY SPACE
JRST 1(T1) ;SKIP ONCE
CAIN C,"-" ;TRY HYPHEN
JRST 2(T1) ;SKIP TWICE
CAIE C,";" ;SEE IF COMMENT [272]
CAIN C,"!" ;OR NEW STYLE [273]
JRST TISCNC ;YES--GO HANDLE [272]
SKIPL FLRCMD ;SEE IF () MODE [270]
JRST 3(T1) ;NO--SKIP THREE [360]
SKIPGE FLVERB ;YES--SEE IF VERB MODE [360]
CAIE C,"/" ;YES--SEE IF SWITCH [360]
SKIPA ;NO--SKIP TEST [360]
JRST [HRREI C,.CHEOL ;YES--PRETEND END LINE [360]
JRST (T1)] ;TAKE EOL RETURN [360]
CAIE C,")" ;NO--SEE IF )
JRST 3(T1) ;NO--SKIP THREE
;HERE WHEN COMMENT SEEN
TISCNC: PUSHJ P,.TICHT ;GET NEXT CHAR
JUMPG C,.-1 ;LOOP TO EOL
JRST (T1) ;GIVE EOL RETURN
;.REEAT -- SAVE C AWAY TO BE RE-EATEN ON NEXT CALL
;CALL: MOVEI C,THIS CHARACTER
; PUSHJ P,.REEAT
;RETURNS WITH ACS UNCHANGED
.REEAT::MOVEM C,SAVCHR ;SAVE CHARACTER
JUMPN C,.POPJ## ;RETURN UNLESS 0
MOVEI C,C.TE ;IF SO, SET FAKE
EXCH C,SAVCHR ;AND RESTORE ORIGINAL TO AC
POPJ P, ;RETURN
;DOPRMP -- ROUTINE TO PROMPT THE USER FOR COMMANDS
;CALL: MOVEI T1,CHAR IF FIRST LINE
; MOVSI T1,-1 IF CONTINUATION
; PUSHJ P,DOPRMP
;RETURNS AFTER PROMPTING
;USES T1
DOPRMP: SKIPE PREMPT ;ALWAYS PROMPT IF PREEMPTING [572]
JRST DOPRM2 ;WE ARE--GO PROMPT [572]
SKIPGE T1 ;SEE IF CONTINUATION, [267,525]
JRST DOPRM1 ;YES--OK TO ISSUE [267]
; [526]
SKIPE FLCCMD ;OR IN CCL OR COMMAND MODE
POPJ P, ;YES--NO PROMPT
DOPRM1: ; [267]
IFN M$INDP,<
SKIPE A.DEV ;SEE IF INDIRECT FILE
JRST [SKIPN FLIIND ;SEE IF @TTY:
POPJ P, ;NO--NO PROMPT NEEDED
HRRZI T1,"#" ;YES--SET # PROMPT
JRST .+1] ;PROCEED
>
DOPRM2: SKIPE PROMPT ;SEE IF USER EXIT [572]
PJRST @PROMPT ;YES--GO LET HIM DO IT
SKPINL ;DEFEAT ^O [571]
JFCL ; .. [571]
SKIPGE T1 ;SEE IF CONTINUATION
MOVEI T1,"#" ;YES--SET CODE
OUTCHR T1 ;OUTPUT THE PROMPT
POPJ P, ;RETURN
;.TICHT -- INPUT ONE CHARACTER AND HANDLE ALL EQUIVALENCES
;.TICHE -- INPUT ONE CHAR AND HANDLE ALL EXCEPT TAB
;ALT-MODE AND LINE FEED ARE KEPT DISTINCT
;CALL: PUSHJ P,.TICHE/T
; RETURN WITH RESULT IN C
;USES NO ACS
.TICHT::PUSHJ P,.TICHE ;GET CHAR HANDLING MOST EQUIVS
CAIN C,.CHTAB ;SEE IF TAB
SKIPLE .QUOTE ;AND NOT QUOTED
POPJ P, ;[645] NO--LEAVE ALONE
SKIPE .VQUOT ;[645] UNLESS SUPER-QUOTED,
MOVEI C," " ;YES--MAKE INTO SPACE
POPJ P, ;RETURN
.TICHE::
TYICH1:!PUSHJ P,.TIGET ;GET ONE CHARCTER
SKIPG .VQUOT ;IS THIS CHARACTER QUOTED BY ^V?
POPJ P, ;YES--DONE HERE
JUMPL C,.POPJ ;IF END-OF-LINE, RETURN
JUMPE C,TYICH1 ;IGNORE NULLS
CAIE C,.CHCRT ;IGNORE CARRIAGE RETURNS
CAIN C,.CHDEL ;IGNORE RUBOUTS
JRST TYICH1 ; ..
IFN FT$ALT,<
CAIE C,.CHALT ;MAKE VARIOUS FLAVORS OF ALT-MODE
CAIN C,.CHAL2 ; BEHAVE THE SAME
HRREI C,.CHALX ; ..
>;END OF IFN FT$ALT
CAIN C,.CHESC ;OR STANDARD ONE
HRREI C,.CHALX ;YES--SET CODE
CAIE C,.CHALX ;[631] SOME TYPE OF ALT-MODE?
JRST TYICH2 ;[631] NO
SKIPE A.DEV ;[631] NOT READING FROM INDIRECT FILE?
SKIPE PREMPT ;[631] OR PREEMPTING?
PUSHJ P,.TCRLF## ;[631] GIVE A FREE CR/LF
TYICH2: CAIL C,.CHLFD ;[631] MAKE LINE FEED
CAILE C,.CHFFD ; AND FORM FEED
JRST .+2 ; (NOT TRUE)
HRREI C,.CHEOL ; ALL INTO END-OF-LINE
CAIN C,.CHCNC
JRST [SETZM SCANPC ;^C SO CLEAR LINE FLAGS
JRST TYICHF] ;AND HANDLE AS ^Z
CAIN C,.CHCNZ ;MAKE ^C AND ^Z
TYICHF: HRREI C,.CHEOF ; BE END OF FILE [313]
MOVEM C,LASCHR ;SAVE CHARACTER FOR LATER ON
SKIPGE FLJCNM ;IF RESCAN FOUND JUST COMMAND NAME, [365]
SKIPLE C ; AND NOW AT END OF LINE, [365]
SKIPA ;NO [365]
SETZM FLJCNM ;YES--CLEAR SINCE NOT PSCAN [365]
POPJ P, ;RETURN
SUBTTL INDIRECT FILE HANDLING
;.TIGET -- SUBROUTINE TO GET ONE CHARACTER FROM COMMAND INPUT
; AND HANDLE MULTIPLE FILES AND INDIRECTING
;CALL: PUSHJ P,.TIGET
; RETURN WITH RESULT IN C
;USES NO ACS
.TIGET::PUSHJ P,TIGET ;GO DO IT
MOVEM C,LASCHR ;SAVE LAST CHARACTER
POPJ P, ;RETURN
TIGET: SKIPN PREMPT ;[651] PRE-EMPTIVE INPUT?
JRST TIGET1 ;[651] NO
MOVE C,[PUSHJ P,@PREMPT] ;[651] GET INSTRUCTION TO XCT
JRST TIGETC ;[651] ENTER COMMON CODE
TIGET1:
IFN M$INDP,<
SKIPN A.DEV ;[651] INDIRECT FILE PROCESSING?
JRST TIGET2 ;[651] NO
MOVE C,[PUSHJ P,TYIIND] ;[651] GET INSTRUCTION TO XCT
JRST TIGETC ;[651] ENTER COMMON CODE
>
TIGET2: CAMN C,[.CHEOF] ;IF TTY INPUT WRONG, GIVE IT BACK [322]
POPJ P, ;RETURN [322]
SKIPE TYPIN ;SEE IF CALLER SUPPLYING TYPIN [322]
SKIPA C,[PUSHJ P,@TYPIN] ;[651] YES--GET INSTRUCTION TO XCT
MOVE C,[INCHWL C] ;[651] ELSE READ FROM TTY
TIGETC: XCT C ;[651] READ A CHARACTER
PUSHJ P,TIVQT ;[651] CHECK FOR CONTROL-V QUOTING
POPJ P, ;[651] PASS CHARACTER WITH NO CHANGES
CAIN C,.CHBEL ;SEE IF [313]
MOVEI C,.CHLFD ; ONE OF [313]
CAIE C,.CHFFD ; THE LINE- [313]
CAIN C,.CHVTB ; MODE [313]
MOVEI C,.CHLFD ; WAKE-UP [313]
SKIPN PREMPT ;[651] PREMTIVE INPUT?
SKIPE A.DEV ;[651] OR INDIRECT COMMAND FILE?
POPJ P, ;[651] GIVE UP NOW
SKIPN FLRCMD ;IF NOT R (...), [313]
SKIPE FLCCMD ; THEN DONE [313]
SKIPLE FLJCNM ;ELSE, UNLESS PSCAN RESCAN JUST COMMAND [313,365]
POPJ P, ; RETURN [313]
CAIE C,.CHESC ;SEE IF END [313]
CAIN C,.CHLFD ; OF LINE [313]
HRREI C,.CHEOF ;YES--PRETEND EOF [313]
POPJ P, ;RETURN
;[651]
;TIVQT -- CHECK FOR CONTROL-V QUOTING
;CALL: PUSHJ P,TIVQT
; RETURN HERE IF CONTROL-V QUOTING IN EFFECT
; RETURN HERE IF AN ORDINARY CHARACTER
TIVQT: AOSN .VQUOT ;WAS LAST CHARACTER ^V?
POPJ P, ;YES--ALWAYS PASS QUOTED CHR WITH NO CHANGES
CAIE C,.CHCNV ;CONTROL-V QUOTING?
AOSA (P) ;NO
SETOM .VQUOT ;REMEMBER CONTROL-V WAS TYPED
POPJ P, ;AND RETURN
;.TYPRE -- INITIALIZE PREEMPTIVE INPUT ROUTINE
; Implements a preemptive character input facility for
; forcing some input from designated device (TTY:) during
; input from .CCL or indirect file, and allow later
; resumption of input from the original source.
;CALL: MOVEI T1,ADDRESS ;ADDRESS OF PREEMPT ROUTINE
; PUSHJ P,.TYPRE
;RETURNS PREVIOUS ADDRESS IN T1
;ALL OTHER AC'S ARE UNCHANGED
;
;PURPOSE: WHEN SET (NON-ZERO), THE PREEMPT ROUTINE IS CALLED
;FOR INPUT RATHER THAN ANY OTHER SOURCE. NORMALLY USED TO
;OVERRIDE .CCL AND INDIRECT INPUT (E.G. FOR ERROR PROCESSING).
;WHEN AGAIN SET TO ZERO, INPUT FROM PREVIOUS SOURCE WILL BE
;CONTINUED AT THE POINT AT WHICH IT WAS INTERRUPTED.
;WARNING--THIS WILL WORK ONLY AT END OF LINE!
;
.TYPRE::EXCH T1,PREMPT ;SET FLAG WITH NEW ADDRESS [544]
PJRST INILIN ;RESET LINE & RETURN [544]
;HERE TO GET NEXT CHAR FROM INDIRECT OR CCL FILE
IFN M$INDP,<
TYIIND: SKIPE B.IND+1 ;SKIP IF INDIRECT OR CCL FILE NOT SET UP
PJRST TYIIGT ;READY TO READ NEXT CHAR
;HERE TO OPEN INDIRECT OR CCL FILE
SETZM INDUSI ;CLEAR USETI POINTER
MOVE C,A.DEV ;GET DEVICE
DEVCHR C, ;GET ITS CHARACTERISTICS
TXNN C,DV.DSK ;SEE IF DISK
TXNN C,DV.DIR ;OR NOT DIRECTORY DEVICE [320]
JRST .+2 ;OK
HRROS INDUSI ;NO--NO USETI LOGIC ON DECTAPE
PUSHJ P,.PSH4T## ;SAVE T1-4
MOVEI T1,A.ZER ;POINT TO INDIRECT SPEC
MOVEI T2,A.OPEN ;POINT TO OPEN BLOCK
MOVEI T3,A.LOOK ;POINT TO LOOKUP BLOCK
PUSHJ P,.STOPN ;SETUP OPEN
JRST E.IWI ;ERROR IF WILD-CARDS
MOVEI T1,5 ;SET LENGTH OF LOOKUP
MOVEM T1,A.LOOK ; FOR FILSER
MOVEI T1,B.IND ;POINT TO BUFFER HEADERS
MOVEM T1,A.OPEN+2 ; FOR OPEN
;STILL UNDER M$INDP
MOVE T1,A.LOOK+.RBPPN ;GET DIRECTORY
HRL T2,T1 ;GET POSSIBLE SFD POINTER
HRRI T2,A.PATH ;POINT TO BACKUP PLACE
JUMPE T1,TYINI1 ;IF DEFAULT, LEAVE ALONE
TLNN T1,-1 ;SEE IF PATH
BLT T2,A.PTHE ;YES--COPY TO BACKUP AREA
MOVEI T2,A.PATH ;POINT TO IT
TLNN T1,-1 ;SEE IF NEEDED
MOVEM T2,A.LOOK+.RBPPN ;YES--CHANGE POINTER
TYINI1: PUSHJ P,.POP4T## ;RESTORE T1-4
PUSHJ P,TYIINL ;GO LOOK AT FILE
JRST TYINGF ;CAN'T--RETURN EOF
;HERE TO GET INDIRECT CHARACTER
TYIIGT: SKIPL C,B.IND+1 ;SEE IF AT END OF WORD
TLNN C,(76B5) ; ..
SKIPE FLSOL ;YES--SEE IF END OF LINE
PJRST TYIIGC ;NO--JUST GET CHARACTER
PUSHJ P,TYIIGC ;YES--MIGHT BE A SEQUENCE NUMBER
; SO GET NEXT CHARACTER
CAMN C,[.CHEOF] ;[617] EXIT IF EOF
JRST TYINGF ;[617]
PUSH P,T1 ;MAKE ROOM
MOVE T1,@B.IND+1 ;GET FIRST WORD OF LINE
TRNN T1,1 ;SEE IF FLAG SET
TYIIGN: JRST [POP P,T1 ;NO--RESTORE TEMP
POPJ P,] ;AND RETURN
;[617] HERE IF LINE SEQUENCE NUMBER OR PAGE BREAK.
;[617] A LINE SEQUENCE NUMBER CONSISTS OF FIVE ASCII DIGITS
;[617] WORD ALIGNED, WITH THE LEAST SIGNIFICANT BIT SET. THIS
;[617] IS OPTIONALLY FOLLOWED BY A TAB. THE TAB IS CONSIDERED
;[617] TO BE PART OF THE LINE SEQUENCE NUMBER.
;[617] A PAGE BREAK CONSISTS OF FIVE ASCII SPACES, WORD ALIGNED,
;[617] WITH THE LEAST SIGNIFICANT BIT SET. THIS WORD IS ALWAYS
;[617] FOLLOWED BY A WORD CONTAINING A CARRIAGE RETURN, A FORM
;[617] FEED, AND THREE NULLS.
;[617] NOTE THAT A PAGE BREAK IS RETURNED AS A CARRIAGE RETURN
;[617] AND A FORM FEED. THIS IS BECAUSE UNSEQUENCING A FILE
;[617] CHANGES PAGE BREAKS INTO THAT SEQUENCE, AND IT IS DESIRED
;[617] THAT THE BEHAVIOR BE THE SAME WHETHER OR NOT THE INDIRECT
;[617] FILE CONTAINS LINE SEQUENCE NUMBERS.
MOVEI T1,5 ;GOT A SEQUENCE--ZAP 5 MORE CHARS
TYIIGL: PUSHJ P,TYIIGC ;GET CHAR TO THROW AWAY
CAMN C,[.CHEOF] ;[617] EXIT IF EOF
JRST TYINGP ;[617]
SOJG T1,TYIIGL ;NO--LOOP UNTIL CAUGHT UP
POP P,T1 ;RESTORE TEMP
CAIE C,.CHTAB ;[617] IS IT A TAB?
POPJ P, ;[617]NO - NOT PART OF SEQ. NUMBER
;STILL UNDER M$INDP
;HERE TO READ ONE CHAR FROM BUFFER
TYIIGC: SOSL B.INDC ;[616] SKIP IF NO MORE CHARS IN CORE
JRST TYIIG2 ;OK, GET NEXT
SKIPN B.IND ;SKIP IF NOT CCL IN CORE
JRST TYINGF ;IF CCL IN CORE, ALL DONE
AOS C,INDUSI ;ADVANCE USETI POINTER
MOVEI C,-1(C) ;GET RH(PREVIOUS VALUE)
JUMPE C,TYIIG1 ;JUMP IF FIRST TIME
PUSHJ P,TYIINL ;LOOKUP FILE AGAIN
JRST TYINGF ;CAN'T GIVE EOF
SKIPGE C,INDUSI ;UPDATE USETI COUNTER
JRST TYINGF ;GIVE EOF IF NOT DISK
CAILE C,1 ;OMIT INITIAL POSITIONING
USETI IND,(C) ;TELL MONITOR TO POSITION FILE
TYIIG1: IN IND, ;DEVICE, READ NEXT BUFFER
JRST TYIIGA ;NO PROBLEMS--GO PICK UP DATA
STATZ IND,IO.EOF ;SKIP IF GOT SOME DATA
JRST TYINGF ;EOF
TYIIGA: MOVE C,B.IND+2 ;GET CHARACTER COUNTER
MOVEM C,B.INDC ;STORE IN SAFE PLACE
RELEAS IND, ;FREE UP INDIRECT CHANNEL
JRST TYIIGC ;[616] Now try and read a character
TYIIG2: ILDB C,B.IND+1
CAIL C,.CHLFD ;SEE IF AT END OF LINE
CAILE C,.CHFFD ; ..
JRST [SKIPE C ;NO--SEE IF NON-NULL
SETOM FLSOL ;YES--FLAG STARTED LINE
POPJ P,] ;AND RETURN
SETZM FLSOL ;CLEAR FLAG TO INDICATE START OF NEXT LINE
POPJ P,
TYINGP: POP P,T1 ;RESTORE T1
TYINGF: HRREI C,.CHEOF ;IF TTY INPUT IMPROPER, FLAG EOF
POPJ P, ;RETURN
;STILL UNDER M$INDP
;TYIINL -- ROUTINE TO LOOKUP INDIRECT FILE
;CALL: PUSHJ P,TYIINL
;NON-SKIP IF FAILURE
;SKIP IF OK
;PRESERVES ALL ACS
TYIINL: PUSHJ P,.PSH4T## ;SAVE ACS AS ADVERTIZED
SKIPG FLCCL ;SKIP IF CCL, WHICH NEEDS TMPCOR
JRST TYIIN1 ;NO, MUST BE DEVICE
HLRZ T1,A.OPEN+1 ;[622] GET DEVICE NAME
CAIE T1,'TMP' ;[622] POSSIBLE TMPCORE?
JRST TYIIN1 ;[622] NO, TRY OPEN
TYIIN0: MOVE T1,[.TCRRF,,T2] ;CORE FUNCTION TO READ FILE
HRLZ T2,A.LOOK+.RBNAM ;NAME OF CCL FILE
SKIPN T2 ;[622] ANYTHING THERE?
HLLZ T2,A.LOOK+.RBNAM ;[622] NO, USE LEFT HALF
MOVE T3,[IOWD LN$ABF,A.BUF] ;BUFFER
TMPCOR T1,
JRST TYIIN1 ;NO SUCH FILE, TRY DEVICE
IMULI T1,5 ;THIS MANY CHARS
MOVEM T1,B.INDC ;FAKE BUFFER HEADER
MOVE T1,[POINT 7,A.BUF] ;BYTE PTR
MOVEM T1,B.IND+1
JRST TYIIN4 ;GO GET FIRST CHAR
TYIIN1: OPEN IND,A.OPEN ;OPEN INDIRECT DEVICE
JRST E.IFO ;NOT TODAY
;STILL UNDER M$INDP
MOVE T1,A.LOOK+.RBPPN ;PRESERVE DIRECTORY [253]
TYIIN2: MOVEM T1,A.LOOK+.RBPPN ;RESTORE DIRECTORY [253]
MOVEI T2,IND ;POINT TO INDIRECT CHANNEL [502]
DEVCHR T2, ;GET CHARACTERISTICS [502]
TXNN T2,DV.DTA ;IF DECTAPE, [502]
TDZA T2,T2 ; .. [502]
MOVEI T2,2 ; DO SHORT LOOKUP [502]
LOOKUP IND,A.LOOK(T2) ;LOOKUP INDIRECT FILE [502]
JRST TYININ ;CANT MAKE IT
MOVEM T1,A.LOOK+.RBPPN ;RESTORE DIRECTORY FROM LOOKUP [573]
MOVE T1,A.LOOK+.RBPRV ;GET PROTECTION
LSH T1,-<ALIGN.(RB.PRV)> ;POSITION PROTECTION
HRLI T1,.ACRED ;SET FUNCTION "READ"
MOVE T3,.MYPPN ;GET THIS PPN [312]
SKIPN T2,A.LOOK+.RBPPN ;GET FILE'S DIRECTORY
MOVE T2,T3 ;USE USER IF DEFAULTED
TLNN T2,-1 ;SEE IF PATH
MOVE T2,.PTPPN(T2) ;YES--GET UFD
MOVEI T4,T1 ;POINT TO ARGS
CHKACC T4, ;ASK MONITOR IF READ OK
MOVEI T4,0 ;ASSUME YES IF NOT IMPLEMENTED
MOVEI T2,ERPRT% ;PRESET PROTECTION FAILURE
JUMPN T4,E.IFL ;IF PROTECTED, GO GIVE ERROR
PUSH P,.JBFF
MOVEI T1,A.BUF
MOVEM T1,.JBFF
INBUF IND,1
IFN DEBUG$,<
MOVE T1,.JBFF ;SEE HOW MUCH MONITOR GRABBED
CAILE T1,A.BUFE ;COMPARE WITH OUR FIXED ALLOCATION
HALT .+1 ;GIVE UP IF MONITOR IS A HOG
>
POP P,.JBFF
TYIIN4: PUSHJ P,.POP4T## ;RESTORE T1-4
JRST .POPJ1 ;SKIP RETURN
TYININ: MOVE T2,A.LOOK+.RBEXT ;GET ERROR CODE
SKIPLE INDUSI ;SEE IF FIRST TIME HERE
JRST E.IFL ;NO--JUST GIVE UP
MOVX T4,FX.NUL ;PRESET FOR TEST
TDNE T4,A.MOD ;SEE IF NULL EXTENSION SPECIFIED
TLZN T2,-1 ;YES--SKIP IF NOT A NULL EXTENSION
JRST E.IFL ;NO--GIVE LOOKUP ERROR
JUMPN T2,E.IFL ;JUMP IF STRANGE ERROR
HLRZ T2,A.LOOK+.RBEXT ;NO--GET EXTENSION [253]
CAIE T2,'CCL' ;SEE IF .CCL [253]
TDZA T2,T2 ;NO--FORCE TO NULL [253]
MOVEI T2,'CMD' ;YES--TRY .CMD NEXT [253]
HRLZM T2,A.LOOK+.RBEXT ;STUFF INTO BLOCK [253]
JRST TYIIN2 ;AND TRY AGAIN
;STILL UNDER M$INDP
;HERE ON INDIRECT ERRORS
E.IFL: TLZ T2,-1 ;LOOKUP ERROR--CLEAR JUNK FROM CODE
SKIPE OPTNAM ;SEE IF OPTION MODE
PUSHJ P,EINDLS ;YES--SEE IF FILE NOT FOUND [324]
SKIPA ;NO--GO GIVE ERROR [324]
JRST EINDL2 ;YES--SUPPRESS ERROR [324]
SKIPLE FLCCL ;SEE IF CCL MODE
PUSHJ P,EINDLS ;YES--SEE IF FILE NOT FOUND [324]
JRST EINDL1 ;NO--GO ISSUE ERROR [324]
SETZM FLCCMD ;YES--CLEAR COMMAND MODE [324]
SETZM FLCCL ;CLEAR CCL MODE [324]
JRST EINDL2 ;AND SUPPRESS ERROR MESSAGE [324]
EINDL1: MOVEI N,A.ZER ;GET POINTER TO FILE SPEC
SETOM FLKLIN ;INDICATE TO KILL
M$FAIF (IFL,Indirect file LOOKUP error)
EINDL2: HRREI C,.CHEOF ;FLAG EOF
PUSHJ P,.POP4T## ;RESTORE T1-4
POPJ P, ;RETURN
E.IFO: HLRZ T1,A.OPEN+1 ;GET DEVICE NAME FIRST HALF
CAIE T1,'TMP' ;SEE IF TMPXXX:
JRST EINDO1 ;NO--JUST GIVE ERROR
HRLM T1,A.LOOK+.RBEXT ;YES--SET AT EXTENSION
MOVEI T1,'DSK' ;GET DSK:
HRLM T1,A.OPEN+1 ;CHANGE DEVICE TO DSKXXX:
HLRZ T1,A.LOOK+.RBNAM ;GET ORIGINAL FILE NAME
SKIPN T1 ;SEE IF BLANK
HRRZ T1,CCLNAM ;YES--GET CCL NAME
HLL T1,CCLNAM ;GET JOB NUMBER
MOVEM T1,A.LOOK+.RBNAM ;SET AS FILE NAME
SETZM A.LOOK+.RBPPN ;CLEAR PPN
HRRZS INDUSI ;INDICATE USETI WORKS [260]
JRST TYIIN0 ;GO TRY AGAIN
EINDO1: MOVEI N,A.ZER ;GET FILE SPEC
SETOB T2,FLKLIN ;NO ERROR CODE
M$FAIF (IFO,Can't OPEN indirect device)
;SUBROUTINE TO DETERMINE IF FILE NOT FOUND LEGITIMATELY
;CALL: T2/ERROR CODE
; PUSHJ P,EINDLS
; RETURN +1 IF SOME OTHER ERROR WITH T2 UNCHANGED
; RETURN +2 IF FILE NOT FOUND
EINDLS: CAIE T2,ERSNF% ;SEE IF SFD NOT FOUND
CAIN T2,ERSLE% ; OR SEARCH LIST EMPTY
JRST .POPJ1 ;RIGHT--FILE NOT FOUND
SOJLE T2,.POPJ1 ;IF NO FILE OR UFD, NOT FOUND
AOJA T2,.POPJ ;ELSE, GIVE ERROR
;.KLIND -- ROUTINE TO CLEAR INDIRECT FILE (DELETE IF CCL)
;KILINE -- DITTO WITHOUT DELETE
;KILINB -- ROUTINE TO CLEAR INDIRECT FILE BUT NOT NAME
;CALL: PUSHJ P,.KLIND/KILINB
;USES T1-T4
.KLIND::SKIPN A.DEV ;IF NOT AN INDIRECT FILE,
POPJ P, ;RETURN GRACEFULLY
SKIPE B.IND+1 ;SEE IF INDIRECT OPEN
SKIPG FLCCL ;SEE IF CCL FILE
JRST KILINE ;YES--GO RELEASE I/O
SETOM FLCCL ;SET TO NORMAL CCL MODE
SKIPN B.IND ;SEE IF TEMP CORE
JRST KILIN1 ;YES--GO ZAP IT
PUSHJ P,TYIINL ;REOPEN FILE
JRST KILINE ;CAN'T--GIVE UP
SETZB T1,T2 ;YES--DELETE FILE
SETZB T3,T4 ; ..
RENAME IND,T1 ; ..
JFCL ;IGNORE ERROR
JRST KILINE ;GO FINISH UP
KILIN1: MOVE T1,[.TCRDF,,T2] ;DELETE
HRLZ T2,A.LOOK+.RBNAM ; TEMP CORE
SKIPN T2 ;[626] ANYTHING THERE?
HLLZ T2,A.LOOK+.RBNAM ;[626] NO, TRY OTHER HALF
MOVE T3,[IOWD LN$ABF,A.BUF]
TMPCOR T1, ; FILE
JFCL ;IGNORE ERROR
KILINE: SETZM A.DEV ;CLEAR INDIRECT DEVICE
SETZM FLKLIN ;INDICATE KILLED
RELEAS IND, ;RELEASE CHANNEL
MOVE C,INDSVC ;RECOVER TOP LEVEL CHARACTER [350]
SETZM INDSVC ;CLEAR MEMORY [535]
SETZM B.ZER ;CLEAR INDIRECT STUFF
MOVE T1,[B.ZER,,B.ZER+1]
BLT T1,B.EZER ; ..
POPJ P, ;RETURN
E.IWI: MOVEI N,A.ZER ;POINT TO FILE SPEC
SETOB T2,FLKLIN ;FLAG FOR NO ERROR CODE
M$FAIF (IWI,Wildcard illegal in indirect specification)
> ;END OF M$INDP
SUBTTL ROUTINE TO CONVERT SCAN BLOCKS
;.STOPN -- ROUTINE TO TURN SCAN BLOCK INTO OPEN/LOOKUP BLOCKS
; WILD-CARDS ARE ILLEGAL
;CALL: MOVEI T1,SCAN BLOCK
; MOVEI T2,OPEN BLOCK (3 WORDS)
; MOVEI T3,LOOKUP BLOCK (6 WORDS OR MORE)
; PUSHJ P,.STOPN
;ERROR RETURN IF WILD-CARDS
;SKIP RETURN IF SETUP OK
;USES T1-4
.STOPN::MOVEI T4,STOPTH ;USE LOCAL PATH STORAGE IF NEEDED
PJRST .STOPB## ;GO HANDLE
SUBTTL SUBROUTINES FOR ERROR MESSAGE OUTPUT
;ALL THESE ROUTINES BEHAVE THE SAME
;ALL DESTROY T1-4
;ALL RESTORE P TO "VIRGIN" STATE
;ALL JUMP TO RESTART
;.FMSG -- ISSUE FATAL MESSAGE AND RESTART JOB
;CALL: M.FAIL (MESSAGE)
;OR M$FAIL (PFX,MESSAGE)
FMSG: SKIPA T2,(T1) ;GET PFX,,TEXT ADDR [303]
.FMSG:: HRRZ T2,T1 ;CLEAR PREFIX [303]
PUSH P,T1 ;PRETEND PUSHJ
MOVE T1,T2 ;GET ARGUMENT
PUSHJ P,.TERRP
JRST .FMSGE ;GO FINISH UP
;.FMSGN -- ISSUE FATAL MESSAGE WITH SIXBIT ARGUMENT FROM N
;CALL: M.FAIN (MESSAGE)
;OR M$FAIN (PFX,MESSAGE)
;.FMSGD -- ISSUE FATAL MESSAGE WITH DECIMAL ARGUMENT N
;CALL: M.FAID (MESSAGE)
;OR M$FAID (PFX,MESSAGE)
;.FMSGO -- ISSUE FATAL MESSAGE WITH OCTAL ARGUMENT N
;CALL: M.FAIO (MESSAGE)
;OR M$FAIO (PFX,MESSAGE)
FMSGN: SKIPA T2,(T1) ;GET PFX,,TEXT ADDR [303]
.FMSGN::HRRZ T2,T1 ;CLEAR PREFIX [303]
MOVEI T4,.TSIXN## ;GET SIXBIT TYPER
JRST FMSGXE ;GO DO THINGS
FMSGD: SKIPA T2,(T1) ;GET PFX,,TEXT ADDR [303]
.FMSGD::HRRZ T2,T1 ;CLEAR PREFIX [303]
MOVEI T4,.TDECW## ;GET DECIMAL TYPER
JRST FMSGXE ;GO DO THINGS
FMSGO: SKIPA T2,(T1) ;GET PFX,,TEXT ADDR [303]
.FMSGO::HRRZ T2,T1 ;CLEAR PREFIX [303]
MOVEI T4,.TOCTW## ;GET OCTAL TYPER
FMSGXE: PUSH P,T1 ;PRETEND PUSHJ
MOVE T1,T2 ;GET ARGUMENT
PUSHJ P,.TERRP ;TYPE LEADING ? AND MESSAGE
TXNN T1,JWW.FL ;SEE IF FIRST [303]
JRST .FMSGE ;NO--SKIP VALUE PRINTING [303]
PUSHJ P,.TSPAC## ;SPACE TO VALUE
MOVE T1,N ;GET ARGUMENT
PUSHJ P,(T4) ;TYPE IT
JRST .FMSGE ;GO FINISH UP
;.FMSGF -- ISSUE FATAL MESSAGE WITH FILE DESCRIPTOR
;CALL: MOVEI N,ADDR OF FILE DESCRIPTOR
; HRR T2,ERROR CODE (OR -1 IF NONE)
; M.FAIF (MESSAGE)
;OR M$FAIF (PFX,MESSAGE)
FMSGF: SKIPA T3,(T1) ;GET PFX,,TEXT ADDR [303]
.FMSGF::HRRZ T3,T1 ;CLEAR PREFIX [303]
PUSH P,T1 ;PRETEND PUSHJ
MOVE T1,T3 ;GET ARGUMENT
HRL N,T2 ;N=ERROR CODE
PUSHJ P,.TERRP
TXNN T1,JWW.FL ;SEE IF FIRST [303]
JRST .FMSGE ;NO--SKIP VALUE PRINTING [303]
PUSHJ P,.TSPAC## ;SPACE TO VALUE
JUMPL N,FMSGF1 ;IF NO ERROR CODE, SKIP TYPE OUT
HLRZ T1,N ;ERROR CODE
PUSHJ P,.TOCTW##
PUSHJ P,.TSPAC##
FMSGF1: HRRZ T1,N ;GET FILE POINTER
PUSHJ P,.TFBLK## ;TYPE FILE BLOCK
;FALL INTO .FMSGE
;FALL HERE
;.FMSGE -- FINISH UP FATAL ERROR PROCESSING
;.FMSGX -- SAME EXCEPT DON'T CLEAR TYPE AHEAD
;CALL: JRST .FMSGE
;RESTORES P TO VIRGIN STATE
;JUMPS TO RESTART
.FMSGE::SKIPE FLKLIN ;SEE IF FORCED IND KILL NEEDED
PUSHJ P,KILINE ;YES--KILL IT WITHOUT DELETE
HRREI T1,.CHEOF ;PREPARE AN EOF MARKER [322]
SKIPG FLVERB ;SEE IF VERB MODE
SKIPN A.DEV ;YES--SEE IF INDIRECT FILE
SKIPA ;NO--LEAVE CHARACTER ALONE
MOVEM T1,LASCHR ;YES--FORCE EOF [322]
.FMSGX::PUSHJ P,.TCRLF## ;SEND CR/LF
PUSHJ P,.TCRLF## ;SEND ANOTHER
MOVE C,LASCHR ;RESTORE LAST CHARACTER [322]
SKIPN OPTNAM ;UNLESS OPTION FILE,
SETZM N.DEV ; CLEAR /RUN
MOVE P,SAVPDP ;RESTORE P
SKIPGE FLVERB ;SKIP IF VERB FORM
JRST VRSTRT ;VERB RESTART
SKIPN T2,SAVCAL ;SEE IF SOME CALL SAVED
JRST FMSGEX ;NO--GO DIE
MOVEM T2,(P) ;YES--RESTORE IT
MOVEI T1,0 ;CLEAR ARG POINTER TO LEAVE ALONE [370]
SKIPN FLVERB ;SEE IF TRAD. MODE
JRST .PSCAN ;NO--PART. MODE SO START IT OVER [322]
MOVEM T2,-5(P) ;YES--RESTORE BEFORE .SAVE4 AREA
HRRI T2,.SAVX4## ;RESET .SAVE4 RETURN POINT
MOVEM T2,(P) ; ..
JRST RESTRT ;AND GO START OVER
FMSGEX: PUSHJ P,.MONRT ;RETURN
EXIT ;TOLERATE NO NONSENSE
;.CLRBF -- ROUTINE TO CLEAR TYPE-AHEAD
;.CCLRB -- DITTO BUT ONLY IF ERROR ROUTINES SET FLAG TO DO SO
; IF INDIRECT, IT GOES TO END OF THIS LINE
;CALL: PUSHJ P,.CLRBF/.CCLRB
;PRESERVES ALL AC'S
.CCLRB::SKIPN .FLCBF## ;SEE IF NEED TO CLEAR BUFFER [322]
POPJ P, ;NO--RETURN [322]
.CLRBF::SETZM .FLCBF## ;CLEAR ERROR FLAG [322]
PUSH P,C ;SAVE CHARACTER AC [322]
MOVE C,LASCHR ;GET LAST CHARACTER [322]
IFN M$INDP,<
SKIPE B.IND+1 ;SEE IF INDIRECT OPEN
JRST CLRBFL ;YES--GO DO IT
>
CLRBFI ;NO--CLEAR TYPE AHEAD
SKIPN FLCCMD ;SEE IF COMMAND MODE, [322]
SKIPGE FLRCMD ; OR IF RUN (...) MODE [322]
HRREI C,.CHEOF ;YES--SET END OF FILE [322]
JRST CLRBFX ;GO CLEAN UP
;ROUTINE TO SKIP TO END OF LINE
CLRBFN: PUSH P,C ;SAVE CHARACTER AC [322]
CLRBFL: SKPINC ;SEE IF TTY INPUT
IFN M$INDP,<
SKIPE B.IND+1 ;OR INDIRECT FILE
>
IFE M$INDP,<SKIPA>
JUMPG C,[PUSHJ P,.TICHR ;YES--GET NEXT CHAR [366,524]
JRST CLRBFL] ;CONTINUE UNTIL DONE [366]
CAME C,[.CHEOF] ;NO--UNLESS EOF, [322]
HRREI C,.CHEOL ; DUMMY UP EOL
CLRBFX: SETZM SAVCHR ;CLEAR SAVED CHARACTER
SETZM SCANPC ;CLEAR BLANK COMPRESSOR
SETZM SCANCH ;CLEAN OUT JUNK [364]
SETZM .QUOTE ;CLEAR ANY QUOTING
CAME C,[.CHEOF] ;IF NOT EOF,
HRREI C,.CHEOL ; SET EOL
MOVEM C,LASCHR ;SAVE AS LAST CHAR
POP P,C ;RESTORE CHARACTER AC [322]
POPJ P, ;AND RETURN
;.MONRT -- EITHER RETURN TO MONITOR OR, IF NOT LOGGED IN, DO A KJOB
;CALL: PUSHJ P,.MONRT
;PRESERVES ALL ACS
.MONRT::PUSHJ P,.CCLRB ;CONDITIONALLY CLEAR TYPE-AHEAD
IFN M$INDP,<
PUSHJ P,.KLIND ;CLEAR INDIRECT STUFF
SETZM FLCCL ;CLEAR CCL MODE
>
SETZM FLCCMD ;CLEAR COMAND MODE
SETZM FLRCMD ;CLEAR RUN COMMAND MODE
SKIPE MONRT ;SEE IF CALLER WANTS CONTROL
PJRST @MONRT ;YES--GIVE IT TO HIM
;.MNRET -- ROUTINE WHICH UNCONDITIONALLY GOES TO MONITOR
; (TO BE CALLED BY USER'S MONRT EXIT ROUTINE)
.MNRET::PUSHJ P,.ISLGI## ;SEE IF WE ARE LOGGED IN [251,263,347]
JRST MONRT1 ;NO--MUST GO KJOB [251]
RESET ;CLEAR ALL I/O
MONRT. ;YES--RETURN TO MONITOR
POPJ P, ;IN CASE OF CONTINUE
MONRT1: SKIPG T1 ;SEE IF NOT KNOWN IF LOGGED IN [347]
E$$KJB: OUTSTR [ASCIZ /
.KJOB
./] ; [262]
LOGOUT ;KILL THE JOB
;.TERRP -- SUBROUTINE TO TYPE PREFIX TO FATAL ERROR
;AND TO TYPE THE ? AND THE TEXT ARGUMENT
;CALL: T1/ PREFIX,,[ASCIZ STRING]
; PUSHJ P,.TERRP
;RETURNS T1/ MESSAGE BITS (JWW.?? FORMAT)
.TERRP::PUSHJ P,.PSH4T##
HRRZ T2,T1 ;MOVE MESSAGE TEXT POINTERR
HLRZS T1 ;GET MESSAGE ERROR CODE
SKIPE T1 ;SEE IF SET
HRLI T1,'SCN' ;YES--INDICATE FROM SCAN
HRLI T2,"?" ;INDICATE FATAL ERROR
SKIPE OPTNAM ;SEE IF FROM OPTION FILE
HRLI T2,"%" ;YES--CHANGE TO WARNING
MOVE T3,-4(P) ;GET CALL ADDRESS [366]
HRRZI T3,-1(T3) ; ..
PUSHJ P,.ERMSA## ;GO ISSUE START OF ERROR MESSAGE
MOVEM T1,-3(P) ;STORE RESULT
PUSH P,C ;PRESERVE C [366]
SKIPE OPTNAM ;IF OPTION,
PUSHJ P,.KLIND ; KILL OPTION FILE
POP P,C ;RESTORE C [366]
PUSHJ P,.POP4T## ;RESTORE TEMPS
POPJ P, ;RETURN
SUBTTL STORAGE
STDSWC: ;POINTERS TO STANDARD (LOCAL) SWITCH TABLES
STSWTN(P1)
STSWTP(P1)
STSWTM(P1)
STSWTD(P1)
;OFFSETS FOR TABLES
SWN==0 ;NAME TABLE
SWP==1 ;POINTERS TABLE
SWM==2 ;MAX,,PROCESSOR TABLE
SWD==3 ;DEFAULT TABLE
XLIST ;LITERALS
LIT
LIST
RELOC ;SWITCH TO LOW SEG
.SCANZ::! ;START OF SCAN LOW SEG
ZCOR:! ;START OF AREA TO ZERO ON INITIAL LOAD
.MYPPN::BLOCK 1 ;THIS JOB'S PROJECT-PROGRAMMER NUMBER
;THESE LOCATIONS ARE USED TO FETCH AND STORE PARAMETERS
SWTPTR: BLOCK 1 ;POINTER TO NAMES OF SWITCHES
SWTCHC:! ;POINTERS TO USER'S SWITCH TABLES
SWTCHN: BLOCK 1 ;TABLE OF SWITCH NAMES
SWTCHP: BLOCK 1 ;TABLE OF POINTERS FOR STORING
SWTCHM: BLOCK 1 ;TABLE OF MAX,,PROCESSOR
SWTCHD: BLOCK 1 ;TABLE OF DEFAULTS
SWTPFF: BLOCK 1 ;FIRST LOCATION OF USER FXXX
SWTPFL: BLOCK 1 ;LAST LOCATION OF USER FXXX
SWTPFO: BLOCK 1 ;OFFSET PXXX-FXXX
SWTHLP: BLOCK 1 ;ADDR OF HELP PROCESSOR
CLRANS: BLOCK 1 ;ROUTINE TO CLEAR ANSWERS
CLRSTK: BLOCK 1 ;ROUTINE TO CLEAR STICKY DEFAULTS
CLRFIL: BLOCK 1 ;ROUTINE TO CLEAR FILE
ALLIN: BLOCK 1 ;ROUTINE TO ALLOCATE INPUT FILE
ALLOUT: BLOCK 1 ;ROUTINE TO ALLOCATE OUTPUT FILE
MEMSTK: BLOCK 1 ;ROUTINE TO MEMORIZE STICKY DEFAULTS
APPSTK: BLOCK 1 ;ROUTINE TO APPLY STICKY DEFAULTS
USRFLG: BLOCK 1 ;USER SUPPLIED FLAGS
STRSWT: BLOCK 1 ;USER ROUTINE FOR SWITCH HANDLING
SAVCOR: BLOCK 1 ;INITIAL VALUE OF LOW SEG CORE SIZE
IFN M$INDP,<
CCLNAM: BLOCK 1 ;NAME OF CCL INDIRECT FILE
USRIND: BLOCK 1 ;USER POINTER TO IND SPEC
OPTNAM: BLOCK 1 ;CODE NAME IN SWITCH.INI
VOPTN: BLOCK 1 ;OPTNAM FOR VERB MODE
LOGTIM: BLOCK 1 ;TIME OF LAST LOGIN
>
TYPIN: BLOCK 1 ;ROUTINE TO INPUT ONE CHARACTER
MONRT: BLOCK 1 ;ROUTINE TO RETURN TO MONITOR
PROMPT: BLOCK 1 ;ROUTINE TO PROMPT FOR INPUT
INIFLG: BLOCK 1 ;.ISCAN FLAGS [366]
SAVCHR: BLOCK 1 ;SAVED CHARACTER IN .TICHR FOR SPACE/HYPHEN
CALCNT: BLOCK 1 ;CALL COUNTER FOR .TSCAN
LASCHR: BLOCK 1 ;LAST CHARACTER READ
SCANPC: BLOCK 1 ;PC IN CHARACTER SCAN (0=START OF LINE)
SCANCH: BLOCK 1 ;CHARACTER IN SCAN
.NOQTE::BLOCK 1 ;[604] IF NON-ZERO, DISABLE QUOTING W/I STRING
.QUOTE::BLOCK 1 ;QUOTING CHARACTER IN EFFECT
.VQUOT::BLOCK 1 ;CONTROL-V QUOTE FLAG. -1 IF CONTROL-V SEEN.
IFN M$INDP,<
N.ZER::! ;BLOCK FOR /RUN COMMAND
N.DEV: BLOCK 1 ;DEVICE (=1 IF /EXIT)
N.NAM: BLOCK 2 ;NAME
N.EXT: BLOCK 1 ;EXTENSION
N.MOD: BLOCK 2 ;MODIFIERS
N.DIR: BLOCK 2*.FXLND ;DIRECTORY
N.EZER==:.-1
N.CORE::BLOCK 1 ;CORE ARG
N.OFFS::BLOCK 1 ;OFFSET
N.OPEN: BLOCK 3 ;OPEN BLOCK
N.LOOK: BLOCK 7 ;LOOKUP BLOCK
A.ZER:! ;BLOCK FOR INDIRECT COMMAND
A.DEV: BLOCK 1 ;DEVICE
A.NAM: BLOCK 1 ;NAME
A.NAMM: BLOCK 1 ;NAME MASK
A.EXT: BLOCK 1 ;EXTENSION AND MASK
A.MOD: BLOCK 1 ;MODIFIERS
A.MODM: BLOCK 1 ;MODIFIER MASK
A.DIR: BLOCK 1 ;DIRECTORY
A.DIRM: BLOCK 2*.FXLND-1 ;DIRECTORY MASK
A.EZER==.-1
A.OPEN: BLOCK 3 ;OPEN BLOCK
A.LOOK: BLOCK 6 ;LOOKUP BLOCK
A.PATH: BLOCK .PTMAX ;SFD FOR LOOKUP [565]
A.PTHE==.-1
A.BUF: BLOCK LN$ABF+3 ;BUFFER TO READ INDIRECT FILE
A.BUFE==.
B.ZER:! ;START OF INDIRECT AREA
B.IND: BLOCK 3 ;BUFFER HEADERS FOR INDIRECT FILE
; ALSO FLAGS:
; +0 IS 0 IF TMPCOR, NOT 0 IF FILE
; +1 IS NON ZERO IF FILE OPEN
B.INDC: BLOCK 1 ;COUNT OF BYTES IN BUFFER
FLIIND: BLOCK 1 ;FLAG FOR INTERACTIVE INDIRECT
INDUSI: BLOCK 1 ;USETI FOR INDIRECT FILE
B.EZER==.-1
>
INDSVC: BLOCK 1 ;TOP LEVEL EOL CHAR (AFTER @)
IFG M$INDP,<
INDCNT: BLOCK 1 ;COUNT OF @ SINCE TTY: INPUT
>
P.ZER:! ;START OF AREA FOR FILE DEFAULTS
P.DEV: BLOCK 1 ;LAST STICKY DEVICE TYPED BY USER
P.NAM: BLOCK 1 ;LAST STICKY NAME
P.NAMM: BLOCK 1 ;LAST STICKY NAME MASK
P.EXT: BLOCK 1 ;LAST STICKY EXT,,MASK TYPED BY USER
P.MOD: BLOCK 1 ;LAST STICKY FILE SWITCHES TYPED BY USER
P.MODM: BLOCK 1 ;LAST STICKY FILE SWITCHES MASK TYPED BY USER
P.DIR: BLOCK 1 ;LAST STICKY DIRECTORY TYPED BY USER
P.DIRM: BLOCK 2*.FXLND-1 ;LAST STICKY DIRECTORY MASK TYPED BY USER
P.MZER:!
P.BFR: BLOCK 1 ;LAST STICKY /BEFORE
P.SNC: BLOCK 1 ;LAST STICKY /SINCE
P.ABF: BLOCK 1 ;LAST STICKY /ABEFORE
P.ASN: BLOCK 1 ;LAST STICKY /ASINCE
P.FLI: BLOCK 1 ;LAST STICKY FILE MIN
P.FLM: BLOCK 1 ;LAST STICKY FILE MAX
P.EST: BLOCK 1 ;LAST STICKY /ESTIMATE
P.VER: BLOCK 1 ;LAST STICKY /VERSION
P.EZER==.-1
F.ZER:! ;START OF AREA FOR FILE TYPE-INS
F.DEV: BLOCK 1 ;DEVICE (ALWAYS NON-ZERO IF ANYTHING TYPED)
F.NAM:: BLOCK 1 ;NAME (NON-ZERO IF NAME TYPED)
F.NAMM: BLOCK 1 ;NAME MASK
F.EXT: BLOCK 1 ;EXT,,MASK (NON-ZERO IF DOT TYPED)
F.MOD: BLOCK 1 ;FILE SWITCHES
F.MODM: BLOCK 1 ;FILE SWITCH MASK (ON IF TYPED)
F.DIR: BLOCK 1 ;DIRECTORY (DIR!DIRM ZERO IF DEFAULT DIRECTORY)
F.DIRM: BLOCK 2*.FXLND-1 ;DIRECTORY MASK
F.MZER:!
F.BFR: BLOCK 1 ;/BEFORE
F.SNC: BLOCK 1 ;/SINCE
F.ABF: BLOCK 1 ;/ABEFORE
F.ASN: BLOCK 1 ;/ASINCE
F.FLI: BLOCK 1 ;FILE MIN
F.FLM: BLOCK 1 ;FILE MAX
F.EST: BLOCK 1 ;/ESTIMATE
F.VER: BLOCK 1 ;/VERSION
F.EMZR==.-1
FLFSP: BLOCK 1 ;FLAG SOMETHING FOUND
F.EZER==.-1
SWTCNT: BLOCK 1 ;RECURSION COUNTER FOR FILIN
FLFLLP: BLOCK 1 ;RECURSION COUNTER FOR (...) IN FILIN
G.ZER: BLOCK F.EZER-F.ZER+1 ;PUSH DOWN FOR FILE SWITCHES
G.EZER==.-1
FXNOTD==FX.NDV!FX.NUL!FX.DIR!FX.DFX!FX.TRM ;NOT DEFAULTED IN .OSDFS
FXNOTI==FX.PRO!FX.SUP ;ILLEGAL ON INPUT FILE
FXNOTO==FX.NOM!FX.STR ;ILLEGAL ON OUTPUT FILE
IFN M$INDP,<
.OPTN:: ;[627] GLOBAL NAME FOR OPTION
OPTION: BLOCK 1 ;NAME OF /OPTION (-1 IF DEFAULT, 0 IF /NOOPTION)
>
SAVPDP: BLOCK 1 ;SAVE PUSH DOWN POINTER IN CASE FATAL ERROR
SAVCAL: BLOCK 1 ;SAVE LOCATION OF CALL
.NMUL:: BLOCK ^D30 ;MULTIPLE WORD RESULT
.NMUE==:.-1
VAL1==.NMUL ;TEMP IN DATE/TIME ROUTINES
VAL2==.NMUL+1
VAL3==.NMUL+2
VAL4==.NMUL+3
VAL5==.NMUL+4
VAL6==.NMUL+5
VAL7==.NMUL+6
VAL8==.NMUL+7
VAL9==.NMUL+8
.LASWD::BLOCK 1 ;FORMAT OF LAST WORD INPUT
MASK: BLOCK 1 ;MASK AFTER WORD ACCUMULATION
NOW: BLOCK 1 ;HOLDS CURRENT DATE/TIME
STOPTH: BLOCK .PTMAX ;SFDS FOR .STOPN [565]
FLCCL: BLOCK 1 ;CCL MODE (-1 AFTER @ SEEN, 1 BEFORE)
FLCCMD: BLOCK 1 ;CCL OR COMMAND MODE
FLFUTD: BLOCK 1 ;FUTURE/PAST DEFAULT
FLFUTR: BLOCK 1 ;FUTURE/PAST RELATIVE
;BOTH: -1 PAST, 0 ABS, +1 FUT
FLJCNM: BLOCK 1 ;PSCAN AFTER RESCAN OF JUST COMMAND
;-1=RESCAN; +1=FIRST PSCAN THEN [365]
FLKLIN: BLOCK 1 ;NEED TO KILL INDIRECT FILE
FLMULS: BLOCK 1 ;FLAG FOR MULTIPLE SWITCH VALUES
FLNEG: BLOCK 1 ;FLAG FOR NEGATIVE NUMBER
FLNULL: BLOCK 1 ;-1 IF FIELD NOT NULL
FLOUT: BLOCK 1 ;FLAG FOR = SEEN
FLRCMD: BLOCK 1 ;RUN COMMAND MODE (-1=()
FLSOL: BLOCK 1 ;SEEN SOMETHING ON THIS LINE
FLSOME: BLOCK 1 ;INDICATES SOMETHING SEEN
FLVERB: BLOCK 1 ;FLAG FOR MODE OF SCANNING (LT 0 VERB,=0 P, GT 0 TRAD)
PREMPT: BLOCK 1 ;ADDRESS OF PREEMPTIVE INPUT ROUTINE, IF ANY
EZCOR==.-1 ;END OF AREA TO ZERO
.SCANL==:.-.SCANZ ;LENGTH OF SCAN LOW SEG
PRGEND
TITLE .VERBO -- ROUTINE TO RETURN /MESSAGE SETTINGS
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
DEFINE CLEARO,<
IFE FT$TNX,<
SKPINL
JFCL
>
IFN FT$TNX,<
MOVEI T1,.PRIOU
RFMOD
TXO T2,TT%OSP
SFMOD
>>
IFN FT$TNX,<
DEFINE OUTSTR (TEXT)<
HRROI 1,TEXT
PSOUT
>
DEFINE OUTCHR (ACC)<
IFN ACC-1,<
HRRZ 1,ACC
>
PBOUT
>
>;END IFN FT$TNX
;ENTRY POINTS
ENTRY .VERBO,.ERMSA,.ERMSG
;.ERMSG/.ERMSA -- ROUTINES TO ISSUE STANDARD ERROR MESSAGE PREFIXES
;CALL: 1/ MODULE CODE (0=SYSTEM),,MESSAGE CODE IN SIXBIT
; 2/ (11) ??? (7) LEAD CHAR,,[ASCIZ TEXT]
; 3/ ???,,ADDRESS OF ERROR IF .ERMSA
; PUSHJ P,.ERMSG/.ERMSA
;RETURN +1 WITH 1/ LH(ARG 2),,/VERBOS BITS
;USES T2-4
.ERMSG::MOVEI T3,0 ;CLEAR ADDRESS
.ERMSA::PUSH P,T2 ;SAVE CONTROL BITS
PUSH P,T3 ;SAVE ADDRESS
PUSH P,T1 ;SAVE PREFIXES
HLRZ T1,T2 ;GET PREFIX CHARACTER
ANDI T1,177 ;MASK TO JUST LEAD CHARACTER
CAIN T1,"?" ;IF FATAL ERROR,
SKIPE .FLCBF ;SEE IF FIRST FATAL ERROR [354,567]
JRST ERMSG1 ;NO, PROCEED [567]
CLEARO ;YES--CLEAR ^O [567]
SETOM .FLCBF ; INDICATE TO CLEAR TYPE-AHEAD
ERMSG1: PUSHJ P,.TNEWL## ;GO TO START OF LINE [355]
PUSHJ P,.TCHAR## ;ISSUE LEAD CHARACTER
PUSHJ P,.VERBO ;GET /MESSAGE
MOVE T4,T1 ;COPY TO SAFER PLACE
POP P,T1 ;GET PREFIX
TLNN T1,-1 ;SEE IF SYSTEM CODE
HRLZS T1 ;YES--REMOVE SPACES
TXNE T4,JWW.PR ;SEE IF /VERBOS:PREFIX
PUSHJ P,.TSIXN## ;YES--ISSUE PREFIX
POP P,T3 ;GET ADDRESS OF CALL
TRNE T3,-1 ;SEE IF CALL ADDRESS SET
TXNN T4,1_<VRBADX-1> ; AND IF USER ASKED FOR IT
JRST ERMSG2 ;NO--PROCEED BELOW
MOVEI T1,"(" ;YES--INDICATE
PUSHJ P,.TCHAR## ; ADDRESS
HRRZ T1,T3 ;GET ADDRESS
PUSHJ P,.TOCTW## ; TYPE IN OCTAL
MOVEI T1,")" ;GET END
PUSHJ P,.TCHAR## ; AND INDICATE
ERMSG2: PUSHJ P,.TSPAC## ;SPACE OVER TO TEXT AREA
HRRZ T1,(P) ;GET TEXT ADDRESS
TXNE T4,JWW.FL ;SEE IF /MESSAGE:FIRST
PUSHJ P,.TSTRG## ;YES--ISSUE TEXT
POP P,T1 ;RESTORE FLAGS (???)
ANDX T4,JWW.CN!JWW.FL ;REMOVE JUNK BITS
HRR T1,T4 ;MOVE TO ANSWER
POPJ P, ;RETURN
;.VERBO -- ROUTINE TO RETURN /MESSAGE SETTING
;CALL: PUSHJ P,.VERBO
;RETURNS T1/BITS IN JWW.?? FORMAT
.VERBO::
IFE FT$TNX,<
HRROI T1,.GTWCH ;GET FROM MONITOR
GETTAB T1, ;THE USER'S DEFAULT
>
MOVEI T1,0 ;(DEFAULT TO 0)
TXNN T1,JW.WMS ;SEE IF SET
TXO T1,.JWWPO_<ALIGN. (JW.WMS)> ;NO--DEFAULT TO PREFIX,FIRST
ANDX T1,JW.WMS ;REMOVE JUNK
LSH T1,^D18-<ALIGN.(JW.WMS)> ;ALIGN IN LEFT HALF
ANDCM T1,.FLVRB ;CLEAR ANY SET IN SWITCH
HLRZS T1 ;POSITION TO RIGHT
IOR T1,.FLVRB ;INCLUDE ANY SET IN SWITCH
TLZ T1,-1 ;CLEAR JUNK
TRNE T1,JWW.CN ;SEE IF CONTINUATION
TRO T1,JWW.FL ;YES--SET FIRST
SKIPN T1 ;SEE IF ANYTHING LEFT
TRO T1,.JWWPO ;NO--SET FIRST,PREFIX
POPJ P, ;RETURN
RELOC
.VRBOZ::! ;START OF LOW CORE AREA
.FLVRB::BLOCK 1 ;MASK,,SET OF /MESSAGE BITS
.FLCBF::BLOCK 1 ;FLAG TO CLEAR TYPEAHEAD
.VRBOL==:.-.VRBOZ ;LENGTH OF LOW CORE AREA
RELOC
PRGEND
TITLE .TNEWL -- ROUTINE TO FORCE OUTPUT TO START OF LINE
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .TNEWL
.TNEWL::PUSHJ P,.SAVE1## ;SAVE P1
MOVE P1,[2,,[EXP .TOFLM,-1]]
TRMOP. P1, ;FORCE LEFT MARGIN
PJRST .TCRLF## ;OLD MONITOR
POPJ P, ;DONE
PRGEND
TITLE .TTYIO -- SIMPLE TERMINAL I/O ROUTINES
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;This entire module is new with edit 647
ENTRY .TOINI ;ONLY ENTRY POINT SINCE THIS MUST BE CALLED
ND LN$BUF,^D80 ;LENGTH OF TTY OUTPUT BUFFER IN CHARACTERS
;.TOINI -- INITIALIZE POINTER AND COUNTER FOR .TOCHR
;CALL: PUSHJ P,.TOINI
;USES NO ACS
.TOINI::PUSH P,T1 ;SAVE T1
MOVEI T1,LN$BUF ;RESET CHAR COUNTER
MOVEM T1,.TOCNT ;..
MOVE T1,[POINT 7,.TOBUF] ;RESET BYTE POINTER
MOVEM T1,.TOPTR ;..
POP P,T1 ;RESTORE T1
POPJ P, ;AND RETURN
;.TOPMT -- PROMPT USER VIA STANDARD "*" OR "#"
;CALL: PUSHJ P,.TOPMT
; T1/ .GE. 0 IF INITIAL, OR .LT. 0 IF CONTINUATION
;CHANGES ONLY T1
.TOPMT::SKIPL T1 ;CHECK IF CONTINUATION
SKIPA T1,["*"] ;NO--USE AN ASTERISK
MOVEI T1,"#" ;YES--USE A HASH-MARK
PUSH P,T1 ;SAVE OUR CHARACTER
PUSHJ P,.TOCCO ;CLEAR CONTROL-O
POP P,T1 ;GET OUR CHARACTER BACK
PUSHJ P,.TCHAR## ;TYPE THE CHARACTER
PJRST .TOOUT ;DUMP THE BUFFER
;.TOPRN -- PROMPT USER VIA PROGRAM (OR OTHER) NAME
;CALL: PUSHJ P,.TOPRN
; T1/ .GE. 0 IF INITIAL, OR .LT. 0 IF CONTINUATION
;CHANGES ONLY T1
.TOPRN::PUSHJ P,.PSH4T## ;SAVE SOME ACS FOR A WHILE
PUSHJ P,.TOCCO ;CLEAR CONTROL-O
SKIPE T1,.TOPNM ;DO WE KNOW OUR NAME YET?
JRST TOPRN1 ;YES, GO TYPE IT
HRROI T1,.GTPRG ;NO, SET UP FOR GETTAB
GETTAB T1, ;ASK THE MONITOR
SETZ T1, ;CAN'T?!?
MOVEM T1,.TOPNM ;SAVE NAME FOR NEXT TIME
TOPRN1: PUSHJ P,.TSIXN## ;TYPE OUT IN SIXBIT
PUSHJ P,.POP4T## ;RESTORE ACS
SKIPL T1 ;CHECK IF CONTINUATION
SKIPA T1,[76] ;NO, GET RIGHT ANGLE
MOVEI T1,"#" ;YES, GET HASH-MARK
PUSHJ P,.TCHAR## ;TYPE A CHARACTER
PJRST .TOOUT ;DUMP THE BUFFER AND RETURN
;.TOCCO -- CLEAR CONTROL-O OUTPUT SUPPRESSION ON OUR TERMINAL
;CALL: PUSHJ P,.TOCCO
;CHANGES ONLY T1
.TOCCO::MOVEI T1,.TOOSU+.TOSET ;FUNCTION TO TWIDDLE OUTPUT SUPPRESSION
SETZM TRMBLK+2 ;CLEARING CONTROL-O BIT
PUSHJ P,SETTRM ;SET UP TRMOP BLOCK AND UUO AC
TRMOP. T1, ;CLEAR THE BIT
JFCL ;ASSUME WE GOT DETACHED
POPJ P, ;RETURN TO CALLER
;.TOINP -- SETUP UDX AND OUTPUT ROUTINE GIVEN PHYSICAL NAME
;CALL: MOVE T1, PHYSICAL TERMINAL NAME
; PUSHJ P,.TOINP
;USES NO ACS
.TOINP::IONDX. T1,UU.PHY ;PHYSICAL ONLY GET THE UDX
POPJ P, ;FAILED
AOS (P) ;SKIP RETURN
JRST .TOINU ;AND STORE UDX
;.TOINT -- SETUP UDX AND OUTPUT ROUTINE GIVEN LOGICAL NAME
;CALL: MOVE T1,LOGICAL SIXBIT TERMINAL NAME
; PUSHJ P,.TOINT
;USES NO ACS
.TOINT::IONDX. T1, ;CONVERT TO UDX
POPJ P, ;ERROR
AOS (P) ;TAKE SKIP RETURN
;FALL INTO .TOINU
;.TOINU - SETUP UDX AND OUTPUT ROUTINE GIVEN UDX
;CALL: MOVE T1, TERMINAL UDX
; PUSHJ P,.TOUNU
;USES NO ACS
.TOINU::MOVEM T1,TRMBLK+1 ;STORE UDX
PJRST .TOINI ;GO RESET POINTERS AND COUNTERS
;.TOCHR -- STORE CHARACTER IN BUFFER FOR OUTSTR
;CALL: MOVEI T1,CHAR
; PUSHJ P,.TOCHR
;USES NO ACS
.TOCHR::SOSG .TOCNT ;SEE IF OVERFLOW
PUSHJ P,.TOOUT ;YES--OUTPUT BUFFER
IDPB T1,.TOPTR ;STORE CHAR
CAIE T1,.CHLFD ;SEE IF BREAK
POPJ P, ;NO--RETURN
;FALL INTO .TOOUT
;.TOOUT -- FORCE BUFFER OUT NOW
;CALL:
; PUSHJ P,.TOOUT
;USES NO ACS
.TOOUT::PUSH P,T1 ;SAVE T1
MOVEI T1,0 ;END WITH NULL
IDPB T1,.TOPTR ;STORE
SKIPN TRMBLK+1 ;SEE IF UDX SPECIFIED
JRST TOUT1 ;NO--OUTPUT WITH OUTSTR
MOVEI T1,.TOOUS ;GET OUTPUT STRING FUNCTION
MOVEM T1,TRMBLK+0 ;STORE FUNCTION
MOVEI T1,.TOBUF ;POINT TO BUFFER
MOVEM T1,TRMBLK+2 ;STORE THAT
MOVE T1,[3,,TRMBLK] ;POINT TO TRMOP. ARGS
TRMOP. T1, ;OUTPUT IT
TOUT1: OUTSTR .TOBUF ;OUTPUT BUFFER
POP P,T1 ;RESTORE T1
JRST .TOINI ;AND RESET VIA .TOINI
;.T7BIT -- SET 7-BIT TTY I/O
;.T8BIT -- SET 8-BIT TTY I/O
;CALL: PUSHJ P,.T7BIT/.T8BIT
;USES T1
.T7BIT::TDZA T1,T1 ;SET TTY NO EIGHTBIT
.T8BIT::MOVEI T1,1 ;SET TTY EIGHTBIT
MOVEM T1,TRMBLK+2 ;SAVE ARGUMENT
MOVEI T1,.TO8BI+.TOSET ;FUNCTION CODE TO TOGGLE I/O MODE
PUSHJ P,SETTRM ;SET UP TRMOP BLOCK AND UUO AC
TRMOP. T1, ;SET 7 OR 8-BIT MODE
JFCL ;MONITOR DOESN'T SUPPORT 8-BIT TTYS
POPJ P, ;RETURN
;.TECHO -- SET/READ ECHO STATUS
;CALL: MOVNI T1, 1 ;TO READ STATUS
; MOVEI T1, 0 ;TO SET NO ECHO
; MOVEI T1, 1 ;TO SET ECHO
; PUSHJ P,.TECHO
;USES T1
.TECHO::MOVEM T1,TRMBLK+2 ;SAVE ARGUMENT
MOVEI T1,.TOECH ;FUNCTION CODE TO READ ECHO STATUS
SKIPL TRMBLK+2 ;SETTING?
ADDI T1,.TOSET ;YES
PUSHJ P,SETTRM ;SET UP TRMOP BLOCK AND UUO AC
TRMOP. T1, ;SET ECHO STATUS
JFCL ;SHOULDN'T FAIL
POPJ P, ;RETURN
;SETTRM -- INTERNAL ROUTINE TO SETUP TRMOP BLOCK
;CALL: MOVE T1, FUNCTION CODE
; PUSHJ P,SETTRM
;ON RETURN, T1 IS SETUP WITH THE TRMOP UUO AC
;USES T1
SETTRM: MOVEM T1,TRMBLK ;STORE FUNCTION CODE
CAIL T1,1000 ;RANGE
CAILE T1,1777 ; CHECK
SKIPA T1,[3,,TRMBLK] ;ACTION OR SET--USE 3 WORD BLOCK
MOVE T1,[2,,TRMBLK] ;READ--USE 2 WORD BLOCK
SKIPN TRMBLK+1 ;HAVE A UDX?
SETOM TRMBLK+1 ;NO--DEFAULT TO CONTROLLING TTY
POPJ P, ;AND RETURN
SUBTTL DATA STORAGE
XLIST
LIT
LIST
RELOC
.TOCNT::BLOCK 1 ;COUNT OF CHARACTERS FOR .TOCHR
.TOPTR::BLOCK 1 ;BYTE POINTER FOR STORAGE
.TOBUF::BLOCK <LN$BUF+5>/5 ;SPACE FOR BUFFER
.TOPNM::BLOCK 1 ;PROMPT NAME (.TOPRN)
TRMBLK: BLOCK 3 ;BLOCK FOR TRMOP. OUTPUT
RELOC
PRGEND
TITLE .TOUTS -- SUBROUTINES FOR OUTPUT
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .TYOCH
;.TYOCH -- INITIALIZE TYPEOUT ROUTINE
;CALL: MOVEI T1,ADDR. OF ROUTINE
; PUSHJ P,.TYOCH
;RETURNS PREVIOUS ADDR. IN T1
.TYOCH::EXCH T1,TYPOUT ;SWAP ADDR.
POPJ P,
; [650]
; .TFRFS -- TYPE A "RETURNED FILESPEC BLOCK".
; CALL: T1/ ADDR OF BLOCK
; PUSHJ P,.TFRFS
; USES T1-T4
.TFRFS::PUSHJ P,.SAVE1## ;SAVE P1
MOVE P1,T1 ;COPY RETURNED FILESPEC BLOCK ADDRESS
SKIPN T1,.FOFND(P1) ;HAVE A NODE?
JRST RFSDEV ;NO
PUSHJ P,.TSIXN ;PRINT NODE NAME
MOVEI T1,"_" ;PROPER DELIMITER
PUSHJ P,.TCHAR ;PRINT IT
RFSDEV: MOVE T1,.FOFDV(P1) ;GET DEVICE NAME
PUSHJ P,.TSIXN ;PRINT IT
MOVEI T1,":" ;GET DELIMITER
PUSHJ P,.TCHAR ;PRINT IT
SKIPN T1,.FOFFN(P1) ;GET FILE NAME
POPJ P, ;NOT A FILE-ORIENTED DEVICE
PUSHJ P,.TSIXN ;PRINT IT
HLLZ T1,.FOFEX(P1) ;GET EXTENSION
LSH T1,-6 ;POSITION
TLO T1,'. ' ;INCLUDE DELIMITER
PUSHJ P,.TSIXN ;PRINT .EXT
SKIPN .FOFPP(P1) ;DIRECTORY DEVICE?
POPJ P, ;NO
MOVEI T1,.FOFPP(P1) ;POINT TO START OF PATH
HRLI T1,1 ;INDICATE STANDARD PATH BLOCK
PJRST .TDIRB ;PRINT IT AND RETURN
;.TOFEB -- TYPE FILOP BLOCK [613]
;CALL: T1/ ADDRESS OF FILOP BLOCK. [613]
; PUSHJ P,.TOFEB [613]
;USES T1-T4 [613]
.TOFEB::HRRZ T2,.FOLEB(T1) ;[613] GET POINTER TO LOOKUP/ENTER BLOCK
AOJ T1, ;[613] POINT T1 AT PSUEDO-OPEN BLOCK IN THE
;[613] FILOP BLOCK.
;FALL THROUGH TO .TOLEB [613]
;.TOLEB -- TYPE ENTER/LOOKUP BLOCK
;CALL: 1/ ADDRESS OF OPEN BLOCK
; 2/ ADDRESS OF EXTENDED LOOKUP/ENTER BLOCK
; PUSHJ P,.TOLEB
;USES T1-4
.TOLEB::MOVE T4,T2 ;MAKE SAFE COPY
MOVE T1,.OPDEV(T1) ;GET DEVICE
PUSHJ P,.TSIXN ;ISSUE IT
PUSHJ P,.TCOLN ;ISSUE SEPARATOR
MOVE T1,.RBNAM(T4) ;GET FILE NAME
HLRZ T2,.RBEXT(T4) ;GET EXTENSION
CAIN T2,'UFD' ;SEE IF UFD
JUMPG T1,[PUSHJ P,.TPPNW ;YES--TYPE AS P,PN
JRST .+2] ;PROCEED
PUSHJ P,.TSIXN ;ELSE ISSUE IN SIXBIT
MOVEI T1,"." ;INDICATE EXTENSION
PUSHJ P,.TCHAR ;ISSUE IT
HLLZ T1,.RBEXT(T4) ;GET EXTENSION
PUSHJ P,.TSIXN ;ISSUE THAT
MOVEI T1,.RBPPN(T4) ;POINT TO DIRECTORY
PJRST .TDIRB ;GO TYPE THAT AND RETURN
;.TFBLK -- TYPE SCANER STYLE FILE BLOCK
;CALL: MOVEI T1,ADDR OF BLOCK
; PUSHJ P,.TFBLK
;USES T1-4
.TFBLK::MOVE T4,T1 ;SAVE AWAY ARGUMENT
SKIPN T1,.FXDEV(T4)
JRST TFBLK1
PUSHJ P,.TSIXN ;TYPE DEVICE
PUSHJ P,.TCOLN ;TYPE COLON
TFBLK1: MOVE T1,.FXNAM(T4)
PUSHJ P,.TSIXN ;TYPE NAME
HLLZ T3,.FXEXT(T4) ;GET EXTENSION
MOVX T2,FX.NUL ;SEE IF USER
TDNE T2,.FXMOM(T4) ; ..
TDNE T2,.FXMOD(T4) ; TYPED A DOT
JUMPE T3,TFBLK2 ;YES--IS THIS A NULL EXTENSION
MOVEI T1,"." ;GET DOT
PUSHJ P,.TCHAR ;TYPE IT
MOVE T1,T3 ;GET EXTENSION
PUSHJ P,.TSIXN
TFBLK2: MOVEI T1,.FXDIR(T4) ;POSITION TO DIRECTORY
TLO T1,2 ;FLAG FOR BIWORDS
;FALL INTO .TDIRB
;.TDIRB -- TYPE A DIRECTORY BLOCK
;CALL: MOVEI T1,ADDRESS OF DIRECTORY WORD OR PATH OR BIWORDS
; TLO T1,0 FOR WORD, 1 FOR PATH, 2 FOR BIWORDS
; PUSHJ P,.TDIRB
;USES T1-4
.TDIRB::
IFE FT$SFD,<
SKIPE T1,(T1) ;SEE IF SOMETHING
PJRST .TPPNW ;YES--PRINT IT
POPJ P,
>
IFN FT$SFD,<
MOVE T4,T1 ;SAVE POINTER
SKIPN T1,(T4) ;SEE IF SOMETHING THERE
JRST [HLRZ T2,T4 ;NO--SEE IF BIWORDS
CAIN T2,2 ; ..
SKIPN 2(T4) ;YES--SEE IF SOMETHING LATER ON
POPJ P, ;NO--RETURN
JRST TDIRB1] ;PROCEED WITH OUTPUT
TLNE T4,-1 ;SEE IF STRAIGHT
JRST TDIRB1 ;NOPE--DO IT THE HARD WAY
TLNE T1,-1 ;YES--SEE IF SFD
PJRST .TPPNW ;NO--JUST UFD
MOVEI T4,2(T1) ;YES--CHANGE POINTER
TDIRB1: HLRZ T1,T4 ;GET LENGTH
SUBI T1,2 ;SET FLAG -1 FOR SINGLE, 0 FOR BIWORDS
PUSH P,T1 ;SAVE FOR LATER TESTING
HRLI T4,-.FXLND ;SET LENGTH [256]
MOVEI T1,"[" ;OUTPUT BREAK
PUSHJ P,.TCHAR ; ..
MOVE T1,(T4) ;GET UFD
CAME T1,[-1] ;UNLESS -1 OR POSITIVE, USE SIXBIT [560]
JUMPL T1,[PUSHJ P,.TSIXN
JRST TDIRB2]
SKIPL (P) ;SEE IF DOUBLE
JRST [MOVE T2,1(T4) ;YES--GET MASK
PUSHJ P,.TXWWW ;OUTPUT MASKED OCTAL XWD
JRST TDIRB2] ;AND PROCEED
PUSHJ P,.TXWDW ;TYPE IT
TDIRB2: AOBJP T4,TDIRB3 ;LOOP UNTIL DONE
SKIPL (P) ;IF BIWORDS,
AOS T4 ; MOVE UP ONE EXTRA
SKIPN (T4) ; ..
JRST TDIRB3 ;YES--RETURN TYPING LAST BREAK
PUSHJ P,.TCOMA ;TYPE A COMMA
MOVE T1,(T4) ;GET SFD NAME
PUSHJ P,.TSIXN ;TYPE IT
JRST TDIRB2 ; AND LOOP UNTIL DONE
TDIRB3: POP P,(P) ;THROW AWAY FLAG
JRST .TRBRK ;AND FINISH UP
>
;.TXWWW -- TYPE A MASKED (WILD) OCTAL WORD IN XWD FORMAT
;CALL: MOVE T1,WORD
; MOVE T2,MASK
; PUSHJ P,.TXWWW
;USES T1-3
.TXWWW::MOVSS T2 ;T1,T2=LH(V),RH(V),RH(M),LH(M)
ROTC T1,-^D18 ;T1,T2=LH(M),LH(V),RH(V),RH(M)
PUSH P,T2 ;SAVE SECOND HALF (V,,M)
MOVSS T1 ;T1=LH V,,M
PUSHJ P,.TMOHW ;TYPE MASKED OCTAL HALF-WORD
PUSHJ P,.TCOMA ;TYPE COMMA
POP P,T1 ;RESTORE RH V,,M
;FALL INTO .TMOHW
;.TMOHW -- TYPE MASKED OCTAL HALF-WORD
;CALL: MOVE T1,[VALUE,,MASK]
; PUSHJ P,.TMOHW
;USES T1-3
.TMOHW::TRCN T1,-1 ;MAKE MASK BIT 0 IF NOT WILD
PJRST .TASTR ;TYPE * IF ALL WILD
MOVE T2,T1 ;MOVE TO CONVENIENT PLACE
MOVEI T3,6 ;SET LOOP COUNT
TMOHW1: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;POSITION FIRST DIGIT
JUMPN T1,TMOHW3 ;GO IF NON-ZERO
SOJG T3,TMOHW1 ;LOOP UNTIL ALL DONE
TMOHW2: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;GET NEXT DIGIT
TMOHW3: ADDI T1,"0" ;CONVERT TO ASCII
TLNE T2,7 ;CHECK MASK
MOVEI T1,"?" ;CHANGE TO ? IF WILD
PUSHJ P,.TCHAR ;TYPE CHARACTER
SOJG T3,TMOHW2 ;LOOP UNTIL DONE
POPJ P, ;RETURN
;.TDTTM -- TYPE DATE AND TIME IN UNIVERSAL FORMAT
;CALL: T1/ DATE-TIME IN INTERNAL FORMAT
; PUSHJ P,.TDTTM
;USES T1-4
.TDTTM::PUSHJ P,.CNTDT## ;TAKE APART
ADDI T1,^D500 ;[574] ROUND TO SECOND FOR PRINTING
CAMG T1,[^D24*^D60*^D60*^D1000] ;[574] PAST MIDNIGHT?
JRST TDTTM1 ;[574] NO, NORMAL CASE
ADDI T2,1 ;[574] WAS 23:59:59.835, BUMP DAY
SUB T1,[^D24*^D60*^D60*^D1000] ;[574] MAKE TIME 0:0:0
TDTTM1: PUSH P,T1 ;[574] SAVE TIME
MOVE T1,T2 ;POSITION DATE
PUSHJ P,.TDATE ;TYPE DATE
PUSHJ P,.TCOLN ;TYPE COLON
POP P,T1 ;RESTORE TIME
PJRST .TTIME ;TYPE TIME AND RETURN
;.TDATN -- TYPE TODAY'S DATE IN STANDARD FORMAT
;.TDATE -- TYPE DATE IN STANDARD FORMAT OF DD-MMM-YY
;CALL: MOVEI T1,DATE IN SYSTEM FORMAT FROM DATE UUO
; PUSHJ P,.TDATE/.TDATN
;USES T1-4
.TDATN::DATE T1, ;GET TODAY'S DATE
.TDATE::PUSHJ P,.SAVE1## ;SAVE P1
IDIVI T1,^D31 ;GET DAYS
MOVE T4,T1 ;SAVE REST
MOVEI T1,1(T2) ;GET DAYS AS 1-31
MOVEI T2," " ;FILL WITH SPACE
PUSHJ P,.TDEC2 ;TYPE IN DECIMAL
IDIVI T4,^D12 ;GET MONTHS
MOVEI T1,[ASCIZ /-Jan/
ASCIZ /-Feb/
ASCIZ /-Mar/
ASCIZ /-Apr/
ASCIZ /-May/
ASCIZ /-Jun/
ASCIZ /-Jul/
ASCIZ /-Aug/
ASCIZ /-Sep/
ASCIZ /-Oct/
ASCIZ /-Nov/
ASCIZ /-Dec/](P1) ;GET ASCII
PUSHJ P,.TSTRG ;TYPE IT
MOVEI T1,^D64(T4) ;GET YEAR SINCE 1900
IDIVI T1,^D100 ;GET JUST YEARS IN CENTURY [257]
MOVN T1,T2 ;NEGATE TO GET - SIGN [257]
PJRST .TDECW ;TYPE IT AND RETURN
;.TTIMN -- TYPE CURRENT TIME IN STANDARD FORMAT
;.TTIME -- TYPE TIME IN STANDARD FORMAT OF HH:MM:SS
;CALL: MOVEI T1,TIME IS MILLISEC SINCE MIDNIGHT
; PUSHJ P,.TTIME/.TTIMN
;USES T1-4
;WARNING: THIS ROUTINE TRUNCATES THE TIME; IT WILL PRINT 15:59:59.995
; AS 15:59:59, NOT 16:00:00. THIS IS BECAUSE A ROUND UP COULD
; CAUSE THE DAY TO INCREMENT, AND THIS ROUTINE DOESN'T KNOW THE
; DAY (IT HAS PROBABLY ALREADY BEEN PRINTED). THE CALLER OF THIS
; ROUTINE MUST MAKE SURE THE TIME HAS ALREADY BEEN ROUNDED TO THE
; NEAREST SECOND HIMSELF. SEE THE CODE AT .TDTTM FOR AN EXAMPLE.
.TTIMN::MSTIME T1, ;GET CURRENT TIME
.TTIME::IDIV T1,[^D3600000] ;GET HOURS
MOVE T4,T2 ;SAVE REST
MOVEI T2," " ;FILL WITH SPACE
PUSHJ P,.TDEC2 ;TYPE TWO DIGITS
PUSHJ P,.TCOLN ;TYPE COLON
MOVE T1,T4 ;RESTORE REST
IDIVI T1,^D60000 ;GET MINS
MOVE T4,T2 ;SAVE REST
PUSHJ P,TDEC2Z ;TYPE TWO DIGITS WITH 0 FILLER
PUSHJ P,.TCOLN ;TYPE COLON
MOVE T1,T4 ;RESTORE THE REST
IDIVI T1,^D1000 ;GET SECONDS
TDEC2Z: MOVEI T2,"0" ;FILL WITH 0
;FALL INTO .TDEC2
;.TDEC2 -- TYPE DECIMAL AT LEAST TWO DIGITS
;CALL: SAME AS .TDECW WITH T2=FILLER CHAR (" " OR "0")
.TDEC2::JUMPL T1,.TDECW ;JUMP IF NEGATIVE
CAILE T1,^D9 ;SEE IF ONE DIGIT
PJRST .TDECW ;NO--JUST OUTPUT
EXCH T1,T2 ;GET FILLER
PUSHJ P,.TCHAR ;TYPE
MOVEI T1,"0"(T2) ;CONVERT DIGIT
PJRST .TCHAR ;OUTPUT IT AND RETURN
;.TFCHR -- TYPE POSSIBLY FUNNY CHARACTER
;CALL: MOVEI T1,CHARACTER
; PUSHJ P,.TFCHR
;USES T1, T2
.TFCHR::CAIL T1,40 ;SEE IF CONTROL CHARACTER
JRST TFCHR5 ;NO--PROCEED
MOVSI T2,-LNSPCH ;SET SCAN LOOP
TFCHR2: HLL T1,SPCH(T2) ;MAKE T1 AGREE
CAME T1,SPCH(T2) ;SEE IF MATCH
AOBJN T2,TFCHR2 ;NO--LOOP
JUMPGE T2,TFCHR3 ;NO MATCH--PROCEED
MOVEI T1,"<" ;MATCH--TYPE INDICATOR
PUSHJ P,.TCHAR ; ..
HLLZ T1,SPCH(T2) ;GET MNEMONIC
PUSHJ P,.TSIXN ;TYPE IT
MOVEI T1,">" ;CLOSE
PUSHJ P,.TCHAR ; INDICATOR
POPJ P, ;AND RETURN
TFCHR3: ADDI T1,100 ;CONVERT
PUSH P,T1 ; AND SAVE CHAR
MOVEI T1,"^" ;SET INDICATOR
JRST TFCHR7 ;AND GO FINISH UP
TFCHR5: CAIGE T1,4000 ;SEE IF GUIDE WORD [507]
JRST TFCHR6 ;NO--PROCEED [507]
SUBI T1,4000 ;REMOVE OFFSET [507]
PUSH P,GUIDT.(T1) ;SAVE GUIDE WORD [507]
MOVEI T1,"'" ;YES--INDICATE [507]
PUSHJ P,.TCHAR ;OUTPUT GUIDE PREFIX [507]
POP P,T1 ;GET GUIDE WORD [507]
PUSHJ P,.TSIXN ;OUTPUT AS SIXBIT [507]
MOVEI T1,"'" ;ADD CLOSING [507]
PJRST .TCHAR ; QUOTE [507]
TFCHR6: CAIGE T1,140 ;SEE IF LOWER CASE
PJRST .TCHAR ;NO--JUST TYPE IT
SUBI T1,40 ;YES--CONVERT TO UPPER
PUSH P,T1 ;SAVE FOR A MINUTE
MOVEI T1,"'" ;SET INDICATOR
TFCHR7: PUSHJ P,.TCHAR ;ISSUE INDICATOR
POP P,T1 ;RESTORE FIXED CHAR
PJRST .TCHAR ;AND TYPE IT
;TABLE OF MNEMONIC,,CHARACTER
SPCH: 'EOF',,.CHEOF
'EOL',,.CHEOL
'ALT',,.CHALX
'BEL',,.CHBEL
'TAB',,.CHTAB
'LF ',,.CHLFD
'VT ',,.CHVTB
'FF ',,.CHFFD
'CR ',,.CHCRT
'ESC',,.CHESC
LNSPCH==.-SPCH
;TABLE OF KNOWN GUIDE WORDS
; MUST BE IN ORDER OF VALUES OF THE META-CHARACTER
; (I.E., 4000, 4001, 4002, ETC.)
DEFINE YY($GUIDE),<
EXP <SIXBIT \$GUIDE\>
>
GUIDT.::YY AND
YY OR
YY NOT
YY TO
YY FROM
YY INPUT
YY OUTPUT
YY SOURCE
YY LIST
YY OBJECT
GUIDL.==:.-GUIDT.
GUIDM.==:-GUIDL.
;.TVERW -- TYPE WORD IN VERSION NUMBER FORMAT
;CALL: T1/ WORD
; PUSHJ P,.TVERW
;USES T1-4
.TVERW::MOVE T4,T1 ;PUT IN SAFE PLACE
LDB T1,[POINT 9,T4,11] ;GET MAJOR VERSION
SKIPE T1 ;IF NON-ZERO,
PUSHJ P,.TOCTW ; PRINT IN OCTAL
LDB T1,[POINT 6,T4,17] ;GET MINOR VERSION
JUMPE T1,TVER2 ;IF NON-ZERO,
SOS T1 ; PRINT IN MODIFIED
IDIVI T1,^D26 ; RADIX 26 ALPHA
JUMPE T1,TVER1 ; JUMP IF ONE CHAR
MOVEI T1,"A"-1(T1) ; ISSUE FIRST OF TWO
PUSHJ P,.TCHAR ; CHARACTERS
TVER1: MOVEI T1,"A"(T2) ; ISSUE "UNITS"
PUSHJ P,.TCHAR ; CHARACTER
TVER2: HRRZ T1,T4 ;GET EDIT NUMBER
JUMPE T1,TVER3 ;IF NON-ZERO,
MOVEI T1,"(" ; ISSUE
PUSHJ P,.TCHAR ; AS OCTAL
HRRZ T1,T4 ; WITHIN
PUSHJ P,.TOCTW ; PARENTHESES
MOVEI T1,")" ; ..
PUSHJ P,.TCHAR ; ..
TVER3: LDB T2,[POINT 3,T4,2] ;GET "WHO" FIELD
JUMPE T2,.POPJ ;IF NON-ZERO,
MOVEI T1,"-" ; PRINT -
PUSHJ P,.TCHAR ; AND THEN
MOVE T1,T2 ; THE FIELD
PJRST .TOCTW ; AS OCTAL
;.TBLOK -- TYPE NUMBER IN BLOCKS, ETC.
;.TCORW -- TYPE NUMBER IN CORE SIZE
;CALL: 1/ SIZE TO TYPE
; PUSHJ P,.TBLOK/.TCORW
;USES T1-4
.TBLOK::TRNE T1,177 ;SEE IF EVEN BLOCKS
PJRST TCORWD ;NO--ISSUE IN WORDS
MOVE T4,["B",,177] ;ELSE INDICATE BLOCKS
JRST TCORTP ;AND GO OUTPUT
.TCORW::JUMPE T1,TCORWD ;IF NULL, DO IN WORDS
MOVE T4,["K",,1777] ;PRESET FOR K
JUMPPT (T2,TCORKA,TCORKA) ;IF PDP-6 OR KA-10, DO IN K
MOVE T4,["P",,777] ;ELSE, INDICATE PAGES
TCORKA: TDNE T1,T4 ;SEE IF ROUND UNITS
JRST TCORWD ;NO--DO IN WORDS
TCORTP: IDIVI T1,1(T4) ;YES--DIVIDE BY UNITS
SKIPA ; AND OUTPUT
TCORWD: MOVSI T4,"W" ;INDICATE WORDS
PUSHJ P,.TDECW ;ISSUE SIZE
HLRZ T1,T4 ;GET SIZE UNIT INDICATOR
PJRST .TCHAR ;ISSUE THAT AND RETURN
;.TCRLF -- TYPE CARRIAGE RETURN/LINE FEED
;CALL: PUSHJ P,.TCRLF
;PRESERVES ALL ACS
.TCRLF::PUSH P,T1 ;SAVE CHARACTER
MOVEI T1,.CHCRT ;GET CARRIAGE RETURN
PUSHJ P,.TCHAR
MOVEI T1,.CHLFD ;GET LINE FEED
PUSHJ P,.TCHAR ;TYPE IT
TPOPJ: POP P,T1 ;RESTORE CHARACTER
POPJ P, ;RETURN
;.TPPNW -- SUBROUTINE TO TYPE A PPN
;CALL: MOVE T1,PPN
; PUSHJ P,.TPPNW
;USES T1, T2, T3
.TPPNW::PUSH P,T1 ;SAVE ARGUMENT
MOVEI T1,"["
PUSHJ P,.TCHAR
POP P,T1 ;RECOVER ARGUMENT
JUMPL T1,[PUSHJ P,.TSIXN
JRST .TRBRK]
PUSHJ P,.TXWDW ;TYPE XWD
.TRBRK::MOVEI T1,"]"
PJRST .TCHAR
;.TSIXN -- TYPE OUT SIXBIT WORD
;CALL: MOVE T1,WORD
; PUSHJ P,.TSIXN
;USES T1, T2
.TSIXN::MOVE T2,T1 ;MOVE ARGUMENT
TSIXN1: JUMPE T2,.POPJ ;LOOP UNTIL ONLY BLANKS LEFT
MOVEI T1,0 ;CLEAR NEXT CHARACTER
LSHC T1,6 ;GET NEXT CHARACTER
ADDI T1," "-' ' ;CONVERT TO ASCII
PUSHJ P,.TCHAR ;TYPE IT
JRST TSIXN1 ; ..
;.TXWDW -- TYPE OUT N AS TWO OCTAL HALF-WORDS
;CALL: MOVE T1,WORD
; PUSHJ P,.TXWDW
;USES T1, T2, T3
.TXWDW::PUSH P,T1 ;PRESERVE ARGUMENT
HLRZ T1,T1
PUSHJ P,.TOCTW
PUSHJ P,.TCOMA ;ISSUE COMMA
POP P,T1 ;RESTORE ARGUMENT
HRRZ T1,T1
;FALL INTO .TOCTW
;.TDECW -- TYPE OUT SIGNED DECIMAL NUMBER
;.TOCTW -- TYPE OUT SIGNED OCTAL NUMBER
;.TRDXW -- TYPE OUT SIGNED NUMBER (RADIX IN T3)
; (IF RADIX .GT. 9, WILL USE ALPHAS AFTER DIGITS)
;CALL: MOVE T1,NUMBER
; PUSHJ P,.TOCTW/.TDECW/.TRDXW
;USES T1, T2, T3
.TOCTW::SKIPA T3,[10] ;INITIALIZE FOR OCTAL RADIX
.TDECW::MOVEI T3,^D10 ;INITIALIZE FOR DECIMAL RADIX
.TRDXW::JUMPGE T1,TRDXW1 ;CHECK FOR NEGATIVE
MOVE T2,T1 ;SAVE AWAY ARGUMENT
MOVEI T1,"-" ;YES--GET MINUS
PUSHJ P,.TCHAR ;PRINT IT
MOVE T1,T2 ;RESTORE NUMBER
TRDXW1: IDIV T1,T3 ;DIVIDE BY RADIX
MOVMS T2 ;GET MAGNITUDE
HRLM T2,(P) ;SAVE REMAINDER
SKIPE T1 ;SEE IF ANYTHING LEFT
PUSHJ P,TRDXW1 ;YES--LOOP BACK WITH PD LIST
HLRZ T1,(P) ;GET BACK A DIGIT
ADDI T1,"0" ;CONVERT TO ASCII
CAILE T1,"9" ;SEE IF OVERFLOW DIGITS
ADDI T1,"A"-"9"-1 ;[630] YES--SWITCH TO ALPHABETICS
PJRST .TCHAR ;TYPE IT AND RETURN
;[653]
;.TOCTJ -- TYPE OUT SIGNED OCTAL NUMBER RIGHT JUSTIFIED
;.TDECJ -- TYPE OUT SIGNED DECIMAL NUMBER RIGHT JUSTIFIED
;.TRDXJ -- TYPE SIGNED NUMBER (RADIX IN T4) RIGHT JUSTIFIED
;CALL:
; MOVE T1,NUMBER
; MOVEI T3,FIELDWIDTH
; PUSHJ P,.TOCTJ/.TDECJ/.TRDXJ
; <RETURN>
;USES T1-4
.TDECJ::SKIPA T4,[^D10] ;LOAD DECIMAL RADIX
.TOCTJ::MOVEI T4,10 ;LOAD OCTAL RADIX
.TRDXJ::JUMPGE T1,RDX1 ;SEE IF NEGATIVE
SUBI T3,1 ;YES--CORRECT FIELDWIDTH FOR "-"
TLO T4,400000 ;REMEMBER NEGATIVE
IDIVI T1,(T4) ;PERFORM FIRST DIVISION
MOVM T2,T2 ;MAKE SURE OF REMAINDER
MOVM T1,T1 ;AND MAKE POSITIVE
CAIA ;SKIP EXTRA DIVISION
RDX1: IDIVI T1,(T4) ;DIVIDE BY RADIX
HRLM T2,(P) ;SAVE REMANDER
SUBI T3,1 ;COUNT DIGITS
CAIE T1,0 ;ALL DONE?
PUSHJ P,RDX1 ;NO--LOOP
JUMPN T1,RDX2 ;FIRST TIME HERE?
JUMPLE T3,RDX3 ;FIELDWIDTH FILLED?
MOVEI T1," " ;ASSUME PAD WITH SPACES
TLNE T4,177 ;RIGHT?
LDB T1,[POINT 7,T4,17] ;NO--GET FILL CHAR
PUSHJ P,.TCHAR ;TYPE FILLER
SOJG T3,.-1 ;LOOP FOR FIELDWIDTH
RDX3: TLNE T4,400000 ;WAS NUMBER NEGATIVE?
PUSHJ P,.TDASH ;YES, INDICATE MINUS SIGN
RDX2: HLRZ T1,(P) ;GET BACK A DIGIT
ADDI T1,"0" ;MAKE ASCII
CAILE T1,"9" ;SEE IF OVERFLOW DIGITS
ADDI T1,"A"-"9"-1 ;YES--SWITCH TO ALPHABETICS
PJRST .TCHAR ;AND TYPE
;[653]
;.TOCTZ -- TYPE OUT SIGNED OCTAL NUMBER RIGHT JUSTIFIED
;.TDECZ -- TYPE OUT SIGNED DECIMAL NUMBER RIGHT JUSTIFIED
;.TRDXZ -- TYPE SIGNED NUMBER (RADIX IN T4) RIGHT JUSTIFIED
;CALL:
; MOVE T1,NUMBER
; MOVEI T3,FIELDWIDTH
; PUSHJ P,.TOCTJ/.TDECJ/.TRDXJ
; <RETURN>
;USES T1-4
.TDECZ::SKIPA T4,[^D10] ;LOAD DECIMAL RADIX
.TOCTZ::MOVEI T4,10 ;LOAD OCTAL RADIX
.TRDXZ::HRLI T4,"0" ;FILL WITH "0" (ZEROS)
PJRST .TRDXJ ;TYPE NUMBER AND RETURN
;[653]
;.TSIXJ -- TYPE A SIXBIT WORD LEFT JUSTIFIED IN FIELDWIDTH
;CALL:
; MOVE T1,WORD
; MOVEI T3,FIELDWIDTH
; PUSHJ P,TSIXJ
; <RETURN>
;USES T1-3
;[653]
;.TSIXS -- TYPE A SIXBIT WORD (WITH SPACES)
;CALL:
; MOVE T1,WORD
; PUSHJ P,.TSIXS
; <RETURN>
;USES T1-3
.TSIXS::MOVEI T3,6 ;SETUP FOR 6
.TSIXJ::MOVE T2,T1 ;SAVE WORD
TSIX1: MOVEI T1,0 ;CLEAR T1
LSHC T1,6 ;GET A CHAR
ADDI T1," "-' ' ;MAKE ASCII
PUSHJ P,.TCHAR ;TYPE
SOJG T3,TSIX1 ;AND LOOP FOR FIELDWIDTH
POPJ P, ;RETURN
;[652]
;.T7STR -- TYPE 7-BIT ASCIZ STRING
;.T8STR -- TYPE 8-BIT ASCIZ STRING
;CALL: XMOVEI T1,LOCTN. OF STRING
; PUSHJ P,.T7STR/.T8STR
;PRESERVES ALL ACS
.T7STR::PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVSI T2,(POINT 7,) ;BYTE POINTER TO USE
JRST TXSTR ;ENTER COMMON CODE
.T8STR::PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVSI T2,(POINT 8,) ;BYTE POINTER TO USE
TXSTR: PUSHJ P,.MKPTR ;SET IT UP
TXSTR1: ILDB T1,.BYTPT ;GET A CHARACTER
JUMPE T1,TXSTR2 ;DONE?
PUSHJ P,.TCHAR ;OUTPUT CHARACTER
JRST TXSTR1 ;LOOP UNTIL DONE
TXSTR2: POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
;[652]
;.MKPTR -- MAKE A BYTE POINTER
;CALL: XMOVEI T1, ADDRESS
; MOVSI T2,(POINT N,)
;PRESERVES ALL ACS
.MKPTR::PUSH P,T3 ;SAVE T3
EXCH T1,T2 ;SWAP
DMOVEM T1,.BYTPT ;SAVE POSSIBLE 2-WORD BYTE POINTER
XMOVEI T3,. ;NEED TO KNOW CURRENT SECTION
TLNE T3,37 ;NON-ZERO SECTION?
TLO T1,(1B12) ;TURN ON 2-WORD BIT
EXCH T1,.BYTPT ;UPDATE MEMORY
HRRM T2,.BYTPT ;INCLUDE ADDRESS INCASE 1-WORD POINTER
EXCH T1,T2 ;RESTORE T1 AND T2
POP P,T3 ;RESTORE T3
POPJ P, ;RETURN
;.TSTRG -- TYPE ASCIZ STRING
;CALL: MOVEI T1,LOCTN. OF STRING
; PUSHJ P,.TSTRG
;USES T1
.TSTRG::HRLI T1,(POINT 7) ;CONVERT ADDRESS TO POINTER
TRNN T1,-1 ;SEE IF SOMETHING THERE
POPJ P, ;NO--RETURN EMPTY HANDED
PUSH P,T1 ;STORE IN SAFE PLACE [501]
TSTRG1: ILDB T1,(P) ;GET NEXT CHARACTER [501]
JUMPE T1,TPOPJ ;RETURN WHEN DONE [501]
PUSHJ P,.TCHAR ;OUTPUT CHARACTER
JRST TSTRG1 ;LOOP UNTIL DONE
;[653]
;.TASCW -- TYPE AN ASCII WORD
;CALL:
; MOVE T1,[ASCII/XXXXX/]
; PUSHJ P,.TASCW
;USES T1
.TASCW::MOVEM T1,WORD ;STORE STRING
SETZM WORD+1 ;MAKE ASCIZ
MOVEI T1,WORD ;POINT TO ADDRESS
PJRST .TSTRG ;AND TYPE IT
;[653]
;.TDEVN -- TYPE A DEVICE AS DEV:
;CALL:
; MOVE T1,SIXBIT DEVICE NAME
; PUSHJ P,.TDEVN
.TDEVN::PUSHJ P,.TSIXN ;FIRST TYPE IN SIXBIT
PJRST .TCOLN ;AND SUFFIX WITH COLON AND RETURN
;[653]
;.TPROT -- TYPE A PROTECTION AS <NNN>
;CALL:
; MOVE T1,WORD
; PUSHJ P,.TPROT
;USES T1-4
.TPROT::PUSH P,T1 ;SAVE WORD
PUSHJ P,.TLANG ;PREFIX "<"
POP P,T1 ;GET WORD BACK
MOVEI T3,3 ;FIELDWIDTH IS 3
PUSHJ P,.TOCTZ ;TYPE 3 DIGITS FILLING WITH 0
PJRST .TRANG ;SUFFIX ">" AND RETURN
;[653]
;.TSPAN -- TYPE LEADING SPACES
;CALL: MOVEI T1,SPACES
; PUSHJ P,.TSPAN
; <RETURN>
;USES T1-2
.TSPAN::PUSH P,T2 ;SAVE T2
MOVE T2,T1 ;GET COUNT
TSPAN1: JUMPLE T2,TSPAN2 ;DONE?
PUSHJ P,.TSPAC ;TYPE A SPACE
SOJA T2,TSPAN1 ;LOOP
TSPAN2: POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
;.TCHAR -- TYPE ASCII CHARACTER
;CALL: MOVEI T1,CHARACTER
; PUSHJ P,.TCHAR
;PRESERVES ALL ACS
;.TSPAC -- TYPE ASCII SPACE
;.TTABC -- TYPE ASCII TAB
;.TCOMA -- TYPE ASCII COMMA
;.TCOLN -- TYPE ASCII COLON
;.TRBRK -- TYPE ASCII RIGHT BRACKET
;.TASTR -- TYPE ASCII ASTERISK
;.TDASH -- TYPE A DASH
;.TLANG -- TYPE A LEFT ANGLE BRACKET
;.TRANG -- TYPE A RIGHT ANGLE BRACKET
;CALL: PUSHJ P,.TXXXX
;USES T1
.TDASH::MOVEI T1,"-" ;GET A DASH
PJRST .TCHAR ;ISSUE AND RETURN
.TLANG::MOVEI T1,"<" ;GET A LEFT ANGLE BRACKET
PJRST .TCHAR ;ISSUE AND RETURN
.TRANG::MOVEI T1,">" ;GET A RIGHT ANGLE BRACKET
PJRST .TCHAR ;ISSUE AND RETURN
.TASTR::MOVEI T1,"*" ;GET ASTERISK
PJRST .TCHAR ;ISSUE AND RETURN
.TCOLN::MOVEI T1,":" ;GET COLON
PJRST .TCHAR ;ISSUE AND RETURN
.TCOMA::MOVEI T1,"," ;GET COMMA
PJRST .TCHAR ;ISSUE AND RETURN
.TTABC::MOVEI T1,.CHTAB ;GET TAB
PJRST .TCHAR ;ISSUE AND RETURN
.TSPAC::MOVEI T1," " ;GET SPACE
.TCHAR::TRNN T1,377 ;SEE IF NULL
POPJ P, ;YES--IGNORE
SKIPE TYPOUT ;SEE IF SPECIAL ROUTINE
PJRST @TYPOUT ;YES--GO DO IT INSTEAD
OUTCHR T1 ;LET MONITOR DO IT
.POPJ: POPJ P, ;AND RETURN
;DATA STORAGE AREA
RELOC
.TOUTZ::! ;START OF LOW CORE AREA
TYPOUT: BLOCK 1 ;ROUTINE TO TYPE ONE CHARACTER
WORD: BLOCK 2 ;SCRATCH STORAGE FOR .TASCW
.BYTPT::BLOCK 2 ;[652] BYTE POINTER STORAGE
.TOUTL==:.-.TOUTZ ;LENGTH OF LOW CORE AREA
RELOC
PRGEND
TITLE .STOPB -- ROUTINE TO CONVERT SCAN BLOCKS TO MONITOR
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INTIALIZE LISTINGS, ETC.
;ENTRY POINTS
ENTRY .STOPB
SUBTTL ROUTINE TO CONVERT SCAN BLOCKS
;.STOPB -- ROUTINE TO TURN SCAN BLOCK INTO OPEN/LOOKUP BLOCKS
; WILD-CARDS ARE ILLEGAL
;CALL: MOVEI T1,SCAN BLOCK
; LH(T1)=LENGTH IF .GT. 24
; MOVEI T2,OPEN BLOCK (3 WORDS)
; MOVEI T3,LOOKUP BLOCK (6 WORDS OR MORE)
; LH(T3)=LENGTH IF .GT. 6
; MOVEI T4,PATH BLOCK (9 WORDS)
; PUSHJ P,.STOPB
;ERROR RETURN IF WILD-CARDS
;SKIP RETURN IF SETUP OK
;USES T1-4
.STOPB::PUSHJ P,.SAVE3## ;SAVE P1-3
SKIPN P3,.FXDEV(T1) ;GET DEVICE
MOVSI P3,'DSK' ;DEFAULT IF BLANK
MOVEM P3,1(T2) ;STORE IN OPEN BLOCK
MOVE P1,.FXMOD(T1) ;GET SWITCHES
MOVSI P2,'SYS' ;GET A GOOD NAME
DEVCHR P2,UU.PHY ;DO PHYSICAL CALL
TRNN P2,-1 ;SEE IF ANYTHING SET
TXZ P1,FX.PHY ;NO--CLEAR /PHYSICAL
MOVE P2,[DEVCHR P3,] ;GET UUO
TXNE P1,FX.PHY ;SEE IF /PHYSICAL
TXO P2,UU.PHY ;YES--CHANGE UUO
XCT P2 ;DO IT
MOVEI P2,0 ;CLEAR FIRST WORD
TXNE P1,FX.PHY ;SEE IF /PHYSICAL
MOVX P2,UU.PHS ;SET OPEN PHYSICAL BIT
TXNN P3,DV.MTA ;SEE IF MAG TAPE
JRST STOPNM ;NO--PROCEED
TXNE P1,FX.PAR ;SEE IF /PARITY:EVEN
TXO P2,IO.PAR ;YES--SET FOR OPEN
LDB P3,[POINTR (P1,FX.DEN)] ;GET /DENSITY
DPB P3,[POINTR (P2,IO.DEN)] ;SET FOR OPEN
STOPNM: MOVEM P2,(T2) ;SET FIRST WORD OF OPEN BLOCK
SKIPE P3,.FXNAM(T1) ;IF NAME NOT BLANK,
SETCM P3,.FXNMM(T1) ;GET NAME MASK
JUMPN P3,.POPJ## ;ERROR IF WILD
MOVE P3,.FXNAM(T1) ;GET NAME
MOVEM P3,.RBNAM(T3) ;STORE IN LOOKUP BLOCK
SKIPE P3,.FXEXT(T1) ;GET EXTENSION
TRC P3,-1 ;UNLESS BLANK, CHECK MASK
TRNE P3,-1 ;SEE IF WILD
POPJ P, ;YES--ERROR
MOVEM P3,.RBEXT(T3) ;STORE IN LOOKUP BLOCK
LDB P3,[POINTR (.FXMOD(T1),FX.PRO)] ;GET PROTECTION
LSH P3,<ALIGN.(RB.PRV)> ;POSITION FOR LOOKUP
MOVEM P3,.RBPRV(T3) ;STORE IN LOOKUP BLOCK
MOVEI P3,0 ;CLEAR DIRECTORY
MOVX P1,FX.DIR ;GET DIRECTORY BIT
TDNN P1,.FXMOD(T1) ;SEE IF SET
JRST STOPND ;NO--USE [-]
SETCM P3,.FXDIM(T1) ;GET UFD MASK
JUMPN P3,.POPJ## ;ERROR IF WILD
MOVE P3,.FXDIR(T1) ;GET UFD
TLNN P3,-1 ;SEE IF PROJECT
HLL P3,.MYPPN## ;NO--USE LOGGED IN NUMBER [312]
TRNN P3,-1 ;SEE IF PROGRAMMER
HRR P3,.MYPPN## ;NO--USE LOGGED IN NUMBER [312]
MOVEM P3,.FXDIR(T1) ;STORE FOR ERROR MESSAGES
SKIPN .FXDIR+2(T1) ;SEE IF SFDS
JRST STOPND ;NO--GO STORE AND RETURN
SETZM (T4) ;CLEAR PATH
HRLZI P1,(T4) ; ..
HRRI P1,1(T4) ; ..
BLT P1,.PTMAX-1(T4) ; .. [565]
MOVEM P3,.PTPPN(T4) ;STORE UFD
MOVEI P1,.FXDIR+2(T1) ;POINT TO ARGUMENT SFD
MOVSI P2,-.FXLND+1 ;COUNT SFDS
HRRI P2,(T4) ;INDICATE START OF SFD BLOCK
STOPNS: SKIPN P3,(P1) ;SEE IF DONE
JRST STOPNT ;YES--FINISH UP
MOVEM P3,.PTPPN+1(P2) ;NO--STORE IN PATH
SETCM P3,1(P1) ;GET MASK
JUMPN P3,.POPJ## ;ERROR IF WILD
ADDI P1,2 ;ADVANCE FETCH
AOBJN P2,STOPNS ;LOOP UNTIL DONE
STOPNT: MOVEI P3,(T4) ;INDICATE SFD
STOPND: MOVEM P3,.RBPPN(T3) ;SET INTO LOOKUP
HLRZ P1,T1 ;GET SCAN BLOCK LENGTH [346]
MOVX P2,RB.NSE ;GET NON-SUPERSEDING ENTER BIT
MOVX P3,FX.SUP ;GET /ERSUPERSEDE BIT
TDNE P3,.FXMOD(T1) ;SEE IF USER SET
IORM P2,.RBCNT(T3) ;SET FOR ENTER
HLRZ P2,T3 ;GET LOOKUP BLOCK LENGTH [346]
CAILE P1,.FXEST ;SEE IF /ESTIMATE [346]
SKIPGE P3,.FXEST(T1) ;YES--GET /ESTIMATE SIZE [346]
MOVEI P3,0 ;NO OR MISSING--CLEAR SETTING [346]
LSH P3,-7 ;CONVERT TO BLOCKS [346]
CAILE P2,.RBEST ;SEE IF LOOKUP BLOCK LONG ENOUGH [346]
MOVEM P3,.RBEST(T3) ;YES--STORE IN CASE ENTER [346]
CAILE P1,.FXVER ;SEE IF /VERSION [346]
SKIPA P3,.FXVER(T1) ;YES--GET /VERSION [346]
MOVEI P3,0 ;MISSING--CLEAR SETTING [346]
CAILE P2,.RBVER ;SEE IF LOOKUP BLOCK LONG ENOUGH [346]
CAMN P3,[-1] ;YES--SEE IF SET BY USER [346]
SKIPA ;NO [346]
MOVEM P3,.RBVER(T3) ;YES--STORE IN CASE ENTER [346]
JRST .POPJ1## ;SKIP RETURN
PRGEND
TITLE .CNTDT -- GENERALIZED DATE/TIME SUBROUTINE
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INTIALIZE LISTINGS, ETC.
;ENTRY POINTS
ENTRY .CNTDT,.CNVDT,.GTNOW
;.CNTDT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL: MOVE T1,DATE/TIME
; PUSHJ P,.CNTDT
; RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0)
;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
;USES T1-4
.CNTDT::PUSH P,T1 ;SAVE TIME FOR LATER
JUMPL T1,CNTDT6 ;DEFEND AGAINST JUNK INPUT
HLRZ T1,T1 ;GET DATE PORTION (DAYS SINCE 1858)
RADIX 10 ;**** NOTE WELL ****
ADDI T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
;T1=DAYS SINCE JAN 1, 1501 [311]
IDIVI T1,400*365+400/4-400/100+400/400
;SPLIT INTO QUADRACENTURY [311]
LSH T2,2 ;CONVERT TO NUMBER OF QUARTER DAYS [311]
IDIVI T2,<100*365+100/4-100/100>*4+400/400
;SPLIT INTO CENTURY [311]
IORI T3,3 ;DISCARD FRACTIONS OF DAY [311]
IDIVI T3,4*365+1 ;SEPARATE INTO YEARS [311]
LSH T4,-2 ;T4=NO DAYS THIS YEAR [311]
LSH T1,2 ;T1=4*NO QUADRACENTURIES [311]
ADD T1,T2 ;T1=NO CENTURIES [311]
IMULI T1,100 ;T1=100*NO CENTURIES [311]
ADDI T1,1501(T3) ;T1 HAS YEAR, T4 HAS DAY IN YEAR [311]
MOVE T2,T1 ;COPY YEAR TO SEE IF LEAP YEAR
TRNE T2,3 ;IS THE YEAR A MULT OF 4? [311]
JRST CNTDT0 ;NO--JUST INDICATE NOT A LEAP YEAR [311]
IDIVI T2,100 ;SEE IF YEAR IS MULT OF 100 [311]
SKIPN T3 ;IF NOT, THEN LEAP [311]
TRNN T2,3 ;IS YEAR MULT OF 400? [311]
TDZA T3,T3 ;YES--LEAP YEAR AFTER ALL [311]
CNTDT0: MOVEI T3,1 ;SET LEAP YEAR FLAG [311]
;T3 IS 0 IF LEAP YEAR
;UNDER RADIX 10 **** NOTE WELL ****
CNTDT1: SUBI T1,1964 ;SET TO SYSTEM ORIGIN
IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS
JUMPN T3,CNTDT2 ;IF NOT LEAP YEAR, PROCEED
CAIGE T4,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29
JRST CNTDT5 ;NO--JUST INCLUDE IN ANSWER
SOS T4 ;YES--BACK OFF ONE DAY
CNTDT2: MOVSI T2,-11 ;LOOP FOR 11 MONTHS
CNTDT3: CAMGE T4,MONTAB+1(T2) ;SEE IF BEYOND THIS MONTH
JRST CNTDT4 ;YES--GO FINISH UP
ADDI T1,31 ;NO--COUNT SYSTEM MONTH
AOBJN T2,CNTDT3 ;LOOP THROUGH NOVEMBER
CNTDT4: SUB T4,MONTAB(T2) ;GET DAYS IN THIS MONTH
CNTDT5: ADD T1,T4 ;INCLUDE IN FINAL RESULT
CNTDT6: EXCH T1,(P) ;SAVE ANSWER, GET TIME
TLZ T1,-1 ;CLEAR DATE
MUL T1,[24*60*60*1000] ;CONVERT TO MILLI-SEC.
ASHC T1,17 ;POSITION RESULT
POP P,T2 ;RECOVER DATE
POPJ P, ;RETURN
;.GTNOW -- COMPUTE CURRENT TIME IN SPECIAL FORMAT
;CALL: PUSHJ P,.GTNOW
;RETURNS WITH RESULT IN T1
;USES T2, T3, T4
.GTNOW::MOVX T1,%CNDTM ;ASK MONITOR [310]
GETTAB T1, ; FOR ANSWER [310]
MOVEI T1,0 ;(OLD MONITOR) [310]
JUMPN T1,GETNWX ;IF KNOWN, GO GIVE RESULT [310]
MSTIME T1, ;GET SYSTEM TIME IN MILLISECONDS
DATE T2, ;GET SYSTEM DATE IN COMMON FORMAT
;FALL INTO .CNVDT
;UNDER RADIX 10 **** NOTE WELL ****
;FALL HERE FROM .GTNOW
;.CNVDT -- CONVERT ARBITRARY DATE TO SPECIAL FORMAT
;CALL: MOVE T1,TIME IN MILLISEC.
; MOVE T2,DATE IN SYSTEM FORMAT (Y*12+M)*31+DAY SINCE 1/1/64
; PUSHJ P,.CNVDT
;RETURNS WITH RESULT IN T1 (.GT.0; OR -1 IF BEYOND SEPT. 27,2217)
; NOTE THAT IN SPECIAL FORMAT, THE LEFT HALF DIVIDED
; BY 7 GIVES THE DAY OF THE WEEK (0=WED.)
;USES T2, T3, T4
.CNVDT::PUSHJ P,.SAVE1## ;PRESERVE P1
PUSH P,T1 ;SAVE TIME FOR LATER
IDIVI T2,12*31 ;T2=YEARS-1964
CAILE T2,2217-1964 ;SEE IF BEYOND 2217
JRST GETNW2 ;YES--RETURN -1
IDIVI T3,31 ;T3=MONTHS-JAN, T4=DAYS-1
ADD T4,MONTAB(T3) ;T4=DAYS-JAN 1
MOVEI P1,0 ;LEAP YEAR ADDITIVE IF JAN, FEB
CAIL T3,2 ;CHECK MONTH
MOVEI P1,1 ;ADDITIVE IF MAR-DEC
MOVE T1,T2 ;SAVE YEARS FOR REUSE
ADDI T2,3 ;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
IDIVI T2,4 ;HANDLE REGULAR LEAP YEARS
CAIE T3,3 ;SEE IF THIS IS LEAP YEAR
MOVEI P1,0 ;NO--WIPE OUT ADDITIVE
ADDI T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2)
;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
MOVE T2,T1 ;RESTORE YEARS SINCE 1964
IMULI T2,365 ;DAYS SINCE 1964
ADD T4,T2 ;T4=DAYS EXCEPT FOR 100 YR. FUDGE
HRREI T2,64-100-1(T1) ;T2=YEARS SINCE 2001
JUMPLE T2,GETNW1 ;ALL DONE IF NOT YET 2001
IDIVI T2,100 ;GET CENTURIES SINCE 2001
SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS
CAIE T3,99 ;SEE IF THIS IS A LOST L.Y.
GETNW1: ADD T4,P1 ;ALLOW FOR LEAP YEAR THIS YEAR
CAILE T4,^O377777 ;SEE IF TOO BIG
GETNW2: SETOM T4 ;YES--SET -1
POP P,T1 ;GET MILLISEC TIME
MOVEI T2,0 ;CLEAR OTHER HALF
ASHC T1,-17 ;POSITION
DIV T1,[24*60*60*1000] ;CONVERT TO 1/2**18 DAYS
CAMLE T2,[^D24*^D60*^D60*^D1000/2] ;[574] OVER 1/2 TO NEXT?
ADDI T1,1 ;[574] YES, SHOULD ACTUALLY ROUND UP
HRL T1,T4 ;INCLUDE DATE
GETNWX: POPJ P, ;RETURN
;UNDER RADIX 10 **** NOTE WELL ****
MONTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
RADIX 8
PRGEND
TITLE .GTPUT -- ROUTINES TO GET AND PUT IN A COUNTED LIST
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .GTWRD,.PTWRD,.MKMSK,.LKNAM,.ISLGI
;.LKNAM -- LOOKUP NAME IN TABLE ALLOWING FOR UNIQUE ABBREVIATIONS
;ALWAYS CHECK FOR EXACT MATCH FIRST.
;CALL: MOVE T1,[IOWD LENGTH,START OF TABLE]
; MOVE T2,NAME
; PUSHJ P,.LKNAM
; ERROR RETURN IF UNKNOWN OR DUPLICATE
; AND WITH T1.LT.0 IF NOT MATCH, .GT.0 IF SEVERAL MATCHES
; SKIP RETURN IF FOUND WITH T1 POINTING TO ENTRY
; AND WITH LH(T1)=0 IF ABBREVIATION, OR T1.LT.0 IF EXACT MATCH
;USES T3, T4
;PRESERVES T2
.LKNAM::JUMPGE T1,[SETOM T1 ;FLAG UNKNOWN
POPJ P,] ;ERROR RETURN
PUSHJ P,.SAVE2## ;SAVE P1, P2
PUSH P,T1 ;SAVE ARGUMENT
MOVE T3,T2 ;SET ARG TO MASK MAKER
PUSHJ P,.MKMSK ;MAKE MASK
MOVE T2,T3 ;RESTORE NAME
MOVE P1,T1 ;SAVE FOR MATCHING
POP P,T1 ;RECOVER ARGUMENT
SETOM P2 ;SET ABBREVIATION MATCH COUNTER
AOS T1 ;POSITION POINTER
NAME1: MOVE T3,(T1) ;FETCH TABLE ENTRY
TLNE T3,(3B1) ;NOTE THAT * IS 12 IN SIXBIT
JRST NAME2 ;NOT FORCED MATCH
LSH T3,6 ;SEE IF IT MATCHES
XOR T3,T2 ;EVEN IN AN ABBR.
TRZ T3,77 ;CLEAR LAST CHAR SINCE WE DON'T KNOW IT
AND T3,P1 ; ..
JUMPE T3,.POPJ1## ;YES--GIVE MATCH RETURN
JRST NAME3 ;NO--LOOP
NAME2: XOR T3,T2 ;SEE IF EXACT MATCH
JUMPE T3,.POPJ1## ;YES--A WINNER
AND T3,P1 ;SEE IF A SUITABLE ABBREVIATION
JUMPN T3,NAME3 ;NO--LOOP BACK FOR MORE
MOVE T4,T1 ;SALT AWAY THE LOCATION JUST IN CASE
AOS P2 ;YES--COUNT
NAME3: AOBJN T1,NAME1 ;ADVANCE--LOOP IF NOT DONE YET
HRRZ T1,T4 ;RESTORE LOCATION OF A WINNER
JUMPE P2,.POPJ1## ;DONE--JUMP IF ONE ABBREVIATION
MOVE T1,P2 ;GIVE FLAG TO CALLER
POPJ P, ;NONE OR TWO, SO FAIL
;.GTWRD -- SUBROUTINE TO GET NEXT WORD FROM USER'S PARAMETER LIST
;CALL: MOVE T1,ADDRESS OF TABLE
; MOVE T2,COUNTER OF LENGTH TO GO
; PUSHJ P,.GTWRD
;RETURNS WITH T1 INCREMENTED, T2 DECREMENTED, T3=CONTENTS OR 0
.GTWRD::SOJL T2,GETWRX ;DECREMENT COUNTER--CHECK OVERRUN
SKIPA T3,(T1) ;GET USER'S VALUE
GETWRX: MOVEI T3,0 ;GET 0 DUE TO OVERRUN
AOS T1 ;ADVANCE POINTER FOR NEXT TIME
POPJ P, ;RETURN
;.PTWRD -- STORE WORD IN USER PARAMETER AREA IF ROOM
;CALL: MOVE T1,LOCATION (WILL BE INCREMENTED BY ONE)
; MOVE T2,LENGTH TO GO (WILL BE DECREMENTED BY ONE)
; MOVE T3,DATA ITEM
; PUSHJ P,.PTWRD
;RETURNS WITH T1=T1+1, T2=T2-1, WORD STORED (OLD T1) IF OLD T2.GT.0
.PTWRD::SOSL T2 ;DECREMENT COUNT
MOVEM T3,(T1) ;STORE VALUE
AOS T1 ;ADVANCE LOCATION
POPJ P, ;RETURN
;.MKMSK -- MAKE MASK CORRESPONDING TO NON-BLANKS IN SIXBIT WORD
;CALL: MOVE T3,WORD
; PUSHJ P,.MKMSK
;RETURN WITH MASK IN T1
;USES T2
.MKMSK::MOVEI T1,0 ;CLEAR MASK
MOVSI T2,(77B5) ;START AT LEFT END
MAKMS1: TDNE T3,T2 ;SEE IF SPACE HERE
IOR T1,T2 ;NO--IMPROVE MASK
LSH T2,-6 ;MOVE RIGHT ONE CHAR
JUMPN T2,MAKMS1 ;LOOP UNTIL DONE
POPJ P, ;RETURN
;.ISLGI -- ROUTINE TO SEE IF JOB IS LOGGED IN
;CALL: PUSHJ P,.ISLGI
; RETURN +1 IF NOT (1/-1) OR UNKNOWN (1/1)
; RETURN +2 IF KNOWN LOGGED IN
.ISLGI::PJOB T1, ;GET JOB NUMBER
MOVNS T1 ;COMPLEMENT
JOBSTS T1, ;GET OUT STATUS
JRST [MOVEI T1,1 ;DOESN'T WORK--INDICATE PROBLEM
POPJ P,] ;ERROR RETURN
TXNE T1,JB.ULI ;SEE IF LOGGED IN
AOSA (P) ;YES--GIVE SKIP RETURN
SETOM T1 ;NO--INDICATE NOT
POPJ P, ;RETURN
PRGEND
TITLE .SAVE -- SUBROUTINES TO SAVE AND RESTORE P1-P4
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .SAVE1,.SAVE2,.SAVE3,.SAVE4
ENTRY .PSH4T,.POP4T
ENTRY .POPJ1,.POPJ
;.SAVE1 -- SUBROUTINE TO SAVE P1 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE1
;RETURN POPJ OR .POPJ1, RESTORES P1 AND EXITS AS SKIP OR NON-SKIP
.SAVE1::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
SOS -1(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
JRST RET1 ;RESTORE P1 AND EXIT
;.SAVE2 -- SUBROUTINE TO SAVE P1 AND P2 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE2
;RETURN POPJ OR .POPJ1, RESTORES P1 AND P2 AND EXITS AS SKIP OR NON-SKIP
.SAVE2::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSH P,P2 ;SAVE P2
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
SOS -2(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
JRST RET2 ;RESTORE P1 AND P2 AND EXIT
;.SAVE3 -- SUBROUTINE TO SAVE P1 AND P2 AND P3 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE3
;RETURN POPJ OR .POPJ1, RESTORES P1-3 AND SKIPS OR NOT
.SAVE3::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
SOS -3(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
JRST RET3 ;RESTORE P1-3 AND EXIT
;.SAVE4 -- SUBROUTINE TO SAVE P1-4 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE4
;RETURN POPJ OR .POPJ1, RESTORES P1-4 AND SKIPS OR NOT
.SAVE4::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSH P,P4 ;SAVE P4
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
.SAVX4:: SOS -4(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
RET4: POP P,P4 ;RESTORE P4
RET3: POP P,P3 ;RESTORE P3
RET2: POP P,P2 ;RESTORE P2
RET1: POP P,P1 ;RESTORE P1
.POPJ1::AOS (P) ;INCREMENT PC [521]
.POPJ:: POPJ P, ;RETURN
;THE FOLLOWING INSTRUCTION RETSTORES P1 AND DISPATCHES TO THE CALLER.
SAVJMP: JRA P1,(P1) ;RETURN TO CALLER [521]
;.PSH4T -- PUSH T1-T4 ONTO STACK
;.POP4T -- POP T1-T4 FROM STACK
;CALL: PUSHJ P,.PSH4T/.POP4T
;USES NO ACS
.PSH4T::PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
EXCH T1,-3(P) ;SAVE T1/GET RETURN
PUSH P,T1 ;PUT INTO SAFE PLACE
MOVE T1,-4(P) ;RESTORE T1
POPJ P, ;RETURN
.POP4T::POP P,T1 ;GET RETURN
POP P,T4 ;RESTORE T4
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
EXCH T1,(P) ;RESTORE T1/SAVE RETURN
POPJ P, ;RETURN
END