Trailing-Edge
-
PDP-10 Archives
-
BB-JR93N-BB_1990
-
10,7/swil/swiscn.mac
There are 7 other files named swiscn.mac in the archive. Click here to see a list.
TITLE .SCAN SWIL command scan routines
SUBTTL
SEARCH SWIDEF, SWIL ;SWIL PACKAGE DEFINTIONS
SEARCH JOBDAT, MACTEN, UUOSYM ;STANDARD DEFINITIONS
SALL ;PRETTY LISTINGS
.DIREC FLBLST ;PRETTIER LISTINGS
TWOSEG 400000 ;NICE PURE CODE
COMMENT \
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986,1988. 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.
\
SUBTTL Version and Revision History
MAJVER==13 ;MAJOR VERSION LEVEL
MINVER==0 ;MAINTENANCE VERSION LEVEL
CSTVER==0 ;CUSTOMER LEVEL
EDTVER==1055 ;EDIT LEVEL
%%SCAN==:<BYTE (3)CSTVER(9)MAJVER(6)MINVER(18)EDTVER>
%%SWIL==:%%SWIL ;SHOW (AND SYNCHRONIZE) SWIL VERSION
IF2,< PURGE CSTVER,MAJVER,MINVER,EDTVER>
;%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.
;1000 RDH 01-Jan-84
; Incorporate into SWIL %12(1000), sync edit level at 1000.
;1003 RDH 20-Jun-84
; Routine .ASUID (/USERID switch) doesn't accept quoted-string
; construction for the account or password strings (although ^V
; quoting of individual characters works).
;1006 RDH
; Run in non-zero PC sections.
;1007 RDH 28-Nov-84
; FX.APP referenced in .FXMOD, but defined in .FXCTL
;1022 LEO 09-Sep-85
; Do Copyrights.
;1031 RDH 26-Dec-85
; Constructs like "ABC'OR'DEF" lost last character of "ABC".
;1034 RDH 28-Dec-85
; /OPTION:"A B" put .TI??? into a loop.
;1037 RDH 3-Jan-86
; /AFTER:1-JAN-60 not detected and reported as an error.
;1042 RDH 23-Jan-86
; Add /IOMODE:A8CII.
;1054 JJF 30-Nov-88 SPR:10-35586
; Attempt to handle remote directory filespecs a bit better. If the
; spec being parsed is coming from a DAP name message, instead of
; doing the usual PPN/alphanumeric directory test, assume that it is
; a numeric directory. This solves NFT's problem where it blew up
; trying to deal with directories like [000000] or <7-EMACS>.
; Invent a new entry point for .FILSP, called .FILSC, which will
; always treat directories as names. Change .DPRNN so that it will
; call the alternate entry point.
;1055 KDO 3-Apr-89 SPR:10-36249
; Need to differentiate between quoted and unquoted file names.
SUBTTL DEFINITIONS FOR THIS SUB-MODULE
;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]
;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=PROTOCOL VERSION WORD: <MAJOR>,,<MINOR>
; BLOCK+1=0 OR IOWD PTR TO A LIST OF LEGAL MONITOR COMMANDS
; IF 0, NO RESCAN IS DONE
; BLOCK+2=RH 0 OR SIXBIT CCL NAME
; IF 0, NO CCL MODE
; LH 0 OR ADDRESS OF STARTING OFFSET
; BLOCK+3=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+4=0 OR POINTER (XWD LEN,BLOCK) TO INDIRECT FILE BLOCK
; .FXDEV NE 0 TO USE BLOCK
; BLOCK+5=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+6=LH FLAGS
; RH (FUTURE)
; BLOCK+7=0 OR ADDRESS OF [SCAN] ERROR INTERCEPT ROUTINE (FROM FMSGE)
;
;VALUE AC1=INDEX IN TABLE OF COMMANDS IF FOUND(0,1,...), ELSE -1
ENTRY .ISCAN
.ISCAN::STORE T4,ZCOR,EZCOR,0 ;CLEAR ALL MEMORY [545]
MOVEM P,SAVPDP ;PRESET PDL MEMORY
MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC+1 (FOR FXVERC)
SETZM SAVCAL ;CLEAR CALL MEMORY
PUSHJ P,.SAVE4## ;SAVE P1-P4
HLRZ T2,T1 ;GET ARGUMENT COUNT
ANDI T1,-1 ;*X* ASSUME SAME SECTION, MAKE LOCAL INDEX
PUSHJ P,.GTWRD## ;GET BLOCK+0
PUSHJ P,FXVERC ;VERIFY CALLERS PROTOCOL VERSION
PUSHJ P,.GTWRD## ;GET BLOCK+1
MOVEM T3,SWTPTR ;STORE POINTER TO COMMAND NAMES
PUSHJ P,.GTWRD## ;GET BLOCK+2
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+3
MOVEM T3,CALCNT ;STASH COMMAND I/O ROUTINES FOR THE NONCE
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
PUSHJ P,.GTWRD## ;GET BLOCK+4
IFN M$INDP,<
MOVEM T3,USRIND ;SET FLAG IF USER SUPPLIED COMMAND FILE
JUMPE T3,ISCANI ;PROCEED IF NO FILE
HRLZ T4,T3 ;SETUP BLT
HRRI T4,A.BLK ; FROM USER
HLRZ T3,T3 ; TO A.BLK
CAILE T3,.FXEZM ;WITHIN OUR BOUNDS?
MOVEI T3,.FXEZM ;NO, LIMIT TO WHAT WE CAN HANDLE
BLT T4,A.BLK-1(T3) ;BUT NOT TOO FAR
>
ISCANI: PUSHJ P,.GTWRD## ;GET BLOCK+5
PUSHJ P,LOCAL ;*X* CONVERT TO LOCAL ADDRESSES
MOVEM T3,PROMPT ;*X* SAVE USER PROMPT ROUTINE
MOVEM T4,MONRT ;*X* SAVE USER MONRET
PUSHJ P,.GTWRD## ;GET BLOCK+6 [366]
MOVEM T3,INIFLG ;STORE FLAGS [366]
PUSHJ P,.GTWRD## ;GET BLOCK+6
PUSHJ P,LOCAL ;*X* LOCALIZE THE ADDRESSES
MOVEM T4,USRERR ;*X* STORE USER ERROR-INTERCEPT
HRREI C,.CHEOL ;PRESET EOL JUST IN CASE
;DELETED [545]
SETOM OPTION ;CLEAR OPTION [353]
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
GETPPN T1, ;GET OUR PPN
JFCL ;(IN CASE OF JACCT)
MOVEM T1,.MYPPN ;SAVE FOR LATER USE [312]
SETOM .MYPTH ;SET TO READ DEFAULT PATH
.CREF .PTFRD ;CREF REFERENCE TO REAL SYMBOL
MOVE T2,[.PTMAX,,.MYPTH] ;PATH. ARG POINTER TO
PATH. T2, ;READ MY DEFAULT PATH
MOVEM T1,.MYPTH+.PTPPN;NO DEFAULT PATH?????
PJOB T3, ;GET MY JOB NUMBER
MOVEM T3,.MYJOB ;SAVE FOR FUTURE REFERENCE
TRMNO. T3, ;GET CONTROLLING TTY UDX
SETZ T3, ;FAILED???
MOVEM T3,.MYTTY ;SAVE FOR FUTURE
MOVE T1,[2,,T2] ;ARG PTR FOR TRMOP.
MOVX T2,.TOWID ;TTY WIDTH FUNCTION
TRMOP. T1, ;READ THE TTY WIDTH
MOVEI T1,^D64 ;REASONABLE DEFAULT
MOVEM T1,.MYTWD ;AND SAVE FOR FUTURE REFERENCE
HRROI T1,.GTPRG ;PROGRAM NAME TABLE
GETTAB T1, ;ASK MONITOR WHAT WE ARE
SETZ T1, ;CAN'T HAPPEN.
MOVEM T1,.MYPRG ;SAVE FOR OTHERS
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVX T1,%LDMFD ;GETTAB ARG POINTER TO
GETTAB T1, ;READ MASTER FILE DIRECTORY PPN
MOVE T1,[1,,1] ;FAILED???
MOVEM T1,.PPMFD ;SAVE
MOVX T1,%LDFFA ;GETTAB ARG POINTER TO
GETTAB T1, ;READ FULL FILE ACCESS (OPR) PPN
MOVE T1,[1,,2] ;FAILED???
MOVEM T1,.PPFFA ;SAVE
MOVX T1,%LDOLD ;GETTAB ARG POINTER TO
GETTAB T1, ;READ "OLD" SYSTEM LIBRARY PPN
MOVX T1,[1,,3] ;FAILED???
MOVEM T1,.PPOLD ;SAVE
MOVX T1,%LDSYS ;GETTAB ARG POINTER TO
GETTAB T1, ;READ "STANDARD" SYSTEM LIBRARY PPN
MOVE T1,[1,,4] ;FAILED???
MOVEM T1,.PPSYS ;SAVE
MOVX T1,%LDNEW ;GETTAB ARG POINTER TO
GETTAB T1, ;READ "NEW" SYSTEM LIBRARY PPN
MOVE T1,[1,,5] ;FAILED???
MOVEM T1,.PPNEW ;SAVE
MOVE T1,[.NDRNN,,T2] ;SET TO READ HOST NODE NAME
MOVEI T2,2 ;LENGTH FOR NODE.
MOVSI T3,'CTY' ;IDENTIFY HOST
WHERE T3,UU.PHY ;BY TRADITIONAL MEANS
SETZ T3, ;DUH? NO NETWORKS MAYBE?
ANDI T3,-1 ;JUST HOST NODE NUMBER
MOVEM T3,.MYNNM ;REMEMBER THE NUMBER
NODE. T1, ;ASK FOR NODE NAME
SETZ T1, ;DUH? NO NETWORKS MAYBE?
MOVEM T1,.MYNOD ;REMEMBER THE NAME AS WELL
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
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.BLK+.FXDEV ; COUNT TO CORRECT
CAIN P1,1 ; VALUE IF OFFSET ONE
MOVEM T1,INDCNT ; OR IND. FILE POINTER
>
>
IFN M$INDP,<
MOVE T1,.MYJOB ;GET THIS JOB'S NUMBER
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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
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
MOVE T4,.PPMFD ;GET MASTER FILE DIRECTORY
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.BLK+.FXDEV ;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.BLK+.FXDEV
SETOM A.BLK+.FXDEM ;CCL DEVICE IS NOT WILD
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 ;[1046] GET POSSIBLE SIXBIT LEADIN
JUMPLE C,COMND2 ;[1046] SHOULD HAVE BEEN ONE
PUSHJ P,.REEAT ;[1046] PUT IT BACK IN CASE NOT SPECIAL
PUSHJ P,.TICAD ;[1046] SEE IF SPECIAL
JRST COMNDI ;[1046] 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 ;READ ANOTHER COMMAND CHARACTER
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 ;[1046] RANGE-CHECK
CAILE C,137 ;[1046] FOR SIXBIT VALUES
JRST COMNDG ;[1046] NOT FOR US AFTER ALL
MOVEI N,-40(C) ;[1046] YES, CONVERT TO SIXBIT
LSH N,^D30 ;[1046] JUSTIFY
MOVEM N,.NMUL ;[1046] SAVE FOR ERRORS
MOVEI T1,.TSIXN## ;[1046] ERROR TYPER
MOVEM T1,.LASWD ;[1046] SET THAT UP AS WELL
PUSHJ P,.TIALT ;[1046] SKIP OVER OUR CHARACTER
PUSHJ P,.TIALT ;[1046] GET TERMINATOR
;[1046] 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
MOVEM N,FLJCMD ;FLAG COMMAND NAME ALREADY PARSED
SETOM FLJCNM ;INDICATE NAME [365]
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 P1,-1(T1) ;1=ADDRESS-1 OF COMMAND
SUB P1,T2 ;1=INDEX INTO TABLE
JRST COMND7 ;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 P1,
MOVEM C,LASCHR ;SAVE FOR REUSE LATER
COMND7: MOVE T3,CALCNT ;*X* SAVED TERMINAL ROUTINES
PUSHJ P,LOCAL ;*X* LOCALIZE THE ADDRESSES
MOVE T1,T3 ;*X* INPUT ADDRESS
PUSHJ P,.TYICH ;SETUP COMMAND INPUT
MOVE T1,T4 ;*X* OUTPUT ADDRESS
PUSHJ P,.TYOCH## ;SETUP COMMAND OUTPUT
SETOM CALCNT ;INIT CALL COUNTER
MOVE T1,P1 ;RETURN COMMAND FLAG/VALUE IN T1
POPJ P, ;END OF .ISCAN
;LOCAL ADDRESS HACKERIE
;
;CALL WITH XWD ADDRESS,ADDRESS IN T3, RETURN WITH FULL-WORD SECTION-LOCAL
;ADDRESS IN T3+T4.
LOCAL: HRRZ T4,T3 ;POSITION ADDRESS
HLRZ T3,T3 ;POSITION OTHER ADDRESS
CAIE T3,0 ;IS THERE A FIRST ADDRESS?
HRLI T3,(IFIW 0) ;YES, MAKE IT SECTION-LOCAL
CAIE T4,0 ;IS THERE AN OTHER ADDRESS?
HRLI T4,(IFIW 0) ;YES, MAKE IT SECTION-LOCAL
POPJ P, ;HO HUM.
SUBTTL TINY SHEEP COMMAND KROCK
;.TSKRK - TINY SHEEP KROCK COMMAND SCANNING FOR NFT
;ARGS AC1=XWD LENGTH,BLOCK
;
; BLOCK+0=PROTOCOL VERSION WORD: <MAJOR>,,<MINOR>
; BLOCK+1=0 OR IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+2=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+3=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+4=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
;
;This routine is an "expedient" measure to get NFT to do the "right"
;thing re command scanning. It doesn't, but it is closer than not . . .
;
;Ultimately [drum roll please] .CSCAN will take care of all of this
;nonsense, 'till then this will just hafta do.
.TSKRK::MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC+1 (FOR FXVERC)
MOVEM T4,SAVCAL ;ALSO SAVE FOR ERROR RESTART
;RDH PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
MOVE T2,.JBREL ;GET SIZE OF CORE
HRL T2,.JBFF ; AND CURRENT USAGE
MOVEM T2,SAVCOR ; AND SAVE IT
MOVE C,LASCHR ;RESTORE LAST CHARACTER
MOVEM P,SAVPDP ;SAVE PUSH DOWN LIST POINTER
PUSHJ P,SETPR4 ;SET STANDARD PARAMETERS
HRRZM P,FLVERB ;SET FLVERB .GT. 0
AOSE CALCNT ;COUNT CALL
JRST TSKTRT ;IF NOT FIRST, DO A RESTART
SKIPE FLCCMD ;SKIP IF NEITHER CCL OR COMMAND
SKIPE PREMPT ;ALWAYS PROMPT PREEMPTIVE INPUT [572]
JRST TSKTRT ;GO DO THE PROMPTING [572]
JRST TSKCMD ;THEY REQUIRE NO *
TSKTRT:
IFN DEBUG$,<
CAME P,SAVPDP
JRST E$$PDL ;FAIL IF PDL PHASE ERROR
>
MOVE T1,SAVCOR ;RESTORE CORE
HLRM T1,.JBFF ;RESTORE FIRST FREE
TLZ T1,-1 ;CLEAR JUNK
CAME T1,.JBREL ; TO ITS INITIAL
CORE T1, ; SETTING IF IT
JFCL ; WAS CHANGED
SKIPE PREMPT ;IGNORE INDIRECT IF PREEMPTING [572]
JRST TSKTRP ;SINCE WE WANT TO READ THE TTY [572]
IFN M$INDP,<
SKIPE A.BLK+.FXDEV ;SEE IF INDIRECT
JRST TSKTRC ;YES--SKIP END TEST
PUSHJ P,.RUNCK ;SEE IF /RUN
CAIA ;NO
JRST TSKCMD ;YES, NO PROMPTING/ETC.
>
SKIPE FLCCMD ;SEE IF IN TRADITIONAL MODE
PUSHJ P,.MONRT ;NO--RETURN TO MONITOR
TSKTRC: CAMN C,[.CHEOF] ;SEE IF END OF FILE [504]
JRST [PUSHJ P,.ALDON ;YES--HANDLE EOF [504]
JUMPG C,TSKCMD ;CONTINUE IF NOT DONE YET [535]
JRST TSKTRT] ;RETURN TO MAIN LINE [504]
TSKTRP: 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
;HERE TO START ONE PASS THROUGH THE CUSP (ONE COMMAND LINE)
TSKCMD: PUSHJ P,.CCLRB ;CONDITIONALLY CLEAR TYPEAHEAD [524]
SKIPE PREMPT ;IGNORE /RUN IF PREEMPT [572]
JRST TSKCM2 ;SINCE WE REALLY WANT INPUT [572]
IFN M$INDP,<
PUSHJ P,.RUNCM ;HANDLE /RUN IF NEEDED [264]
JUMPN T1,TSKTRT ;IF DID SOMETHING, START OVER [506]
>
TSKCM2: PUSHJ P,INICMD ;INITIALIZE COMMAND [572]
SKIPN N,FLJCMD ;GOT A (.ISCAN) COMMAND WAITING?
PUSHJ P,.SIXSW ;NO, PICK UP COMMAND NAME
SETZM FLJCMD ;NO MORE SAVED COMMAND
JUMPN N,TSKCM4 ;GO WITH COMMAND IF ANYTHING SPECIFIED
IFN M$INDP,<
CAIN C,"@" ;NULL COMMAND, GOT COMMAND FILE INSTEAD?
JRST TSKCFI ;YEAH, GO SETUP COMMAND FILE THEN
> ;END IFN M$INDP
JRST .POPJ1## ;LET CALLER DEAL WITH NULL COMMAND
TSKCM4: MOVEM N,FLKCMD ;SAVE LAST COMMAND SEEN
JRST .POPJ1## ;RETURN NAME TO CALLER
;HERE FOR COMMAND-LEVEL INDIRECT FILE
IFN M$INDP,<
TSKCFI: MOVX T2,FS.IFI ;THE SHOULDN'T-OUGHTA-BE-HERE FLAG
TDNE T2,INIFLG ;USER SAY NO COMMAND FILES?
JRST E$$IFI ;YEAH, GO BARF ON HIM
PUSHJ P,.GTIND ;NO, GO PARSE @FILESPEC, SETUP COMMAND INPUT
JRST TSKCMD ;AND START OVER
> ;END IFN M$INDP
SUBTTL TRADITIONAL COMMAND SCANNER
;.TSCAN--SUBROUTINE FOR TRADITIONAL COMMAND SCANNER
;ARGS AC1=XWD LENGTH,BLOCK
;
; BLOCK+0=PROTOCOL VERSION WORD: <MAJOR>,,<MINOR>
; BLOCK+1=0 OR IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+2=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+3=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+4=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+5=LH 0 OR SUBROUTINE TO CLEAR ALL ANSWERS
; RH 0 OR SUBROUTINE TO CLEAR FILE ANSWERS
; BLOCK+6=LH SUBROUTINE TO ALLOCATE INPUT FILE AREA
; RH SUBROUTINE TO ALLOCATE OUTPUT FILE AREA
; BOTH RETURN T1=START OF AREA, T2=LENGTH
; BLOCK+7=LH 0 OR SUBROUTINE TO MEMORIZE STICKY DEFAULTS
; RH 0 OR SUBROUTINE TO APPLY STICKY DEFAULTS
; BLOCK+10=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+11=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::MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC+1 (FOR FXVERC)
MOVEM T4,SAVCAL ;ALSO SAVE FOR ERROR RESTART
SKIPGE INIFLG ;IF .TSKRK HAS ALREADY DONE THIS
JRST TSCAN1 ;THEN DON'T DO IT AGAIN
PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
MOVE T2,.JBREL ;GET SIZE OF CORE
HRL T2,.JBFF ; AND CURRENT USAGE
MOVEM T2,SAVCOR ; AND SAVE IT
TSCAN1: 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+5
PUSHJ P,LOCAL ;*X* LOCALIZE THE ADDRESSES
MOVEM T3,CLRANS ;*X* SUBROUTINE TO CLEAR ANSWER AREA
MOVEM T4,CLRFIL ;*X* SUBROUTINE TO CLEAR FILE AREA
PUSHJ P,.GTWRD## ;GET BLOCK+6
TLNE T3,-1 ;(REQUIRED)
TRNN T3,-1 ;(REQUIRED)
JRST [OUTSTR [ASCIZ\? .TSCAN called with no allocation routine(s)\]
EXIT] ;THIS IS A FATAL ERROR!!!
PUSHJ P,LOCAL ;*X* LOCALIZE THE ADDRESSES
MOVEM T3,ALLIN ;*X* SUBROUTINE TO ALLOCATE INPUT AREA
MOVEM T4,ALLOUT ;*X* SUBROUTINE TO ALLOCATE OUTPUT AREA
PUSHJ P,.GTWRD## ;GET BLOCK+7
PUSHJ P,LOCAL ;*X* LOCALIZE THE ADDRESSES
MOVEM T3,MEMSTK ;*X* SUBROUTINE TO MEMORIZE STICKY DEFAULTS
MOVEM T4,APPSTK ;*X* SUBROUTINE TO APPLY STICKY DEFAULTS
PUSHJ P,.GTWRD## ;GET BLOCK+10
PUSHJ P,LOCAL ;*X* LOCALIZE THE ADDRESSES
MOVEM T3,CLRSTK ;*X* SUBROUTINE TO CLEAR STICKY DEFAULTS
MOVEM T4,USRFLG ;*X* STORE AWAY USER'S PARAMETER FLAGS
PUSHJ P,.GTWRD## ;GET BLOCK+11
PUSHJ P,LOCAL ;*X* LOCALIZE THE ADDRESSES
MOVEM T4,STRSWT ;*X* ADDRESS OF ROUTINE TO STORE RESULTS
HRRZM P,FLVERB ;SET FLVERB .GT. 0
SKIPGE INIFLG ;IF .TSKRK ALREADY PROMPTED,
JRST RESTRL ;THEN DON'T EVEN THINK ABOUT PROMPTING AGAIN
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
TLZ T1,-1 ;CLEAR JUNK
CAME T1,.JBREL ; TO ITS INITIAL
CORE T1, ; SETTING IF IT
JFCL ; WAS CHANGED
;**;[577] Delete @ RESTRT+11L JNG 18-Jan-77
SKIPE PREMPT ;IGNORE INDIRECT IF PREEMPTING [572]
JRST RESTRP ;SINCE WE WANT TO READ THE TTY [572]
IFN M$INDP,<
SKIPE A.BLK+.FXDEV ;SEE IF INDIRECT
JRST RESTRC ;YES--SKIP END TEST
;**; [600] DELELTE AT RESTRT+14 LCR 21-JAN-77.
PUSHJ P,.RUNCK ;SEE IF /RUN
CAIA ;NO
JRST RESTRL ;YES, NO PROMPTING/ETC.
>
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
SKIPGE INIFLG ;TINY SHEEP HAVE ALREADY /RUN RAMPANT
JRST RESTRS ;SO JUST CONTINUE THE COMMAND SCAN
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]
CAIA ;SKIP INTO FILE SPEC SCANNING PORTION
;HERE TO SCAN ONE SIDE OF COMMAND LINE
RESTRS: PUSHJ P,INILIM ;INITIALIZE AT START OF LINE
;RDH PUSHJ P,CLERST ;CLEAR STICKY DEFAULTS [534]
;**;[577] Delete @ RESTRS+2L JNG 18-Jan-77
;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]
;RDH MOVX T2,FS.IFI ;FS.IFI MEANS @ ILLEGAL [605]
MOVX T2,FS.ICK!FS.IFI;ALSO DISALLOW IF .TSKRK MODE (DOESN'T WORK)
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.BLK+.FXMOD,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
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
;**;[577] Replace @ OUTFIL+1L JNG 18-Jan-77
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.BLK+.FXMOM ;GET FILE MODIFIERS
TXNE T1,FXNOTO ;CHECK ILLEGAL ONES
JRST E.FMO ;ERROR IF WRONG ONES
SETO T1, ;THE "NO-VALUE" VALUE
CAMN T1,F.BLK+.FXBFR ;SEE IF /BEFORE
CAME T1,F.BLK+.FXSNC ;OR /SINCE
JRST E.FMO ;YES--ERROR
CAMN T1,F.BLK+.FXABF ;SEE IF /ABEFORE
CAME T1,F.BLK+.FXASN ; OR IF /ASINCE
JRST E.FMO ;YES--ERROR
CAMN T1,F.BLK+.FXPBF ;SEE IF /PBEFORE
CAME T1,F.BLK+.FXPSN ; OR IF /PSINCE
JRST E.FMO ;YES--ERROR
CAMN T1,F.BLK+.FXFLI ;SEE IF MIN LENGTH
CAME T1,F.BLK+.FXFLM ; OR IF MAX LENGTH
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.BLK+.FXMOM ;GET FILE MODIFIERS
TXNE T1,FXNOTI ;CHECK ILLEGAL ONES
JRST E.FMI ;ERROR IF WRONG ONES
SETO T1,-1 ;THE "NO-VALUE" VALUE
CAMN T1,F.BLK+.FXEST ;SEE IF /ESTIMATE
CAME T1,F.BLK+.FXVER ;SEE IF /VERSION
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
SKIPGE INIFLG ;IS THIS A .TSKRK-STYLE CALL?
POPJ P, ;YES, THEN *ALWAYS* RETURN AT EOL
IFN M$INDP,<
SKIPE A.BLK+.FXDEV ;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
;**;[577] Delete @ INDFI1+2L JNG 18-Jan-77
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=PROTOCOL VERSION WORD: <MAJOR>,,<MINOR>
; BLOCK+1=IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+2=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+3=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+4=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+5=LH LENGTH OF FXXX AND PXXX AREAS
; RH START OF FXXX (PER FILE SWITCHES)
; BLOCK+6=LH (FUTURE)
; RH START OF PXXX (STICKY FORM OF FXXX)
; BLOCK+7=NAME OF OPTION LINES (0 IF THIS PROGRAM'S NAME)
.VSCAN::MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC+1 (FOR FXVERC)
MOVEM P,SAVPDP ;SAVE PUSH DOWN LIST POINTER
PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
SETOM FLVERB ;NOTE VERB FORM [556]
PUSHJ P,SETPR4 ;SET STANDARD PARAMETERS
PUSHJ P,.GTWRD## ;GET BLOCK+5
MOVE P1,T3 ;SAVE POINTER TO FXXX
PUSHJ P,.GTWRD## ;GET BLOCK+6
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+7
IFN M$INDP,<
MOVEM T3,VOPTN ;SAVE AS OPTION FILE LINE NAME
>
MOVE C,SAVCHR ;RESTORE RESCANNED CHARACTER
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: CAIE T1,E$$NSS ;NO SWITCH SPECIFIED?
JRST (T1) ;NO, MORE SEVERE ERROR
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=PROTOCOL VERSION WORD: <MAJOR>,,<MINOR>
; BLOCK+1=IOWD POINTER TO LIST OF SWITCH NAMES (IOWD XXXXXL,XXXXXN)
; BLOCK+2=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+3=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+4=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+5=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::MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC+1 (FOR FXVERC)
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]
SETZM SCANPC ;CLEAR [515]
SETZM SCANCH ; COMPRESSOR [515]
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]
PUSH P,FLVERB ;SAVE VERBOSITY FLAG [370]
SETZM FLVERB ;TREAT LIKE PSCAN [370]
MOVE T2,P ;COPY PDL POINTER [366]
PUSH T2,T2 ;INCREMENT STACK ONCE [366]
MOVEM T2,SAVPDP ; WITH A GOOD PDL [366]
SKIPGE (P) ;SEE IF VSCAN CALL [370]
....=FLVERB ;FORCE INTO CREF [370]
JRST OSCANV ;YES--SKIP RE-INITIALIZE [370]
MOVE P1,OPTION ;SAVE /OPTION TO FAKE QSCAN
PUSHJ P,QSCAN0 ;SETUP FOR QSCAN [335]
JRST OPTNSX ;HERE ONLY IF ERROR IN FILE
MOVEM P1,OPTION ;RESTORE OPTION
PUSHJ P,.GTWRD## ;GET BLOCK+5
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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.BLK+.FXDEV ;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]
MOVEI T1,1 ;DON'T CALL USER
PUSHJ P,.CLRFL ;WHEN WE CLEAR OUT THE FILE AREA
;CONSTRUCT FILE SPEC FOR DSK:SWITCH.INI[,]/PHYSICAL/OKNONE
MOVX T1,.IOASL ;SPECIFY ASCII MODE
MOVX T2,FX.QRY!FX.IOM;/QUERY:NEVER/IOMODE:ASCII
DMOVEM T1,F.BLK+.FXCTL ;SET CONTROL FIELD(S)
MOVX T1,FX.PHY!FX.NOM;/PHYSICAL/OKNONE
MOVX T2,FX.PHY!FX.NOM;MATCHING CONTROL MASK
DMOVEM T1,F.BLK+.FXMOD ;SET THE MODS FIELD(S)
MOVX T1,FX.UDV!FX.UDR!FX.UNM!FX.UEX ;FIELDS PRESENT
MOVEM T1,F.BLK+.FXFLD ;SET FIELDS FLAGS
SETO T2, ;NO WILDCARDS MASK
MOVSI T1,'DSK' ;JOB SEARCH LIST
DMOVEM T1,F.BLK+.FXDEV ;SET DEVICE SPECIFICATION
MOVE T1,.MYPPN ;USE LOGGED-IN ACCOUNT
DMOVEM T1,F.BLK+.FXDIR ;SET DIRECTORY SPECIFICATION
MOVE T1,['SWITCH'] ;A SWITCH-CONTAINING FILE
DMOVEM T1,F.BLK+.FXNAM ;SET FILE NAME SPECIFICATION
HRLOI T1,'INI' ;AN "INIT-FILE" TYPE
MOVEM T1,F.BLK+.FXEXT ;SET FILE TYPE SPECIFICATION
PUSHJ P,GTINDF ;SET INDIRECT FILE SPEC
MOVEI T1,1 ;AGAIN, DON'T CALL USER
PUSHJ P,.CLRFL ;CLEAR OUT FILE SPEC AREA [513]
SKIPN OPTION ;SEE IF /NOOPTION
JRST OPTNSW ;YES--RETURN IMMEDIATELY
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;STILL UNDER M$INDP
AOSE OPTION ;IF OPTION IS -1,
SOS OPTION ; 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,.SIXSW ;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,.SIXSW ;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
OPTNSE: CAIE T1,E$$NSS ;NO SWITCH SPECIFIED?
JRST (T1) ;NO, SEVERE ERROR
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 OPTNSE ;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 (P) ;IF ORIGINALLY VERB, ERROR [370]
....=FLVERB ;FORCE INTO CREF
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,FLVERB ;RESTORE MODE OF SCAN **USED ABOVE** [370]
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,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
> ;END M$INDP
SUBTTL PARTIAL SCANNER
;.PSCAN --SUBROUTINE TO INITIALIZE PARTIAL MODE SCANNER
;.QSCAN -- DITTO BUT ONLY INITIALIZE 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=PROTOCOL VERSION WORD: <MAJOR>,,<MINOR>
; BLOCK+1=IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+2=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+3=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+4=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::MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC+1 (FOR FXVERC)
MOVEM T4,SAVCAL ;ALSO SAVE FOR ERROR RESTART
MOVEM P,SAVPDP ;SAVE PUSH-DOWN POINTER [364]
SETZM .FLVRB## ;CLEAR /MESSAGE [327]
SETZM FLVERB ;INDICATE .PSCAN [364]
MOVE T2,SAVCHR ;GET SAVED CHARACTER [401]
CAIN T2,C.TE ;CONVERT SPECIAL EOL [401]
MOVEI T2,0 ; TO EOL [401]
JUMPG T2,PSCAN1 ;IF SOME END [401]
SKIPGE FLJCNM ; AND JUST COMMAND LINE [401]
SETZM SAVCHR ; THEN CLEAR RE-EAT OF EOL [401]
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]
JRST QSCAN0 ;CONTINUE INTO QSCAN
.QSCAN::MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC (FOR FXVERC)
QSCAN0: 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.BLK+.FXDEV ;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
JRST SSCAN0 ;CONTINUE INTO SSCAN
;.SSCAN -- ENTRY TO ALLOW CALLER TO RESET SCAN'S SWITCH TABLES
;CALL IS SAME AS .TSCAN/VSCAN/ETC FOR BLOCK+0 - BLOCK+4
.SSCAN::MOVE T4,0(P) ;GET CALLER'S RETURN ADDRESS
MOVEM T4,SAVUPC ;SAVER ORIGINAL USER PC (FOR FXVERC)
SSCAN0: ;FALL INTO SETPR4
;SETPR4 -- SUBROUTINE TO STORE STANDARD PARAMETERS FROM GLOBAL CALLS
; HANDLES ARGUMENT BLOCK THROUGH BLOCK+4
;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
ANDI T1,-1 ;*X* ASSUME SAME SECTION, MAKE LOCAL INDEX
PUSHJ P,.GTWRD## ;GET BLOCK+0
PUSHJ P,FXVERC ;VERIFY CALLER'S PROTOCOL VERSION
PUSHJ P,.GTWRD## ;GET BLOCK+1
MOVEM T3,SWTPTR ;SAVE POINTER FOR SCANNING
ADDI T3,1 ;ADVANCE TO TABLE POINTER
HRLI T3,(IFIW (P1)) ;*X* INCLUDE SECTION-LOCAL INDEX
MOVEM T3,SWTCHN ;SET ADDRESS FOR MESSAGES
PUSHJ P,.GTWRD## ;GET BLOCK+2
HLRZ T4,T3 ;GET DEFAULT TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,(IFIW (P1)) ;*X* INCLUDE SECTION-LOCAL 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,(IFIW (P1)) ;*X* INCLUDE SECTION-LOCAL INDEX
MOVEM T4,SWTCHM ;STORE FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+3
HRRZ T4,T3 ;GET STORAGE POINTER TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,(IFIW (P1)) ;*X* INCLUDE SECTION-LOCAL INDEX
MOVEM T4,SWTCHP ;STORE FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+4
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
INICMD: ;FOR NOW, THE SAME
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
;VERIFY THE CALLER'S PROTOCOL VERSION AND SCAN'S VERSION ARE THE SAME
;CALL IS:
;
; MOVX T3,<VERSION>
; PUSHJ P,FXVERC
; RETURN
;
;WHERE <VERSION> IS THE PROTOCOL VERSION WORD IN <MAJOR>,,<MINOR> FORMAT.
;
;IF THE VERSIONS DON'T MATCH, AN ERROR MESSAGE IS PRINTED AND THE PROGRAM
;IS ABORTED.
;
;USES NO ACS.
FXVER: 12,,%%FXVE ;SCAN'S VERSION WORD
FXVERC::CAMN T3,FXVER ;VERSIONS THE SAME?
POPJ P, ;YES, OK
FXVERE: MOVEI T1,0 ;SELECT NO TYPEOUT ROUTINE
PUSHJ P,.TYOCH## ;SO OUTPUT GOES TO CONTROLLING TERMINAL (IF ANY)
RESET ;"STOP THE WORLD" - FAILSA
PUSH P,T3 ;SAVE CALLER'S BAD VERSION
MOVE T1,['SCN',,'MVI'] ;ERROR PREFIX
HLRZ T2,T3 ;GET MAJOR VERSION
CAIE T2,12 ;MAJOR VERSION THE SAME?
JRST FXVERM ;NO, MAJOR INCOMPATIBILITY
MOVE T2,["?",,[ASCIZ\Minor SWIL version incompatibility!\]]
XMOVEI T3,@SAVUPC ;FETCH ORIGINAL CALLER'S PC+1
PUSHJ P,.ERMSA## ;START UP ERROR PROCESSING
POP P,T3 ;RESTORE CALLER'S BAD VERSION
TXNN T1,JWW.FL!JWW.CN;IF /MESSAGE:FIRST!CONTINUATION
JRST FXVERX ;NOT, JUST EXIT
PUSHJ P,FXVERT ;TYPE OUT THE VERSIONS
MOVEI T1,[ASCIZ\;
Recompile and reload calling program with correct version of SWIL!\]
JRST FXVERW ;CAP OFF ERROR AND EXIT
FXVERM: MOVE T2,["?",,[ASCIZ\Major SWIL version incompatibility!\]]
XMOVEI T3,@SAVUPC ;FETCH ORIGINAL CALLER'S PC+1
PUSHJ P,.ERMSA## ;START UP ERROR PROCESSING
POP P,T3 ;RESTORE CALLER'S BAD PROTOCOL VERSION
TXNN T1,JWW.FL!JWW.CN;IF /MESSAGE:FIRST!CONTINUATION
JRST FXVERX ;NOT, JUST EXIT
PUSHJ P,FXVERT ;LIST THE VERSIONS
MOVEI T1,[ASCIZ\;
Changes required in calling program logic interface with SWIL!\]
FXVERW: PUSHJ P,.TSTRG## ;OUTPUT THE STRING
FXVERX: PUSHJ P,.TCRLF## ;CAP OFF SUMMARY
EXIT ;AND THAT IS THAT
;COMMON HELPER FOR PROTOCOL VERSION TYPEOUT
FXVERT: PUSH P,T3 ;SAVE THE BAD PROTOCOL VERSION
MOVEI T1,[ASCIZ\
Calling program's protocol version is \]
PUSHJ P,.TSTRG## ;OUTPUT THE STRING
HLRZ T1,0(P) ;EXTRACT MAJOR VERSION
PUSHJ P,.TOCTW## ;TYPE OUT MAJOR VERSION
PUSHJ P,.TCOMA## ;SEPARATE WITH A ",
PUSHJ P,.TCOMA## ; ,"
POP P,T1 ;FETCH MINOR VERSION
ANDI T1,-1 ;AND JUST MINOR VERSION
PUSHJ P,.TOCTW## ;TYPE OUT MINOR VERSION IN OCTAL
MOVEI T1,[ASCIZ\;
Called SWIL's protocol version is \]
PUSHJ P,.TSTRG## ;OUTPUT THE STRING
HLRZ T1,FXVER ;GET SCAN'S MAJOR VERSION
PUSHJ P,.TOCTW## ;TYPE IT OUT
PUSHJ P,.TCOMA## ;SEPARATE
PUSHJ P,.TCOMA## ; ",,"
HRRZ T1,FXVER ;GET SCAN'S MINOR VERSION
PUSHJ P,.TOCTW## ;TYPE IT OUT
MOVEI T1,[ASCIZ\;
Incompatible SWIL call was from user PC \]
PUSHJ P,.TSTRG## ;LIST NEXT LINE'S WORTH
XMOVEI T1,@SAVUPC ;GET ORIGINAL CALLER'S PC+1
HRRI T1,-1(T1) ;RELOCATE IT BACK TO THE CALLING PC
PJRST .TOCTW## ;AND TYPE IT OUT
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.BLK+.FXDEV ;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)
;**;[577] Insert @ E.FMO-1L JNG 18-Jan-77
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.BLK
IFN M$INDP,<
.GTINC::MOVE T1,INDCNT ;GET CURRENT COMMAND FILE NESTING LEVEL
POPJ P, ;RETURN IT TO CALLER
.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.BLK+.FXDEV ; ..
MOVEM T1,INDCNT ;TO LIMIT DEPTH
; THIS IS NEEDED TO PROTECT
; THE USER FROM INFINITE
; INDIRECT LOOPS (PARTICULARLY
; IF JACCT IS ON)
>
SKIPN A.BLK+.FXDEV ;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.BLK ;POINT TO @ AREA
MOVEI T2,.FXEZM ;AND ITS LENGTH
PUSHJ P,.GTSPC ;GO COPY SPEC
INDGT1: SETO T2, ;DEFAULT NON-WILD MASK
HRLOI T1,'CCL' ;DEFAULT IS CCL
SKIPN A.BLK+.FXEXT ;SKIP IF EXT SPECIFIED
MOVEM T1,A.BLK+.FXEXT ;SUPPLY DEFAULT FILE TYPE
HRLZ T1,CCLNAM ;GET DEFAULT FILE NAME
SKIPN A.BLK+.FXNAM ;SKIP IF NAME SPECIFIED
DMOVEM T1,A.BLK+.FXNAM ;SUPPLY DEFAULT FILE NAME
MOVSI T1,'DSK' ;DEFAULT DEVICE
SKIPN A.BLK+.FXDEV ;WAS A DEVICE SPECIFIED?
DMOVEM T1,A.BLK+.FXDEV ;SUPPLY DEFAULT DEVICE
MOVE T1,A.BLK+.FXDEV ;GET RESULTANT DEVICE SPECIFICATION
MOVE T2,A.BLK+.FXMOD ;AND THE ASSOCIATED FILE MODS
TXNN T2,FX.PHY ;WAS /PHYSICAL GIVEN?
TDZA T2,T2 ;NO
MOVEI T2,UU.PHY ;YES, DO DEVCHR PHYSICAL ONLY
DEVCHR T1,(T2) ;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.BLK ;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.BLK ;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,<
.RUNCK::SKIPE N.BLK+.FXFLD ;IF A FILE SPEC WAITING FOR /RUN
TDZA T1,T1 ;THEN /RUN:FILE WAS TYPED
SKIPE T1,N.BLK+.FXDEV ;DID /EXIT LEAVE DRIPPINGS?
AOS (P) ;NO, THEN NO /RUN/EXIT PROCESSING PENDING
POPJ P, ;RETURN AS APPROPRIATE
.RUNCL::SETZM N.BLK ;CLEAR START OF /RUN /EXIT BLOCK
MOVE T1,[N.BLK,,N.BLK+1] ;BLT POINTER TO
BLT T1,N.BLK+.FXEZM-1 ;CLEAR REST OF /RUN /EXIT BLOCK
POPJ P, ;RETURN HAVING CLEARED /RUN /EXIT
.RUNXT::PUSHJ P,.RUNCL ;CLEAR OUT ANY PENDING PROCESSING
MOVEI T1,1 ;A "YES" VALUE
MOVEM T1,N.BLK+.FXDEV ;PRETEND A /EXIT WAS TYPED
POPJ P, ;THAT'S ALL FOR NOW
.RUNCM::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF ERROR
PUSHJ P,.RUNCK ;SEE IF ANYTHING HERE TO DO
POPJ P, ;NO--RETURN [264]
JUMPN T1,[SETZM N.BLK+.FXDEV ;/EXIT, CLEAR IN CASE OF CONTINUE
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]
PUSHJ P,.CLOSU ;CLEAR ^O TTY OUTPUT SUPPRESSION
MOVEI T1,N.BLK ;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
MOVE T1,N.BLK+.FXFLD ;GET FIELDS FLAGS
TXNN T1,FX.UDV ;USER SPECIFY A DEVICE?
MOVSI T2,'SYS' ;NO--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: RUN T1, ;RUN THE PROGRAM
HALT . ;LET MONITOR DEAL WITH ERROR
E.RWI: MOVEI N,N.BLK ;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
;.FILSP -- INPUT FILE SPECIFICATION; RETURN ERROR (NO TYPEOUT)
;.FILSC -- IDENTICAL TO .FILSP, EXCEPT ALL DIRECTORIES ARE STORED
; AS CHARACTER STRINGS WHETHER THEY LOOK LIKE PPNS OR NOT
;
;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/FILSP
; 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,.FILSP ;PARSE THE FILE SPEC
JRST (T1) ;HANDLE ERROR (FOR NOW)
POPJ P, ;PROPAGATE SUCCESSFUL RETURN
.FILSC::PUSHJ P,.SAVE2## ;PRESERVE P1, P2
SETOM DIRMOD ;DIRECTORIES ARE CHARACTER STRINGS, NOT PPNS
JRST FILSP0 ;NOW DO THE WORK
.FILSP::PUSHJ P,.SAVE2## ;PRESERVE THE P'S
SETZM DIRMOD ;TREAT DIRECTORY SPECS IN ORDINARY MANNER
FILSP0: MOVE T1,SWTCNT ;GET RECURSION COUNTER [301]
PUSHJ P,.CLRFL ;GO CLEAR FXXX AREA
SETZ P2, ;START WITH NOTHING SEEN
JRST FILSP2 ;GO START THE READ
;HERE WHEN SOMETHING FOUND
FILSP1: SETOM FLFSP ;SET SOMETHING FOUND FLAG
;HERE TO START ANOTHER WORD
FILSP2: PUSHJ P,.TIAUC ;START THE READ
;HERE TO READ IN NEXT WORD
FILSP3: DMOVE T1,FSCTR ;### CURRENT STRING BUILDER
DMOVEM T1,NSCTR ;### TELL TIAUC TO BUILD ASCII STRING TOO
MOVE T1,LASCHR ;### REAL ACTUAL FIRST CHARACTER
CAIN T1,"""" ;START OF QUOTED STRING?
JRST FILS3A ;YES, SET THE FLAG
SOS NSCTR ;### NOTE HAVE FIRST CHARACTER
IDPB T1,NSPTR ;### START UP NAME STRING
TDZA T2,T2 ;NOT A QUOTED STRING: CLEAR FLAG
FILS3A: MOVEI T2,1 ;QUOTED STRING: SET THE FLAG
MOVEM T2,FLQUO ;
PUSHJ P,.NAMEC ;READ REST OF WORD
SKIPG NSCTR ;### DID STRING OVERFLOW?
JRST E.STB ;### YEAH, DIE
MOVNS NSCTR ;### FLAG TO STOP ACCUMULATION OF STRING
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE WITH WORD, SEE WHAT KIND OF SEPARATOR
FILSP4: CAIN C,"_" ;SEE IF NODE NAME
JRST FILNOD ;YES
CAIN C,":" ;SEE IF DEVICE
JRST FILDEV ;YES
;IF ANYTHING TYPED, THEN IT MUST BE A FILE NAME
JUMPE N,FILSP6 ;IF NULL, NOT A FILE NAME
TXNE P2,FX.UNM ;MUST BE A FILENAME, BEEN HERE BEFORE?
JRST E.DFN ;ERROR IF TWO
MOVEM P2,F.BLK+.FXFLD ;SET FIELDS SO FAR FOR FILSTK
PUSHJ P,FILSTK ;GO MEMORIZE STICKY DEFAULTS
TXO P2,FX.UNM ;NOW SET FILENAME SEEN FLAG
SKIPE FLQUO ;IS THE FILE NAME A QUOTED STRING?
TXO P2,FX.UQN ;YES, SET THE FLAG BIT
PUSHJ P,.LEFTX ;GUARANTEE LH=0
MOVEM N,F.BLK+.FXNAM ;OK--SAVE NAME
MOVEM T1,F.BLK+.FXNMM ;AND MASK
AOJE T1,.+2 ;WILDCARDS PRESENT?
TXO P2,FX.WNM ;YES, NOTE FILE NAME WILDCARDS
HRRZ T4,FSPTR ;### ADDRESS OF LAST STRING BUILT
MOVEM T4,F.BLK+.FSNAM ;### SET FILE NAME STRING
PUSHJ P,FLEOS ;### HANDLE END OF NAME STRING
SETOM FLFSP ;FLAG THAT SOMETHING FOUND
;DISPATCH BASED ON TYPE OF FIELD COMING UP NEXT
FILSP6: 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 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 FILSQ0 ;YES
CAIN C,"/" ;SEE IF SWITCH
JRST FILSW ;YES
CAIN C," " ;SEE IF WORD SEPARATOR
JRST FILSP2 ;YES--LOOP BACK FOR MORE WORK
; JRST FILSQ0 ;NOT A FILE SPECIFICATION FIELD, END OF SCAN
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
FILSQ0: MOVEM P2,F.BLK+.FXFLD ;SET FIELDS SEEN SO FAR
SKIPN F.BLK+.FXNAM ;SKIP IF FILE NAME SPECIFIED
PUSHJ P,FILSTK ;NO, SAVE STICKY DEFAULTS
;IF SPECIFICATION WAS OF FORM [P,PN].UFD THEN FAKE UP THE FILE SPEC BLOCK
;A LITTLE TO MAKE THE "OBVIOUSLY INTENDED" THING HAPPEN . . .
MOVS T1,F.BLK+.FXEXT ;GET THE FILE TYPE (IF ANY)
TLC T1,-1 ;LH:=0 IF NO WILDCARDS IN TYPE/EXTENSION
CAIN T1,'UFD' ;A "USER-FILE-DIRECTORY"?
SKIPE F.BLK+.FXNAM ;AND STILL ROOM FOR A FILE NAME?
JRST FILSQ3 ;NO, NO FUNNY STUFF HERE THEN
MOVE T1,F.BLK+.FXFLD ;GET FIELDS FLAGS
SKIPE F.BLK+.FXDIR+2 ;DON'T USE PPN IF ACCOMPANIED BY SFDS
TXNE T1,FX.DPN!FX.DPJ;UNLESS THEY CAME FROM [] OR [-]
CAIA ;OK TO USE PPN
JRST FILSQ3 ;FORGET IT
;USER SPECIFIED [P,PN].UFD OR .UFD AND NOT (E.G.) *.UFD OR [P,PN,SFD].UFD
;FUDGE THE FILE NAME TO BE THE SPECIFIED PPN, AND SET THE ACTUAL DIRECTORY
;TO BE MFDPPN
MOVE T1,F.BLK+.FSDIR ;### GET DIRECTORY NAME STRING
MOVEM T1,F.BLK+.FSNAM ;### AND MAKE IT THE FILE NAME
SKIPN T1,F.BLK+.FXDIR ;GET USER-SPECIFIED PPN NAME
SKIPA T1,.MYPPN ;NONE-SPECIFIED - ASSUME A DEFAULT
SKIPA T2,F.BLK+.FXDIM ;GET USER-SPECIFIED PPN MASK
SETO T2, ;NONE-SPECIFIED - DEFAULT IS NON-WILD
DMOVEM T1,F.BLK+.FXNAM ;SET DESIRED NAME TO BE PPN(S)
MOVE T1,.PPMFD ;MASTER-FILE-DIRECTORY PPN
SETO T2, ;WHICH IS NON-WILD
DMOVEM T1,F.BLK+.FXDIR ;FUDGE THE DIRECTORY SPECIFICATION
SETZM F.BLK+.FXDIR+2 ;CLEAR START OF REST OF DIRECTORY
MOVE T1,[F.BLK+.FXDIR+2,,F.BLK+.FXDIR+2+1] ;BLT POINTER TO
BLT T1,F.BLK+.FXDIR+<2*.FXLND>-1 ;CLEAR REST OF DIRECTORY
MOVE T1,F.BLK+.FXFLD ;FETCH THE FIELDS-TYPED WORD
TXO T1,FX.DNP ;NOTE THAT THE NAME IS PPN FORMAT
TXZE T1,FX.UDR ;IF USER EXPLICITLY SUPPLIED DIRECTORY
TXO T1,FX.UNM ;THEN IT IS NOW A NAME
TXZE T1,FX.SDR ;IF THE DIRECTORY CAME FROM STICKYNESS
TXO T1,FX.SNM ;THEN THE NAME CAME FROM STICKYNESS
TXZE T1,FX.WDR ;IF THE DIRECTORY HAD WILDCARDS
TXO T1,FX.WNM ;THEN THEY ARE IN THE NAME NOW
TXZE T1,FX.DPJ ;IF PROJECT FIELD WAS DEFAULTED,
TXO T1,FX.DNJ ;THEN CARRY OVER THE DEFAULTEDNESS
TXZE T1,FX.DPG ;IF PROGRAMMER FIELD WAS DEFAULTED,
TXO T1,FX.DNG ;THEN CARRY OVER THE DEFAULTEDNESS
TXZE T1,FX.DPN!FX.DPT;IF PATH WAS DEFAULTED,
TXO T1,FX.DNT ;THEN CARRY OVER THE DEFAULTEDNESS
MOVEM T1,F.BLK+.FXFLD ;SET NEW FIELDS FLAGS
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;SET FILE EXPRESSION TERMINATOR (OPERATOR)
FILSQ3: MOVX T3,FX.TRM ;PREPARE TO SEE IF CONCATENATOR [247]
IORM T3,F.BLK+.FXMOM ;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]
CAIL C,.CHGWD ;IN RANGE OF GUIDEWORDS
CAILE C,.CHGWD+37 ; (SUCH AS 'OR' ETC.)
CAIA ;NO
MOVEI T3,-.CHGWD(C) ;YES, SET APPROPRIATE TERMINATION CODE
DPB T3,[POINTR (F.BLK+.FXMOD,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
JRST .POPJ1## ;SUCCESSFUL 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
JUMPL T1,FILSW3 ;IF END, FLAG SPEC
....==FS.NFS
TXO P2,FX.UFS ;NOTE A FILE-SPECIFIC SWITCH
JRST FILSPR ;CHECK OUT NEW BREAK
FILSW3: TXNE T1,FS.NCM ;SEE IF NOT IN COMMAND [516]
JRST FILSPN ;GO LOOK AT BREAK CHAR
SKIPN FLFSP ;NOT A COMMAND SWITCH, [516]
AOS FLFSP ;IF ONLY THING, INDICATE SAME [516]
TXO P2,FX.UGS ;NOTE A GLOBAL SWITCH TYPED
JRST FILSPN ; AND NOTHING ELSE [516]
;HERE WHEN UNDERSCORE OR COLON COLON SEEN - PREVIOUS WORD IS NODE NAME
FILNOD: JUMPE N,E.NNO ;ERROR IF NO NAME PRESENT
TXOE P2,FX.UND ;NOTE A NODE FIELD TYPED
JRST E.DNO ;ERROR IF TWO
MOVEM N,F.BLK+.FXNOD ;STASH NODE NAME IN FILE SPEC BLOCK
MOVE T1,MASK ;GET ASSOCIATED WILDCARDS
MOVEM T1,F.BLK+.FXNOM ;SAVE WILDCARD MASK TOO
AOJE T1,.+2 ;ANY WILDCARDS PRESENT?
TXO P2,FX.WND ;YES, FLAG NODE WILDCARDS
HRRZ T4,FSPTR ;### ADDRESS OF LAST STRING BUILT
MOVEM T4,F.BLK+.FSNOD ;### BECOMES ADDRESS OF NODE NAME STRING
PUSHJ P,FLEOS ;### ASCIIZE LAST STRING, SET FOR NEXT ONE
JRST FILSP1 ;GO READ SOME MORE
;HERE WHEN COLON SEEN -- PREVIOUS WORD IS DEVICE
FILDEV: PUSHJ P,.TIAUC ;PEEK AT THE NEXT CHARACTER
CAIN C,":" ;"::" (I.E., NODE NAME)?
JRST FILNOD ;YES, PROCESS AS NODE NAME THEN
PUSHJ P,.REEAT ;NO, SAVE CHARACTER FOR .NAMEC
JUMPE N,E.NDV ;ERROR IF NO DEVICE
TXOE P2,FX.UDV ;NOTE A DEVICE FIELD TYPED
JRST E.DDV ;ERROR IF TWO
MOVEM N,F.BLK+.FXDEV ;SAVE
MOVE T1,MASK ;GET ASSOCIATED WILDCARDS
MOVEM T1,F.BLK+.FXDEM ;SAVE WILDCARD MASK TOO
AOJE T1,.+2 ;ANY WILDCARDS PRESENT?
TXO P2,FX.WDV ;NOTE DEVICE WILDCARDS
MOVX T1,FX.NDV ;(OBSOLETE) NOTE THAT
ANDCAM T1,F.BLK+.FXMOD ;(OBSOLETE) DEVICE SPECIFIED
HRRZ T4,FSPTR ;### ADDRESS OF LAST STRING BUILT
MOVEM T4,F.BLK+.FSDEV ;### BECOMES ADDRESS OF DEVICE NAME STRING
PUSHJ P,FLEOS ;### ASCIIZE LAST STRING, SET FOR NEXT ONE
JRST FILSP1 ;GO READ SOME MORE
;HERE WHEN PERIOD SEEN -- NEXT WORD IS EXTENSION
FILEXT: DMOVE T1,FSCTR ;### GET STRING BUILDER PROTOTYPE
DMOVEM T1,NSCTR ;### AND SET FOR BUILDING A NEW STRING
PUSHJ P,.NAMEW ;GO GET THE EXTENSION
SKIPG NSCTR ;### DID STRING OVERFLOW?
JRST E.STB ;### YES, DIE
MOVNS NSCTR ;### CLEAR STRING BUILDER
HRRZ T4,FSPTR ;### ADDRESS OF LAST STRING BUILT
MOVEM T4,F.BLK+.FSEXT ;### BECOMES ADDRESS OF EXTENSION NAME STRING
PUSHJ P,FLEOS ;### ASCIIZE LAST STRING, SET FOR NEXT ONE
PUSHJ P,.LEFTX ;PUT INTO LEFT HALF-WORD
TXOE P2,FX.UEX ;NOTE AN EXTENSION TYPED
JRST E.DEX ;ERROR IF TWO
HLR N,MASK ;PUT MASK IN RIGHT HALF
MOVEM N,F.BLK+.FXEXT ;SAVE
HRLO T1,N ;GET WILDCARD MASK
AOJE T1,.+2 ;ANY WILDCARDS PRESENT?
TXO P2,FX.WEX ;YES, NOTE EXTENSION WILDCARDS
MOVX T1,FX.NUL ;(OBSOLETE) THE NULL EXTENSION BIT
ANDCAM T1,F.BLK+.FXMOD ;(OBSOLETE) WE HAVE AN EXPLICIT EXTENSION
ANDCAM T1,F.BLK+.FXMOM ;(OBSOLETE) SO CLEAR OLD CRUFTY BIT
PUSHJ P,.TINBC ;GET TO NON-BLANK TERMINATOR
CAIE C,"." ;FILE GENERATION COMING UP?
JRST FILSPR ;NO, GO PROCESS NEW BREAK
FILGEN: TXOE P2,FX.UGN ;NOTE GENERATION SEEN
JRST E.DEG ;DUPLICATE GENERATION SEEN ERROR
DMOVE T1,FSCTR ;### GET STRING BUILDER PROTOTYPE
DMOVEM T1,NSCTR ;### AND SET FOR BUILDING A NEW STRING
PUSHJ P,.TIAUC ;GET FIRST CHARACTER OF GENERATION
CAIN C,"*" ;WILD-CARD GENERATION?
JRST FILGEW ;YES
PUSHJ P,.DECNC ;NO, READ IN DECIMAL GENERATION NUMBER
MOVEM N,F.BLK+.FXGEN ;STASH IN FILE SPEC BLOCK
JRST FILGEX ;AND PROCESS NEW BREAK
FILGEW: TXO P2,FX.WGN ;NOTE WILD GENERATION SUPPLIED
MOVSI N,'* ' ;PSEUDO-WILDCARD
MOVEM N,F.BLK+.FXGEN ;STUFF SOMETHING INTO GENERATION FIELD
PUSHJ P,.TIAUC ;SKIP THE "*" CHARACTER
FILGEX: SKIPG NSCTR ;### DID STRING FIT?
JRST E.STB ;### NO, DIE
MOVNS NSCTR ;### CLEAR STRING BUILDER
HRRZ T4,FSPTR ;### ADDRESS OF LAST STRING BUILT
MOVEM T4,F.BLK+.FSGEN ;### BECOMES ADDRESS OF NODE NAME STRING
PUSHJ P,FLEOS ;### ASCIIZE LAST STRING, SET FOR NEXT ONE
JRST FILSPR ;AND 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]
MOVEM P2,F.BLK+.FXFLD ;SAVE MASK OF FIELDS SEEN SO FAR FOR FILSTK
PUSHJ P,FILSTK ;REMEMBER STICKY DEFAULTS [534]
JRST FILSP0 ;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 FILSP2 ;AND CONTINUE THIS SPEC [534]
;HERE WHEN LEFT SQUARE BRACKET SEEN -- DIRECTORY COMING
;
;SPECIAL FORMS ARE:
;
; [] NO DIRECTORY WANTED
; [-] JOB DEFAULT PATH
; [,] JOB LOGGED-IN DIRECTORY
FILDIR: TXOE P2,FX.UDR ;HAS A DIRECTORY BEEN SEEN?
JRST E.DDR ;ERROR IF TWO SEEN
DMOVE T1,FSCTR ;### PROTOTYPE STRING BUILDER
DMOVEM T1,NSCTR ;### ENABLE STRING STUFFER
MOVX P1,FX.DIR ;(OBSOLETE) GET DIRECTORY FLAG
IORM P1,F.BLK+.FXMOD ;(OBSOLETE) SET DIRECTORY SEEN
IORM P1,F.BLK+.FXMOM ;(OBSOLETE) SET DIRECTORY SEEN
PUSHJ P,.TINBL ;GET FIRST DIRECTORY CHARACTER
CAIN C,"]" ;USER REQUESTING NO DIRECTORY?
JRST FILDR7 ;YES, SET IN FILE SPEC BLOCK
CAIN C,"-" ;USER REQUESTING DEFAULT PATH?
JRST FILDR6 ;YES, SET IN FILE SPEC BLOCK
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE FOR "CONVENTIONAL" PROJECT,PROGRAMMER COMBINATION
FILDR0: PUSHJ P,.NOCTC ;GET OCTAL NAME
SKIPN DIRMOD ;ARE WE FORCIBLY TREATING DIRECTORIES AS STRINGS?
JRST FILDR1 ;NO -- SEE WHAT KIND WE HAVE
JRST FILD1A ;YES -- GO STORE IT AND MOVE ON
FILDR1: PUSHJ P,.LEFTX ;MOVE TO LEFT HALF-WORD
TLNE T1,(1B0) ;SEE IF WILD-CARD OFF
JUMPL N,FILD1A ;AND SIXBIT TYPEIN
CAIN C,"." ;IF FIRST FIELD DELIMITED BY "."
JRST FILD1B ;SEE IF IT'S T-20 STYLE
CAIE C,"," ;MUST HAVE COMMA NOW
JRST E.CDR ;ERROR IF NOT
FILD10: 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
TLNN N,-1 ;NOW, DID USER TYPE "[,"?
TXOA P2,FX.DPJ ;YES, REMEMBER PROJECT FIELD DEFAULTED
CAIA ;NO, USE WHATEVER WAS SUPPLIED VERBATIM
HLL N,.MYPPN ;SUPPLY DEFAULT PROJECT
HLLZM N,F.BLK+.FXDIR ;SET PROJECT SPECIFICATION
HLLZM T1,F.BLK+.FXDIM ;AND MASK
IORI T1,-1 ;IGNORE R.H.
AOJE T1,.+2 ;WILDCARDS PRESENT?
TXO P2,FX.WDR ;NOTE WILDCARDS IN DIRECTORY
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
TLNN N,-1 ;DID USER TYPE [,] OR THE LIKE?
TXOA P2,FX.DPG ;YES, REMEMBER PROGRAMMER FIELD DEFAULTED
CAIA ;NO, USE WHATEVER WAS SUPPLIED VERBATIM
HRL N,.MYPPN ;SUPPLY PROGRAMMER DEFAULT
HLRM N,F.BLK+.FXDIR ;SET PROGRAMMER SPECIFICATION
HLRM T1,F.BLK+.FXDIM ;AND MASK
IORI T1,-1 ;IGNORE R.H.
AOJE T1,FILDR2 ;WILDCARDS PRESENT?
TXO P2,FX.WDR ;NOTE WILDCARDS IN DIRECTORY
JRST FILDR2 ;AND CARRY ON
;HERE IF FIELD IS SIXBIT
FILD1A: MOVEM N,F.BLK+.FXDIR ;STORE THE NAME
MOVEM T1,F.BLK+.FXDIM ;AND THE MASK
AOJE T1,FILDR2 ;WILDCARDS PRESENT?
TXO P2,FX.WDR ;NOTE WILDCARDS IN DIRECTORY
JRST FILDR2 ;AND CARRY ON
;EXAMINE THE TYPE OF DIRECTORY
FILD1B: CAME N,[377777000000];WAS IT "OCTAL" *
JRST FILD10 ;NO
JUMPN T1,FILD10 ;NO
MOVSI N,'* ' ;YES, TREAT AS -20 STYLE THEN
MOVEM N,F.BLK+.FXDIR ;SET FULL WILD DIRECTORY
MOVEM T1,F.BLK+.FXDIM ;AND RELATED MASK
TXO P2,FX.WDR ;FLAG DIRECTORY WILDCARDS
JRST FILDR2 ;GO CHECK OUT SUB-DIRECTORIES
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
FILDR2: MOVEI P1,F.BLK+.FXDIR ;PRESET TO ACCUMULATE SUB-DIRECTORIES
FILDR3: CAIE C,"," ;SEE IF SFD NEXT
CAIN C,"." ; (ALTERNATE WAY OF GIVING "SFD")
CAIA ;YES, SLURP UP ANOTHER SFD
JRST FILDR9 ;NO--EXIT DIRECTORY CODE
ADDI P1,2 ;ADVANCE ACCUMULATION POINTER
CAIL P1,F.BLK+.FXDIR+2*.FXLND ;PROHIBIT OVERFLOW
JRST E.SFD ;NO--BOMB USER
PUSHJ P,.NAMEW ;GET WILD NAME
PUSHJ P,.LEFTX ;FORCE TO LEFT END
MOVEM N,(P1) ;STORE NAME
MOVEM T1,1(P1) ;AND MASK
JUMPE N,E.NSF ;NULL FIELD--ERROR
AOJE T1,.+2 ;SEE IF ANY WILDCARDS IN THIS SFD
TXO P2,FX.WDR ;NOTE WILDCARDS IN DIRECTORY
JRST FILDR3 ;AND LOOP FOR MORE
;HERE FOR "[-]"
FILDR6: PUSHJ P,.TIAUC ;ADVANCE PAST THE "-"
TXOA P2,FX.DPT ;REMEMBER EXPLICIT DEFAULT PATH
;HERE FOR "[]"
FILDR7: TXO P2,FX.DPN ;REMEMBER ACTUALLY ASKED FOR NO PATH
MOVX T2,FX.DIR ;(OBSOLETE) CLEAR DIRECTORY FLAG
ANDCAM T2,F.BLK+.FXMOD ;(OBSOLETE) TO INDICATE [-]/[]
SETO T2, ;INDICATE NO WILDCARDS
SETZ T3, ;BIWORD INDEX
MOVSI T4,-.FXLND ;AOBJN COUNTER/INDEX FOR DEFAULT PATH
FILDR8: SKIPN T1,.MYPTH+.PTPPN(T4) ;GET DEFAULT PATH ENTRY
SETZ T2, ;ENDED, CLEAR MASK TOO
DMOVEM T1,F.BLK+.FXDIR(T3) ;SET INTO THE FILE SPEC BLOCK
ADDI T3,2 ;ADVANCE BI-WORD INDEX
AOBJN T4,FILDR8 ;LOOP FOR ENTIRE PATH POSSIBILITY
;HERE TO VERIFY END OF DIRECTORY - MUST BE "]" OR END OF LINE
FILDR9: SKIPG NSCTR ;### DID DIRECTORY STRING FIT?
JRST E.STB ;### NO, DIE
MOVNS NSCTR ;### CLEAR STRING BUILDER
HRRZ T4,FSPTR ;### ADDRESS OF LAST STRING BUILT
MOVEM T4,F.BLK+.FSDIR ;### BECOMES ADDRESS OF DIRECTORY NAME STRING
PUSHJ P,FLEOS ;### ASCIIZE LAST STRING, SET FOR NEXT ONE
PUSHJ P,.TINBC ;GOBBLE UP ANY BLANKS
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,FILSP1 ;PROCESS SEPARATOR UNLESS EOL
JRST FILSPR ;BACK FOR MORE
;HERE WHEN NEXT BREAK CHARACTER TO BE ANALYZED
FILSPR: SETOM FLFSP ;NOTE THAT SOMETHING HAS HAPPENED
FILSPN: JRST FILSP3 ;AND GO PROCESS SEPARATOR
;.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.BLK+.FXBZM ;ZERO FILE RESULT AREA
MOVE T2,[F.BLK+.FXBZM,,F.BLK+.FXBZM+1]
BLT T2,F.XZER
MOVEI T2,<.FSLXX*5> ;### MAXIMUM STRING CHARACTERS
MOVEM T2,FSCTR ;### SET IN PROTOTYPE STRING BUILDER
MOVE T2,[POINT 7,F.BLK+.FSXXX] ;### BYTE POINTER TO STRING AREA
MOVEM T2,FSPTR ;### SET IN PROTOTYPE STRING BUILDER
SETOM F.BLK+.FXBOM ;CLEAR SWITCHES [346]
MOVE T2,[F.BLK+.FXBOM,,F.BLK+.FXBOM+1]
BLT T2,F.BLK+.FXEOM-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 ;(OBSOLETE) GET NULL DEVICE BIT
IORM T1,F.BLK+.FXMOD ;(OBSOLETE) SET IN MOD WORD
IORM T1,F.BLK+.FXMOM ;(OBSOLETE) SET IN MASK
POPJ P, ;RETURN
;FLEOS - SET END OF FILE SPECIFICATION COMPONET STRING
FLEOS: PUSHJ P,.SAVE3## ;### NEED SOME P ACS
SETZ P1, ;### A NULL CHARACTER
MOVN P2,NSCTR ;### THE BYTE COUNTER
MOVE P3,NSPTR ;### AND THE BYTE POINTER
DPB P1,P3 ;### TERMINATE THE ASCIZ STRING
FLEOS2: TLNN P3,760000 ;### ANY BYTES LEFT IN THE CURRENT WORD?
JRST FLEOS5 ;### NO
IDPB P1,P3 ;### YES, FILL OUT TO END OF WORD
SOJA P2,FLEOS2 ;### COUNT DOWN TOTAL ROOM LEFT
FLEOS5: ADDI P3,1 ;### ADVANCE BYTE POINTER TO START OF WORD
HRLI P3,(POINT 7,) ;### SO THAT HRRZ'S WORK . . .
DMOVEM P2,FSCTR ;### ADVANCE MASTER STRING BUILDER PROTOTYPE
POPJ P, ;### RETURN
;.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
JRST [OUTSTR [ASCIZ\? .GTSPC called pointing to the ACS/JOBDAT\]
EXIT] ;THIS IS A FATAL ERROR!!!
MOVEI T3,APLSTD ;SET DSK: DEFAULTER
SKIPE SWTCNT ;IF TOP LEVEL
SKIPGE FLVERB ;OR VERB
MOVEI T3,APLSTK ;SET FULL DEFAULTER
PUSH P,T1 ;SAVE T1
PUSH P,T2 ; AND T2
PUSHJ P,(T3) ;GO SET DEFAULTS
DMOVE T1,-1(P) ;RESTORE T1 (ADDRESS) AND T2 (LENGTH)
CAILE T2,.FXLEN ;MAKE SURE NOT TOO LONG
MOVEI T2,.FXLEN ;SHRINK IF SO
ADDI T2,(T1) ;COMPUTE END PLUS ONE
HRLI T1,F.BLK ;COPY FROM F.XXX
BLT T1,-1(T2) ; TO END OF AREA
MOVE T1,-1(P) ;### ADDRESS OF USER BLOCK
MOVEI T2,F.BLK ;### ADDRESS OF OUR FILE SPEC BLOCK
SUBM T1,T2 ;### T2 := DIFFERENCE IN ABSOLUTE ADDRESS
ADD T1,[-6,,.FSNOD] ;### AOBJN POINTER TO STRING POINTERS
SKIPE 0(T1) ;### GOT A STRING ADDRESS?
ADDM T2,0(T1) ;### YES, RELOCATE IT
AOBJN T1,.-2 ;### RELOCATE ALL POSSIBLE STRINGS
POP P,T2 ;RESTORE T2
POP P,T1 ;AND T1
POPJ P, ;RETURN
;FILSTK -- MEMORIZE STICKY DEFAULTS
;CALL: PUSHJ P,FILSTK
; RETURNS AFTER NON-ZERO F.XXX COPIED TO P.XXX
;USES T1, T2
FILSTK: PUSHJ P,.SAVE1## ;NEED ANOTHER AC
SKIPE SWTCNT ;SEE IF NESTED SWITCH
SKIPGE FLVERB ;NO--SEE IF VERB MODE
SKIPA
POPJ P, ;YES--DON'T SAVE
MOVE P1,F.BLK+.FXFLD ;GET FIELD FLAGS
MOVSI T1,(FX.UXX) ;ALL USER-SUPPLIED STUFF
AND T1,P1 ;GET JUST FX.U?? FLAGS
LSH T1,-^D18 ;POSITION OVER CORRESPONDING WILDCARDS
ANDCAM T1,P.BLK+.FXFLD ;CLEAR OLD WILDCARDS
IORM P1,P.BLK+.FXFLD ;SET NEW STICKY STUFF
FILST1: TXNN P1,FX.UND ;USER SPECIFY A NODE NAME?
JRST FILST2 ;NO
DMOVE T1,F.BLK+.FXNOD ;GET USER NODE
DMOVEM T1,P.BLK+.FXNOD ;REMEMBER IT FOR DEFAULTS
MOVE T1,F.BLK+.FSNOD ;ADDRESS OF NODE STRING
MOVEI T2,P.SNOD ;HOLDING AREA FOR STICKY NODE
MOVEM T2,P.BLK+.FSNOD ;SET STICKY NODE STRING ADDRESS
PUSHJ P,FILSBL ;AND COPY OVER STICKY NODE STRING
FILST2: TXNN P1,FX.UDV ;USER SPECIFY A DEVICE?
JRST FILST3 ;NO
DMOVE T1,F.BLK+.FXDEV ;GET USER DEVICE
DMOVEM T1,P.BLK+.FXDEV ;REMEMBER IT FOR DEFAULTS
MOVE T1,F.BLK+.FSDEV ;ADDRESS OF DEVICE STRING
MOVEI T2,P.SDEV ;HOLDING AREA FOR STICKY DEVICE
MOVEM T2,P.BLK+.FSDEV ;SET STICKY DEVICE STRING ADDRESS
PUSHJ P,FILSBL ;AND COPY OVER STICKY DEVICE STRING
FILST3: TXNN P1,FX.UDR ;USER SPECIFY A DIRECTORY?
JRST FILST4 ;NO
MOVE T1,[F.BLK+.FXDIR,,P.BLK+.FXDIR] ;BLT POINTER TO
BLT T1,P.BLK+.FXDIR+.FXLND+.FXLND-1 ;REMEMBER STICKY DIRECTORY
MOVE T1,F.BLK+.FSDIR ;ADDRESS OF DIRECTORY STRING
MOVEI T2,P.SDIR ;HOLDING AREA FOR STICKY DIRECTORY
MOVEM T2,P.BLK+.FSDIR ;SET STICKY DIRECTORY STRING ADDRESS
PUSHJ P,FILSBL ;AND COPY OVER STICKY DIRECTORY STRING
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
FILST4: TXNN P1,FX.UNM ;USER SPECIFY A FILE NAME?
JRST FILST5 ;NO
DMOVE T1,F.BLK+.FXNAM ;GET USER NAME
DMOVEM T1,P.BLK+.FXNAM ;REMEMBER IT FOR DEFAULTS
MOVE T1,F.BLK+.FSNAM ;ADDRESS OF NAME STRING
MOVEI T2,P.SNAM ;HOLDING AREA FOR STICKY NAME
MOVEM T2,P.BLK+.FSNAM ;SET STICKY NAME STRING ADDRESS
PUSHJ P,FILSBL ;AND COPY OVER STICKY NAME STRING
FILST5: TXNN P1,FX.UEX ;USER SPECIFY AN EXTENSION?
JRST FILST6 ;NO
MOVE T1,F.BLK+.FXEXT ;GET USER EXTENSION
MOVEM T1,P.BLK+.FXEXT ;REMEMBER IT FOR DEFAULTS
MOVE T1,F.BLK+.FSEXT ;ADDRESS OF EXTENSION STRING
MOVEI T2,P.SEXT ;HOLDING AREA FOR STICKY EXTENSION
MOVEM T2,P.BLK+.FSEXT ;SET STICKY EXTENSION STRING ADDRESS
PUSHJ P,FILSBL ;AND COPY OVER STICKY EXTENSION STRING
FILST6: TXNN P1,FX.UGN ;USER SPECIFY A GENERATION?
JRST FILST7 ;NO
MOVE T1,F.BLK+.FXGEN ;GET USER GENERATION
MOVEM T1,P.BLK+.FXGEN ;REMEMBER IT FOR DEFAULTS
MOVE T1,F.BLK+.FSGEN ;ADDRESS OF GENERATION STRING
MOVEI T2,P.SGEN ;HOLDING AREA FOR STICKY GENERATION
MOVEM T2,P.BLK+.FSGEN ;SET STICKY GENERATION STRING ADDRESS
PUSHJ P,FILSBL ;AND COPY OVER STICKY GENERATION STRING
FILST7: DMOVE T1,F.BLK+.FXCTL ;GET CONTROL FIELDS
ANDCAM T2,P.BLK+.FXMOD ;CLEAR OUT THE OLD STICKY FIELDS
IORM T1,P.BLK+.FXCTL ;AND SET IN THE NEW FIELDS
IORM T2,P.BLK+.FXCTM ; . . .
DMOVE T1,F.BLK+.FXMOD ;COPY FILE MODIFIERS
ANDCAM T2,P.BLK+.FXMOD
IORM T1,P.BLK+.FXMOD
IORM T2,P.BLK+.FXMOM
MOVSI T2,.FXBOM-.FXEOM;GET LENGTH OF SWITCHES [346]
FILST8: MOVE T1,F.BLK+.FXBOM(T2) ;GET CURRENT VALUE [346]
CAME T1,[-1] ;SEE IF SET [255,346]
MOVEM T1,P.BLK+.FXBOM(T2);YES--UPDATE STICKY VALUE [346]
AOBJN T2,FILST8 ;LOOP OVER SWITCHES [346]
SKIPE MEMSTK ;SEE IF USER WANTS CONTROL
PJRST @MEMSTK ;YES--GO TO HIM
POPJ P, ;RETURN
;APLSTK -- APPLY USER'S STICKY DEFAULTS
;APLSTD -- APPLY DEFAULT DEVICE IF INDICATED
;CALL: PUSHJ P,APLSTK/D
;USES T3, T4
APLSTK: PUSHJ P,.SAVE2## ;WANT ANOTHER AC HERE
MOVE P1,F.BLK+.FXFLD ;FIELDS SEEN SO FAR
MOVE P2,P.BLK+.FXFLD ;FIELDS PRESENT IN STICKY AREA
HRRZ T2,FSPTR ;### ADDRESS OF STRING BLOCK FREE POINT
APLSS1: SKIPN F.BLK+.FXNOD ;GOT A NODE SPECIFICATION?
TXNN P2,FX.UND ;NO, HAVE A STICKY FIELD TO SUPPLY?
JRST APLSS2 ;NO STICKY
DMOVE T3,P.BLK+.FXNOD ;GET STICKY NODE NAME
DMOVEM T3,F.BLK+.FXNOD ;SUPPLY HIS STICKY NODE NAME/MASK
MOVE T1,P.BLK+.FSNOD ;ADDRESS OF STICKY NODE STRING
MOVEM T2,F.BLK+.FSNOD ;SET APPLIED STICKY NODE STRING
PUSHJ P,FILSBL ;COPY OVER STICKY NODE STRING
TXO P1,FX.UND!FX.SND;NOTE A "STICKY" NODE NAME
TXNE P2,FX.WND ;NODE WILDCARDS?
TXO P1,FX.WND ;YES, NOTE THOSE TOO
APLSS2: SKIPN F.BLK+.FXDEV ;GOT A DEVICE SPECIFICATION?
TXNN P2,FX.UDV ;NO, STICKY DEVICE?
JRST APLSS3 ;NO STICKY DEVICE NAME
DMOVE T3,P.BLK+.FXDEV ;APPLY DEVICE--PICK UP STICKY
DMOVEM T3,F.BLK+.FXDEV ;NO--SUPPLY HIS STICKY DEVICE
MOVE T1,P.BLK+.FSDEV ;ADDRESS OF STICKY DEVICE STRING
MOVEM T2,F.BLK+.FSDEV ;SET APPLIED STICKY DEVICE STRING
PUSHJ P,FILSBL ;COPY OVER STICKY DEVICE STRING
TXO P1,FX.UDV!FX.SDV;NOTE A "STICKY" DEVICE NAME
TXNE P2,FX.WDV ;DEVICE WILDCARDS?
TXO P1,FX.WDV ;YES, NOTE THOSE TOO
APLSS3: SKIPN F.BLK+.FXDIR ;GOT A DIRECTORY SPECIFICATION?
TXNN P2,FX.UDR ;NO, STICKY DIRECTORY?
JRST APLSS4 ;NO STICKY DIRECTORY
MOVE T4,[P.BLK+.FXDIR,,F.BLK+.FXDIR]
BLT T4,F.BLK+.FXDIR+<2*.FXLND>-1 ;COPY STICKY
MOVE T1,P.BLK+.FSDIR ;ADDRESS OF STICKY DIRECTORY STRING
MOVEM T2,F.BLK+.FSDIR ;SET APPLIED STICKY DIRECTORY STRING
PUSHJ P,FILSBL ;COPY OVER STICKY DIRECTORY STRING
TXO P1,FX.UDR!FX.SDR;NOTE "STICKY" DIRECTORY
TXNE P2,FX.WDR ;WILD DIRECTORY?
TXO P1,FX.WDR ;YES, NOTE THOSE TOO
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
APLSS4: SKIPN F.BLK+.FXNAM ;GOT A FILE NAME SPECIFICATION?
TXNN P2,FX.UNM ;NO, STICKY FILE NAME?
JRST APLSS5 ;NO STICKY FILE NAME
DMOVE T3,P.BLK+.FXNAM ;GET NAME [534]
DMOVEM T3,F.BLK+.FXNAM ; APPLY STICKY NAME [534]
MOVE T1,P.BLK+.FSNAM ;ADDRESS OF STICKY NAME STRING
MOVEM T2,F.BLK+.FSNAM ;SET APPLIED STICKY NAME STRING
PUSHJ P,FILSBL ;COPY OVER STICKY NAME STRING
TXO P1,FX.UNM!FX.SNM;NOTE "STICKY" NAME
TXNE P2,FX.WNM ;NAME WILDCARDS?
TXO P1,FX.WNM ;YES, NOTE THOSE TOO
TXNE P2,FX.UQN ;NAME IN QUOTES?
TXO P1,FX.UQN ;YES, NOTE THOSE TOO
APLSS5: SKIPN F.BLK+.FXEXT ;GOT A FILE TYPE SPECIFICATION?
TXNN P2,FX.UEX ;NO, STICKY EXTENSION?
JRST APLSS6 ;NO STICKY EXTENSION
MOVE T3,P.BLK+.FXEXT ;APPLY EXTENSION
MOVEM T3,F.BLK+.FXEXT ; ..
MOVE T1,P.BLK+.FSEXT ;ADDRESS OF STICKY EXTENSION STRING
MOVEM T2,F.BLK+.FSEXT ;SET APPLIED STICKY EXTENSION STRING
PUSHJ P,FILSBL ;COPY OVER STICKY EXTENSION STRING
TXO P1,FX.UEX!FX.SEX;NOTE "STICKY" EXTENSION
TXNE P2,FX.WEX ;EXTENSION WILDCARDS?
TXO P1,FX.WEX ;YES, NOTE THOSE TOO
APLSS6: SKIPN F.BLK+.FXGEN ;GOT A FILE GENERATION SPECIFICATION?
TXNN P2,FX.UGN ;NO, STICKY GENERATION?
JRST APLSS7 ;NO STICKY GENERATION
MOVE T3,P.BLK+.FXGEN ;APPLY GENERATION
MOVEM T3,F.BLK+.FXGEN ; ..
MOVE T1,P.BLK+.FSGEN ;ADDRESS OF STICKY GENERATION STRING
MOVEM T2,F.BLK+.FSGEN ;SET APPLIED STICKY GENERATION STRING
PUSHJ P,FILSBL ;COPY OVER STICKY GENERATION STRING
TXO P1,FX.UGN!FX.SGN;NOTE "STICKY" GENERATION
TXNE P2,FX.WGN ;GENERATION WILDCARDS?
TXO P1,FX.WGN ;YES, NOTE THOSE TOO
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
APLSS7: CAILE T2,F.BLK+.FSXXX+.FSLXX-1 ;DID ALL THE STRINGS FIT?
JRST E$$STB ;DIE
MOVEM P1,F.BLK+.FXFLD ;STASH AWAY FIELD FLAGS
DMOVE T3,P.BLK+.FXCTL ;APPLY ALL CONTROL MODES
ANDCM T3,F.BLK+.FXCTM ;LESS THOSE EXPLICITLY TYPED
IORM T3,F.BLK+.FXCTL ; . . .
IORM T4,F.BLK+.FXCTM ; . . .
DMOVE T3,P.BLK+.FXMOD ;APPLY ALL FILE SWITCHES
ANDCM T3,F.BLK+.FXMOM ;MASK HERE USED TO INDICATE WHICH WERE TYPED
IORM T3,F.BLK+.FXMOD ; ..
IORM T4,F.BLK+.FXMOM ; ..
MOVSI T4,.FXBOM-.FXEOM ;LENGTH OF SWITCHES [346]
APLST2: MOVE T3,F.BLK+.FXBOM(T4) ;GET CURRENT VALUE [346]
CAMN T3,[-1] ;SEE IF SET [346]
MOVE T3,P.BLK+.FXBOM(T4) ;NO--GET THIS STICKY SWITCH [346]
MOVEM T3,F.BLK+.FXBOM(T4) ;STORE RESULT [346]
AOBJN T4,APLST2 ;LOOP OVER ALL SWITCHES [346]
SKIPL FLFSP ;SEE IF SOME FILE HERE [516]
JRST APLST5 ;YES--SKIP DEFAULTING
;FALL INTO APLSTD
;FALL HERE FROM ABOVE
APLSTD: SETO T4, ;DEFAULT NO WILDCARDS
; MOVE T3,.MYNOD ;GET HOST NAME AS DEFAULT
; SKIPN F.BLK+.FXNOD ;NODE NAME GIVEN?
; DMOVEM T3,F.BLK+.FXNOD ;NO, SET IN FILE SPEC BLOCK
; MOVSI T3,'DSK' ;DEFAULT DEVICE NAME
; SKIPN F.BLK+.FXDEV ;SEE IF DEVICE SPECIFIED
; DMOVEM T3,F.BLK+.FXDEV ;NO, USE OUR DEFAULT
APLST5: SKIPLE T4,F.BLK+.FXBFR ;IF /BEFORE, [331]
CAML T4,F.BLK+.FXSNC ; MAKE SURE AFTER /SINCE [331]
JRST APLST6 ;OK--PROCEED [331]
M$FAIL (BSO,/BEFORE and /SINCE don't overlap)
APLST6: SKIPLE T4,F.BLK+.FXABF ;IF /ABEFORE, [346]
CAML T4,F.BLK+.FXASN ; MAKE SURE AFTER /ASINCE [346]
JRST APLST7 ;OK--PROCEED [346]
M$FAIL (ABO,/ABEFORE and /ASINCE don't overlap)
APLST7: SKIPLE T4,F.BLK+.FXPBF ;IF /PBEFORE, [346]
CAML T4,F.BLK+.FXPSN ; MAKE SURE AFTER /PSINCE [346]
JRST APLST9 ;OK--PROCEED [346]
M$FAIL (PBO,/PBEFORE and /PSINCE don't overlap)
APLST9: SKIPGE FLFLLP ;SEE IF WERE IN () [543]
PUSHJ P,CLERST ;YES, CLEAR STICKIES [543]
IFN ECHO$P,<
OUTSTR [ASCIZ /AFTER USER DEFAULTS: /]
PUSHJ P,TFILE
>
POPJ P, ;RETURN
FILSBL: PUSHJ P,.SAVE1## ;NEED A SCRATCH AC
MOVE P1,0(T1) ;GET A SOURCE WORD
MOVEM P1,0(T2) ;SAVE A DESTINATION WORD
ADDI T1,1 ;ADVANCE SOURCE POINTER
TRNE P1,377 ;END OF ASCIZ STRING?
AOJA T2,FILSBL ;NO, LOOP FOR MORE
AOJA T2,.POPJ## ;YES, ALL DONE
;.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.BLK+.FXMOD ;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.BLK+.FXMOM ;GET MASK OF DEFAULTS
TXZ T3,FXNOTD ;REMOVE ALL BUT SWITCHES [537]
IORM T3,.FXMOM(T1) ;INDICATE SET
MOVEI T4,-.FXBOM(T2) ;COUNT OF EXTRA WORDS
CAILE T4,.FXEOM-.FXBOM;SEE IF MORE THAN WE UNDERSTAND
MOVEI T4,.FXEOM-.FXBOM;YES--SET TO OUR LIMIT
MOVNS T4 ;MAKE NEGATIVE
HRLZS T4 ;SET IN LEFT HALF AS COUNT
OSDFS1: MOVE T3,.FXBOM(T1) ;GET EXISTING VALUE
CAMN T3,[-1] ;SEE IF DEFAULT
MOVE T3,F.BLK+.FXBOM(T4) ;YES--GET OSCAN VALUE
MOVEM T3,.FXBOM(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.BLK+.FXDEV
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /:/]
MOVE T2,F.BLK+.FXNAM
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /./]
HLLZ T2,F.BLK+.FXEXT
PUSHJ P,.TSIXN##
MOVE T1,F.BLK+.FXDIR
PUSHJ P,.TPPNW
MOVE T1,F.BLK+.FXMOD
PUSHJ P,.TXWDW
OUTSTR [ASCIZ /
MASKS: /]
MOVE T2,F.BLK+.FXNMM
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /./]
HRLZ T2,F.BLK+.FXEXT
PUSHJ P,.TSIXN##
MOVE T1,F.BLK+.FXDIM
PUSHJ P,.TPPNW
MOVE T1,F.BLK+.FXMOM
PUSHJ P,.TXWDW
PUSHJ P,.TCRLF##
PJRST .POP4T##
>
;CLERST -- CLEAR STICKY DEFAULTS
;.CLSNS -- DITTO EXCLUDING SWITCHES
CLERST: SETOM P.BLK+.FXBOM ;CLEAR SWITCHES [346]
MOVE T1,[P.BLK+.FXBOM,,P.BLK+.FXBOM+1]
BLT T1,P.BLK+.FXEOM-1
SETZM FLFLLP ;CLEAR ( SWITCH [543]
SKIPE CLRSTK ;SEE IF USER WANTS CONTROL [534]
PUSHJ P,@CLRSTK ;YES--GO TO HIM [534,551]
SETZM P.BLK+.FXMOD ;CLEAR [551]
SETZM P.BLK+.FXMOM ; SMALL SWITCHES [551]
.CLSNS::PUSH P,P.BLK+.FXMOD ;SAVE SWITCHES [551,553]
PUSH P,P.BLK+.FXMOM ; .. [551]
SETZM P.BLK+.FXBZM ;CLEAR STICKY DEFAULTS [551]
MOVE T1,[P.BLK+.FXBZM,,P.BLK+.FXBZM+1]
BLT T1,P.BLK+.FXEZM-1
POP P,P.BLK+.FXMOM ;RESTORE SMALL [551]
POP P,P.BLK+.FXMOD ; SWITCHES [551]
MOVX T1,FX.NDV!FX.NUL!FX.DIR!FX.TRM
ANDCAM T1,P.BLK+.FXMOD ;CLEAR NON-SWITCH [552]
ANDCAM T1,P.BLK+.FXMOM ; 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,.TIAUC ;PRELOAD THE FIRST CHARACTER
.KEYWC::PUSHJ P,.SAVE2## ;SAVE P1 (SWITCH INDEX)
; AND P2 (LOCAL/REMOTE INDEX)
PUSHJ P,.NAMEC ;GET NAME
JUMPE N,[MOVEI T1,E$$NSS ;NO SWITCH SPECIFIED
POPJ P,] ;RETURN ERROR
AOJN T2,[MOVEI T1,E$$SWI ;SWITCH WILDCARDS ILLEGAL
POPJ P,] ;RETURN ERROR
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.
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.BLK ; ALLOW ONLY [357]
CAILE T1,F.BLK+.FXEOM-1 ; 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
;**;[575] Insert @ KEYWD2+10L JNG 7-May-76
PUSHJ P,.TINBL ;ADVANCE TO NON-BLANK CHARACTER
PUSHJ P,.REEAT ;[575] 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,.SIXSW ;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]
MOVX T4,FS.OBV ;THE OR-BIT-VALUES FLAG
CAMN N,['NONE '] ;SEE IF /SWITCH:NONE
JRST [TDNN T4,@SWD(P2) ;VALUE OR MASK?
TDZA N,N ;VALUE, "NONE" = 0
SETO N, ;MASK, "NONE" = -1
JRST KEYWD8] ;GO DISPATCH
TDNN T4,@SWD(P2) ;MASK (OR-BIT-VALUES) SWITCH?
JRST KEYWD6 ;NO--NO MORE POSSIBILITIES
CAMN N,['ALL '] ;SEE IF :ALL [341]
JRST [MOVEI N,-1 ;RIGHT--INDICATE THAT [341]
JRST KEYWD8] ;GO DISPATCH [341]
MOVEI T1,0 ;CLEAR ACCUMULATOR [316]
MOVE T2,N ;COPY WORD [316]
LSHC T1,^D12 ;SPLIT "NO" [316]
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,.SIXSW ;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
JRST SWDPBE ;AND GO STORE
;HERE TO GO TO SWITCH PROCESSOR
KEYWDJ: ANDI T1,-1 ;*X* MAKE INTO SECTION-LOCAL INDEX
MOVX T4,FS.SKP ;THE SKIP-IF-SUCCESSFUL FLAG
TDNE T4,@SWD(P2) ;NEW-STYLE ERROR-RETURNING SWITCH PROCESSOR?
JRST KEYWDK ;YES
PUSHJ P,(T1) ;GO DO IT
JRST SWDPBE ;GO STORE
JRST SWDONE ;HE STORED--JUST CLEAN UP
KEYWDK: PUSHJ P,(T1) ;CALL SWITCH PROCESSOR
POPJ P, ;ERROR (REASON IN T1)
JRST SWDPBE ;STORE RESULTS OF SUCCESSFUL SWITCH
;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,STDPTR ;POINTER TO STANDARD 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 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
MOVE T3,T2 ;POINT TO FLAG FIELD
CAIGE T4,^D36 ;IF PARTIAL, THEN
AOS T3 ; IN NEXT WORD
CAILE T4,^D36 ;SEE IF MULTI-WORD
TLZ T3,(7777B11) ;YES--CLEAR COUNT
TLNN T3,(77B11) ;SEE IF CLEAR COUNT
TLO T3,(^D36B11) ;YES--SET FULL WORD
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
SKIPGE FLVERB ;VERB MODE?
JRST FILSWN ;YES, ALLOW NEW VALUE TO OVERRIDE OLD VALUE
LDB T1,T3 ;SEE IF ALREADY SOMETHING THERE
CAILE T4,^D36 ;MULTIPLE-WORD-VALUE SWITCH?
JRST [JUMPE T1,FILSWN ;YES, IF 0 THEN NO VALUE YET, OK
; THIS IS NOT STRICTLY TRUE, AS THERE
; IS NOTHING TO PREVENT THE FIRST WORD
; FROM BEING 0, AND THE SECOND WORD NOT.
; HOWEVER, TOO BAD.
AOJE T1,FILSWN ;IF -1 THEN ALLOW THAT TOO (SIGH)
JRST FILSWC] ;OTHERWISE CHECK MULTI-WORD VALUE
AOJE T1,FILSWN ;IF -1 THEN NO VALUE YET, OK TO STORE
CAIGE T4,^D36 ;SEE IF FULL WORD
SOJE T1,FILSWN ;PARIAL WORD, IF MASK 0 THEN NO VALUE YET
TXNE P1,FS.OBV ;SEE IF OR BIT VALUES
JRST [HLRZ T1,(T2) ;YES--GET MASK FROM LH
CAIE T1,-1 ;IF WAS ALL OR NONE, OK
TRNN T1,(N) ;SEE IF THIS BIT SET
JRST FILSWN ;NO--OK TO PROCEED
HRRZ T1,(T2) ;GET BIT TO MODIFY
TLNE N,-1 ;SEE IF NOT THIS TIME
TRC T1,-1 ;YES--CHANGE VALUE
TRNE T1,(N) ;SEE IF SET SAME LAST TIME
JRST FILSWN ;YES--OK TO UPDATE
JRST E.DSI] ;ELSE CONTINUE WITH TESTS
LDB T1,T2 ;DUPLICATE SWITCH, FETCH OLD VALUE
CAME T1,N ;IF VALUE IS THE SAME, ALLOW IT
JRST E.DSI ;NO--DUPLICATE SWITCH
FILSWN: CAILE T4,^D36 ;SEE IF MULTI-WORD VALUE
JRST FILSWW ;YES--GO DO IT
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.BLK ;SEE IF IN LOCAL [357]
CAILE T2,F.BLK+.FXEZM ; FILE SPEC AREA [357]
JRST FILSW1 ;NO--TRY BELOW
SUBI T2,F.BLK-P.BLK ;YES--SWITCH TO [357]
SUBI T3,F.BLK-P.BLK ; 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
;HERE TO SEE IF MULTIPLE-WORD-VALUE DUPLICATE SWITCH IS THE SAME
FILSWC: HRLZI T1,-^D65(T4) ;GET MINUS NUMBER OF WORDS IN LEFT HALF
HRRI T4,.NMUL ;MAKE AN AOBJN WORD
HRRZ T3,T2 ;GET ADDRESS OF PREVIOUS VALUE
FILSW5: MOVE T1,(T4) ;GET WORD OF NEW VALUE
CAME T1,(T3) ;SAME AS OLD?
JRST E.DSI ;NO - DUPLICATE SWITCH ILLEGAL
AOS T3 ;BUMP POINTER TO OLD VALUE
AOBJN T4,FILSW5 ;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
JRST .POPJ1## ;SUCCESSFUL RETURN TO CALLER
.SWDON==:.POPJ1
SUBTTL SWITCH PROCESSORS
;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
;HERE WHEN SWITCH IS A USERID
.SWUID::CAIN C,":" ;VALUE COMING?
PJRST .ASUID ;YES, PROCESS USERID STRING
MOVEI N,1 ;NO, FLAG SWITCH SEEN BUT NO VALUE
MOVEM N,.NMUL ;AND LET SOMEONE WORRY ABOUT IT
POPJ P, ;RETURN TO STORE SWITCH "VALUE"
;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 VALUE IS A TELEPHONE NUMBER
.SWPNM==:.PNMNW
;HERE WHEN SWITCH TAKES A FILE SPECIFICATION AS ITS VALUE
.SWFIL::MOVE T1,[F.BLK,,G.BLK]
BLT T1,G.XZER ;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.BLK,,F.BLK]
BLT T1,F.XZER ;RESTORE ORIGINAL SPECIFICATION
PJRST .POPJ1 ;GO FINISH UP [343]
;SWALC - /ALLOCATE SWITCH
;SYNTAX IS:
;
; /ALLOCATE:<SIZ>
;
;WHERE <SIZ> IS THE SIZE (A LA .BLOKW).
SWALC: MOVX T1,FX.ALC ;NOTE /ALLOCATE VS /ESTIMATE
IORM T1,F.BLK+.FXCTL ;IN THE FILE SPEC BLOCK
IORM T1,F.BLK+.FXCTM ;(AND IT WAS EXPLICITLY TYPED)
PJRST .BLOKW ;FINISH OFF AS IF /ESTIMATE
;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)
SWLEN: PUSHJ P,.BLOKW ;GET MINIMUM FILE SIZE
SKIPL F.BLK+.FXFLI ;SEE IF ALREADY SET
CAMN N,F.BLK+.FXFLI ; 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.BLK+.FXFLI ;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.BLK+.FXFLI ;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.BLK+.FXFLI ;SEE IF GREATER THAN MINIMUM
JRST E.LVI ;NO--ERROR
POPJ P, ;YES--RETURN AND STORE
;HERE TO HANDLE /EXIT SWITCH
SWEXIT: MOVE T1,@SWP(P2) ;GET POINTER [506]
SKIPN (T1) ;IF NOT SET, [506]
SETOM (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"
SWTMP: PUSHJ P,.SIXSW ;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
>
E.CWT:; MOVEI T1,E$$CWT
; POPJ P,
M$FAIL (CWT,Can't write tmpfile)
E.ITF:; MOVEI T1,E$$ITF
; POPJ P,
M$FAIL (ITF,Incorrect tmpfile argument format)
;HERE ON /HELP OF ALL FLAVORS
.SWHLP::JRST @[FILHLT ;/HELP OR /HELP:* OR /HELP:
FILHLT ;/HELP:TEXT
FILHLS ;/HELP:SWITCHES
FILHLK](N) ;/HELP:KEYWORDS
;HERE FOR /HELP OR /HELP:TEXT OR /HELP:TEXT:ARGS
;
; 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
; .GT. 77 = NAME OF HELP FILE TO GIVE .HELPR
FILHLT: SKIPN T1,SWTHLP ;SKIP IF HELP PROCESSOR SPECIFIED
JRST E.NHA ;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
JRST E.NHA ;UNKNOWN TYPE
FILTXH: ANDI T1,-1 ;WORD=ADDR OF TEXT STRING
PUSHJ P,.TSTRG## ;TYPE STRING
PUSHJ P,.TCRLF## ;AND TOP OFF WITH CRLF
JRST FILSHX
FILHLP: SETO P1, ;USE P1 AS A FLAG
CAIE C,":" ;USER SPECIFY ANY ARGS?
JRST FILHLR ;NO - STANDARD THING THEN
PUSHJ P,.TIALT ;PEEK AT NEXT CHARACTER
PUSHJ P,.REEAT ;FLAG TO RE-RETURN IT
CAIN C,"(" ;MULTIPLE ARGS COMMING UP?
SETZB P1,SAVCHR ;YES - SET FLAG AND EAT "("
FILHLQ: PUSHJ P,.SIXSW ;READ IN NAME
CAIN C,")" ;CLOSE OF MULTIPLE ARGS?
SETZ P1, ;YES
SKIPE T1,N ;GET ARG IF NON-ZERO
FILHLR: PUSHJ P,.HELPR## ;TYPE OUT USEFUL INFO
JUMPN P1,FILSHX ;IF MULTI ARGS THEN LOOP BACK
JUMPLE C,FILSHX ;DON'T READ BEYOND EOL
PUSHJ P,.TCRLF## ;SEPARATE WITH <CR><LF>
CAIN C,"," ;MORE COMING UP?
JRST FILHLQ ;LOOP FOR NEXT REQUEST
JRST FILSHX ;END OF HELP PROCESSING
;HERE FOR /HELP:SWITCHES TO LIST THE SWITCHES AS KEYWORDS
FILHLS: SKIPGE T1,SWTHLP ;EXPLICIT HELP NAME SUPPLIED?
CAMN T1,[-1] ;AND NOT EXPLICIT IMPLICIT PROGRAM NAME?
MOVE T1,.MYPRG ;PROGRAM NAME FOR HEADER MESSAGE
MOVEI P2,SWTCHC ;POINT TO USER SWITCH TABLE
PUSHJ P,FILHTS ;TYPE OUT SWITCH TABLE NAMES
; JUMPE P1,FILHLC ;IF NONE THERE, DON'T TRY FOR KEYS
; MOVE T1,.MYPRG ;RESTORE PROGRAM NAME FOR NEATNESS
; PUSHJ P,FILHTK ;TYPE OUT ANY KEYWORDS ALSO
FILHLC: SETZ T1, ;IDENTIFY SCAN'S PRIVATE SWITCHES
MOVEI P2,STDSWC ;SCAN'S "STANDARD" SWITCHES
PUSHJ P,FILHTS ;TYPE OUT SWITCH TABLE
; SETZ T1, ;SAY "STANDARD" ONCE AGAIN
; PUSHJ P,FILHTK ;TYPE SCAN'S KEYWORDS
JRST FILSHW ;END - RESET WORLD
;HERE ON /HELP:KEYWORDS
FILHLK: MOVE T1,.MYPRG ;PROGRAM NAME FOR HEADER MESSAGE
MOVEI P2,SWTCHC ;USER'S SWITCH TABLE
PUSHJ P,FILHTK ;TYPE OUT ANY KEYWORDS FOUND
SETZ T1, ;IDENTIFY SCAN'S STANDARD KEYS
MOVEI P2,STDSWC ;SCAN'S SWITCH TABLE
PUSHJ P,FILHTK ;TYPE OUT SCAN'S KEYWORDS
JRST FILSHW ;RESTART THE WORLD
;FILHTS -- TYPE OUT A SWITCH TABLE
;CALL WITH T1 = NAME TO TYPE IF SWITCHES FOUND,
; P2 = ADR OF SWITCH TABLE TABLE
FILHTS: MOVSI P1,-STSWTL ;LENGTH OF SCAN'S TABLE
CAIE P2,STDSWC ;RIGHT GUESS?
HLLZ P1,SWTPTR ;NOPE - USE USERS
JUMPE P1,.POPJ ;IGNORE IF NON-EXTANT
MOVEI T2,[ASCIZ/switches are:
/] ;HEADER MESSAGE
PUSHJ P,FILHDR ;TYPE THE HEADER
SKIPLE T1,.MYTWD ;GET TTY WIDTH
IDIVI T1,^D8 ;CONVERT TO <TAB> COLUMNS
MOVEM T1,.NMUE ;TEMP PLACE TO STICK IT
JRST FILTS1 ;ENTER LOOP
FILTS0: PUSHJ P,.TCOMA## ;END EACH SWITCH WITH A COMMA
SOJG T3,FILTS2 ;LINE FULL YET?
PUSHJ P,.TCRLF## ;YES - START A NEW ONE
FILTS1: SKIPA T3,.NMUE ;RESET COLUMN COUNTER
FILTS2: PUSHJ P,.TTABC## ;START EACH SWITCH ON A <TAB> BOUNDRY
MOVE T1,@SWN(P2) ;GET SIXBIT SWITCH
PUSHJ P,.TSIXN ;TYPE IT OUT
AOBJN P1,FILTS0 ;LOOP FOR ENTIRE TABLE
PJRST .TCRLF ;CAP OFF WITH A <CR><LF>
;FILHTK -- TYPE OUT THE KEYWORDS FOR A SWITCH
;CALL WITH T1 = NAME TO TYPE IF ANY KEYWORDS
; P2 = ADR OF SWITCH TABLE TABLE
;IF SWITCH OR'S VALUES THEN KEYWORDS ENCLOSED IN "()"
FILHTK: MOVSI P1,-STSWTL ;SCAN'S TABLE LENGTH
CAIE P2,STDSWC ;RIGHT GUESS??????
HLLZ P1,SWTPTR ;NO - USE USER'S INSTEAD
JUMPE P1,.POPJ ;IGNORE NOTHING - SO TO SPEAK
SKIPLE T2,.MYTWD ;GET TTY WIDTH
SUBI T2,^D8+^D7 ;SET TO MAX CHARACTERS
MOVEM T2,.NMUE ;USE .NMUE AS CONVENIENT STASH
FILHT0: MOVE T4,@SWM(P2) ;GET ALLEGED IOWD
TLC T4,777700 ;SEE IF REASONABLE
TLCE T4,777700 ; . . .
JRST FILHT1 ;NO, ASSUME NOT KEYWORD IOWD
JUMPL P2,FILHT2 ;NEED INTRO MESSAGE?
MOVEI T2,[ASCIZ/switch keywords are:
/] ;IDENTIFY THE KEYWORDS
PUSHJ P,FILHDR ;TYPE INTRO MESSAGE
TLO P2,(1B0) ;FLAG
FILHT2: PUSHJ P,FILKTP ;TYPE OUT ONE SET OF KEYWORDS
FILHT1: AOBJN P1,FILHT0 ;LOOP FOR ALL OF TABLE
ANDI P2,-1 ;CLEAR LOCAL FLAG
POPJ P,
;FILKTP -- TYPE OUT ONE SET OF KEYWORDS
FILKTP: MOVE T1,@SWN(P2) ;GET NAME
PUSHJ P,.TSIXN## ;TYPE OUT
PUSHJ P,.TCOLN## ;FOLLOWED BY A ":"
PUSHJ P,.TTABC## ;ALLIGN OUR COLUMNS
MOVEI T1,"(" ;GET "(" CHARACTER
MOVX T2,FS.OBV ;OR-BIT VALUES FLAG
TDNE T2,@SWD(P2) ;IS IT SET?
PUSHJ P,.TCHAR## ;YES - ENCLOSE KEYS IN () THEN
JRST FILKT1 ;LOOP
FILTK0: PUSHJ P,.TCOMA## ;FOLLOW EACH KEY WITH A ","
SOJG T3,FILKT2 ;LINE FULL?
PUSHJ P,.TCRLF## ;SET TO NEW LINE
PUSHJ P,.TTABC## ;SPACE OVER A <TAB> COLUMN
FILKT1: MOVE T3,.NMUE ;RESET WIDTH
FILKT2: SKIPN T2,1(T4) ;NEXT KEY NAME
AOBJN T4,.-1 ;IGNORE NULL ENTRIES
FILKT4: JUMPE T2,FILKT6 ;EXIT CHAR LOOP WHEN DONE
SETZ T1, ;ROOM FOR CHAR
LSHC T1,6 ;GET SIXBIT CHAR
ADDI T1,"0" - '0' ;MAKE INTO SEVENBIT CHAR
PUSHJ P,.TCHAR## ;OUTPUT
SOJA T3,FILKT4 ;LOOP FOR WHOLE WORD
FILKT6: AOBJN T4,FILTK0 ;LOOP FOR WHOLE IOWD OF KEYS
MOVEI T1,")" ;GET A ")" IN CASE
MOVX T2,FS.OBV ;OR-BIT VALUES BIT
TDNE T2,@SWD(P2) ;IS IT SET?
PUSHJ P,.TCHAR## ;YES, CLOSE WITH CLOSING ")"
PJRST .TCRLF## ;AND CAP OFF THIS KEYWORD SET
;FILHDR -- TYPE HEADER ROUTINE FOR /HELP SUBPROCESSORS
FILHDR: PUSH P,T2 ;SAVE ASCIZ STRING FOR MOMENT
PUSH P,T1 ;AND HEADER "NAME" ALSO
PUSHJ P,.TCRLF## ;GIVE FREE <CR><LF> FOR NEATNESS
POP P,T1 ;GET BACK THE NAME
JUMPE T1,FILHD2 ;IF 0 THEN SCAN'S STANDARD STUFF
PUSHJ P,.TSIXN## ;TYPE OUT SIXBIT PROGRAM "NAME"
PUSHJ P,.TSPAC## ;SPACE OVER BY ONE
JRST FILHD4 ;CAP OFF WITH TEXT STRING
FILHD2: MOVEI T1,[ASCIZ/Standard /] ;SCAN'S "NAME"
PUSHJ P,.TSTRG ;SEND IT OUT TO USER TTY
FILHD4: POP P,T1 ;ASCIZ STRING
PJRST .TSTRG## ;AND TYPE IT OUT TOO
;HERE ON END OF HELP SWITCH
FILSHW: POP P,P3 ;RESTORE P3
FILSHX: PUSHJ P,CLRBFN ;EAT LINE
JRST .FMSGX
E.NHA: MOVEI T1,E$$NHA
POPJ P,
M$FAIL (NHA,<No help available, try /HELP:SWITCHES or /HELP:KEYWORDS>)
;HERE WE DEFINE STANDARD SWITCHES PROCESSED IN SCAN
DEFINE SWTCHS,<
SP ABEFORE,F.BLK+.FXABF,.DYTIP,,FS.VRQ!FS.SKP
SP ALLOCATE,F.BLK+.FXEST,SWALC,,FS.VRQ
SS ANYDEVICEOK,<POINTR (F.BLK+.FXMOD,FX.ADO)>,1
SN APPEND,<POINTR (F.BLK+.FXCTL,FX.APP)>
SS ASCII,<POINTR (F.BLK+.FXCTL,FX.DAM)>,DAMASC
SP ASINCE,F.BLK+.FXASN,.DYTIP,,FS.VRQ!FS.SKP
SP BEFORE,F.BLK+.FXBFR,.DYTIP,,FS.VRQ!FS.SKP
SS BINARY,<POINTR (F.BLK+.FXCTL,FX.DAM)>,DAMBIN
SP BLOCKSIZE,F.BLK+.FXBLS,.SWDEC,BLK,FS.VRQ
SP BYTESIZE,F.BLK+.FXBSZ,.SWDEC,BYT,FS.VRQ
SP BUFFERS,F.BLK+.FXBFN,.SWDEC,BFN,FS.VRQ
SN CONTIGUOUS,<POINTR (F.BLK+.FXCTL,FX.CTG)>
SL DATAMODE,<POINTR (F.BLK+.FXCTL,FX.DAM)>,DAM,DAMASC
SN DELETE,<POINTR (F.BLK+.FXCTL,FX.DEL)>
SL DENSITY,<POINTR (F.BLK+.FXMOD,FX.DEN)>,DENS,DENSIN
SS DSKONLY,<POINTR (F.BLK+.FXMOD,FX.ADO)>,0
SS ERNONE,<POINTR (F.BLK+.FXMOD,FX.NOM)>,0
SS ERPROTECTION,<POINTR (F.BLK+.FXMOD,FX.PRT)>,0
SS ERSUPERSEDE,<POINTR (F.BLK+.FXMOD,FX.SUP)>,1
SS ERUID,<POINTR (F.BLK+.FXMOD,FX.UID)>,0
SP ESTIMATE,F.BLK+.FXEST,.BLOKW,,FS.VRQ
SP EXIT,N.BLK+.FXDEV,SWEXIT,,FS.NFS!FS.NCM
SS FIXED,<POINTR (F.BLK+.FXCTL,FX.RFM)>,RFMFIX
SP FRAMESIZE,F.BLK+.FXFSZ,.SWDEC,BYT,FS.VRQ
SL *HELP,<-1,,.SWHLP>,HELP,HELPTEXT,FS.NFS!FS.NCM
SS IMAGE,<POINTR (F.BLK+.FXCTL,FX.DAM)>,DAMIMA
SL IOMODE,<POINTR (F.BLK+.FXCTL,FX.IOM)>,IOM,IOMASC
SP LENGTH,F.BLK+.FXFLM,SWLEN,,FS.VRQ
SN LIB,<POINTR (F.BLK+.FXMOD,FX.LIB)>
SN MACY11,<POINTR (F.BLK+.FXCTL,FX.MCY)>
SN MECY11,<POINTR (F.BLK+.FXCTL,<FX.MCY!FX.MEY>)>
SL MESSAGE,<*F,.FLVRB##>,VRB,PD.MSG,FS.OBV!FS.NFS!FS.NCM
SN NEW,<POINTR (F.BLK+.FXMOD,FX.NEW)>
IFN M$INDP,<
SS NOOPTION,OPTION,0,FS.NFS
>
SS OKNONE,<POINTR (F.BLK+.FXMOD,FX.NOM)>,1
SS OKPROTECTION,<POINTR (F.BLK+.FXMOD,FX.PRT)>,1
SS OKSUPERSEDE,<POINTR (F.BLK+.FXMOD,FX.SUP)>,0
SS OKUID,<POINTR (F.BLK+.FXMOD,FX.UID)>,1
IFN M$INDP,<
SP OPTION,OPTION,.SWSIX,OPT,FS.NFS
>
SL PARITY,<POINTR (F.BLK+.FXMOD,FX.PAR)>,PAR,PARODD
SP PBEFORE,F.BLK+.FXPBF,.DYTIP,,FS.VRQ!FS.SKP
SN PHYSICAL,<POINTR (F.BLK+.FXMOD,FX.PHY)>
SN PRINT,<POINTR (F.BLK+.FXCTL,FX.PRI)>
SP PROTECTION,<POINTR (F.BLK+.FXMOD,FX.PRO)>,.SWOCT,PRO
SP PSINCE,F.BLK+.FXPSN,.DYTIP,,FS.VRQ!FS.SKP
SL QUERY,<POINTR (F.BLK+.FXCTL,FX.QRY)>,QRY,QRYASK
SP RECSIZE,F.BLK+.FXRSZ,.SWDEC,BLK,FS.VRQ
SL RECFORMAT,<POINTR (F.BLK+.FXCTL,FX.RFM)>,RFM,0
IFN M$INDP,<
SP RUN,N.BLK,.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
>
SL SCERROR,<POINTR (F.BLK+.FXCTL,FX.SCE)>,SCE,SCEINS
SL SCWILD,<POINTR (F.BLK+.FXCTL,FX.SCW)>,SCW,SCWFIE
SP SINCE,F.BLK+.FXSNC,.DYTIP,,FS.VRQ!FS.SKP
SN STRS,<POINTR (F.BLK+.FXMOD,FX.STR)>
SN SUBMIT,<POINTR (F.BLK+.FXCTL,FX.SUB)>
SN SYS,<POINTR (F.BLK+.FXMOD,FX.SYS)>
SS TELL,<POINTR (F.BLK+.FXCTL,FX.QRY)>,QRYTEL
SP TMPFILE,,SWTMP,,FS.VRQ!FS.NFS!FS.NCM
SS VARIABLE,<POINTR (F.BLK+.FXCTL,FX.RFM)>,RFMVAR
SP VERSION,F.BLK+.FXVER,.VERSW,,FS.VRQ
>
;DEFINE SWITCH DEFAULTS, MAXIMA, ETC.
DM BFN,^D63,0,0 ;/BUFFERS MAXIMUM OF 63
DM BLK,200000,0,0 ;/BLOCKSIZE MAXIMUM OF 64K (-1)
DM BYT,^D36,0,0 ;/BYTESIZE MAXIMUM OF 36 BITS
DM MSG,77777,0,7 ;/MESSAGE
DM OPT,1,0,0
DM PRO,777,0,277 ;/PROTECTION
DM RNC,777777,0,0 ;/RUNCORE
DM RUN,7,-1,1 ;/RUNOFFSET
DM RNL,.FXEZM,0,0 ;/RUN MAXIMUM IS LENGTH OF FILE SPEC BLOCK
;HERE WE BUILD THE KEYS
KEYS (DAM,<ASCII,,,,,,,IMAGE,,,,BINARY>)
KEYS (DENS,<200,556,800,1600,6250,,,INSTALLATION>)
IFN DENSIN-1-<FX.DEN_-<ALIGN. (FX.DEN)>>,<
PRINTX ? DENSITY:INSTALLATION is wrong>
KEYS (HELP,<TEXT,SWITCHES,KEYWORDS>)
KEYSG (IOM,<ASCII,PIM,BYTE,A8CII,,,,IMAGE,,,IBINAR,BINARY>)
KEYS (PAR,<EVEN,ODD>)
KEYSG (QRY,<NEVER,TELL,,ASK>)
KEYSG (RFM,<FIXED,VARIABLE,VFC,,,,,,,,,,,,36PACK>)
KEYSG (SCE,<NEVER,INSUFFICIENT,DIFFERENT>)
KEYSG (SCW,<ANY,FIELD,DFIELD,SAME,DSAME>)
KEYSG (VRB,<PREFIX,FIRST,CONTINUATION,,,,,ADDRESS>)
IFN VRBADX-VRBADD,<
PRINTX ? Define VRBADX to be VRBADD value>
;NOW BUILD THE TABLES FROM THE SWTCHS MACRO
DOSCAN (STSWT)
;FILE SPECIFICATION ERROR MESSAGES
E.DNO: MOVEI T1,E$$DNO
POPJ P,
M$FAIN (DNO,Double node illegal)
E.DDV: MOVEI T1,E$$DDV
POPJ P,
M$FAIN (DDV,Double device illegal)
E.DFN: MOVEI T1,E$$DFN
POPJ P,
M$FAIN (DFN,Double file name illegal)
E.DEX: MOVEI T1,E$$DEX
POPJ P,
M$FAIN (DEX,Double extension illegal)
E.DEG: MOVEI T1,E$$DEG
POPJ P,
M$FAIN (DEG,Double file generation/extension illegal)
E.NNO: MOVEI T1,E$$NNO
POPJ P,
M$FAIL (NNO,Null node illegal)
E.NDV: MOVEI T1,E$$NDV
POPJ P,
M$FAIL (NDV,Null device illegal)
E.WNO: MOVEI T1,E$$WNO
POPJ P,
M$FAIN (WNO,Node wildcards illegal)
E.WDV: MOVEI T1,E$$WDV
POPJ P,
M$FAIN (WDV,Device wildcards illegal)
E.CDR: HLRZS N
MOVEI T1,E$$CDR
POPJ P,
M$FAIO (CDR,Comma required in directory)
E.DDR: PUSHJ P,.NOCTW ;GRAB PROGRAMMER NUMBER FOR MESSAGE
MOVEI T1,E$$DDR
POPJ P,
M$FAIO (DDR,Double directory illegal)
E.RDR: HLRZS N
MOVEI T1,E$$RDR
POPJ P,
M$FAIO (RDR,Right bracket required in directory)
E.IPJ: TRNN N,-1 ;DON'T POSITION IF OK
HLRZS N
MOVEI T1,E$$IPJ
POPJ P,
M$FAIO (IPJ,Improper project number)
E.IPG: TRNN N,-1 ;DON'T POSITION IF OK
HLRZS N
MOVEI T1,E$$IPG
POPJ P,
M$FAIO (IPG,Improper programmer number)
E.SFD: MOVEI N,F.BLK
MOVEI T2,.FXLND-1
MOVEI T1,E$$SFD
POPJ P,
M$FAIF (SFD,SFD depth greater than)
E.NSF: MOVEI T1,E$$NSF
POPJ P,
M$FAIL (NSF,Null SFD illegal)
E.UKS: MOVEI T1,E$$UKS
POPJ P,
M$FAIN (UKS,Unknown switch)
E.ABS: MOVEI T1,E$$ABS
POPJ P,
M$FAIN (ABS,Ambiguous switch)
E.NSS: CAIN T1,0 ;PASS ERROR RETURN UP TO FILIN
MOVEI T1,E$$NSS
POPJ P,
M$FAIL (NSS,No switch specified)
E.SWI: MOVEI T1,E$$SWI
POPJ P,
M$FAIN (SWI,Switch wildcards illegal)
E.UKK:: JUMPGE T1,E.ASV ;SEE IF AMBIGUOUS
E.USV: MOVEI T1,E$$USV
POPJ P,
M$FAIN (USV,Unknown switch value)
E.ASV: MOVEI T1,E$$ASV
POPJ P,
M$FAIN (ASV,Ambiguous switch value)
E.UDS: MOVE N,@SWN(P2)
MOVEI T1,E$$UDS
POPJ P,
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)
MOVEI T1,E$$DSI
POPJ P,
M$FAIN (DSI,Double switch illegal)
E.NMA: MOVE N,@SWN(P2)
MOVEI T1,E$$NMA
POPJ P,
M$FAIN (NMA,No modifier allowed on switch)
E.SVTL::MOVEI T1,E$$SVL
POPJ P,
M$FAID (SVL,Switch value too large)
E.SVNG::MOVEI T1,E$$SVN
POPJ P,
M$FAID (SVN,Switch value negative)
E.ILC:
E.MRP:
E.SENS: MOVEI T1,E$$ILC
POPJ P,
E.SVR:: MOVE N,@SWN(P2)
MOVEI T1,E$$SVR
POPJ P,
M$FAIN (SVR,Switch value required on)
E.LVI: MOVEI T1,E$$LVI
POPJ P,
M$FAIL (LVI,<Length values inconsistent; specify min:max>)
E.PND: MOVEI T1,E$$PND
POPJ P,
M$FAIL (PND,Parenthesis nesting too deep)
E.UOP: SETZM FLFLLP ;CLEAR ( SWITCH AND GIVE ERROR [543]
MOVEI T1,E$$UOP
POPJ P,
M$FAIL (UOP,Unmatched open parenthesis)
E.STB: MOVEI T1,E$$STB ;STRING TOO BIG
POPJ P, ;ERROR
M$FAIL (STB,String too big)
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::PUSHJ P,.DYTIG ;READ THE DATE/TIME ARGUMENT
JRST (T1) ;ERROR
POPJ P, ;SUCCESS
.DYTIF::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DYTIG::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: PUSHJ P,DATIM ;GET DATE/TIME
POPJ P, ;ERROR RETURN
;RDH CAMGE N,NOW ;SEE IF IN FUTURE
;RDH JRST E.NFT ;NO--NOT FUTURE ERROR
JRST .POPJ1 ;SUCCESSFUL RETURN
;.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::PUSHJ P,.DYTIQ ;READ THE DATE/TIME
JRST (T1) ;ERROR
POPJ P, ;SUCCESSFUL RETURN
.DYTIP::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DYTIQ::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: PUSHJ P,DATIM ;GET DATE/TIME
POPJ P, ;ERROR RETURN
;RDH CAMLE N,NOW ;SEE IF IN PAST
;RDH JRST E.NPS ;NO--NOT PAST ERROR
JRST .POPJ1## ;SUCCESSFUL RETURN
;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
;.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::PUSHJ P,.DYTIC ;READ THE DATE/TIME
JRST (T1) ;ERROR
POPJ P, ;SUCCESSFUL RETURN
.DYTIM::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DYTIC::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
;GENERIC DATE/TIME GETTER - ENTERED FROM ASSORTED PLACES
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 DATIMA ;NO - ALPHABETIC MNEMONIC OR SOMETHING
JRST DATIMD ;YES--GO GET DECIMAL
;HERE IF STARTING WITH ALPHA, MIGHT BE DAY, MONTH, OR MNEMONIC
DATIMA: PUSHJ P,.SIXAC ;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,DTIME ;GO CHECK TIME
JRST [JUMPN T1,.POPJ## ;PROPAGATE ERROR
HRRZ N,(P) ;NO--USE VALUE IN DATE
JRST .+1] ;CONTINUE
POP P,T1 ;RESTORE DATE
HLL N,T1 ; TO ANSWER
;**; [576] Delete one line @ DATIMW + 5L, add lines at same
;**; [576] location. LLN, 9-Sep-76
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]
PUSH P,N ;SAVE DATE
PUSHJ P,DTIME ;GO CHECK TIME
JRST [JUMPN T1,.POPJ## ;PROPAGATE ERROR
HRRZ N,(P) ;NO--USE VALUE IN DATE
JRST .+1] ;CONTINUE
POP P,T1 ;RESTORE DATE
HLL N,T1 ; TO ANSWER
JRST DATIMX ;AND GO FINISH UP [305]
;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,DTIME ;GO CHECK FOR TIME
JRST [JUMPN T1,.POPJ## ;PROPAGATE ERROR
MOVEI N,0 ;ELSE JUST RETURN 0 TIME
JRST .+1] ;CONTINUE
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,DTIME2 ;GET REST OF TIME
JRST [JUMPN T1,.POPJ## ;PROPAGATE ERROR (E.G., FIELD TOO LARGE)
OUTSTR [ASCIZ\? Impossible null return from DTIME2 in DATIT\]
EXIT 1, ;DIE SINCE WE ARE TERRIBLY CONFUSED
JRST .+1] ;KEEP GOING, SEE WHAT HAPPENS
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,.SIXAC ;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
CAIE T1,2 ;DO WE KNOW THE CENTURY?
JRST DATIY2 ;YES -- NO NEED TO TEST FOR ASSUMPTIONS
ADDI T2,^D1900 ;NO -- ADD 1900 TO IT
CAIGE T2,^D1964 ;.LT. 1964?
ADDI T2,^D100 ;YES -- ASSUME THEY MEAN 20xx
MOVEI T1,4 ;INDICATE WE HAVE A 4-DIGIT YEAR
DATIY2: 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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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,DTIME ;GET TIME IF PRESENT
JRST [JUMPN T1,.POPJ## ;PROPAGATE ERROR
SKIPG FLFUTD ;IGNORE ABSENCE
JRST .+1 ;UNLESS FUTURE
JRST .+2] ;CONTINUE
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 ; ..
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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]
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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]
PUSHJ P,STRNML ;STORE DATE/TIME VALUE
CAML N,[<1964-1859>*365+<1964-1859>/4+<31-18>+31,,0] ;[261]
JRST .POPJ1## ;SKIP RETURN TO INDICATE SUCCESS
JRST E.DOR ;ELSE FLAG DATE/TIME OUT-OF-RANGE ERROR
RADIX 8
;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
DTIME: SETZ T1, ;IN CASE NO TIME
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
DTIME2: 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 DTIME6 ;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 DTIME6 ;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
DTIME6: 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
;RDH E.NFT: MOVEI T1,E$$NFT
;RDH POPJ P,
;RDH M$FAIL (NFT,Date/time must be in the future)
;RDH E.NPS: MOVEI T1,E$$NPS
;RDH POPJ P,
;RDH M$FAIL (NPS,Date/time must be in the past)
E.NND: MOVEI T1,E$$NND
POPJ P,
M$FAIL (NND,Negative number in date/time)
E.NPF: MOVEI T1,E$$NPF
POPJ P,
M$FAIL (NPF,Not known whether past or future in date/time)
E.DFL: MOVEI T1,E$$DFL
POPJ P,
M$FAIL (DFL,Field too large in date/time)
E.DFZ: MOVEI T1,E$$DFZ
POPJ P,
M$FAIL (DFZ,Field zero in date/time)
E.UDM: JUMPGE T1,E.ADM ;DIFFERENT IF AMBIGUOUS
MOVEI T1,E$$UDM
POPJ P,
M$FAIN (UDM,Unrecognized month in date/time)
E.ADM: MOVEI T1,E$$ADM
POPJ P,
M$FAIN (ADM,Ambiguous month in date/time)
E.ILR: MOVEI T1,E$$ILR
POPJ P,
M$FAIL (ILR,Illegal year format in date/time)
E.UDN: JUMPGE T1,E.ADN ;DIFFERENT IF AMBIGUOUS
MOVEI T1,E$$UDN
POPJ P,
M$FAIN (UDN,Unrecognized name in date/time)
E.ADN: MOVEI T1,E$$ADN
POPJ P,
M$FAIN (ADN,Ambiguous name in date/time)
E.MDD: MOVEI T1,E$$MDD
POPJ P,
M$FAIL (MDD,Missing day in date/time)
E.DTM: MOVEI T1,E$$DTM
POPJ P,
M$FAIL (DTM,Value missing in date/time)
E.MDS: MOVE N,(T1) ;GET NAME OF SWITCH
MOVEI T1,E$$MDS
POPJ P,
M$FAIN (MDS,Mnemonic date/time switch not implemented)
E.DOR: MOVEI T1,E$$DOR
POPJ P,
M$FAIL (DOR,Date/time out of range)
;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 TELEPHONE NUMBER
;.PNMNW -- INPUT TELEPHONE NUMBER
;.PNMNC -- DITTO FIRST CHARACTER IN C
;
;A "TELEPHONE" NUMBER IS DEFINED AS:
;
; [[<PCHAR>]] [ "(" <DCHAR><DCHAR><DCHAR> ")"] [[PCHAR]]
;
; <DCHAR> ::= "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", -
; "*", "#"
; <PCHAR> ::= ".", "-", "X", <DCHAR>
;
;THE "*" AND "#" DIGITS EQUATE TO TOUCHTONE KEYS OF SAME GRAPHIC
;THE "." DIGIT INDICATES A 5-SECOND PAUSE IN THE DIALING SEQUENCE;
;THE "-" AND "X" CHARACTERS ARE NOISE CHARACTERS ALLOWED SIMPLY BECAUSE
;PHONE NUMBERS OFTEN CONTAIN THEM - A MAXIMUM OF ONE EACH IS ALLOWED.
;
;THE ENTIRE PHONE NUMBER MAY BE ENCLOSED IN DOUBLE-QUOTES (THIS IS THE
;ONLY WAY TO HAVE A LEADING "AREA CODE"). THE PHONE NUMBER SCAN WILL
;NORMALLY BE TERMINATED BY A SPACE - IF ENCLOSED IN QUOTES THEN SPACES
;ARE SIMPLY IGNORED.
;
;EXAMPLES:
;
; 1234 ;SMALL NUMBER, PROBABLY AN IN-HOUSE EXTENSION
; X1234 ;SAME THING
; 123-4567 ;NORMAL 7-DIGIT LOCAL PHONE NUMBER
; 1234567890 ;NORMAL 10-DIGIT LONG DISTANCE NUMBER
; "(123) 456-7890" ;NORMAL 10-DIGIT LONG DISTANCE NUMBER
; 9.1234567 ;"9", PAUSE, 7-DIGIT LOCAL PHONE NUMBER
; 9.(123)456-7890 ;"9", PAUSE, 10-DIGIT LONG DISTANCE NUMBER
; "9. (123) 456-7890" ;"9", PAUSE, 10-DIGIT LONG DISTANCE NUMBER
;
;RETURNS TWO-WORD MAXIMUM VALUE IN .NMUL, UPDATES C TO SEPARATOR CHARACTER.
;
;USES T1 - T4.
;A FEW INTERNAL FLAGS
PNM.OP==1B01 ;"("
PNM.OA==1B02 ;"(" FOR AREA CODE
PNM.CA==1B03 ;")" FOR AREA CODE
PNM.CP==1B04 ;")"
PNM.OQ==1B05 ;"""" FIRST
PNM.CQ==1B06 ;"""" LAST
PNM.DS==1B07 ;"-"
PNM.XX==1B08 ;"X" (EXTENSION)
.PNMNW::PUSHJ P,.TIAUC ;"PRIME THE PUMP"
.PNMNC::PUSHJ P,.PHNMC ;READ IN THE PHONE NUMBER
JRST (T1) ;ERROR
POPJ P, ;SUCCESSFUL RETURN
.PHNMW::PUSHJ P,.TIAUC ;"PRIME THE PUMP"
.PHNMC::PUSHJ P,.SAVE2## ;PROTECT THE P'S
SETZB T4,.NMUL ;INITIALIZE A FEW THINGS
SETZB P1,.NMUL+1 ;INITIALIZE A FEW MORE THINGS
SKIPA P2,[POINT 4,.NMUL] ;POINTER TO STORE PHONE NUMBER
;LOOP READING TELEPHONE NUMBER
PNMN10: PUSHJ P,.TIAUC ;GET THE NEXT CHARACTER
CAIL C,"0" ;NORMAL EVERYDAY DIGIT-TYPE NUMBER?
CAILE C,"9" ; . . .
JRST PNMN20 ;NO, LOOK FOR KINKIER CONSTRUCTS
; SUBI C,"0" ;YES, CONVERT TO BINARY DIGIT
PNMN15: IDPB C,P2 ;AND APPEND TO NUMBER SO FAR
PNMN17: HRRZ C,P2 ;ADDRESS LAST DEPOSITED
CAIG C,.NMUL+1 ;.GT. TWO WORDS' WORTH?
AOJA T4,PNMN10 ;NO, OK, LOOP BACK FOR MORE NUMBER
JRST E.PNL ;PHONE NUMBER TOO LONG
PNMN20: CAIN C,"(" ;AREA CODE?
JRST PNMN30 ;MAYBE
CAIN C,")" ;END AREA CODE?
JRST PNMN35 ;MAYBE
CAIN C,"""" ;QUOTING?
JRST PNMN40 ;MAYBE
CAIN C,"-" ;JUNK CHARACTER
JRST PNMN50 ;PROBABLY
CAIE C,"x" ;JUNK CHARACTER
CAIN C,"X" ;JUNK CHARACTER (SHIFTED)?
JRST PNMN55 ;PROBABLY
CAIN C,"." ;PAUSE?
JRST PNMN70 ;YES
CAIN C,"*" ;FUNCTION ESCAPE?
JRST PNMN72 ;YES
CAIN C,"#" ;FUNCTION ESCAPE?
JRST PNMN74 ;YES
CAIN C," " ;SPACE?
JRST PNMN80 ;YES - MAYBE IGNORE
;END OF NUMBER, DO SOME LAST MINUTE SYNTAX CHECKING
PNMN21: TXNE P1,PNM.OA ;SEEN START OF AREA CODE?
TXNE P1,PNM.CA ;YES, SEEN END ALSO?
JRST PNMN22 ;OK
JRST E.PNA ;ILLEGAL AREA CODE
PNMN22: JUMPL C,PNMN29 ;EOL IS OK FROM HERE ON
; TXNN P1,PNM.OP ;STARTED WITH OPEN PAREN?
; JRST PNMN23 ;NO
; JUMPL C,PNMN29 ;EOL IS OK
; CAIN C,"," ;COMMA IS ALSO OK
; JRST PNMN29 ;SINCE MUST BE MULTIPLE ARGS
; JRST E.PNP ;PARENTHESIS NOT MATCHED
PNMN23: TXNN P1,PNM.OQ ;STARTED WITH OPEN QUOTE?
JRST PNMN29 ;NO
JRST E.PNQ ;QUOTES NOT MATCHED
PNMN29: MOVEI T1,17 ;END OF NUMBER CODE
IDPB T1,P2 ;TERMINATE PHONE NUMBER SCAN
HRRZ T1,P2 ;GET LAST ADDRESS DEPOSITED
CAILE T1,.NMUL+1 ;PHONE NUMBER FIT?
JRST E.PNL ;NO, TOO LONG
LDB T1,[POINT 4,.NMUL+1,35] ;PICK UP 18TH DIGIT
JUMPE T1,.POPJ1## ;MAXIMUM IS 17 DIGITS
JRST E.PNL ;PHONE NUMBER TOO BIG
;HANDLE "(" - MAY BE AREA CODE, OR WHOLE NUMBER
PNMN30:;TXNE P1,PNM.OA ;CLEAR SO FAR?
; JRST E.PNA ;SOMETHING WRONG
; TXOE P1,PNM.OP ;NOTE OPEN PAREN
; JRST PNMN32 ;OOPS - ALREADY BEEN HERE, MUST BE AREA CODE
; JUMPE T4,PNMN10 ;LEGAL ONLY IF PRECEDES ALL DIGITS
; TXZ P1,PNM.OP ;NOT WHOLE NUMBER, MUST BE AREA CODE
PNMN32: HRR P1,T4 ;STORE NUMBER OF DIGITS AT START OF AREA CODE
TXON P1,PNM.OA ;NOTE AREA CODE STARTED
JRST PNMN10 ;KEEP SCANNING
JRST E.PNP ;ILLEGAL PARENTHESIS
;HANDLE ")"
PNMN35: TXNE P1,PNM.OA ;INSIDE AREA CODE?
JRST PNMN37 ;YES
PNMN36:;TXNE P1,PNM.OP ;NO, INSIDE PAREN?
; PUSHJ P,.TIAUC ;YES, GRAB CHARACTER FOLLOWING
JRST PNMN21 ;AND GET OUT OF HERE
PNMN37: TXOE P1,PNM.CA ;NOTE END OF AREA CODE
JRST PNMN36 ;OOPS - ALREADY ENDED AREA CODE
HRRZ T1,P1 ;DIGIT COUNT AT START OF AREA CODE
MOVNS T1 ;NO SUB TO MEMORY
ADD T1,T4 ;T1:=COUNT OF DIGITS IN AREA CODE
CAIN T1,3 ;AREA CODES ARE THREE DIGITS LONG
JRST PNMN10 ;BACK FOR MORE NUMBER
JRST E.PNB ;BAD AREA CODE
;HERE FOR QUOTING
PNMN40: TXOE P1,PNM.OQ ;MARK QUOTING IN EFFECT
JRST PNMN43 ;OOPS - QUOTING WAS IN EFFECT ALREADY
JUMPE T4,PNMN10 ;LOOP BACK FOR THE ACTUAL NUMBER
TXZ P1,PNM.OQ ;NUMBER ALREADY STARTED,
JRST PNMN21 ;MUST BE END THEN
PNMN43: TXZ P1,PNM.OQ ;CLOSE THE QUOTING
PUSHJ P,.TIAUC ;GET CHARACTER AFTER QUOTE
JRST PNMN21 ;AND END THE NUMBER
;HERE FOR "-"
PNMN50: TXON P1,PNM.DS ;NOTE A DASH SEEN
JRST PNMN10 ;BACK FOR MORE NUMBER
JRST PNMN21 ;ALREADY SEEN DASH, END OF NUMBER
;HERE FOR "X"
PNMN55: TXON P1,PNM.XX ;NOTE AN X SEEN
JRST PNMN10 ;BACK FOR MORE NUMBER
JRST PNMN21 ;ALREADY SEEN X, END OF NUMBER
;HERE FOR "." - FIVE SECOND PAUSE
PNMN70: MOVEI C,16 ;PAUSE CODE
JRST PNMN15 ;STORE AND KEEP SCANNING
;HERE FOR "*" - FUNCTION ESCAPE
PNMN72: MOVEI C,12 ;"*" CODE
JRST PNMN15 ;STORE AND KEEP SCANNING
;HERE FOR "#" - FUNCTION ESCAPE
PNMN74: MOVEI C,13 ;"#" CODE
JRST PNMN15 ;STORE AND KEEP SCANNING
;HERE FOR A SPACE
PNMN80: TXNE P1,PNM.OQ ;IF QUOTING THE NUMBER
JRST PNMN10 ;THEN JUST IGNORE ANY SPACES
JRST PNMN21 ;NOT QUOTED, THEN MUST BE DONE
;PHONE NUMBER ERRORS
E.PNL: MOVEI T1,E$$PNL
POPJ P,
M$FAIL (PNL,Telephone number too long)
E.PNA: MOVEI T1,E$$PNA
POPJ P,
M$FAIL (PNA,Telephone number area code construction illegal)
;E.PNP: MOVEI T1,E$$PNP
; POPJ P,
; M$FAIL (PNP,Telephone number parenthesis not matched)
E.PNQ: MOVEI T1,E$$PNQ
POPJ P,
M$FAIL (PNQ,Telephone number quotes not matched)
E.PNP: MOVEI T1,E$$PNP
POPJ P,
M$FAIL (PNP,Telephone number parenthesis illegally used)
E.PNB: MOVEI T1,E$$PNB
POPJ P,
M$FAIL (PNB,Telephone number area code not three digits)
E.PNS: MOVEI T1,E$$PNS
POPJ P,
M$FAIL (PNS,Telephone number "*" not supported)
E.PNH: MOVEI T1,E$$PNH
POPJ P,
M$FAIL (PNH,Telepone number "#" not supported)
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,.CHCNV ;IF A ^V, ASSUME QUOTING A NAME
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
SKIPE DIRMOD ;ARE WE IN "FORCED NAME MODE"?
PJRST NAMST ;THEN GET THE NAME
CAIE C,.CHCNV ;IF A ^V THEN ASSUME A NAME
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,.CHCNV ;IF A ^V THEN IS ALPHANUMERIC
CAIE C,"#" ;SEE IF OCTAL SPECIFICATION
JRST NAMWD ;NO--GET ALPHANUMERIC
NAMNUR: SETOM FLNULL ;INDICATE SOMETHING FOUND
NAMNU: PUSHJ P,.TIAUC ;YES--GET NEXT DIGIT
NAMNU1: CAIE C,"?" ;SEE IF WILD CARD
CAIN C,"%" ;(TOPS-20'S WAY)
CAIA ;WILDCARD CHARACTER
JRST NAMNU2 ;NO--STUFF
LSH T2,3 ;YES--GET 0 INTO MASK
LSH N,3 ;UPDATE NAME
TRO N,3 ;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 DIGIT
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: SKIPLE .QUOTE ;SEE IF QUOTE SET
JRST NAMWDS ;YES--JUST STORE
CAIE C,"?" ;SEE IF WILD CARD
CAIN C,"%" ;(TOPS-20'S WAY)
CAIA ;WILDCARD CHARACTER
JRST NAMWD1 ;NO--STUFF
TLNE T3,(77B5) ;YES--UPDATE MASK
IDPB T1,T3
JRST NAMWDS ;GO UPDATE NAME
NAMWD1: PUSHJ P,.TICAD ;SEE IF ALPHA-NUMERIC OR DASH
JRST [CAIE C,.CHCNV ;IF A ^V THEN QUOTE NEXT CHARACTER
JRST NAMWDD ;NOT, END THE WORD
PUSHJ P,.TIGET ;READ IN NEXT COMMAND CHARACTER
JUMPLE C,NAMWDD ;EOL ALSO ENDS WORD
SKIPG NSCTR ;### DOING STRING JUNK?
JRST .+1 ;### NO, SKIP IT
SOS NSCTR ;### COUNT ANOTHER CHARACTER
IDPB C,NSPTR ;### AND STASH IT AWAY
JRST .+1] ;GO STORE QUOTED CHARACTER
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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
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 OCTIN0 ;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
OCTIN0: PUSH P,P1 ;SAVE ACCUMULATOR [273]
MOVEI P1,0 ;CLEAR ACCUMULATOR FOR DECIMAL [273]
CAIN C,"#" ;FORCING OCTAL?
JRST OCTIN2 ;YES, HOW CONVENIENT
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
;.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::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]
SKIPA T1,[POINT 7,.NMUL] ;[1003] INITIALIZE BYTE POINTER
ASCM0: PUSHJ P,.TIALT ;[1003] ADVANCE TO FIRST CHARACTER OF STRING
PUSHJ P,.TICQT ;[1003] CHECK FOR QUOTING
ASCM1: SKIPLE .QUOTE ;SEE IF IN QUOTED STRING
JRST ASCM2 ;YES--JUST GO STORE
PUSHJ P,.TICAD ;SEE IF LEGITIMATE ALPHA-NUMERIC (OR DASH)
JRST [CAIE C,.CHCNV ;IF A ^V, THEN QUOTE SINGLE CHARACTER
POPJ P, ;NOT, MUST BE DONE
PUSHJ P,.TIGET ;GET NEXT INPUT CHARACTER
JUMPLE C,.POPJ## ;EOL TERMINATES INPUT STRING
JRST .+1] ;GO STORE QUOTED CHARACTER
ASCM2: CAME T1,[POINT 7,.NMUE,34] ;SEE IF OVERFLOW
IDPB C,T1 ;NO--STORE
ASCM3: PUSHJ P,.TIALT ;GET NEXT CHARACTER
JRST ASCM1 ;LOOP BACK TO PROCESS IT
;.ASUID -- INPUT A USERID STRING HANDLING QUOTING
;
;A "USERID" IS DEFINED AS FOLLOWS:
;
; <USR>[:[<ACT][:<PSW>]]
;
;WHERE <USR> IS THE USERID STRING, <ACT> IS THE ACCOUNT STRING TO BE
;ASSOCIATED WITH <USR>, AND <PSW> IS THE PASSWORD ASSOCIATED WITH <USR>.
;
;EACH ELEMENT IS MAX OF 8 WORDS LONG.
;
;THE USERID IS AN ASCII STRING ALLOWING []<>, CHARACTERS, THE ACCOUNT
;AND PASSWORD STRINGS ARE NORMAL ASCII.
;
;RETURNS "USERID" IN .NMUL
.ASUID::PUSHJ P,.TIALT ;PRIME THE PUMP
.ASUIC::SETZM .NMUL ;CLEAR STRING BLOCK BUILDING AREA
MOVE T1,[.NMUL,,.NMUL+1] ;BLT POINTER TO
BLT T1,.NMUE ;CLEAR REST OF BUILDING AREA
HRROI T1,.TSTRG## ;ASCII STRING TYPEOUT
MOVEM T1,.LASWD ;SET FOR ERROR PRINTING
MOVE T1,[POINT 7,.NMUL+<0*^D8>] ;STRING BUILDER POINTER
CAIN C,":" ;BLANK USERID?
JRST [MOVEI N,1 ;YES, FLAG NEED TO PROMPT
MOVEM N,.NMUL ;STORE UID VALUE
JRST ASUID5] ;CONTINUE WITH ACCOUNT, PASSWORD
PUSHJ P,.TICQT ;CHECK FOR QUOTED STRING
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;LOOP READING USER ID STRING
ASUID1: SKIPLE .QUOTE ;QUOTING IN EFFECT?
JRST ASUID2 ;YES, ACCEPT ANYTHING
PUSHJ P,.TICAD ;SEE IF ALPHANUMERIC/ETC.
JRST [CAIE C,"[" ;ALLOW []
CAIN C,"]" ; . . .
JRST ASUID2 ;ACCEPT THESE CHARACTERS
CAIE C,"<" ;ALLOW <>
CAIN C,">" ; . . .
JRST ASUID2 ;ACCEPT THESE CHARACTERS
CAIE C,"." ;ALLOW DOTS
CAIN C,"," ;ALLOW COMMA TOO
JRST ASUID2 ;ACCEPT THESE CHARACTERS
CAIN C,"_" ;I'M TOLD THAT VAXEN ALLOW UNDERSCORE
JRST ASUID2 ;ACCEPT EVEN THAT
CAIE C,.CHCNV ;MAYBE A ^V
JRST ASUID5 ;NO, END OF USER ID
PUSHJ P,.TIGET ;YES, QUOTE SINGLE CHARACTER
JUMPLE C,ASUID5 ;WATCH OUT FOR EOL
JRST ASUID2] ;STORE ^V'ED CHARACTER
ASUID2: CAME T1,[POINT 7,.NMUE,34] ;FULL YET?
IDPB C,T1 ;STORE CHARACTER
PUSHJ P,.TIALT ;GET ANOTHER CHARACTER
JRST ASUID1 ;LOOP BACK
;CHECK FOR ACCOUNT STRING
ASUID5: SETZM .NMUL+<1*^D8> ;JUST TO MAKE SURE
CAIE C,":" ;ACCOUNT STRING TOO?
JRST ASUID6 ;NO
MOVE T1,[POINT 7,.NMUL+<1*^D8>] ;BYTE BUILDER
PUSHJ P,ASCM0 ;[1003] READ IN ACCOUNT STRING
;CHECK FOR PASSWORD
ASUID6: SETZM .NMUL+<2*^D8> ;JUST TO MAKE SURE
CAIE C,":" ;PASSWORD TOO?
JRST ASUID9 ;NO
MOVE T1,[POINT 7,.NMUL+<2*^D8>] ;BYTE BUILDER
PUSHJ P,ASCM0 ;[1003] READ IN PASSWORD
ASUID9: SETZ T1, ;NULL TO MAKE ASCIZ STRINGS
DPB T1,[POINT 7,.NMUL+<0*^D8>+7,34] ;ASCIZIZE USERID
DPB T1,[POINT 7,.NMUL+<1*^D8>+7,34] ;ASCIZIZE ACCOUNT STRING
DPB T1,[POINT 7,.NMUL+<2*^D8>+7,34] ;ASCIZIZE PASSWORD
POPJ P, ;RETURN
;.SIXAW -- INPUT A SIXBIT WORD (ALPHANUMERIC ONLY) FROM COMMAND STRING
;.SIXAC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE FIRST SIX
;CALL: PUSHJ P,.SIXAC/.SIXAW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.SIXAW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.SIXAC::PUSHJ P,.TICQT ;CHECK FOR QUOTING
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
SIXA1: SKIPLE .QUOTE ;QUOTING THE WHOLE NAME?
JRST SIXA4 ;YES, JUST STORE QUOTED CHARACTER
PUSHJ P,.TICAN ;SEE IF CHARACTER IS ALPHA-NUMERIC
JRST [CAIE C,.CHCNV ;IF A ^V THEN QUOTE NEXT CHARACTER
JRST STRNML ;NOT, END WORD
PUSHJ P,.TIGET ;GET NEXT COMMAND CHARACTER
JUMPLE C,STRNML ;EOL ALSO ENDS WORD
JRST .+1] ;GO STORE THE QUOTED CHARACTER
SIXA4: CAIGE C,"z" ;IF PAST LOWER-CASE "Z"
CAIGE C," " ;OR A CONTROL-CHARACTER
JRST STRNML ;THEN END OF STRING
CAIN C,"`" ;OR IF AN ACCENT GRAVE
JRST STRNML ;THEN END OF STRING
CAIL C,"a" ;IF LOWER CASE,
SUBI C,"a"-"A" ;THEN CONVERT TO UPPER CASE FIRST
SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;DON'T OVERFLOW
IDPB C,T1 ;STORE CHARACTER
ADDI C," "-' ' ;[1034] BACK TO ASCII
PUSHJ P,.TIAUC ;GO GET ANOTHER CHARACTER
JRST SIXA1 ;LOOP BACK TO PROCESS IT
;.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::PUSHJ P,.TICQT ;CHECK FOR QUOTING
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: SKIPLE .QUOTE ;QUOTING THE WHOLE NAME?
JRST SIXS4 ;YES, JUST STORE QUOTED CHARACTER
PUSHJ P,.TICAD ;SEE IF CHARACTER IS ALPHA-NUMERIC (OR DASH)
JRST [CAIE C,.CHCNV ;IF A ^V THEN QUOTE NEXT CHARACTER
JRST STRNML ;NOT, END WORD
PUSHJ P,.TIGET ;GET NEXT COMMAND CHARACTER
JUMPLE C,STRNML ;EOL ALSO ENDS WORD
JRST .+1] ;GO STORE THE QUOTED CHARACTER
SIXS4: CAIGE C,"z" ;IF PAST LOWER-CASE "Z"
CAIGE C," " ;OR A CONTROL-CHARACTER
JRST STRNML ;THEN END OF STRING
CAIN C,"`" ;OR IF AN ACCENT GRAVE
JRST STRNML ;THEN END OF STRING
CAIL C,"a" ;IF LOWER CASE,
SUBI C,"a"-"A" ;THEN CONVERT TO UPPER CASE FIRST
SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;DON'T OVERFLOW
IDPB C,T1 ;STORE CHARACTER
ADDI C," "-' ' ;[1034] BACK TO ASCII
PUSHJ P,.TIAUC ;GO GET ANOTHER CHARACTER
JRST SIXS1 ;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 ;SEE IF LEGITIMATE ALPHA-NUMERIC (OR DASH)
JRST [CAIE C,.CHCNV ;IF A ^V THEN QUOTE THE NEXT CHARACTER
POPJ P, ;NOT, MUST BE DONE
PUSHJ P,.TIGET ;GET NEXT COMMAND CHARACTER
JUMPLE C,.POPJ## ;EOL ALSO ENDS STRING
JRST .+1] ;GO STORE QUOTED CHARACTER
SIXM2: CAIGE C,"z" ;IF PAST LOWER-CASE "Z"
CAIGE C," " ;OR A CONTROL-CHARACTER
POPJ P, ;THEN END OF STRING
CAIE C,"`" ;OR IF AN ACCENT GRAVE
POPJ P, ;END STRING
CAIL C,"a" ;IF LOWER CASE,
SUBI C,"a"-"A" ;THEN CONVERT TO UPPER CASE FIRST
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
SUBTTL SUBROUTINES FOR COMMAND INPUT -- GET NEXT CHARACTER
;.TICAN -- CHECK CHARACTER FOR ALPHA-NUMERIC
;.TICAD -- CHECK CHARACTER FOR ALPHA-NUMERIC OR DASH/DOLLAR
;ALPHA-NUMERIC IS A-Z OR 0-9
;CALL: MOVEI C,ASCII CHARACTER
; PUSHJ P,.TICAN/TICAD
; RETURN IF NOT ALPHA-NUMERIC
; SKIP RETURN IF ALPHA-NUMERIC
;PRESERVES ALL ACS
.TICAD::CAIE C,"-" ;NEW-FANGLED NAME CHARACTER?
CAIN C,"$" ;NEW-FANGLED NAME CHARACTER?
JRST .POPJ1## ;RETURN "ALPHA-NUMERIC" PLUS
.TICAN::CAIL C,"0" ;IF
CAILE C,"9" ; NUMERIC
CAIL C,"A" ; OR
CAILE C,"Z" ; ALPHABETIC
CAIL C,"a" ; or
CAILE C,"z" ; alphabetic
POPJ P, ;NOT
JRST .POPJ1## ;TAKE ALPHANUMERIC RETURN
;.TINBL -- INPUT ONE NON-BLANK CHARACTER
;.TINBC -- DITTO, START WITH CHAR IN C
;CALL: PUSHJ P,.TINBL/.TINBC
; RESULT IN C
;USES NO ACS
.TINBL::PUSHJ P,.TIALT ;GET ANOTHER CHARACTER
.TINBC::CAIE C,.CHTAB ;IF A TAB
CAIN C," " ; OR A SPACE
JRST .TINBL ;THEN EAT IT, GET NEXT CHARACTER
POPJ P, ;RETURN NON-BLANK CHARACTER IN C
;.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]
SKIPLE .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::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
PUSHJ P,.TICHG ;### READ IN ANOTHER CHARACTER
SKIPG NSCTR ;### STRING BUILDING?
POPJ P, ;### NO
CAILE C,177 ;### NORMAL ASCII?
JUMPG C,[PUSH P,C ;### MUST BE GUIDE WORD OR THE LIKE
MOVEI C,177 ;### REASONABLY-CONSISTENT JUNK
PUSHJ P,.+1 ;### STASH AS THE STRING CHARACTER
POP P,C ;### RESTORE REAL WHATEVER
POPJ P,] ;### AND RETURN THAT TO CALLER
SOS NSCTR ;### YES, DECREMENT ROOM LEFT
IDPB C,NSPTR ;### ACCUMULATE CHARACTER STRING
POPJ P, ;### RETURN WITH CHARACTER IN "C"
;.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
SKIPG .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,.CHGWD(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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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
.TYI:: SKIPE SAVCHR ;SEE IF ANYTHING SAVED
JRST [MOVE C,SAVCHR ;YES--RE-USE IT
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 TYIT ;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
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.BLK+.FXDEV ;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 RE-EAT IT
IFN DEBUG$,<
JRST [OUTSTR [ASCIZ\? Attempt to read past end of command line\]
EXIT 1, ;STOP HERE
JRST TYIF] ;START UP A NEW LINE, SEE WHAT HAPPENS
>
;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 .QUOTE ;SEE IF QUOTING IN EFFECT
JRST TISCNQ ;NO--PROCEED
JUMPLE C,TISCNE ;IF EOL, END QUOTE
CAME C,.QUOTE ;YES--SEE IF QUOTE CHAR
JRST 3(T1) ;NO--RETURN LITERALLY
PUSHJ P,.TICHT ;YES--GET NEXT CHAR
CAMN C,.QUOTE ;SEE IF QUOTE AGAIN
JRST 3(T1) ;YES--RETURN ONE
;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.BLK+.FXDEV ;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
PUSHJ P,.CLOSU ;CLEAR ^O TTY OUTPUT SUPPRESSION
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
SKIPA ;NO--LEAVE ALONE
MOVEI C," " ;YES--MAKE INTO SPACE
POPJ P, ;RETURN
.TICHE::
TYICH1:!PUSHJ P,.TIGET ;GET ONE CHARACTER
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
CAIN C,.CHALX ;IF SOME TYPE OF ALT-MODE,
PUSHJ P,[SKIPE A.BLK+.FXDEV ;ESC, AT TOP-LEVEL COMMAND INPUT?
SKIPE FLIIND ;NO, COMMAND FILE. INTERACTIVE?
PJRST .TCRLF## ;TOP LEVEL, OR INTERACTIVE COMMAND
POPJ P,] ;NO FREE <CR><LF> ECHO FOR <ESC>
CAIL C,.CHLFD ;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: SKIPE PREMPT ;SEE IF PRE-EMPTIVE INPUT [544]
PJRST @PREMPT ; YES--GO USE IT INSTEAD [544]
IFN M$INDP,<
SKIPE A.BLK+.FXDEV ;SEE IF INDIRECT
JRST TYIIND ;YES--GET NEXT CHAR FROM FILE INSTEAD OF TTY
>
CAMN C,[.CHEOF] ;IF TTY INPUT WRONG, GIVE IT BACK [322]
POPJ P, ;RETURN [322]
SKIPE TYPIN ;SEE IF CALLER SUPPLYING TYPIN [322]
PJRST @TYPIN ;YES--GET FROM HIM [322]
INCHWL C ;NO--GET FROM USER
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 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
;.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]
.TYICH::EXCH T1,TYPIN ;SET NEW INPUT PROCESSOR
POPJ P, ;RETURNING PREVIOUS IN T1
;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.BLK+.FXDEV ;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.BLK ;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
AOJL C,TYINGF ;EXIT IF EOF
PUSH P,T1 ;MAKE ROOM
MOVE T1,B.INDC ;GET CHAR COUNT
CAIGE T1,5 ;SEE IF SOME MORE LEFT
JRST TYIIGN ;NOT ENOUGH--IGNORE SEQ. TEST
HRRZ T1,B.IND+1 ;GET SECTION-LOCAL ADDRESS OF BYTE POINTER
MOVE T1,(T1) ;GET CURRENT DATA WORD FROM BUFFER
TRNN T1,1 ;SEE IF FLAG SET
TYIIGN: JRST [POP P,T1 ;NO--RESTORE TEMP
SOS C ;CORRECT OFFSET COUNT
POPJ P,] ;AND RETURN
MOVEI T1,5 ;GOT A SEQUENCE--ZAP 5 MORE CHARS
TYIIGL: PUSHJ P,TYIIGC ;GET CHAR TO THROW AWAY
AOJL C,TYINGP ;EXIT IF EOF
SOJG T1,TYIIGL ;NO--LOOP UNTIL CAUGHT UP
POP P,T1 ;RESTORE TEMP
;STILL UNDER M$INDP
;HERE TO READ ONE CHAR FROM BUFFER
TYIIGC: SOSLE B.INDC ;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
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
TYIIN0: MOVE T1,[.TCRRF,,T2] ;CORE FUNCTION TO READ FILE
HRLZ T2,A.LOOK+.RBNAM ;NAME OF CCL FILE
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
;**;[573] Insert @ TYIIN2+8L JNG 17-Mar-76
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
MOVE T1,.JBFF ;SEE HOW MUCH MONITOR GRABBED
CAILE T1,A.BUFE ;COMPARE WITH OUR FIXED ALLOCATION
JRST [OUTSTR [ASCIZ\? Indirect file I/O buffer overflow\]
EXIT] ;THIS IS A FATAL ERROR!
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
MOVE T4,A.BLK+.FXFLD ;GET FIELDS FLAGS
TXNN T4,FX.UEX ;USER SPECIFY AN EXTENSION?
TLZN T2,-1 ;NO--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]
;**; [600] DELETE AT E.IFL+12 LCR 21-JAN-77.
JRST EINDL2 ;AND SUPPRESS ERROR MESSAGE [324]
EINDL1: MOVEI N,A.BLK ;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.BLK ;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.BLK+.FXDEV ;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
MOVE T3,[IOWD LN$ABF,A.BUF]
TMPCOR T1, ; FILE
JFCL ;IGNORE ERROR
KILINE: SETZM A.BLK+.FXDEV ;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.BLK ;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.BLK+.FXDEV ;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,
PUSHJ P,.RUNCL ; CLEAR /RUN
SKIPE USRERR ;IF USER PROVIDED AN ERROR INTERCEPT ROUTINE
PJRST @USRERR ;THEN BLINDLY GO TO IT
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,-6(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
;.CLEOL -- EAT TEXT UP TO NEXT END OF LINE
.CLEOL::SKIPA C,LASCHR ;GET LAST CHARACTER SEEN
PUSHJ P,.TICHR ;READ ANOTHER ONE
JUMPG C,.-1 ;LOOP TILL END OF LINE
CAIA ;CLEAR OUT "OLD" JUNK
;.CLRTI -- RESET COMMAND TEXT INPUT PROCESSOR
.CLRTI::MOVE C,LASCHR ;GET LAST THING SEEN
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
POPJ P, ;AND RETURN
;.CLOSU -- CLEAR ^O TERMINAL OUTPUT SUPPRESSION
.CLOSU::PUSHJ P,.SAVE4## ;NEED FOUR SCRATCH ACS HERE
MOVEI P4,0 ;0 = CLEAR ^O
MOVE P3,.MYTTY ;CONTROLLING TERMINAL UDX
MOVEI P2,.TOOSU+.TOSET;FUNCTION: ^O
MOVE P1,[3,,P2] ;TRMOP. ARGUMENT POINTER TO
TRMOP. P1, ;CLEAR ^O SUPPRESSION
SKPINL ;FAILED???
JFCL ;LA TI DA
POPJ P, ;RETURN READY FOR NEW OUTPUT
;.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]
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
STDPTR: IOWD STSWTL,STSWTN ;IOWD POINTER TO STANDARD SWITCH NAMES
STDSWC: ;POINTERS TO STANDARD (LOCAL) SWITCH TABLES
IFIW STSWTN(P1) ;POINTER TO NAME
IFIW STSWTP(P1) ;POINTER TO STORAGE
IFIW STSWTM(P1) ;POINTER TO MAX,,PROCESSOR
IFIW STSWTD(P1) ;POINTER TO DEFAULT
;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
.MYPTH::BLOCK .PTMAX ;THIS JOB'S DEFAULT PATH
.MYJOB::BLOCK 1 ;THIS JOB'S JOB NUMBER
.MYPRG::BLOCK 1 ;THIS JOB'S PROGRAM NAME
.MYTTY::BLOCK 1 ;THIS JOB'S CONTROLLING TTY UDX
.MYTWD::BLOCK 1 ;THIS JOB'S TTY'S WIDTH
.MYNOD::BLOCK 1 ;THIS JOB'S HOST NODE NAME
.MYNNM::BLOCK 1 ;THIS JOB'S HOST NODE NUMBER
.PPMFD::BLOCK 1 ;MASTER FILE DIRECTORY PPN
.PPFFA::BLOCK 1 ;FULL FILE ACCESS (OPR) PPN
.PPOLD::BLOCK 1 ;"OLD" SYSTEM LIBRARY PPN
.PPSYS::BLOCK 1 ;"STANDARD" SYSTEM LIBRARY PPN
.PPNEW::BLOCK 1 ;"NEW" SYSTEM LIBRARY PPN
;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 ;SCAN FLAGS [366]
USRERR: BLOCK 1 ;USER ERROR INTERCEPT (FROM FMSGE)
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
.QUOTE::BLOCK 1 ;QUOTING CHARACTER IN EFFECT
IFN M$INDP,<
N.BLK: BLOCK .FXEZM ;FILE SPEC BLOCK FOR RUN COMMAND
N.CORE::BLOCK 1 ;CORE ARG
N.OFFS::BLOCK 1 ;OFFSET
N.OPEN: BLOCK 3 ;OPEN BLOCK
N.LOOK: BLOCK 7 ;LOOKUP BLOCK
A.BLK:: BLOCK .FXEZM ;INDIRECT COMMAND FILE SPEC BLOCK
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.BLK:: BLOCK .FXLEN ;THE STICKY FILE STUFF
P.SNOD: BLOCK 4 ;### STICKY NODE STRING
P.SDEV: BLOCK 4 ;### STICKY DEVICE STRING
P.SDIR: BLOCK 12 ;### STICKY DIRECTORY STRING
P.SNAM: BLOCK 12 ;### STICKY NAME STRING
P.SEXT: BLOCK 12 ;### STICKY EXTENSION STRING
P.SGEN: BLOCK 4 ;### STICKY GENERATION STRING
F.BLK:: BLOCK .FXLEN ;THE BEING-BUILT FILE SPEC BLOCK
FLFSP: BLOCK 1 ;FLAG SOMETHING FOUND
FLQUO: BLOCK 1 ;FLAG QUOTED STRING
F.XZER==.-1
G.BLK: BLOCK F.XZER-F.BLK+1 ;PUSH DOWN FOR FILE SWITCHES
G.XZER==.-1
FSCTR: BLOCK 1 ;### STRING-BUILDER BYTE COUNTER (MASTER)
FSPTR: BLOCK 1 ;### AND BYTE POINTER (MASTER)
NSCTR: BLOCK 1 ;### STRING-BUILDER BYTE COUNTER (ACTIVE)
NSPTR: BLOCK 1 ;### AND BYTE POINTER (ACTIVE)
SWTCNT: BLOCK 1 ;RECURSION COUNTER FOR FILSP
FLFLLP: BLOCK 1 ;RECURSION COUNTER FOR (...) IN FILSP
DIRMOD::BLOCK 1 ;MODE INDICATOR FOR .FILSP -- IF 0, DIRECTORY
;SPECS STARTING WITH DIGITS ARE PPNS, OTHERWISE
;THEY'RE DIRECTORY NAMES ON OTHER FILESYSTEMS.
IFN M$INDP,<
OPTION::BLOCK 1 ;NAME OF /OPTION (-1 IF DEFAULT, 0 IF /NOOPTION)
>
SAVUPC: BLOCK 1 ;ORIGINAL CALLER'S PC (FOR FXVERC)
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]
FLJCMD: BLOCK 1 ;.NE. 0 THEN "PRE-PARSED" TINY SHEEP COMMAND
FLKCMD: BLOCK 1 ;LAST/PENDING COMMAND
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=()
;**;[577] Delete @ FLSECE JNG 18-Jan-77
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 .STOPB -- ROUTINE TO CONVERT SCAN BLOCKS TO MONITOR
SUBTTL
SEARCH SWIDEF, SWIL ;SWIL PACKAGE DEFINTIONS
SEARCH JOBDAT, MACTEN, UUOSYM ;STANDARD DEFINITIONS
SALL ;PRETTY LISTINGS
.DIREC FLBLST ;PRETTIER LISTINGS
TWOSEG 400000 ;NICE PURE CODE
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986,1988. ALL RIGHTS RESERVED.
COMMENT \
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986,1988. 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.
\
;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
PUSHJ P,TSAV14## ;SAVE THE T'S ALSO (FOR LH LENGTHS)
ANDI T1,-1 ;*X* ASSUME SECTION-RELATIVE ADDRESS
ANDI T3,-1 ;*X* ASSUME SECTION-RELATIVE ADDRESS
MOVE P3,.FXFLD(T1) ;GET FIELDS FLAGS
TXNE P3,FX.WDV!FX.WDR!FX.WNM!FX.WEX ;ANY [PERTINENT] WILDCARDS?
POPJ P, ;YES, ERROR
SKIPE P3,.FXNOD(T1) ;GET NODE SPECIFICATION (IF ANY)
CAMN P3,.MYNOD## ;SOMETHING TYPED, IS IT LOCAL?
CAIA ;OK
POPJ P, ;NOT LOCAL NODE SPECIFIED
SKIPN P3,.FXDEV(T1) ;GET DEVICE
MOVSI P3,'DSK' ;DEFAULT IF BLANK
MOVEM P3,.OPDEV(T2) ;STORE IN OPEN BLOCK
MOVE P1,.FXMOD(T1) ;GET SWITCHES
TXNE P1,FX.PHY ;SEE IF /PHYSICAL
DEVCHR P3,UU.PHY ;YES, PHYSICAL-ONLY DEVCHR
TXNN P1,FX.PHY ;SEE IF /PHYSICAL
DEVCHR P3, ;NO, ALLOW LOGICAL NAMES ETC.
LDB P2,[POINTR .FXCTL(T1),FX.IOM] ;GET I/O MODE (DEFAULT 0 = ASCII)
TXNE P1,FX.PHY ;SEE IF /PHYSICAL
TXO 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,.OPMOD(T2) ;SET I/O MODE/STATUS WORD OF OPEN BLOCK
HLRZ P3,-T3(P) ;RETRIEVE LOOKUP BLOCK LENGTH (IF ANY)
CAIE P3,0 ;IF NONZERO
MOVEM P3,.RBCNT(T3) ;THEN SET LOOKUP BLOCK LENGTH
MOVE P3,.FXNAM(T1) ;GET NAME
MOVEM P3,.RBNAM(T3) ;STORE IN LOOKUP BLOCK
MOVE P3,.FXEXT(T1) ;GET EXTENSION
HLLZM 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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVEI P3,0 ;INITIALLY NO PATH
MOVE P2,.FXFLD(T1) ;GET FIELDS FLAGS
SKIPE .FXDIR(T1) ;IF NO DIRECTORY SPECIFIED, OR
TXNE P2,FX.DPN ;IF USER ASKED FOR []
JRST STOPND ;USE []
STOPNR: MOVE P3,.FXDIR(T1) ;GET PPN
SKIPN .FXDIR+2(T1) ;SEE IF SFDS
JRST STOPND ;NO--GO STORE AND RETURN
JUMPE T4,.POPJ## ;MAKE SURE WE HAVE A PATH BLOCK
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
ADDI P1,2 ;ADVANCE FETCH
AOBJN P2,STOPNS ;LOOP UNTIL DONE
STOPNT: MOVEI P3,(T4) ;INDICATE SFD
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
STOPND: MOVEM P3,.RBPPN(T3) ;SET INTO LOOKUP
HLRZ P1,-T1(P) ;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(P) ;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
SUBTTL
SEARCH SWIDEF, SWIL ;SWIL PACKAGE DEFINTIONS
SEARCH JOBDAT, MACTEN, UUOSYM ;STANDARD DEFINITIONS
SALL ;PRETTY LISTINGS
.DIREC FLBLST ;PRETTIER LISTINGS
TWOSEG 400000 ;NICE PURE CODE
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986,1988. ALL RIGHTS RESERVED.
COMMENT \
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986,1988. 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.
\
;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
;**;[574] Insert @ GETNW2+6L JNG 4-May-76
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
END