Trailing-Edge
-
PDP-10 Archives
-
BB-D868D-BM
-
4-sources/scan11.mac
There are 14 other files named scan11.mac in the archive. Click here to see a list.
;<2-UTILITIES>SCAN11.MAC.2, 11-Apr-77 17:01:54, EDIT BY HURLEY
;CAHNGED FMSG TO FMES TO ASSEMBLE WITH RELEASE 2 MACSYM
UNIVERSAL $SCNDC -- DECLARATIONS FOR COMMAND SCANNER
IF1,< ;DEFINE ONLY DURING PASS 1
;DEFINE MACRO TO PASS DECLARATIONS ON TO EACH SUB-MODULE
DEFINE $SCNDC,<
SUBTTL P.CONKLIN/DJB/DMN/DAL/PFC -- %11(571) 14-JUL-75
LALL
;***COPYRIGHT 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
SALL ;;SUPPRESS MACRO LISTINGS
SCNDC1 ;;GET REST OF DECLARATIONS
> ;END OF $SCNDC
CUSTVR==0 ;CUSTOMER VERSION
DECVER==11 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==571 ;DEC EDIT VERSION
;ASSEMBLY INSTRUCTIONS:
;MAKE A FILE, U.MAC, CONTAINING JUST %.C==-3
;.COMPILE U+C(P,,),U+SCNMAC(P,,),SCAN(P,,),HELPER
;THEN LOAD THE .REL FILE WITH ANY PROGRAM
;************ W A R N I N G ************
;** CHANGE SCANDM IF LOW-SEG CHANGES **
;***************************************
SEARCH MACTEN
;AC NAMES
T1=1 ;TEMPORARIES
T2=2
T3=3
T4=4
P1=5 ;PRESERVED ACS FOR CALLING ROUTINES
P2=6
P3=7
P4=10
P=17 ;PUSH-DOWN POINTER
SUBTTL PARAMETERS AND DEFAULTS
SYN IFE,IF
ND TOPS,20 ;WHICH OPERATING SYSTEM
IF TOPS-10,< SEARCH SCNM10>
IF TOPS-20,< SEARCH SCNM20>
;ASSEMBLY PARAMETERS
ND DEBUG$,1 ;1=INCLUDE DEBUGGING FEATURES
ND ECHO$C,0 ;1=ECHO COMMAND STRING AS CHARACTER PROCESSED
ND ECHO$P,0 ;1=ECHO COMMAND STRING AS PHRASE PROCESSED
ND ECHO$W,0 ;1=ECHO COMMAND STRING AS WORD PROCESSED
ND FT$ALT,0 ;1=CONVERT 175,176 TO 033
IF TOPS-10,<
ND FT$SFD,-1 ;SUB-FILE DIRECTORIES
ND FT$UEQ,1 ;1=UNDERLINE SAME AS EQUALS
ND FT$ESC,1 ;ESCAPE IS END-OF-LINE
> ;END TOPS-10
IF TOPS-20,<
ND FT$SFD,0 ;SUB-FILE DIRECTORIES
ND FT$UEQ,-1 ;-1=UNDERLINE SAME AS ALPHA
ND FT$ESC,0 ;ESCAPE IS NOT END-OF-LINE
ND LTXTBF,^D250 ;LENGTH OF RDTTY BUFFER IN BYTES
ND .STEML,^D50 ;LENGTH OF STRING TEMP (.STEMP) IN WORDS
> ;END TOPS-20
ND LN$ABF,200 ;LENGTH OF INDIRECT BUFFER
ND M$INDP,^D10 ;MAX. INDIRECT DEPTH (-1=INF., 0=NONE)
DM MSG,77777,0,7 ;MESSAGE
IF TOPS-10,<
DM PRO,777,0,277 ;PROTECTION
>
IF TOPS-20,<
DM PRO,777777,0,570000 ;PROTECTION
>
DM RNC,777777,0,0 ;RUN CORE
DM RUN,7,-1,1 ;RUN OFFSET
VRBADX==10 ;/MESSAGE:ADDRESS
;COMPLETE DEFINITION OF DECLARATIONS MACRO
DEFINE SCNDC1,<
IF TOPS-10,<
SEARCH SCNM10,MACTEN,UUOSYM
>
IF TOPS-20,<
SEARCH SCNM20,MACTEN,MACSYM,MONSYM
.TCRDF==2 ;TMPCOR READ
.TCRWF==3 ;TMPCOR WRITE
.JBFF==121 ;FIRST FREE
>
XP %%SCAN,CUSTVR*1B2+DECVER*1B11+DECMVR*1B17+DECEVR
%%%SCN==:DECVER ;PROTECTIVE VERSION NUMBER [546]
PURGE CUSTVR,DECVER,DECMVR,DECEVR,....
TWOSEG
RELOC 400000
;MACROS TO DO SOME SIMPLE THINGS USING UUO OR JSYS CALLS
DEFINE CLEARO,<
IF TOPS-10,<
SKPINL
JFCL
>
IF TOPS-20,<
PUSH P,T1
PUSH P,T2
MOVEI T1,.PRIOU
RFMOD
TXZ T2,TT%OSP
SFMOD
POP P,T2
POP P,T1
>>
IF TOPS-20,<
DEFINE OUTSTR (TEXT)<
PUSH P,1
HRROI 1,TEXT
PSOUT
POP P,1
>
DEFINE OUTCHR (ACC)<
IFN ACC-1,<
PUSH P,1
HRRZ 1,ACC
>
PBOUT
IFN ACC-1,<
POP P,1
>
>
> ;END TOPS-20
> ;END OF SCNDC1
; TABLE OF CONTENTS FOR SCAN
;
;
; SECTION PAGE
; 1. PARAMETERS AND DEFAULTS............................... 2
; 2. REVISION HISTORY...................................... 4
; 3. DEFINITIONS FOR THIS SUB-MODULE....................... 12
; 4. INITIALIZE............................................ 14
; 5. TRADITIONAL COMMAND SCANNER........................... 20
; 6. MAIN LOOP FOR TRADITIONAL COMMAND SCANNING............ 23
; 7. VERB FORM COMMAND SCANNER............................. 26
; 8. OPTION FILE SCANNER................................... 29
; 9. PARTIAL SCANNER....................................... 32
; 10. INDIRECT FILE SETUP AND FINISH........................ 35
; 11. RUN COMMAND PROCESSING................................ 40
; 12. SUBROUTINES FOR COMMAND INPUT -- FILE SPECIFICATION... 41
; 13. SUBROUTINES FOR COMMAND INPUT -- SWITCH/VERB PROCESS.. 50
; 14. SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME........ 70
; 15. SUBROUTINES FOR COMMAND INPUT -- GET WORD/STRING...... 80
; 16. SUBROUTINES FOR COMMAND INPUT -- GET NEXT CHARACTER... 94
; 17. INDIRECT FILE HANDLING................................ 103
; 18. ROUTINE TO CONVERT SCAN BLOCKS........................ 111
; 19. SUBROUTINES FOR ERROR MESSAGE OUTPUT.................. 112
; 20. STORAGE............................................... 118
; 21. .VERBO MODULE......................................... 123
; 22. .TNEWL DUMMY MODULE................................... 126
; 23. .TOUTS MODULE......................................... 127
; 24. .STOPB MODULE......................................... 140
; 25. .CNTDT MODULE......................................... 144
; 26. .GTPUT MODULE......................................... 148
; 27. .SAVEn MODULE......................................... 151
SUBTTL REVISION HISTORY
;%1 (SCANER) -- 6/71 WITH 5.03 MONITOR
;A) MOVE MACROS TO C.MAC AND SCNMAC.MAC. USE ALL BIT AND
; BYTE DEFINITIONS FROM C.MAC. DEFINE FILE SPEC AREA
; IN SCNMAC.MAC.
;B) RESTRICT AC USAGE TO 1-10 (1-4 TEMPS, 5-10 PRESERVED).
; FLAGS AND MASK MOVED TO CORE. NAME MOVED TO 7, CHARACTER
; TO 10.
;C) INDIRECT I/O REDUCED TO CHANNEL 0 AND READ ONE BLOCK AT A TIME.
;D) CHARACTER CODING CHANGED TO FOLLOWING: ESCAPE=0, END OF LINE=-1,
; END OF FILE=-2. OCCASIONALLY 200 IS END OF LINE (SAVCHR).
;E) ALL UUOS AND THEIR BITS, BYTES, AND FUNCTIONS ARE SYMBOLIZED WITH
; C.MAC.
;F) CALLING SEQUENCES CHANGED TO BE A BLOCK POINTED TO FROM AC1 TO GIVE
; UPWARD GROWTH COMPATIBLY. MANY PARAMETERS ARE OPTIONAL.
;G) INDIRECT/CCL CODE PLACED UNDER CONDITIONAL.
;H) TYPEOUT CHARACTER ROUTINE SEPARATED. CAN BE ARGUMENT.
;I) ALLOW PROGRAM TO SPECIFY A PRESET INDIRECT FILE.
;J) CHANGE ALL INTERNALS TO INCLUDE PERIOD IN NAME.
;K) WHEN SKIPPING OVER RESCANNED LINE, AVOID POSSIBLE TT IN WAIT.
;L) RECODE EOF HANDLING TO COVER ALL CASES.
;M) ADD TSCAN ARGS TO GIVE USER CONTROL AT KEY POINTS IN SCAN.
;N) CHANGE MESSAGE FROM "ILLEGAL COMMAND SYNTAX CHARACTER" TO
; "ILLEGAL CHARACTER". TYPEOUT ASCII 7,11-15,33 MNEMONICALLY.
;O) IMPLEMENT MULTIPLE OUTPUT SPECS FOR COMPILERS. IF MULT. OUTPUT,
; THE = (OR _) IS MANDATORY.
;P) ADD WORDS FOR /BEFORE/SINCE. SWITCH SCAN WILL BE IMPLEMENTED
; LATER. ALSO ADD .GTNOW (INTERNAL DATE FORMAT CONVERTER).
;Q) ADD MESSAGE "?PROTECTION SWITCH ILLEGAL IN INPUT FILE".
; REMOVE "? TOO MANY INPUT FILES".
;R) IMPLEMENT /RUN/RUNOFFSET SWITCHES.
;S) IN VERB MODE, PERIOD BEFORE VERB SETS STICKY DEFAULTS.
; CHANGE LOGIC SO VERBS FOR A FILE APPEAR AFTER THE
; FILES DEFINITION.
;T) DEFEAT ^O BEFORE TYPING * / OR #.
;U) IN VERB MODE, ADD NEW MESSAGE
; ? EXCESS ARGUMENTS STARTING WITH ....
;V) IN VERB MODE, IGNORE LEADING /. THIS ALLOWS /HELP TO
; WORK IN ANY PROGRAM.
;W) .VSCAN WILL RETURN ONLY AT TOP LEVEL EOF.
;X) GENERALIZE /HELP ARGUMENT TO GIVE SIXBIT PROGRAM NAME
; (-1 FOR GETTAB 3) TO USE AS ARGUMENT TO HELPER.
;Y) PUT LIMIT OF 10 ON INDIRECT FILES (ASSEMBLY PARAM)
; ADD MESSAGES:
; ? INDIRECT SPECIFICATION INCOMPLETE
; ? TOO MANY INDIRECT FILES
; ? WILDCARD ILLEGAL IN INDIRECT SPECIFICATION
;Z) IN FILE SCAN, FORCE NAME TO LEFT HALF.
;AA) IN /RUN, DON'T ALLOW SWITCHES.
;AB) IF NO FILE NAME, MAKE FILE SPEC STICKY.
;AC) DETECT NULL DEVICE PROPERLY.
;AD) IMPLEMENT PATH SPECIFICATION. ALSO NOTATIONS [,] [P,]
; [,P] AND [-].
;AE) ADD ROUTINE .GTSPC TO MOVE FILE SPEC TO STORAGE.
;AF) ADD DEFAULT DEVICE 'DSK:' IF USER TYPES PART OF A SPEC BUT
; OMITS THE DEVICE.
;AG) ADD INTERNAL (STANDARD) SWITCHES WHICH COMPETE EQUALLY
; FOR ABBREVIATIONS, BUT ON EXACT EQUIVALENCE THE CALLER'S
; SWITCHES OVERRIDE.
;AH) ADD MESSAGE: ? AMBIGUOUS SWITCH.
;AI) IF SWITCH TABLES GIVE NO MAX, THEN ALWAYS GO TO PROCESSOR.
; IF SWITCH TABLES OMIT POINTER (LH=0), CALL ROUTINE
; POINTED TO BY RH.
;AJ) ALLOW KEYWORD SWITCHES TO GET VALUE "0" TO CLEAR INDEX.
;AK) EXPAND TWO WORD SIXBIT SCAN TO BE MULTIWORD.
;AL) ADD /HELP:SWITCHES TO LIST ACTUAL SWITCH TABLE.
;AM) ADD SWITCH TABLE PREFIX '*' TO MEAN ALL ABBREVIATIONS ARE
; EXACT MATCHES.
;AN) ADD STANDARD SWITCHES /DENSITY,/OKNONE,/PARITY,/PHYSICAL,
; /PROTECTION,/STRS.
;AO) ADD MESSAGES:
; ? IMPROPER PROJECT NUMBER
; ? IMPROPER PROGRAMMER NUMBER
; ? SFD DEPTH GREATER THAN 5
; ? NULL SFD ILLEGAL
; ? NO SWITCH SPECIFIED
; ? SWITCH VALUE NEGATIVE
;AP) CORRECT LOGIC WHICH MEMORIZED STICKY SWITCHES.
;AQ) # PREFIX ON DECIMAL INPUT IMPLIES OCTAL INPUT.
;AR) ALLOW - ON DECIMAL/OCTAL INPUT.
;AS) RECODE ALGORITHM WHICH HANDLES CONTINUATION, COMMENTS, AND
; MULTIPLE SPACES TO HANDLE ALL CASES CORRECTLY.
;AT) ADD CHKACC UUO ON INDIRECT FILES LOOKUPS IN CASE CALLER
; HAS JACCT ON.
;AU) IF NO . IN @, CHECK .(NUL) AFTER .CCL.
;AV) SKIP SEQUENCE NUMBERS IN @ FILE.
;AW) RECODE END/ERROR LOGIC ON @ FILES TO ALWAYS HANDLE CCL
; FILES CORRECTLY. IN PARTICULAR, DELETE .TMP FILES
; AFTER SUCCESSFUL CCL CALL.
;AX) CHANGE OCTAL FATAL MESSAGE TO RH(N) FOR CONSISTENCY.
;AY) ON ERROR IN INDIRECT FILE, SKIP TO END OF LINE.
;AZ) ON VERB @ ERROR, TERMINATE @ FILE.
;BA) WHEN DOING MONRT., RESET ALL I/O. IF NOT LOGGED IN,
; EXCLUDE THE ^D IN PREVIOUS VERSIONS.
;BB) ADD NEW ROUTINE (.TFBLK) TO TYPE SCAN STYLE FILESPEC AREA.
;BC) ADD NEW ROUTINE (.TDIRB) TO TYPE DIRECTORY IN SINGLE WORD,
; SFD, OR SCAN FORMATS.
;BD) ADD NEW ROUTINE (.TFCHR) TO TYPE POSSIBLE FUNNY CHARS.
; IT HANDLES CONTROL AND LOWER CASE FLAGGING.
;BE) EXPAND ALL P,PN HANDLING TO ALLOW ONE SIXBIT WORD INSTEAD
; OF TWO OCTAL HALF WORDS.
;BF) CHANGE CALLS TO ALL TYPEOUT ROUTINES TO PASS ARGS IN T1.
;BG) REMOVE ALL OUTSTR/OUTCHR CALLS EXCEPT PROMPTS.
;BH) HANDLE SIGNED NUMBERS IN RADIX TYPER.
;BI) CHANGE SAVEN CALL TO BE PUSHJ.
;BJ) INTERN F.NAM AS FLAG FOR SWITCH SCANNERS.
;%2(127) -- 5/72 WITH DIRECT %2.
;130 REMOVE INTERNS. MAKE ALL DOT SYMBOLS INTERN WITH ::.
;131 REMOVE # OUTPUT ON INDIRECT CONTINUATIONS (SPR 10-7212).
;132 BAN MULTIPLE BUFFER INDIRECT FILE ONLY ON DTA (SPR 10-7212).
;133 SPLIT .TICHT FROM .TICHE
;134 FIX BUG IN .CNVDT
;135 ADD .CNTDT (INVERSE OF .CNVDT)
;136 CREATE .PSCAN FOR PEOPLE WITH PARTIAL SCAN NEEDS
;137 CHANGE ALLDON TO .ALDON
;140 CLEAR SCANPC ON .CLRBF
;141 ADD PROTECTIVE TESTS TO CNVDAT
;142 ADD TTY INPUT AND MONRET ROUTINES IN ISCAN CALL
;143 CHANGE RUNXYZ TO N.XYZ; USE .FX SYMBOLS
;144 ADD /BEFORE/SINCE SWITCHES
;145 ALLOW / BETWEEN PROJ AND PROG IN DIRECTORIES
;146 DON'T FLUSH NULL FILE SPECS
;147 ADD DATE/TIME SCANNERS.
;150 ADD .OSCAN ROUTINE.
;151 ADD /OPTION SWITCH TO SELECT OPTIONS FROM SWITCH.INI FILE.
;152 ADD .SWFIL TO HANDLE FILE SWITCHES
;153 CANCEL 145 AS A BAD IDEA.
;154 HANDLE MISSING DIRECTORIES IN OPTIONS LOOKUPS. CORRECT BUG
; WHICH DECREMENTED START ADDRESS ON OPTIONS NOT FOUND.
;155 CREATE ROUTINE .TERRP (WAS FMADDR)
;156 SPLIT INTO 4 SUB-MODULES--SCAN, OUTPUT, DATE, SAVE
;157 CREATE UNIVERSAL .SCNDC TO PASS PARAMETERS TO EACH SUB-MODULE
;160 HANDLE NUMBERS IN ILL.CHAR MESSAGE
;161 UPDATE LASCHR ON STRING INPUT (.TIGET)
;162 DEFINE .SCANZ AND .SCANL FOR SEGMENT SHUFFLERS
;163 CLEAN UP EXTERNS WITH GLOB.SNO
;164 GIVE USER EXIT ONLY ON HIS OWN SWITCHES
;165 ADD .TTABC ROUTINE TO TYPE A TAB, ETC.
;166 ALLOW FOR PARTIAL WORD IN LAST WORD OF IND. FILE BUFFER
;167 ADD .TTIME, .TDATE TO TYPE OUT DATE AND TIME
;170 MAKE MULTIWORD AREA HANDLE WORST CASE (30. WORDS)
;171 FIX .TRDXW TO HANDLE 1B0 CORRECTLY
;172 FIX .NAME ON SIX LETTER * SWITCHES
;173 CORRECT PDL ERROR IN .FMSGX ROUTINE IF .TSCANNING
;%3(173) -- 12/72 WITH DIRECT%3 AND DUMP%4
;174 ADD /NOSTRS /NOPHYSICAL AND /ERNONE
;175 ADD /NOOPTION
;176 FIX .PSCAN BUG IF <EOL> AFTER MONITOR COMMAND
;177 ADD DEFENSIVE HALT TO ENSURE THAT .OSCAN IS CALLED ONLY AT <EOL>
;200 (10-SEVERAL) DETECT USER ERROR OF "0" AS PROJECT OR PROGRAMMER
;201 CLEAR STICKY DEFAULTS EACH LINE OF .VSCAN AND .PSCAN
;202 E.INCL, E.ILSC INTERN
;203 FIX BUG IN HANDLING OF [] IN /RUN:
;204 CLEAR .NMUL AREA ON EACH SWITCH
;205 FIX /H:S IF NO SWITCHES. MAKE .SWHLP INTERNAL
;206 (10-9709) PRINT WILD PPNS WITH ? INSTEAD OF 7.
;207 (10-10004) ALLOW /RUN IN OPTION FILE; HANDLE AT END (AFTER
; COMMAND); HANDLE /SW:FILE LIKE OTHER SWITCHES.
; MAKE N.ZER AND N.EZER INTERN FOR .PSCAN CALLERS.
;210 MULTI-WORD STORE WAS MISCHECKING DUPLICATE SWTICHES
;211 DISTINGUISH AMBIGUOUS FROM UNKNOWN SWITCH VALUES
;212 REMOVE 175, 176 CHECKS. CAN BE RESTORED BY FT$ALT==1
;213 SET FX.NDV EVEN IF NO DEVICE SET
;214 (10-10123) REMOVE PURESW SINCE IT DOESN'T WORK
;215 CREATE A DUMMY FILE "SCANDM.MAC" WHICH CAN BE LOADED
; WITH OTHER OVERLAYS OF MULTI-SEGMENT PROGRAMS TO RESERVE
; SCAN'S LOW SEG AREA.
;216 SUPPORT FS.NFS
;217 SUPPORT FS.LRG
;220 CHANGE U.MOUT TO FS.MOT
;221 ADD .CKNEG, .SENEG
;222 IMPLEMENT .STOPN. SUPPORT SFDS ON @ AND /RUN. SUPPORT
; /DENSITY/PARITY/PHYSICAL ON @.
;223 HANDLE MONITOR COMMANDS R, RUN, AND START. IF ONE OF
; THESE, AND LINE HAS "-" OR "(", THEN DO ONLY ONE COMMAND,
; THAT WHICH IS AFTER THE "-" OR BETWEEN "(" AND ")".
;224 ACCEPT TMPXXX: FOR INDIRECT FILES. IF THE DEVICE DOES NOT
; EXIST, TRY TMPCOR USING FIRST THREE CHARS OF FILE
; NAME. IF THAT FAILS, TRY DSKXXX:NNNAAA.TMP WHERE NNN
; IS THE JOB NUMBER IN DECIMAL WITH LEADING
; ZEROS AND AAA IF THE FIRST THREE CHARS OF THE
; FILE NAME.
;225 ADD .PSH4T AND .POP4T ROUTINES
;226 ADD /RUNCORE:CORE AND .SWCOR AND .COREW/.COREC
;227 ADD FS.NUE TO SUPPRESS USER EXIT ON SOME SWITCHES
;230 ADD .TICQT/.TISQT TO CONTROL/SUPPORT QUOTED STRINGS. ALLOW
; .NAMEW (FILE NAMES, ETC.) TO HAVE QUOTED STRINGS
; WITHOUT WILD-CARDS. ADD .SIXQW/C, .ASCQW/C, .SWASQ,
; .SWSXQ TO HANDLE SIXBIT AND ASCII POSSIBLY QUOTED
; STRINGS. (QUOTE IS ' AND ").
;231 ADD .KLIND TO KILL INPUT FOR LINK-10 (/GO). CALL IT
; FROM /RUN PROCESSING FOR FORTRAN-10, ETC.
;232 ADD MULTIPLE SWITCH VALUES IN TSCAN/PSCAN MODES.
; EXCERCIZED BY /SWITCH:(VAL1,VAL2,...,VALN)
; REQUIRES USER EXIT SWITCH STORAGE TO AVOID DUPLICATE
; VALUE MESSAGE.
;233 HANDLE LOWER CASE IN .TICAN
;234 ADD ROUTINE .REEAT
;235 REQUIRE THAT SWITCH VALUES END WITH A NON-ALPHANUMERIC
;236 ADD /OKPROT/ERPROT
;237 SUPPORT FS.VRQ
;240 MAKE OPTION ERRORS APPEAR AS WARNINGS
;241 HANDLE VSCAN STICKY (PXXXX) ON MULTI-WORDS BUT NOT FILES
;242 FIX USER APPLY STICKY FOR TSCAN TO BE CALLED BEFORE ALLOC.
;243 ADD .CLRFL
;244 FIX BUG IN * HANDLING FOR PROJECTS
;245 RECOGNIZE @ ONLY AT START OF .TSCAN LINE
;246 ADD PROMPT ROUTINE SET BY .ISCAN; REMOVE ALL OUTCHR/OUTSTRS
;247 STORE ALL TERMINATORS OF CONCATENATED SPEC
;250 CORRECT BUG IN DATE DEFAULTER WHICH (AT 21:00) GAVE
; FOR /AFTER:21, <DAY>:22:00 INSTEAD OF <DAY+1>:21:00
;251 CORRECT NOT-LOGGED IN BUG WHEN DOING A MONRT. TO CALLER
;252 FOR THE CONVENIENCE OF 2741 USERS, ALLOW <> AS == TO []
;253 ON INDIRECT FILE, TRY .CMD AFTER .CCL ON NULL EXTENSION
;254 FIX BUG IN EDIT 200 WHICH CAUSES .<NUL> TO BE .*
;255 (10-11399,11423) /SINCE/BEFORE DID NOT DEFAULT ACROSS FILES
;256 GET ALL FIVE SFDS IN .TDIRB
;257 HANDLE YEARS GE 2000 IN .TDATE
;260 FIX BUG IN CCL MODE IF GT 1 BLOCK IN TMP FILE
;261 (10-11663) ALLOW JAN-1-64 IN DATES
;262 (QAR 1400) PRINT . AFTER "KJOB"
;263 ADD ROUTINE .MNRET
;264 CHANGE .PSCAN TO NOT HANDLE /RUN IMMEDIATELY
; ADD .RUNCM TO HANDLE /RUN SWITCH
;265 REMOVE ' AS A QUOTING CHARACTER TO AGREE WITH DEC
; COMMAND STANDARD
;266 CORRECT PSCAN BUG IN MIDDLE OF LINE
;267 (QAR 1396) PROMPT CONTINUATIONS IN COMMAND MODE
;270 REMOVE THE - OPTION ON RUN COMMANDS
;271 CANCEL 247 UNTIL STANDARD LANGUAGE IS DEFINED
;272 ADOPT ! AS AN ALTERNATE COMMENT CHARACTER
;273 HAVE TRAILING "." FORCE DECIMAL NUMBER
;274 SPIFF UP MESSAGE IF MISSING DATE/TIME VALUE
;275 BUG INTRODUCED SINCE VERSION 3
;%4(275) DEC, 1973
;276 MOVE .PTWRD HERE FROM .WILD; PUT INTO NEW SUBMODULE
; MOVE .MKMSK TO THAT ALSO
;277 SUPPORT FS.OBV
;300 ADD /MESSAGE, .FLVRB,.VERBO AS SEPARATE MODULE
;301 ADD ARG TO CLRFL
;302 SUPPORT FS.MIO
;303 OUTPUT SCN PREFIX SUPPORTING /MESSAGE
;304 ALLOW DEV:NAME ON RESCAN
;305 ADD YESTERDAY, TODAY, TOMORROW
;306 ADD .TVERW
;307 IMPLEMENT D.TODD'S LATEST .SAVEN
;310 USE GETTAB FOR .GTNOW IF AVAILABLE
;311 INCLUDE CLEANER DATE CONVERSION
;312 MAKE .MYPPN INTERNAL
;313 FIX ^Z IN .PSCAN; ALSO FIX RUN ()
;314 IMPROVE MESSAGES "FOLLOWING WORD"
;315 ADD .TDTYM
;316 SUPPORT "NO" SWITCHES
;317 (10-12400) FIX /RUN WHEN NOT LOGGED IN
;320 FIX @ LOGIC FOR NON-DIRECTORY DEVICES TO HANDLE MULTIPLE
; BUFFERS.
;321 ADD OPTION /MESSAGE:ADDRESS TO INCLUDE ADDRESSES OF
; ERROR ROUTINES
;322 HANDLE EOF CORRECTLY ON MULTIPLE PSCAN.
;323 FIX 312
;324 (10-12439) AVOID ERROR MESSAGES IF CCL FILE MISSING
;325 CONSIDER DUPLICATE SWITCH OF SAME VALUE NOT AN ERROR
;326 (10-12416) DETECT TIME GT 24 HOURS
;327 ADD .QSCAN
;330 (10-12344) IMPROVE MESSAGE IF JUNK AFTER IND FILE
;331 DETECT /BEFORE/SINCE DON'T OVERLAP
;332 ADD .STOPB AS SEPARATE MODULE
;333 ADD .ERMSG
;334 CHANGE .SCND? TO $SCND?
;335 HAVE .OSCAN CALL .QSCAN NOT .PSCAN
;336 ADD .TCORW, ALLOW W AT END OF CORE INPUT FOR WORDS AND
; ALLOW B FOR BLOCKS
;337 ADD .TBLOK, .BLOKW/C (SAME AS .COREW/C) WHICH INVOKES .TBLOK
;340 ADD .TOLEB
;341 ON OR-KEYS, ALLOW ALL AND NONE
;342 SN SWITCHES CAN TAKE :0,1,NO,YES,OFF,ON
;343 CALL SW PROCESSORS RET+1=DPB, +2=DON
;344 LIST OF NAMES TO .OSCAN
;345 DO ALL LINES IN SWITCH.INI
;346 ADD /LENGTH/ABEFORE/ASINCE/ERSUPERSEDE/ESTIMAT/VERSION. ERROR LVI.
;347 RECOMPUTE LOGGED IN STATUS FOR LOGIN.
;350 FIX EOF ON @ LINE
;351 (10-13045) CORRECT ERROR IF DEBUG$=0
;352 (QAR 1975) FIX BUG IN 316
;353 (QAR 1975) ALLOW DEFAULT OPTION IN VSCAN
;354 (QAR 1975) CLEAR ^O ON FIRST ? MESSAGE
;355 (QAR 1975) DEFINE .TNEWL IF CALLER DIDNt
;356 MOVE OPTION TEST TO E.DSI; MAKE E.DSI AND E.SVR GLOBAL
;357 ALLOW SWITCH ON FILE SPEC IN VSCAN IF FILE MODIFIER;
; FILE MODIFIERS AT VERB LEVEL SET STICKY DEFAULTS
;360 HANDLE R..(....) IN VSCAN WITH "/"=EOL
;361 MORE OF 352
;362 (WITHDRAWN)
;363 USE SCNMAC EDIT 77
;%5(363) JUNE, 1974
;364 DON'T CLOBBER FLVERB ON OSCAN/QSCAN
;365 ALLOW PSCAN RESCAN WITH JUST CUSP NAME TO HAVE MULT. LINES
;366 FIX EOF LOGIC FOR PSCAN FOR LOGIN
;367 REMOVE SPURIOUS NO-OPTION MESSAGE
;370 CLEANUP .OSCAN ERROR RECOVERY
;%6(370) JULY, 1974
;401 (QAR 2424) FIX 365 TO NOT FOUL UP TSCAN
;402 SAME AS 530
;501 (10-13597) MAKE .TSTRG REENTRANT
;502 (QAR 2384) LET @ WORK TO DTA:
;503 MAKE /MESS:(ALL,NOXX) WORK
;504 (QAR 2439) FIX .FOO/RUN
;505 ADD LOGIN AS A MNEMONIC TIME
;506 ADD /EXIT
;507 ADD GUIDE WORD CONCEPT
;510 RECOGNIZE FILE SEPARATORS 'AND', 'OR', 'NOT'
;511 PREPARE TO REMOVE UNDERLINE AS SAME AS EQUALS (UNDER FT$UEQ)
;512 ALLOW * AT END OF NAME (IN FUT., ? NOT MATCH NULL)
;513 ADD .OSDFS
;514 ADD NON-FILE SWITCHES BEFORE @ (ONLY FIRST LINE OF IND FILE)
;515 (QAR 1975) ALLOW A=B,C=D
;516 DON'T SET DSK: IF ONLY GLOBAL SWITCHES
;517 REMOVE DIALOGUE MODE INTRODUCTION
;520 ADD MNEMONIC DATE-TIME OF NOON AND MIDNIGHT
;521 IMPROVE SAVEN ROUTINES EVEN MORE
;522 ADD % ATTRIBUTES AND IGNORE THEM
;523 ADD GUIDES 4002-4011
;524 AVOID HALT ON @ ERRORS
;525 (10-13,818) FIX TO PROMPT ON CONTINUATION OF COMMAND
;526 (10-13,818) REMOVE FLSPRP AS REDUNDANT
;527 (10-13,817) DON'T DISCARD LEADING SPACE OF CONT. LINE
;530 (10-13,999) FIX BUG IN 313 WHICH DISALLOWED CONT. OF MONITOR COMMAND
;531 ALLOW /MESSAGE TO DEFAULT TO :(PREFIX,FIRST,CONT)
;532 ADD /TMPFILE SWITCH TO WRITE TMPCOR
;533 (10-13,943) DETECT A,B ERROR ON FS.MOT
;534 ADD (...) TO SET CLEAR DEFAULTS
;535 ALLOW @A,@B
;536 ADD DENSITIES OF 1600 AND 6250 FOR 5.07 AND 6.02.
;537 REMOVE NON-SWITCHES FROM .OSDFS LOGIC.
;540 FIX 535
;541 DON'T RECOGNIZE GUIDE WORDS IN QUOTES
;%7(541) OCT, 1974
;542 (10-15001) DETECT ILLEGAL DATE-TIME FORMATS BEFORE DEFAULTS
; ARE FILLED IN
;543 (10-15220) REMEMBER DEFAULTS AT ) INSTEAD OF CLEARING THEM
;544 (10-15135) ADD PREEMPTIVE TTY INPUT ROUTINE FOR LINK
;545 CLEAR CORE AT VERY START OF ISCAN
;546 ADD %%%SCN FOR MODULE STANDARD
;547 CORRECT BUG IN EDIT 357: ALSO ALLOW SWITCHES WITHOUT VALUES
;550 IF MULTIPLE OUTPUT AND MIX IN/OUT, DON'T REQUIRE =
;551 CLEAR DEVICE, ETC., BETWEEN LINES IN VERB MODE
;552 CORRECT BUG IN EDIT 551: CLEAR NON-SWITCH FLAGS BETWEEN LINES
;553 MAKE ROUTINE TO CLEAR STICKY PATH DEFAULTS INTERNAL (.CLSNS)
;554 CLEAR NEGATIVE FLAG FLNEG WHEN COMPLETED READING AN OCTAL FIELD
;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
;%7B(567) DEC, 1975 WITH BACKUP%2 AND LINK%
;570 ADD TOPS-20 CODE
;VERSION 11 FOR RUNOFF-20
> ;END OF IF1 FROM FIRST PAGE
PRGEND
TITLE .SCAN -- GENERALIZED USER MODE COMMAND SCANNER
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .ISCAN ;ONLY INITIALIZER SINCE THAT MUST BE CALLED
SUBTTL DEFINITIONS FOR THIS SUB-MODULE
;AC NAMES
N=P3 ;NUMBER OR NAME ACCUMULATION PRESERVED ONLY AT TOP LEVEL
C=P4 ;CHARACTER INPUT PRESERVED ONLY AT TOP LEVEL
;WITH THE FOLLOWING ENCODING:
; -2 =EOF
; -1 =EOL
; 0 =ESCAPE OR ALTMODE
; 1-177=ASCII CHARACTER
;THUS, TO TEST FOR END OF COMMAND LINE,
; JUMPLE C,...JUMP ON EOL...
PURGE P3,P4 ;NOT USED IN THIS SUB-MODULE
;I/O CHANNELS
IFN M$INDP,<
IND==0 ;INDIRECT FILE (TEMPORARY; ONLY OPEN WHEN PC IS IN SCAN)
>
;CHARACTERS
C.TE==7777 ;TEMPORARY EOL CODE FOR SAVCHR FLAG [507]
;TEMPORARY DEFS UNTIL DEFINED LATER ON
IF1,< FXNOTO==1,,1
FXNOTI==1,,0
FXNOTD==1,,0>
;M$FAIL (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR
DEFINE M$FAIL ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMES
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$FAIN (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N IN SIXBIT
DEFINE M$FAIN ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGN
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$FAID (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N IN DECIMAL
DEFINE M$FAID ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGD
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$FAIO (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N IN OCTAL
DEFINE M$FAIO ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGO
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
;M$MAIF (XYZ,FOO) SENDS TEXT FOO WITH PREFIX "SCNXYZ" AS A FATAL ERROR WITH N=ADDR OF FILE DESCRIPTOR
DEFINE M$FAIF ($PFX,$TEXT),<
E$$'$PFX: PJSP T1,FMSGF
XLIST
''$PFX'',,[ASCIZ \$TEXT\]
LIST
>
SUBTTL INITIALIZE
;.ISCAN--SUBROUTINE TO INITIALIZE COMMAND SCANNER
;CALL AC1=XWD LENGTH,BLOCK
; BLOCK+0=0 OR IOWD PTR TO A LIST OF LEGAL MONITOR COMMANDS
; IF 0, NO RESCAN IS DONE
; BLOCK+1=RH 0 OR SIXBIT CCL NAME
; IF 0, NO CCL MODE
; LH 0 OR ADDRESS OF STARTING OFFSET
; BLOCK+2=RH 0 OR ADDRESS OF CHARACTER TYPEOUT ROUTINE
; IF 0, OUTCHR WILL BE DONE FROM T1
; LH 0 OR ADDRESS OF CHARACTER INPUT ROUTINE
; MUST SAVE ALL ACS, CHAR IN P4
; BLOCK+3=0 OR POINTER (XWD LEN,BLOCK) TO INDIRECT FILE BLOCK
; A.DEV NE 0 TO USE BLOCK
; BLOCK+4=RH 0 OR ADDRESS OF MONRET ROUTINE
; LH 0 OR ADDRESS OF PROMPT ROUTINE
; CALLED WITH CHAR IN RH(T1), LH(T1) HAS
; 0 FOR FIRST LINE, -1 FOR CONTINUATION LINES
; BLOCK+5=LH FLAGS
; RH (FUTURE)
;VALUE AC1=INDEX IN TABLE OF COMMANDS IF FOUND(0,1,...), ELSE -1
.ISCAN::STORE T4,ZCOR,EZCOR,0 ;CLEAR ALL MEMORY [545]
MOVEM P,SAVPDP ;PRESET PDL MEMORY
SETZM SAVCAL ;CLEAR CALL MEMORY
PUSHJ P,.SAVE4## ;SAVE P1-P4
HLRZ T2,T1 ;GET ARGUMENT COUNT
PUSHJ P,.GTWRD## ;GET BLOCK+0
MOVEM T3,SWTPTR ;STORE POINTER TO COMMAND NAMES
PUSHJ P,.GTWRD## ;GET BLOCK+1
IFN M$INDP,<
HRRZM T3,CCLNAM ;SAVE CCL NAME
TRNE T3,-1 ;IF SETUP, CHECK OFFSET
HLRZ T3,T3 ;GET ADDRESS OF OFFSET
TRNE T3,-1 ;SKIP FETCH IF 0
MOVE P1,(T3) ;GET OFFSET
>
PUSHJ P,.GTWRD## ;GET BLOCK+2
HLRZM T3,TYPIN ;SAVE CHARACTER TYPEIN ROUTINE
HRRZS T3 ;CLEAR TYPEIN NAME
PUSH P,T3 ;SAVE CHARACTER TYPEOUT ROUTINE
PUSHJ P,.GTWRD## ;GET BLOCK+3
IFN M$INDP,<
SKIPN .FXZER(T3) ;SEE IF DEVICE
MOVEI T3,0 ;NO--CLEAR POINTER
MOVEM T3,USRIND ;SET FLAG OF USER SUPPLIED IND. FILE
JUMPE T3,ISCANI ;PROCEED IF NO FILE
HRLZ T4,T3 ;SETUP BLT
HRRI T4,A.ZER ; FROM USER
HLRZ T3,T3 ; TO A.ZER
CAILE T3,A.EZER-A.ZER+1
MOVEI T3,A.EZER-A.ZER+1
BLT T4,A.ZER-1(T3) ;BUT NOT TOO FAR
>
ISCANI: PUSHJ P,.GTWRD## ;GET BLOCK+4
HLRZM T3,PROMPT ;SAVE USER PROMPT ROUTINE
HRRZM T3,MONRT ;SAVE USER MONRET
PUSHJ P,.GTWRD## ;GET BLOCK+5 [366]
MOVEM T3,INIFLG ;STORE FLAGS [366]
HRREI C,.CHEOL ;PRESET EOL JUST IN CASE
;DELETED [545]
IFN M$INDP,<
SETOM OPTION ;CLEAR OPTION [353]
>
IF TOPS-10,<
GETPPN T1, ;GET OUR PPN
JFCL ;(IN CASE OF JACCT)
MOVEM T1,.MYPPN ;SAVE FOR LATER USE [312]
>
IFN M$INDP,<
CAIE P1,1 ;SEE IF OFFSET IS ONE
JRST ISCANR ;NO--SKIP ON
AOS FLCCL ;YES--INDICATE CCL (WITH FLAG FOR TMPCOR POSSIBLE)
SETOM FLCCMD ;ALSO INDICATE CCL OR COMMAND
ISCANR:
IF TOPS-10,<
SETOM N.OFFS ;CLEAR RUN OFFSET
SETOM N.CORE ;CLEAR RUN CORE
> ;END TOPS-10
IFG M$INDP,<
MOVEI T1,M$INDP ;PRESET INDIRECT FILE
SKIPN A.ZER ; COUNT TO CORRECT
CAIN P1,1 ; VALUE IF OFFSET ONE
MOVEM T1,INDCNT ; OR IND. FILE POINTER
>
>
POP P,T1 ;RESTORE NAME OF TYPEOUT ROUTINE
PUSHJ P,.TYOCH## ;INITIALIZE TYPEOUT ROUTINES
SETOM CALCNT ;PRESET CALL COUNTER
IF TOPS-10,<
PJOB T1, ;GET THIS JOB'S NUMBER
>
IF TOPS-20,<
GJINF ;GET JOB NUMBER INTO T3
MOVE T1,T3 ;PUT IN T1
>
IFN M$INDP,<
PUSHJ P,.MKPJN ;MAKE INTO SIXBIT
HRLM T1,CCLNAM ; STORE JOB NUMBER
>
IF TOPS-10,<
MOVE T1,.JBREL ;SAVE CURRENT CORE
>
HRL T1,.JBFF ;ALSO SAVE .JBFF
MOVEM T1,SAVCOR ; FOR LATER TO RESTORE
IF TOPS-10,<
HRROI T1,.GTJLT ;GET LOGIN TIME [564]
GETTAB T1, ; ... [564]
SKIPA ;TRY IT THE HARD WAY [564]
JRST ISCAN8 ;GO SAVE LOGIN TIME [564]
> ;END TOPS-10
IF TOPS-20,<
MOVX T1,.FHJOB ;FIGURE OUT LOGIN TIME
RUNTM
IDIV T3,T2 ;GET SECONDS
IMUL T3,[1B17] ;MAKE FRACTION OF A DAY
IDIVI T3,^D24*^D60*^D60
GTAD ;GET CURRENT TIME
SUB T1,T3 ;LOGIN TIME
> ;END TOPS-20
IF TOPS-10,<
SETZB T1,T3 ;GET "LOGIN"
MOVSI T2,'DSK' ; TIME
OPEN IND,T1 ; ..
JRST ISCAN9 ;CAN'T!
MOVE T1,.MYPPN ;GET
MOVSI T2,'UFD' ; MY
MOVX T4,%LDMFD ; UFD
GETTAB T4, ; (IN
MOVE T4,[1,,] ; MFD)
LOOKUP IND,T1 ; ..
JRST ISCAN9 ;CAN'T!
LDB T1,[POINTR (T3,RB.CRT)] ;GET CREATION
IMULI T1,^D60000 ; TIME INTO MILLI-SEC.
LSH T2,-3 ;POSITION EXTENDED DATE
ANDI T2,70000 ;REMOVE JUNK
ANDX T3,RB.CRD ;GET MAIN PART OF DATE
IOR T2,T3 ;GET ENTIRE CREATION DATE
PUSHJ P,.CNVDT## ;CONVERT TO INTERNAL FORM
>
ISCAN8: MOVEM T1,LOGTIM ;SAVE AS "LOGIN" TIME
IFN M$INDP,<
ISCAN9: SKIPE A.ZER ;SEE IF PRESET INDIRECT
PUSHJ P,INDGT1 ;YES--FINISH SETUP
SKIPN FLCCL ;SKIP IF CCL ENTRY
JRST COMND ;NO, LOOK FOR MONITOR COMMAND
IF TOPS-10,<
MOVSI T1,'TMP' ;CCL DEVICE IS TMP:
MOVEM T1,A.DEV
> ;END TOPS-10
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
IF TOPS-10,<
RESCAN 1 ;BACK UP TTY INPUT TO SEE IF COMMAND
SKPINC ;SEE IF ANYTHING THERE
JRST COMND2 ;NO--MUST HAVE COME FROM CUSP LEVEL
> ;END TOPS-10
IF TOPS-20,<
MOVEI T1,0 ;WANT TO READ
RSCAN ;RESCAN COMMAND
JRST COMND2 ;SHOULD NEVER DO THIS
PUSHJ P,SKPCHR ;BUFFER EMPTY?
JRST COMND2 ;YES--SKIP COMMAND
> ;END TOPS-20
SETOM P1 ;SET PREFIX COUNTER [304]
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
IF TOPS-20,<
JRST COMNDS ;ON TOPS-20 START AND RUN DO NOT
; TAKE ARGUMENTS.
> ;END TOPS-20
COMNDL: JUMPLE C,COMND2 ;IF END OF LINE, GIVE UP
CAIN C,"(" ;SEE IF (...) FORMAT [270]
JRST COMNDR ;YES--GO HANDLE
PUSHJ P,SKPCHR ;SEE IF MORE TO COME
TLOA C,-1 ;NO--SET END OF LINE
PUSHJ P,.TIALT ;YES--GET IT
JRST COMNDL ;LOOP UNTIL DONE
COMNDR: SETOM FLRCMD ;FLAG (...) INSTEAD [270]
HRRZ T1,SWTPTR ;GIVE ERROR RETURN
HRREI C,.CHEOL ;INDICATE START OF LINE [360]
MOVEM C,LASCHR ; IN CASE OSCAN CALLED NEXT [360]
JRST COMNDC ;AND FINISH SETUP OF COMMAND
COMNDU: MOVE T1,SWTPTR ;POINTER TO LIST OF LEGAL SWITCHES
PUSHJ P,.NAME ;SEE IF ON LIST
JRST COMND1 ;NO--SKIP OVER COMMAND
SETOM FLJCNM ;INDICATE NAME [365]
; [365,401]
CAIE C," " ;IF NOT A SPACE,
PUSHJ P,.REEAT ; REEAT CHARACTER
COMNDC: MOVX T2,FS.ICL ;SEE IF NEED TO IGNORE COMMAND [366]
TDNN T2,INIFLG ; LINE MODE FURTHER DOWN [366]
SETOM FLCCMD ;FLAG AS SUCH AND REEAT SEPARATOR
SKIPG C ;SEE IF END OF LINE
SETZM SCANPC ;YES--CLEAR SCANNER SINCE C.TE WILL
; BE PICKED UP AGAIN
HRRZ T2,SWTPTR ;ADDR OF LIST -1
HRRZI T1,-1(T1) ;1=ADDRESS-1 OF COMMAND
SUB T1,T2 ;1=INDEX INTO TABLE
POPJ P, ;END INITIALIZATION (.ISCAN)
COMNDS: PUSHJ P,SKPCHR ;SEE IF ANYTHING STILL THERE
TLOA C,-1 ;NO--SET END-OF-LINE
PUSHJ P,.TIALT ;GET NEXT CHARACTER
COMND1: JUMPG C,COMNDS ;LOOP FOR END OF LINE
COMND2: SETO T1,
MOVEM C,LASCHR ;SAVE FOR REUSE LATER
POPJ P, ;END OF .ISCAN
;ROUTINE TO SKIP IF INPUT BUFFER IS NOT EMPTY
;CALL WITH:
; PUSHJ P,SKPCHR
; HERE IF EMPTY
; HERE IF NOT-EMPTY
SKPCHR:
IF TOPS-10,<
SKPINC ;IS THE BUFFER EMPTY
POPJ P,0 ;YES
JRST .POPJ1 ;NO
>
IF TOPS-20,<
MOVE T1,TXTPTR ;SEE IF THERE IS ANYTHING IN THE
ILDB T1,T1 ; RDTTY BUFFER.
JUMPN T1,.POPJ1 ;SKIP RETURN IF ANYTHING THERE
MOVEI T1,-1 ;OUR TERMINAL
SIBE ;BUFFER EMPTY
JRST .POPJ1 ;NO
POPJ P,0 ;YES
>
SUBTTL TRADITIONAL COMMAND SCANNER
;.TSCAN--SUBROUTINE FOR TRADITIONAL COMMAND SCANNER
;ARGS AC1=XWD LENGTH,BLOCK
; BLOCK+0=0 OR IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
; BLOCK+4=LH 0 OR SUBROUTINE TO CLEAR ALL ANSWERS
; RH 0 OR SUBROUTINE TO CLEAR FILE ANSWERS
; BLOCK+5=LH SUBROUTINE TO ALLOCATE INPUT FILE AREA
; RH SUBROUTINE TO ALLOCATE OUTPUT FILE AREA
; BOTH RETURN T1=START OF AREA, T2=LENGTH
; BLOCK+6=LH 0 OR SUBROUTINE TO MEMORIZE STICKY DEFAULTS
; RH 0 OR SUBROUTINE TO APPLY STICKY DEFAULTS
; BLOCK+7=LH 0 OR SUBROUTINE TO CLEAR STICKY DEFAULTS
; RH FLAGS TO CONTROL SCAN:
; 1B18=MORE THAN ONE OUTPUT SPEC POSSIBLE
; 1B19=ALLOW INPUT SWITCHES ON OUTPUT AND VV
; BLOCK+10=LH (FUTURE)
; RH 0 OR ROUTINE TO STORE SWITCH VALUES
; ;ENTERRED WITH T1=VALUE, T2=POINTER
; ;NON-SKIPS IF SCAN SHOULD NOT STORE
; ;SKIPS IF SCAN SHOULD STORE (T1-2 OK)
.TSCAN::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
MOVE T2,(P) ;PRESERVE CALLING
MOVEM T2,SAVCAL ; LOCATION
IF TOPS-10,<
MOVE T2,.JBREL ;GET SIZE OF CORE
>
HRL T2,.JBFF ; AND CURRENT USAGE
MOVEM T2,SAVCOR ; AND SAVE IT
PUSHJ P,.SAVE4## ;SAVE P1-P4
MOVE C,LASCHR ;RESTORE LAST CHARACTER
MOVEM P,SAVPDP ;SAVE PUSH DOWN LIST POINTER
PUSHJ P,SETPR4 ;SET STANDARD PARAMETERS
PUSHJ P,.GTWRD## ;GET BLOCK+4
HLRZM T3,CLRANS ;SUBROUTINE TO CLEAR ANSWER AREA
HRRZM T3,CLRFIL ;SUBROUTINE TO CLEAR FILE AREA
PUSHJ P,.GTWRD## ;GET BLOCK+5
TLNE T3,-1 ;(REQUIRED)
TRNN T3,-1 ;(REQUIRED)
HALT . ;PROTECTION
HLRZM T3,ALLIN ;SUBROUTINE TO ALLOCATE INPUT AREA
HRRZM T3,ALLOUT ;SUBROUTINE TO ALLOCATE OUTPUT AREA
PUSHJ P,.GTWRD## ;GET BLOCK+6
HLRZM T3,MEMSTK ;SUBROUTINE TO MEMORIZE STICKY DEFAULTS
HRRZM T3,APPSTK ;SUBROUTINE TO APPLY STICKY DEFAULTS
PUSHJ P,.GTWRD## ;GET BLOCK+7
HLRZM T3,CLRSTK ;SUBROUTINE TO CLEAR STICKY DEFAULTS
HRRZM T3,USRFLG ;STORE AWAY USER'S PARAMETER FLAGS
PUSHJ P,.GTWRD## ;GET BLOCK+10
HRRZM T3,STRSWT ;ADDRESS OF ROUTINE TO STORE RESULTS
HRRZM P,FLVERB ;SET FLVERB .GT. 0
AOSE CALCNT ;COUNT CALL
JRST RESTRT ;IF NOT FIRST, DO A RESTART
SKIPE FLCCMD ;SKIP IF NEITHER CCL OR COMMAND
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
IF TOPS-10,<
TLZ T1,-1 ;CLEAR JUNK
CAME T1,.JBREL ; TO ITS INITIAL
CORE T1, ; SETTING IF IT
JFCL ; WAS CHANGED
> ;END TOPS-10
SKIPE FLSECE ;IF AFTER SECOND EQUALS, [515,562]
JRST RESTRL ; SKIP OVER PROMPT [515,562]
IFN M$INDP,<
SKIPE A.ZER ;SEE IF INDIRECT
JRST RESTRC ;YES--SKIP END TEST
IF TOPS-10,<
SKIPE FLCCL ;SEE IF CCL MODE
SOS .JBSA ;YES--RESTORE STARTING ADDRESS
> ;END TOPS-10
SKIPE N.ZER ;SEE IF /RUN
JRST RESTRL ;YES--PROCEED
>
SKIPE FLCCMD ;SEE IF IN TRADITIONAL MODE
PUSHJ P,.MONRT ;NO--RETURN TO MONITOR
RESTRC: CAMN C,[.CHEOF] ;SEE IF END OF FILE [504]
JRST [PUSHJ P,.ALDON ;YES--HANDLE EOF [504]
JUMPG C,RESTRL ;CONTINUE IF NOT DONE YET [535]
JRST RESTRT] ;RETURN TO MAIN LINE [504]
SKIPG C ;IF END OF LINE, [540]
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
IFN M$INDP,<
PUSHJ P,.RUNCM ;HANDLE /RUN IN NEEDED [264]
JUMPN T1,RESTRT ;IF DID SOMETHING, START OVER [506]
>
PUSHJ P,INILIN ;INITIALIZE LINE
;HERE TO SCAN ONE SIDE OF COMMAND LINE
RESTRS: PUSHJ P,INILIM ;INITIALIZE AT START OF LINE
PUSHJ P,CLERST ;CLEAR STICKY DEFAULTS [534]
SKIPE FLSECE ;SEE IF SECOND EQUALS [515]
JRST SEQEQR ;YES--GO HANDLE SECOND COMMAND [515]
;HERE TO SCAN ONE FILE SPECIFICATION
RESTRF: PUSHJ P,.FILIN ;GET NEXT FILE SPECIFICATION
MOVEI P2,0 ;CLEAR FLAG [522]
IFN M$INDP,<
CAIN C,"@" ;SEE IF INDIRECT REQUESTED [514]
JUMPGE T1,INDFIL ;YES--HANDLE IF NO FILE YET [514]
>
MOVE P1,T1 ;APPSTK CLOBBERS T1 [275]
SKIPE APPSTK ;SEE IF APPLY STICKY [271]
PUSHJ P,@APPSTK ; REQUESTED BY CALLER [271]
JUMPLE C,INFILX ;IF END OF LINE OR
SETOM FLSOME ;NOTE SOMETHING FOUND
LDB T1,[POINTR (F.MOD,FX.TRM)] ;GET TERMINATOR [247,510]
JUMPN T1,INFIL ;MUST BE INPUT [247,510]
MOVSI T2,-BREAKL ;SET LENGTH OF BREAK TABLE [522]
HLRZ T3,BREAKT(T2) ;GET NEXT BREAK [522]
TRZ T3,(1B0) ;CLEAR FLAG [522]
CAIE T3,(C) ;SEE IF MATCH [522]
AOBJN T2,.-3 ;NO--LOOP [522]
MOVE P2,BREAKT(T2) ;GET DISPATCH [522]
JRST (P2) ;GO HANDLE IT [522]
;TABLE OF BREAK,,ADDRESS
DEFINE ZZ(A,B,C),<
BYTE (1) C (17) A (18) B
>
BREAKT: ZZ 054,INOFIL, ;","
ZZ "=",OUTFIL,1
IFG FT$UEQ,<ZZ "_",OUTFIL,1>
ZZ .CHFRM,OUTFIL,1
ZZ .CHSRC,OUTFIL,1
ZZ .CHINP,OUTFIL,1
BREAKL==.-BREAKT
0,,E.ILSC ;FOR ERROR
;HERE TO SEE IF INPUT OR OUTPUT FILE JUST FOUND
INOFIL: MOVX T1,FS.MOT ;SEE IF MULTIPLE OUTPUT POSSIBLE
TDNE T1,USRFLG ;TEST USER'S FLAGS
SKIPL FLOUT ;YES--SEE IF = SEEN YET
JRST INFIL ;GO DO INPUT FILE
JRST OUFIL ;GO DO OUTPUT FILE
;HERE WHEN A SPECIFICATION FOR OUTPUT SIDE IS FOUND
OUTFIL: AOSE FLOUT ;SET/TEST IF ALREADY PAST THIS POINT
JRST SECEQL ;YES--PROCESS SECOND EQUAL SIGN [516]
OUFIL: MOVX T1,FS.MIO ;SEE IF [302]
TDNE T1,USRFLG ; LEGAL FOR SWITCHES [302]
JRST OUFIL1 ; TO BE ON WRONG SIDE [302]
MOVE T1,F.MODM ;GET FILE MODIFIERS
TXNE T1,FXNOTO ;CHECK ILLEGAL ONES
JRST E.FMO ;ERROR IF WRONG ONES
SKIPG F.ABF ;SEE IF /ABEFORE [346]
SKIPLE F.ASN ; OR IF /ASINCE [346]
JRST E.FMO ;YES--ERROR [346]
SKIPG F.FLI ;SEE IF MIN LENGTH [346]
SKIPLE F.FLM ; OR IF MAX LENGTH [346]
JRST E.FMO ;YES--ERROR [346]
SKIPG F.BFR ;SEE IF /BEFORE
SKIPLE F.SNC ;OR /SINCE
JRST E.FMO ;YES--ERROR
OUFIL1: PUSHJ P,@ALLOUT ;ALLOCATE SOME OUTPUT SPACE
JRST INFIL2 ;GO COPY SPEC AND LOOP
;HERE WHEN A SPECIFICATION FOR INPUT SIDE FOUND
INFILX: JUMPE P1,INFIL3 ;IF NOTHING, SKIP ON [275]
MOVE T1,USRFLG ;GET CALLER'S FLAGS [533,550]
TXNN T1,FS.MIO ;IF MIXED IN/OUT SPECS, [533,550]
TXNN T1,FS.MOT ; OR IF SINGLE OUTPUT [533,550]
JRST INFILY ;YES--OK TO HAVE INPUTS [533,550]
SKIPGE FLOUT ;NO--SEE IF = YET [533,550]
JRST E$$ESM ;NO =--ERROR [533,550]
INFILY: SETOM FLSOME ;OTHERWISE FLAG SOMETHING
INFIL: AOS FLOUT ;FORCE ANY OUTPUT SPEC ILLEGAL
MOVX T1,FS.MIO ;SEE IF LEGAL FOR SWITCHES ON WRONG SIDE [302]
TDNE T1,USRFLG ;SEE IF MIXUP OK [302]
JRST INFIL1 ;OK--JUST GO AHEAD [346]
MOVE T1,F.MODM ;GET FILE MODIFIERS
TXNE T1,FXNOTI ;CHECK ILLEGAL ONES
JRST E.FMI ;ERROR IF WRONG ONES
SETCM T1,F.VER ;SEE IF /VERSION [346]
SKIPN T1 ; SKIP IF SET [346]
SKIPL F.EST ;SEE IF /ESTIMATE [346]
JRST E.FMI ;YES--ERROR ON INPUT [346]
INFIL1: PUSHJ P,@ALLIN ;ALLOCATE SOME INPUT SPACE
INFIL2: PUSHJ P,.GTSPC ;AND COPY RESULTS TO IT
;HERE AFTER HANDLING ANY FILE SPEC
INFIL3: JUMPL P2,INDFI1 ;GO SET SAFE CHARACTER [515]
JUMPG C,RESTRF ;IF NOT END, LOOP BACK FOR MORE
SKIPLE FLFLLP ;SEE IF HAD ( BUT NO ) [543]
JRST E.UOP ;YES, ERROR [543]
SKIPE FLSOME ;SEE IF ANYTHING YET
POPJ P, ;YES--RETURN TO USER
;HERE WHEN NO ARGUMENTS TYPED, DO APPROPRIATE THING
IFN M$INDP,<
SKIPE A.ZER ;SEE IF INDIRECT
JRST RESTRT ;YES--JUST LOOP BACK
>
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
;HERE ON SECOND = ON A LINE
SECEQL: MOVE T1,[F.ZER,,FE.ZER] ;SAVE PRECEEDING FILE [515]
BLT T1,FE.EZR ; SINCE IT IS ANOTHER COMMAND [515]
SETOM FLSECE ;FLAG SECOND EQUALS MODE [515]
POPJ P, ;TELL USER DONE WITH THIS COMMAND [515]
;HERE ON RE-ENTRY ON SECOND = ON A LINE
SEQEQR: MOVE T1,[FE.ZER,,F.ZER] ;RESTORE FILE [515]
BLT T1,F.EZER ; SAVE ABOVE [515]
SETZM FLSECE ;CLEAR SECOND EQUALS MODE [515]
JRST OUTFIL ;PROCESS AS OUTPUT FILE [515]
SUBTTL VERB FORM COMMAND SCANNER
;.VSCAN --SUBROUTINE FOR VERB ARGS FORM OF COMMAND SCANNER
; RETURNS CPOPJ IF EOF DURING COMMAND OR CCL AT TOP LEVEL
;ARGS AC1=XWD LENGTH,BLOCK
; BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
; BLOCK+4=LH LENGTH OF FXXX AND PXXX AREAS
; RH START OF FXXX (PER FILE SWITCHES)
; BLOCK+5=LH (FUTURE)
; RH START OF PXXX (STICKY FORM OF FXXX)
; BLOCK+6=NAME OF OPTION LINES (0 IF THIS PROGRAM'S NAME)
.VSCAN::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
MOVEM P,SAVPDP ;SAVE PUSH DOWN LIST POINTER
SETOM FLVERB ;NOTE VERB FORM [556]
PUSHJ P,SETPR4 ;SET STANDARD PARAMETERS
PUSHJ P,.GTWRD## ;GET BLOCK+4
MOVE P1,T3 ;SAVE POINTER TO FXXX
PUSHJ P,.GTWRD## ;GET BLOCK+5
TLZ T3,-1 ;GET START OF PXXX
SUBI T3,(P1) ;GET OFFSET TO PXXX FROM FXXX
MOVEM T3,SWTPFO ;STORE FOR LATER
HRRZM P1,SWTPFF ;STORE START OF FXXX
HLRZ T3,P1 ;GET LENGTH OF FXXX
ADDI T3,(P1) ;GET END [357]
MOVEM T3,SWTPFL ;SAVE END FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+6
IFN M$INDP,<
MOVEM T3,VOPTN ;SAVE AS OPTION FILE LINE NAME
>
MOVE C,SAVCHR ;RESTORE RESCANNED CHARACTER
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 FLCCMD ;UNLESS COMMAND MODE, [360]
PUSHJ P,DOPRMP ;GO DO IT
HRREI C,.CHEOL ;CLEAR ALT FLAG
VRSTRL: PUSHJ P,.KEYWD ;PROCESS THE VERB
JRST VRSTNL ;GO HANDLE NO VERB YET
MOVE C,LASCHR ;RESTORE CHARACTER JUST IN CASE
;HERE AT END OF COMMAND
PJUMPG C,E.INCL ;IF NOT EOL, ISSUE ERROR MESSAGE
IFN M$INDP,<
PUSHJ P,.RUNCM ;HANDLE /RUN IF NEEDED [264]
AOSE OPTION ;SEE IF /OPTION
SOSN OPTION ;YES--CORRECT FOR AOS
JRST VRSTRT ;NO--LOOP
MOVE T3,VOPTN ;GET OPTION NAME
PUSHJ P,.OSCAN ;ENTER MIDDLE OF OSCAN [370]
>
JRST VRSTRT ;LOOP
;HERE BEFORE VERB SEEN
VRSTNL: CAIN C,"/" ;SEE IF /
JRST VRSTRL ;YES--LET USER PRECEDE VERBS THIS WAY
IFN M$INDP,<
CAIN C,"@" ;SEE IF INDIRECT FILE
PUSHJ P,.GTIND ;YES--GET SPECIFICATION
>
JUMPLE C,VRSTRT ;LOOP IF NULL LINE
PJRST E.ILSC ;ELSE, GO TO ERROR MESSAGE
SUBTTL OPTION FILE SCANNER
;.OSCAN -- SUBROUTINE TO SCAN OPTIONS FILE (DSK:SWITCH.INI[,])
; RETURNS CPOPJ AFTER UPDATING GLOBAL SWITCHES FROM FILE
; THIS ROUTINE SHOULD BE CALLED AFTER TSCAN OR PSCAN
; BUT BEFORE DEFAULTING.
; CALL THIS ONLY AT END OF LINE.
; IT SHOULD BE CALLED BETWEEN ISCAN AND VSCAN FOR VERBS.
;ARGS: AC1=XWD LENGTH,BLOCK
; BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
; BLOCK+4=NAME OF OPTIONS TO SELECT IN FILE (0 IF NAME OF PROGRAM)
; OR LENGTH,,LIST OF OPTION NAMES
;IF CALL FROM VSCAN, C(T3)= SAME AS BLOCK+4 ABOVE
IFN M$INDP,<
.OSCAN::PUSHJ P,.SAVE4## ;SAVE P1-4
PUSH P,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
MOVE P2,N.ZER ;SAVE /RUN TO FAKE QSCAN
SETZM N.ZER ; ..
PUSHJ P,.QSCAN ;SETUP FOR QSCAN [335]
JRST OPTNSX ;HERE ONLY IF ERROR IN FILE
MOVEM P1,OPTION ;RESTORE OPTION
MOVEM P2,N.ZER ;RESTORE /RUN TO PREVENT ERRORS
PUSHJ P,.GTWRD## ;GET BLOCK+4
;STILL UNDER M$INDP
OSCANV: JUMPN T3,OSCAN1 ;OK IF NAME
PUSHJ P,GETPGM ;GET PROGRAM NAME IN T3
TLNN T3,(77B5) ;PROTECT AGAINST JUNK NAME [344]
JRST OPTNSY ;RIGHT--IGNORE OPTION FILE [344]
OSCAN1: SKIPE A.ZER ;SEE IF IND FILE OPEN
JRST OPTNSY ;YES--GIVE UP UNTIL IND FILES NEST
MOVEM T3,OPTNAM ;SET OPTION NAME
SKIPGE FLVERB ;UNLESS VERB MODE, [561]
PUSHJ P,CLERST ; CLEAR STICKY STUFF [561]
MOVE T1,[OPTSPC,,F.ZER]
IF TOPS-10,<
BLT T1,F.DIRM ;COPY PRESET SPEC
SETZM F.DIR+2 ;CLEAR DIRECTORY
MOVE T1,[F.DIR+2,,F.DIR+3]
>
IF TOPS-20,<
BLT T1,F.MODM ;COPY PRESET SPEC
> ;END TOPS-20
BLT T1,F.EZER ; AND REST OF SPEC
SETOM F.MZER ;CLEAR SWITCHES [346]
MOVE T1,[F.MZER,,F.MZER+1]
BLT T1,F.EMZR
PUSHJ P,GTINDF ;SET INDIRECT FILE SPEC
PUSHJ P,.CLRFL ;CLEAR OUT FILE SPEC AREA [513]
SKIPN OPTION ;SEE IF /NOOPTION
JRST OPTNSW ;YES--RETURN IMMEDIATELY
;STILL UNDER M$INDP
AOSE OPTION ;IF OPTION IS -1,
SOS OPTION ; MAKE IT 0
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
OPTNSL: SETOM P1 ;INDICATE FOUND A LINE [345]
JUMPLE C,OPTNSF ;GO AGAIN IF DONE [345]
CAIE C,"/" ;LOOK FOR SLASH
CAIN C,"," ;OR COMMA
MOVEI C," " ;YES--OK
CAIE C," " ;SEE IF OK CHAR OR SPACE
JRST E.ILSC ;NO--IMPROPER CHARACTER
PUSHJ P,.KEYWD ;GET NEXT SWITCH
JRST OPTNSL ;SKIP EXTRA SEPARATORS
MOVE C,LASCHR ;RESTORE CHARACTER
JRST OPTNSL ;LOOP UNTIL DONE
;HERE WHEN OPTION NOT FOUND OR NO FILE
OPTNSW: JUMPN P1,OPTNSX ;EXIT IF FOUND AT LEAST ONE LINE [345]
MOVE N,OPTION ;SEE IF OPTION SPECIFIED
SKIPL (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]
SETZM OPTNAM ;CLEAR OPTIONS MODE
POPJ P, ;RETURN TO CALLER
;FILE SPEC FOR DSK:SWITCH.INI[,]/PHYSICAL/OKNONE
IF TOPS-10,<
OPTSPC: 'DSK '
'SWITCH'
-1
'INI',,-1
<FX.DIR!FX.NOM!FX.PHY>
<FX.DIR!FX.NOM!FX.PHY>
0
-1
> ;END TOPS-10
IF TOPS-20,<
OPTSPC: ASCIZ "DSK:SWITCH.INI"
BLOCK .FXMOD-2
<FX.NOM!FX.PHY>
<FX.NOM!FX.PHY>
> ;END TOPS-20
> ;END M$INDP
SUBTTL PARTIAL SCANNER
;.PSCAN --SUBROUTINE TO INITIALIZE PARTIAL MODE SCANNER
;.QSCAN -- DITTO BUT ONLY INITIALIZA THIS LINE
; RETURNS CPOPJ AFTER INITIALIZING. IN CASE OF ANY
; FATAL ERRORS (.FMSGE/X), WILL RESTORE CONTROL AND PDP
; AT RETURN FROM THIS PSCAN CALL.
; THIS SHOULD BE CALLED BEFORE EACH PROMPT OR LINE
; OF INPUT.
; SKIP RETURNS IF NO PROMPT NEEDED
;ARGS AC1=XWD LENGTH,BLOCK
; BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES
; (IOWD XXXXXL,XXXXXN)
; BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
; RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
; BLOCK+2=LH ADDRESS OF (FUTURE)
; RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
; BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
; IF GT 77, NAME OF PROGRAM IN WHOLE WORD
; IF -1 IN WORD, USE JOB TABLE
; RH LOCATION OF HELP
.PSCAN::SETZM .FLVRB## ;CLEAR /MESSAGE [327]
SETZM FLVERB ;INDICATE .PSCAN [364]
MOVE T2,(P) ;GET RETURN POINT [364]
MOVEM T2,SAVCAL ;SAVE FOR ERROR [364]
MOVEM P,SAVPDP ;SAVE PUSH-DOWN POINTER [364]
MOVE T2,SAVCHR ;GET SAVED CHARACTER [401]
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]
;FALL INTO QSCAN
;FALL HERE FROM ABOVE
.QSCAN::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF WAS AN ERROR
;***DELETED HANDLING OF /RUN [264]
MOVEI T2,0 ;CLEAR FLAG [313]
MOVE C,LASCHR ;GET LAST CHARACTER [313]
SKIPL FLRCMD ;IF .RUN, OR [563]
CAMN C,[.CHEOF] ;SEE IF END OF FILE [313]
MOVEI T2,1 ;YES--FLAG NO PROMPT [313]
IFN M$INDP,<
SKIPN A.ZER ;SEE IF INDIRECT
> ;END M$INDP
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]
SKIPE SAVCHR ;SEE IF ANYTHING SAVED [266]
SKIPG T2 ;AND SOMETHING TO SAVE [266]
SKIPA ;OK [266]
HALT .+1 ;NO--ERROR [266]
SKIPLE T2 ;IF USEFUL, [266]
MOVEM T2,SAVCHR ; SAVE IT [266]
CAME C,[.CHEOF] ;UNLESS AT END OF FILE, [313]
SETOB C,LASCHR ; PRESET TO NEW LINE
;FALL INTO SETPR4
;FALL HERE FROM ABOVE
;SETPR4 -- SUBROUTINE TO STORE STANDARD PARAMETERS FROM GLOBAL CALLS
; HANDLES ARGUMENT BLOCK THROUGH BLOCK+3
;CALL: MOVE T1,[LENGTH,,BLOCK]
; PUSHJ P,SETPR4
;USES T1-4
SETPR4: JUMPE T1,INILIN ;IF NO POINTER, DON'T CHANGE [370]
HLRZ T2,T1 ;SETUP COUNTER FOR .GTWRD
PUSHJ P,.GTWRD## ;GET BLOCK+0
MOVEM T3,SWTPTR ;SAVE POINTER FOR SCANNING
ADDI T3,1 ;ADVANCE TO TABLE POINTER
HRLI T3,P1 ;INCLUDE INDEX POINTER
MOVEM T3,SWTCHN ;SET ADDRESS FOR MESSAGES
PUSHJ P,.GTWRD## ;GET BLOCK+1
HLRZ T4,T3 ;GET DEFAULT TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,P1 ;INCLUDE INDEX
MOVEM T4,SWTCHD ;STORE FOR LATER
HRRZ T4,T3 ;GET MAX,PROCESSOR TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,P1 ;INCLUDE INDEX
MOVEM T4,SWTCHM ;STORE FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+2
HRRZ T4,T3 ;GET STORAGE POINTER TABLE
SKIPN T4 ;SKIP IF ONE SETUP
SKIPA T4,[[0]] ;NO--SET LOCATION OF ZERO
HRLI T4,P1 ;INCLUDE INDEX
MOVEM T4,SWTCHP ;STORE FOR LATER
PUSHJ P,.GTWRD## ;GET BLOCK+3
CAME T3,[-1] ;SEE IF DEFAULT NAME
JRST STRPRH ;NO--GO STORE AWAY
PUSHJ P,GETPGM ;GET PROGRAM NAME IN T3
STRPRH: MOVEM T3,SWTHLP ;STORE HELP POINTERS
;FALL INTO INILIN
;FALL HERE
;INILIN/INILIM -- ROUTINES TO INITIALIZE START OF LINE
;USE T3
INILIN: SKIPG LASCHR ;SEE IF AT START
SETZM SCANPC ;YES--CLEAR BLANK COMPRESSOR
SETZM FLFLLP ;CLEAR L.PAREN COUNT [534]
IFN M$INDP,<
SETOM OPTION ;CLEAR /OPTION
>
INILIM: PUSHJ P,.PSH4T## ;SAVE SOME AC'S [534]
SKIPL FLVERB ;SEE IF VERB MODE [357]
PUSHJ P,CLERST ;NO--CLEAR STICKY DEFAULTS [534]
SKIPGE FLVERB ; OR [551]
PUSHJ P,.CLSNS ;YES--CLEAR STICKY DEVICE, ETC. [551]
SETZM SWTCNT ;CLEAR RECURSION COUNTER
SETZM .LASWD ;CLEAR LAST WORD TYPE [314]
PUSHJ P,.POP4T## ;RESTORE TEMPS [534]
POPJ P, ;RETURN
;ROUTINE TO RETURN CURRENT PROGRAM NAME IN T3
;CALL WITH:
; PUSHJ P,GETPGM
; RETURN HERE NAME OR ZERO IN T3
;
GETPGM:
IF TOPS-10,<
HRROI T3,.GTPRG ;ELSE, GET
GETTAB T3, ; PROGRAM NAME
MOVEI T3,0 ;CAN NOT GET NAME
> ;END TOPS-10
IF TOPS-20,<
PUSH P,T1 ;SAVE ANSWER AC
GETNM ;GET PROGRAM NAME
MOVE T3,T1 ;PUT IN RIGHT SPOT
POP P,T1 ;RESTORE T1
> ;END TOPS-20
POPJ P,0 ;RETURN
SUBTTL INDIRECT FILE SETUP AND FINISH
;.ALDON -- SUBROUTINE TO HANDLE EOF WHEN READING COMMANDS
;IF INDIRECT MODE, IT CLEARS IND AND EOF AND RETURNS
;ELSE, IT GOES TO MONITOR AND RETURNS ON A CONTINUE
.ALDON::HRREI C,.CHEOL ;CLEAR EOF
MOVEM C,LASCHR ;UPDATE LAST CHARACTER [313]
IFN M$INDP,<
SKIPN USRIND ;SEE IF USER SUPLIED INDIRECT
SKIPN A.ZER ;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
/]
IF TOPS-10,<
CLRBFI ;CLEAR ANY TYPE-AHEAD
MONRT. ;DIE WITHOUT TOUCHING ANY AC OR CORE
>
IF TOPS-20,<
MOVEI T1,-1 ;OUT TTY
CFIBF ;CLEAR TYPE AHEAD
HALTF
>
JRST .-1 ;LOOP HOPELESSLY
>
;FILE SCANNING ERRORS
M$FAIL (ESM,Equal sign missing)
E.FMO:: M$FAIL (FMO,File switches illegal in output file)
E.FMI:: M$FAIL (FMI,Output switch illegal in input file)
E.INCL::
E$$EXA: SKIPA T1,['EXA',,[ASCIZ /Excess arguments starting with "/] ]
E.ILSC::
E$$ILC: MOVE T1,['ILC',,[ASCIZ /Illegal character "/] ]
PUSH P,T1 ;SAVE TEXT [314]
TRZ T1,-1 ;REMOVE TEXT [314]
PUSHJ P,.TERRP ;ISSUE MESSAGE PREFIX [314]
MOVE T2,T1 ;COPY /MESSAGE [314]
POP P,T1 ;RESTORE TEXT [314]
TXNN T2,JWW.FL ;SEE IF FIRST LINE
JRST .FMSGE ;NO--JUST GO FINISH UP
PUSHJ P,.TSTRG## ;YES--ISSUE TEXT [314]
MOVE T1,C ;GET CHARACTER IN ERROR
PUSHJ P,.TFCHR## ;OUTPUT CHARACTER
SKIPE .LASWD ;IF UNKNOWN LAST WORD [314]
SKIPN .NMUL ; OR NO VALUE [314]
JRST ILSC1 ;JUMP IF NO WORD [314]
MOVEI T1,[ASCIZ /" following word "/]
PUSHJ P,.TSTRG## ;TYPE STRING
MOVE T1,.NMUL ;POSITION WORD [314]
SKIPGE T2,.LASWD ;SEE IF STRING MODE [314]
MOVEI T1,.NMUL ;YES--SET POINTER TO STRING [314]
PUSHJ P,(T2) ;AND ISSUE RESULT [314]
ILSC1: MOVEI T1,"""" ;DOUBLE QUOTE
PUSHJ P,.TCHAR## ;AND TYPE IT
JRST .FMSGE ;AND BOMB USER
;.GTIND--SUBROUTINE TO READ INDIRECT FILE SPECIFIER
;STORED IN AUXILIARY BLOCK STARTING AT A.ZER
IFN M$INDP,<
.GTIND::PUSHJ P,.FILIN ;GET FILE SPECIFIER
JUMPGE T1,E.JFI ;ERROR IF NO FILE SPECIFIED [516]
GTINDF:
IFG M$INDP,<
MOVEI T1,M$INDP ;IF FIRST, RESET COUNTER
SKIPN A.ZER ; ..
MOVEM T1,INDCNT ;TO LIMIT DEPTH
; THIS IS NEEDED TO PROTECT
; THE USER FROM INFINITE
; INDIRECT LOOPS (PARTICULARLY
; IF JACCT IS ON)
SKIPN A.ZER ;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]
IF TOPS-10,<
SKIPE B.IND+1 ;IF ALREADY ONE OPEN,
>
IF TOPS-20,<
SKIPE A.JFN ;IF ALREADY ONE OPEN,
> ;END TOPS-20
PUSHJ P,.KLIND ; GO BIND IT OFF
MOVEI T1,A.ZER ;POINT TO @ AREA
MOVEI T2,A.EZER-A.ZER+1 ; ..
PUSHJ P,.GTSPC ;GO COPY SPEC
INDGT1:
IF TOPS-10,<
SKIPN T1,A.EXT ;SKIP IF EXT SPECIFIED
HRLOI T1,'CCL' ;DEFAULT IS CCL
MOVEM T1,A.EXT
SKIPN A.NAM ;SEE IF NAME
SETOM A.NAMM ;NO--DEFAULT TO NO WILD
SKIPN T1,A.NAM ;SKIP IF NAME SPECIFIED
HRLZ T1,CCLNAM
MOVEM T1,A.NAM
SKIPN T1,A.DEV
JRST E.JFI ;ERROR IF NO DEVICE
DEVCHR T1, ;GET CHARACTERISTICS
TXNE T1,DV.TTA ;SKIP IF NOT AN INTERACTIVE DEVICE
SETOM FLIIND ;NOTE INTERACTIVE
> ;END TOPS-10
IF TOPS-20,<
MOVX T1,GJ%OFG!GJ%SHT;GTJFN FLAGS
HRROI T2,A.FIL ;STRING POINTER
PUSHJ P,GETJFN ;GET A JFN
PUSH P,T1 ;SAVE JFN FOR A SEC
HRRZ T1,T1 ;CLEAR FLAGS
DVCHR ;SEE IF TTY
ERJMP NTIIND ;NOT INTERACTIVE IF ILLEGAL
LDB T1,[POINT 9,T1,17] ;GET DEVICE TYPE
CAIN T1,.DVTTY ;IS THIS A TTY?
SETOM FLIIND ;YES--FLAG AS INTERACTIVE
NTIIND: POP P,T1 ;RESTORE JFN
RLJFN ;GIVE BACK THE JFN
HALT . ;ILL JFN OR STILL OPEN
>
IFG M$INDP,<
SOSGE INDCNT ;DECREMENT COUNT TO PROTECT USER
JRST E.TMI ;TOO FAR--BOMB OUT
>
HRROI T1,"#" ;SETUP PROMPT [515]
JUMPLE C,INDGT2 ;EXIT IF END OF LINE
SKIPGE FLVERB ;IF VERB MODE, [515]
JRST E.JFI ; ERROR IF NOT END OF LINE [515]
CAIN C,"," ;ELSE, MUST BE COMMA [515]
INDGT2: PJRST DOPRMP ;DO PROMPT AND RETURN [515]
E.JFI: MOVEI N,A.ZER ;POINT TO FILE SPEC
SETOB T2,FLKLIN ;NO ERROR CODE
M$FAIF (JFI,Junk after indirect command)
IFG M$INDP,<
E.TMI: MOVEI N,A.ZER ;POINT TO FILE SPEC JUST READ IN
SETOB T2,FLKLIN ;SET FLAG FOR NO ERROR CODE TO PRINT
M$FAIF (TMI,Too many indirect files)
>
>
SUBTTL RUN COMMAND PROCESSING
;.RUNCM -- ROUTINE TO HANDLE /RUN SWITCH IF ANY
;CALL: PUSHJ P,.RUNCM
;RETURNS T1=0 IF NO /RUN SWITCH
;RETURNS T1.NE.0 IF CONTINUE FROM /EXIT SWITCH
;ELSE, TRIES TO DO THE RUN
;IF FAILURE, IT WILL RESTART THIS PROGRAM AT .JBSA
IFN M$INDP,<
.RUNCM::PUSHJ P,.CCLRB ;CLEAR TYPEAHEAD IF ERROR
SKIPN T1,N.ZER ;SEE IF /RUN [264,506]
POPJ P, ;NO--RETURN [264]
CAIN T1,1 ;SEE IF /EXIT [506]
JRST [SETZM N.ZER ;YES--CLEAR IN CASE OF CONT. [506]
SETOM T1 ;FLAG RETURN FOR LATER [506]
PJRST .MONRT] ;GO EXIT TO MONITOR [506]
PUSHJ P,.ISLGI## ;SEE IF LOGGED IN [347]
PJUMPL T1,.MONRT ;NO--EXIT ASAP INSTEAD OF /RUN [317,347]
CLEARO ;DEFEAT CONTROL-O
MOVEI T1,N.ZER ;POINT TO /RUN
IF TOPS-10,<
MOVEI T2,N.OPEN ;POINT TO DUMMY OPEN BLOCK
MOVEI T3,N.LOOK ;POINT TO DUMMY LOOKUP BLOCK
> ;END TOPS-10
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:
IF TOPS-10,<
MOVE T1,N.LOOK+.RBPPN ;MOVE DIRECTORY
MOVEM T1,N.LOOK+5 ; FOR RUN UUO
MOVE T2,N.OPEN+1 ;GET DEVICE
MOVX T1,FX.NDV ;GET NULL DEVICE MASK
TDNE T1,N.MOD ;TEST SPECIFICATION
MOVSI T2,'SYS' ;YES--CHANGE TO 'SYS:'
MOVEM T2,N.LOOK+1 ;SET INTO RUN UUO BLOCK
SKIPGE T1,N.CORE ;GET /N.CORE:XX
MOVEI T1,0 ;DEFAULT TO 0
CAIG T1,777 ;SEE IF AT LEAST 1P
LSH T1,^D10 ;NO--ASSUME K
MOVEM T1,N.LOOK+6 ;STORE IN ARG BLOCK
HRLZ T1,N.OFFS ;GET OFFSET
HRRI T1,N.LOOK+1 ;POINT TO BLOCK
SKIPL N.OFFS ;SEE IF DEFAULT
JRST RUNCM2 ;NO--PROCEED
TLZ T1,-1 ;YES--CLEAR OFFSET
SKIPE FLCCL ;SEE IF CCL MODE
TLO T1,1 ;YES--SET CCL MODE OFFSET
RUNCM2: RUN T1, ;RUN THE PROGRAM
MOVE P,SAVPDP ;IF FAILURE, GIVE MESSAGE
PUSH P,T1 ;SAVE ERROR CODE
>
IF TOPS-20,<
MOVEI T1,RUNJFB ;GTJFN AGRUMENT BLOCK
HRROI T2,N.FIL ;MAIN STRING POINTER
GTJFN ;GET THE JFN
JRST [PUSH P,T1 ;SAVE ERROR CODE
JRST E$$RLF] ;REPORT ERROR
MOVEM T1,N.JFN ;SAVE JFN
SETO T1, ;REMOVE PAGES
MOVSI T2,.FHSLF ; FREOM THIS FORK
MOVX T3,PM%CNT+1000 ; ALL 1000 PAGES
MOVE 17,N.JFN ;SAVE JFN TILL AFTER PMAP
MOVE T4,[RUNCOD,,10] ;MOVE REST OF CODE TO
BLT T4,16 ; ACS 10-16
JRST 10 ;DO IT THERE
RUNCOD: PMAP ;DELETE ALL PAGES FROM MAP
MOVSI T1,.FHSLF ;GET INTO THIS FORK
HRR T1,17 ;FROM THIS FILE
GET ;GO GET IT
MOVEI T1,.FHSLF ;OUR FORK
GEVEC ;GET FORKS ENTRY VECTOR
JRST (T2) ;START FORK
;ARG BLOCK FOR GTJFN
RUNJFB: GJ%OLD ;OLD FILE ONLY
377777,,377777 ;NOT INTERACTIVE
-1,,[ASCIZ "SYS"] ;DEVICE
0 ;DIRECTORY
0 ;FILE
-1,,[ASCIZ "EXE"] ;EXTENSION
0 ;PROTECTION
0 ;ACCOUNT
0 ;DESIRED JFN
> ;END TOPS-20
E$$RLF: MOVE T1,['RLF',,[ASCIZ /Run linkage failure /] ]
PUSHJ P,.TERRP ;TYPE IT
MOVE T2,T1 ;SAVE /MESSAGE BITS
MOVE T1,(P) ;RESTORE ERROR CODE
TXNN T2,JWW.FL ;SEE IF TEXT NEEDED
JRST RUNCM3 ;NO--JUST END LINE
PUSHJ P,.TOCTW## ; CODE
PUSHJ P,.TSPACE ;SPACE OVER
MOVEI T1,N.ZER ;SET POINTER TO RUN BLOCK
PUSHJ P,.TFBLK## ;AND TYPE IT
IF TOPS-20,<
PUSHJ P,.TCRLF## ;END THIS LINE
MOVE T1,(P) ;GET ERROR CODE
PUSHJ P,.TJERR## ;PRINT SYSTEM ERROR MESSAGE
> ;END TOPS-20
RUNCM3: PUSHJ P,.TCRLF## ;END LINE
PUSHJ P,.TCRLF## ;AND LEAVE SPACE
IF TOPS-10,<
CLRBFI ;CLEAR TYPE AHEAD
MOVE T1,.JBSA ;GET START ADDRESS
JRST (T1) ;AND START OVER
> ;END TOPS-10
IF TOPS-20,<
MOVEI T1,-1 ;THIS TTY
CFIBF ;CLEAR TYPE AHEAD
MOVX T1,.FHSLF ;THIS FORK
MOVEI T2,0 ;START ADDRESS
SFRKV ;START FORK
>
E.RWI: MOVEI N,N.ZER ;POINT TO SPEC
SETOM T2 ;FLAG FOR NO ERROR CODE
M$FAIF (RWI,Wildcard illegal in /RUN specification)
>
SUBTTL SUBROUTINES FOR COMMAND INPUT -- FILE SPECIFICATION
;.FILIN -- INPUT WHAT USER TYPES AS THE NEXT FILE SPECIFICATION
;REMEMBER PERMANENT ("STICKY") DEFAULTS
;APPLY STICKY (USER SUPPLIED) DEFAULTS
;PROCESSES SWITCHES, DEVICE, NAME, EXT., AND DIRECTORY
;RETURN ON FIRST BREAK NOT LEGITIMATELY PART OF A FILE SPEC.
; (ALSO ON SOME SYNTAX ERRORS LIKE "*X")
;
;A FILE SPECIFICATION IS CRUDELY DESCRIBED AS FOLLOWS:
; NOT MORE THAN ONE EACH OF
; DEVICE:
; FILENAME
; .EXTENSION
; [PROJECT,PROGRAMMER]
; [,PROG] [PROJ,] [,] IMPLY DEFAULT TO LOGGED IN NUMBER.
; ANY OF ABOVE EXTENDED FOR SFDS: [P,PN, SFD1,SFD2,...]
; [-] FOR DEFAULT DIRECTORY
; ANY NUMBER OF NON-OBVIOUSLY CONFLICTING SWITCHES
; /NAME
; /NAME:VALUE
; WHERE VALUE CAN BE A NUMBER, A NAME, A TIME, ETC.
;SOME SWITCHES APPLY TO FILE NAMES, OTHERS ARE GLOBAL TO THE COMMAND.
;THE DEVICE, EXTENSION, DIRECTORY, AND FILE SWITCHES ARE STICKY
;IF THEY APPEAR BEFORE A FILE NAME, AND LOCAL IT AFTER OR IF
;NO FILE NAME APPEARS. SPACES MAY BE INSERTED FREELY WHERE NEEDED
;OR DESIRED BETWEEN WORDS, BUT MAY NOT SEPARATE THE PARTS OF A WORD.
;FOR EXAMPLE, "/SWITCH:VALUE" IS OK, BUT "/ SWITCH : VALUE" LOSES.
;
;CALL: SET ZEROES OR DEFAULTS INTO P.XXX AREA
; PUSHJ P,.FILIN
; RETURN WITH TYPE-INS IN F.XXX AREA, P.XXX UPDATED
; T1 =0 IF NULL, =-1 IF FILE TYPED, =+1 IF JUST GLOBAL SWITCHES
;USES T2, T3, T4, N UPDATES C (SEPARATOR)
.FILIN::PUSHJ P,.SAVE1## ;PRESERVE P1
FILIN0: MOVE T1,SWTCNT ;GET RECURSION COUNTER [301]
PUSHJ P,.CLRFL ;GO CLEAR FXXX AREA
JRST FILIN2 ;GO START THE READ
;HERE WHEN SOMETHING FOUND
FILIN1: SETOM FLFSP ;SET SOMETHING FOUND FLAG
;HERE TO READ ANOTHER WORD
FILIN2: PUSHJ P,.TIAUC ;START THE READ
;HERE WITH WORD, SEE WHAT KIND OF SEPARATOR
FILIN3:
IF TOPS-10,<
PUSHJ P,.NAMEC ;READ REST OF WORD
CAIN C,":" ;SEE IF DEVICE
JRST FILDEV ;YES
> ;END TOPS-10
IF TOPS-20,<
PUSHJ P,.FSPC ;READ LONG FILE NAME
> ;END TOPS-20
JUMPE N,FILIN4 ;IF NULL, NOT A FILE NAME
IF TOPS-10,<
SKIPE F.NAM ;FILE NAME--SEE IF SECOND TIME
>
IF TOPS-20,<
SKIPE F.FIL ;SEE IF SECOND FILE SPEC
>
JRST E$$DFN ;YES--ISSUE DUPL. ERROR
PUSHJ P,FILSTK ;GO MEMORIZE STICKY DEFAULTS
IF TOPS-10,<
PUSHJ P,.LEFTX ;GUARANTEE LH=0
MOVEM N,F.NAM ;OK--SAVE NAME
MOVEM T1,F.NAMM ;AND MASK
>
IF TOPS-20,<
HRROI T2,.NMUL ;STRING POINTER
MOVX T1,GJ%OFG!GJ%FLG!GJ%SHT
PUSHJ P,GETJFN ;CALL GTJFN AND HANDLE ERROR
PUSH P,T1 ;SAVE JFN
MOVE T2,(P) ;RESTORE JFN FLAGS
TXNE T2,GJ%TFS ;WAS ;T GIVEN
MOVX T1,FX.TMP ;YES--PREPARE TO SET BIT
MOVE N,[SIXBIT "TEMP"]
TDNE T1,F.MODM ;ALREADY GIVEN /TEMP?
JRST E$$DSI ;YES--ERROR
IORM T1,F.MOD ;SET BIT
IORM T1,F.MODM ;AND MASK
HRRZ T2,(P) ;RECALL JFN
MOVX T3,1B17 ;GET PROTECTION
PUSHJ P,DOJFNS ;GET STRING
MOVE N,[SIXBIT "PROTEC"]
SKIPN .STEMP## ;WAS ;P GIVEN?
JRST FLIN3A ;NO--TRY ACCOUNT
SKIPE F.PRO ;YES--WAS /PROTECT GIVEN?
JRST E$$DSI ;YES--ERROR
HRROI T1,.STEMP## ;CONVERT STRING IN .STEMP
MOVEI T3,10 ; TO OCTAL
NIN ; WITH JSYS
HALT . ;CAN NEVER HALT
TXO T2,5B2 ;MAKE STANDARD FORM
MOVEM T2,F.PRO ;SAVE
FLIN3A: HRRZ T2,(P) ;REMEMBER JFN
MOVX T3,1B20 ;ACCOUNT STRING
PUSHJ P,DOJFNS ;CONVERT TO ASCII
MOVE N,[SIXBIT "ACCOUN"]
SKIPN .STEMP## ;WAS ;A GIVEN
JRST FLIN3B ;NO--CHARGE AHEAD
SKIPE F.ACT ;WAS /ACCOUNT GIVEN
JRST E$$DSI ;YES--ERROR
MOVE T1,[.STEMP##,,F.ACT]
BLT T1,F.ACT+7 ;COPY STRING TO F AREA
FLIN3B: MOVE T2,[POINT 7,.NMUL]
MOVE T3,[POINT 7,F.FIL]
FLIN3C: ILDB T1,T2 ;GET SRC BYTE
CAIN T1,";" ;IS IT START OF ATTRIBUTES?
MOVEI T1,0 ;YES--MAKE IT A NULL
IDPB T1,T3 ;COPY BYTE
JUMPN T1,FLIN3C ;LOOP FOR FULL FILE SPEC
POP P,T1 ;RESTORE JFN
RLJFN ;RETURN JFN
HALT . ;ONLY HALTS IF STILL OPEN
> ;END TOPS-20
SETOM FLFSP ;FLAG THAT SOMETHING FOUND
FILIN4:
IF TOPS-10,<
CAIN C,"." ;SEE IF EXTENSION
JRST FILEXT ;YES
CAIE C,074 ;SEE IF 2741 DIRECTORY [252]
CAIN C,"[" ;SEE IF DIRECTORY
JRST FILDIR ;YES
> ;END TOPS-10
CAIN C,"(" ;SEE IF OPEN PAREN [534]
JRST FILLPR ;YES--GO HANDLE [534]
SKIPLE FLFLLP ;IF INSIDE PAREN, [543]
CAIE C,")" ; AND CLOSE PAREN, [534]
SKIPA ;NO--PROCEED [534]
JRST FILRPR ;YES--GO HANDLE [534]
SKIPE SWTCNT ;SEE IF ALREADY SWITCH
SKIPGE FLVERB ; AND NOT VERB [357]
SKIPA ;OK--ALLOW SWITCHES [357]
JRST FILIN5 ;YES
CAIN C,"/" ;SEE IF SWITCH
JRST FILSW ;YES
CAIN C," " ;SEE IF WORD SEPARATOR
JRST FILIN2 ;YES--LOOP BACK FOR MORE WORK
FILIN5:
IF TOPS-10,<
SKIPN F.NAM ;SKIP IF FILE NAME SPECIFIED
> ;END TOPS-10
IF TOPS-20,<
SKIPN F.ZER ;SKIP IF ANYTHING SPECIFIED
> ;END TOPS-20
PUSHJ P,FILSTK ;NO, SAVE STICKY DEFAULTS
MOVX T3,FX.TRM ;PREPARE TO SEE IF CONCATENATOR [247]
IORM T3,F.MODM ;INDICATE THAT WE WORRIED
MOVEI T3,0 ;PRESET FOR NO CONCATENATION [247]
CAIN C,"+" ;SEE IF "CONCATENATE" [247]
MOVEI T3,.FXTRC ;YES--SET CODE [247]
CAIN C,.CHAND ;SEE IF 'AND' [510]
MOVEI T3,.FXTRA ;YES--INDICATE [510]
CAIN C,.CHOR ;SEE IF 'OR' [510]
MOVEI T3,.FXTRO ;YES--INDICATE [510]
CAIN C,.CHNOT ;SEE IF 'NOT' [510]
MOVEI T3,.FXTRN ;YES--INDICATE [510]
DPB T3,[POINTR (F.MOD,FX.TRM)] ;STORE [247]
IFN ECHO$P,<
OUTSTR [ASCIZ /BEFORE DEFAULTS: /]
PUSHJ P,TFILE ;TYPE OUT F.XXX FOR DEBUGGING
>
MOVE T1,FLFSP ;RETURN FLAG
POPJ P, ;RETURN
;.CLRFL -- ROUTINE TO CLEAR FXXX AREA IN SCAN
;CALL: T1/0 IF TOP LEVEL, 1 IF NO SWITCHES ALLOWED
; PUSHJ P,.CLRFL
;USES T1-4
.CLRFL::SETZM F.ZER ;ZERO FILE RESULT AREA
MOVE T2,[F.ZER,,F.ZER+1] ; [301]
BLT T2,F.EZER ; [301]
SETOM F.MZER ;CLEAR SWITCHES [346]
MOVE T2,[F.MZER,,F.MZER+1]
BLT T2,F.EZER-1
SKIPE CLRFIL ;SEE IF USER WANTS CONTROL
SKIPE T1 ;SEE IF TOP LEVEL [301]
SKIPA ;NO--DON'T CLEAR USER'S SWITCHES [301]
PUSHJ P,@CLRFIL ;YES--GO TO HIM
IF TOPS-10,<
MOVX T1,FX.NDV ;GET NULL DEVICE BIT
IORM T1,F.MOD ;SET IN MOD WORD
IORM T1,F.MODM ;SET IN MASK
> ;END TOPS-10
POPJ P, ;RETURN
;HERE WHEN SLASH -- SWITCH COMMING
FILSW: PUSHJ P,.KEYWD ;PROCESS SWITCH
JRST E$$NSS ;ERROR IF NO SWITCH
PUSHJ P,.TICAN ;SEE IF SEPARATOR
SKIPA ;YES--OK
JRST E.SENS ;NO--ERROR
JUMPGE T1,FILINR ;IF END, FLAG SPEC
....==FS.NFS
TXNE T1,FS.NCM ;SEE IF NOT IN COMMAND [516]
JRST FILINN ;GO LOOK AT BREAK CHAR
SKIPN FLFSP ;NOT A COMMAND SWITCH, [516]
AOS FLFSP ;IF ONLY THING, INDICATE SAME [516]
JRST FILINN ; AND NOTHING ELSE [516]
IF TOPS-10,<
;HERE WHEN COLON SEEN -- PREVIOUS WORD IS DEVICE
FILDEV: SETCM T1,MASK ;GET COMPLEMENT OF WILDCARD MASK
JUMPE N,E$$NDV ;ERROR IF NO DEVICE
JUMPN T1,E$$WDV ;WILDCARD ERROR
SKIPE F.DEV ;VERIFY NOT SECOND ONE
JRST E$$DDV ;ERROR IF TWO
MOVEM N,F.DEV ;SAVE
MOVX T1,FX.NDV ;NOTE THAT
ANDCAM T1,F.MOD ; DEVICE SPECIFIED
JRST FILIN1 ;GO READ SOME MORE
;HERE WHEN PERIOD SEEN -- NEXT WORD IS EXTENSION
FILEXT: PUSHJ P,.NAMEW ;GO GET THE EXTENSION
PUSHJ P,.LEFTX ;PUT INTO LEFT HALF-WORD
SKIPE F.EXT ;VERIFY NOT SECOND ONE
JRST E$$DEX ;ERROR IF TWO
HLR N,MASK ;PUT MASK IN RIGHT HALF
MOVEM N,F.EXT ;SAVE
JRST FILINR ;GO PROCESS NEW BREAK
> ;END TOPS-10
;HERE ON LEFT PAREN -- OPEN OF DEFAULT REGION
FILLPR: SKIPE FLFLLP ;SEE IF TOO MANY [534]
JRST E$$PND ;YES--ERROR [534]
AOS FLFLLP ;NO--SET IT ON [534]
PUSHJ P,FILSTK ;REMEMBER STICKY DEFAULTS [534]
JRST FILIN0 ;START FILE SPEC OVER [534]
;HERE ON RIGHT PAREN -- CLOSE OF DEFAULT REGION
FILRPR: SETOM FLFLLP ;RESET COUNTER TO TELL APLSTK TO CALL CLERST [543]
JRST FILIN2 ;AND CONTINUE THIS SPEC [534]
IF TOPS-10,<
;HERE WHEN LEFT SQUARE BRACKET SEEN -- DIRECTORY COMING
FILDIR: MOVX P1,FX.DIR ;GET DIRECTORY FLAG
TDNE P1,F.MODM ;SEE IF SET ALREADY
JRST E.DDR ;YES--DOUBLE DIRECTORY ERROR
IORM P1,F.MOD ;NO--SET IT
IORM P1,F.MODM ; AND IN MASK
PUSHJ P,.NOCTW ;GET OCTAL NAME
PUSHJ P,.LEFTX ;MOVE TO LEFT HALF-WORD
IFN FT$SFD,<
CAIE C,"-" ;SEE IF DEFAULT CODE
JRST FILDR1 ;NO--PROCEED
SKIPE FLNULL ;YES--VERIFY NULL NUMBER
JRST E.CDR ;NO--ERROR
ANDCAM P1,F.MOD ;CLEAR FLAG
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST FILDR4 ;AND FINISH BELOW
>
FILDR1: TLNE T1,(1B0) ;SEE IF WILD-CARD OFF
JUMPL N,[MOVEM N,F.DIR ;AND SIXBIT TYPEIN
MOVEM T1,F.DIRM
JRST FILDR2]
CAIE C,"," ;MUST HAVE COMMA NOW
JRST E.CDR ;ERROR IF NOT
SKIPE FLNULL ;SEE IF SOMETHING
TLNE N,-1 ;YES--MAKE SURE NOT 0
TRNE N,-1 ;MAKE SURE THAT
JRST E.IPJ ;YES--NAUGHTY USER
HLLZM N,F.DIR ;SAVE
HLLZM T1,F.DIRM ;AND MASK
PUSHJ P,.NOCTW ;GET PROGRAMMER
PUSHJ P,.LEFTX ;PUT INTO LEFT HALF-WORD
SKIPE FLNULL ;SEE IF SOMETHING
TLNE N,-1 ;YES--MAKE SURE NOT 0
TRNE N,-1 ;MAKE SURE THAT PROGRAMMER
JRST E.IPG ;BAD--NAUGHTY USER
HLRM N,F.DIR ;SAVE
HLRM T1,F.DIRM ;AND MASK
FILDR2:
IFN FT$SFD,<
MOVEI P1,F.DIR ;PRESET TO ACCUMULATE SUB-DIRECTORIES
FILDR3: CAIE C,"," ;SEE IF SFD NEXT
JRST FILDR4 ;NO--EXIT DIRECTORY CODE
ADDI P1,2 ;ADVANCE ACCUMULATION POINTER
CAIL P1,F.DIR+2*.FXLND ;PROHIBIT OVERFLOW
JRST E.SFD ;NO--BOMB USER
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
JRST FILDR3 ;AND LOOP FOR MORE
FILDR4:
>
CAIE C,"]" ;MUST HAVE END NOW
CAIN C,076 ;ALSO CHECK END OF 2741 DIRECTORY [252]
SKIPA ;OK [252]
JUMPG C,E.RDR ;CATCH IMPROPERLY FORMATTED DIRECTORY
JUMPG C,FILIN1 ;PROCESS SEPARATOR UNLESS EOL
;FALL INTO FILINR
> ;END TOPS-10
;HERE WHEN NEXT BREAK CHARACTER TO BE ANALYZED
FILINR: SETOM FLFSP ;NOTE THAT SOMETHING HAS HAPPENED
FILINN: JRST FILIN3 ;AND GO PROCESS SEPARATOR
;.GTSPC -- ROUTINE TO BLT THE FILE SPEC ACCUMULATED
; TO SOME MORE PERMANENT PLACE
; CALLER MUST APPLY HIS STICKY DEFAULTS FIRST.
; THIS WILL SUPPLY SCAN'S DEFAULTS.
;CALL: MOVEI T1,START OF AREA
; MOVEI T2,LENGTH OF AREA
; PUSHJ P,.GTSPC
;USES T1, T2, T3, T4
.GTSPC::CAIGE T1,100 ;PROTECT AC'S
HALT . ;AGAINST JUNK CALL
MOVEI T3,APLSTD ;SET DSK: DEFAULTER
SKIPE SWTCNT ;IF TOP LEVEL
SKIPGE FLVERB ;OR VERB
MOVEI T3,APLSTK ;SET FULL DEFAULTER
PUSHJ P,(T3) ;GO SET DEFAULTS
CAILE T2,.FXLEN ;MAKE SURE NOT TOO LONG
MOVEI T2,.FXLEN ;SHRINK IF SO
ADDI T2,(T1) ;COMPUTE END PLUS ONE
HRLI T1,F.ZER ;COPY FROM F.XXX
BLT T1,-1(T2) ; TO END OF AREA
POPJ P, ;RETURN
;APLSTK -- APPLY USER'S STICKY DEFAULTS
;APLSTD -- APPLY DEFAULT DEVICE IF INDICATED
;CALL: PUSHJ P,APLSTK/D
;USES T3, T4
APLSTK:
IF TOPS-10,<
MOVE T3,P.DEV ;APPLY DEVICE--PICK UP STICKY
SKIPN F.DEV ;SEE IF USER TYPED SOMETHING
MOVEM T3,F.DEV ;NO--SUPPLY HIS STICKY DEVICE
MOVE T3,P.NAMM ;GET NAME MASK [534]
SKIPN F.NAM ;IF NO NAME YET [534]
MOVEM T3,F.NAMM ; APPLY STICKY NAME MASK [534]
MOVE T3,P.NAM ;GET NAME [534]
SKIPN F.NAM ;IF NO NAME YET, [534]
MOVEM T3,F.NAM ; APPLY STICKY NAME [534]
SKIPE F.EXT ;SEE IF EXTENSION
JRST APLST1 ;YES--GO ON
MOVX T3,FX.NUL ;NO--SET NULL EXT. BIT
IORM T3,F.MOD ;FOR LATER
IORM T3,F.MODM ;AND IN MASK
MOVE T3,P.EXT ;APPLY EXTENSION
MOVEM T3,F.EXT ; ..
APLST1: MOVE T4,[P.DIR,,F.DIR]
MOVX T3,FX.DIR ;GET DIRECTORY FLAG
TDNN T3,F.MODM ;SEE IF DIRECTORY SPECIFIED
BLT T4,F.DIR+.FXLND-1 ;NO--COPY DEFAULT
> ;END TOPS-10
IF TOPS-20,<
;********************
; MAKE ABC:.EXT(FOO,BAR) WORK HERE
;*****************
> ;END TOPS-20
MOVE T3,P.MOD ;APPLY ALL FILE SWITCHES
ANDCM T3,F.MODM ;MASK HERE USED TO INDICATE WHICH WERE TYPED
IORM T3,F.MOD ; ..
MOVE T3,P.MODM ; ..
IORM T3,F.MODM ; ..
MOVSI T4,P.MZER-P.EZER ;LENGTH OF SWITCHES [346]
APLST2: MOVE T3,F.MZER(T4) ;GET CURRENT VALUE [346]
CAMN T3,[-1] ;SEE IF SET [346]
MOVE T3,P.MZER(T4) ;NO--GET THIS STICKY SWITCH [346]
MOVEM T3,F.MZER(T4) ;STORE RESULT [346]
AOBJN T4,APLST2 ;LOOP OVER ALL SWITCHES [346]
;FALL INTO APLSTD
;FALL HERE FROM ABOVE
IF TOPS-10,<
SKIPGE FLFSP ;SEE IF SOME FILE HERE [516]
APLSTD: SKIPE F.DEV ;YES--SEE IF DEVICE SPECIFIED
JRST APLST5 ;YES--SKIP DEFAULTING
MOVSI T3,'DSK' ;NO--SPECIFY DSK:
MOVEM T3,F.DEV ; AS DEVICE
> ;END TOPS-10
IF TOPS-20,<
APLSTD:
>
APLST5: SKIPLE T4,F.BFR ;IF /BEFORE, [331]
CAML T4,F.SNC ; MAKE SURE AFTER /SINCE [331]
JRST APLST6 ;OK--PROCEED [331]
M$FAIL (BSO,/BEFORE and /SINCE don't overlap)
APLST6: SKIPLE T4,F.ABF ;IF /ABEFORE, [346]
CAML T4,F.ASN ; MAKE SURE AFTER /ASINCE [346]
JRST APLST9 ;OK--PROCEED [346]
M$FAIL (ABO,/ABEFORE and /ASINCE don't overlap)
APLST9: PUSH P,T1 ;SAVE T1 FOR .GTSPC [513]
SKIPGE FLFLLP ;SEE IF WERE IN () [543]
PUSHJ P,CLERST ;YES, CLEAR STICKIES [543]
POP P,T1 ;RESTORE T1 [543]
IFN ECHO$P,<
OUTSTR [ASCIZ /AFTER USER DEFAULTS: /]
PUSHJ P,TFILE
>
POPJ P, ;RETURN
IFN M$INDP,<
;.OSDFS--APPLY OSCAN DEFAULT FILE SWITCHES
;MUST BE CALLED AFTER CALLING OSCAN. CALL ONCE FOR EACH
;FILE SPEC TSCAN SETUP. THIS WILL TAKE ANY FILE SWITCHES
;SET IN SWITCH.INI AND USE THEM AS DEFAULTS FOR
;THE FILES TYPED BY THE USER.
;CALL: 1/ LOCATION OF SPEC
; 2/ LENGTH OF SPEC
; PUSHJ P,.OSDFS
;USES T1-4
.OSDFS::MOVE T3,F.MOD ;GET MOD WORD SWITCHES
TXZ T3,FXNOTD ;REMOVE ALL BUT SWITCHES [537]
ANDCM T3,.FXMOM(T1) ;REMOVE ANY USER SET
IORM T3,.FXMOD(T1) ;SET DEFAULT VALUES
MOVE T3,F.MODM ;GET MASK OF DEFAULTS
TXZ T3,FXNOTD ;REMOVE ALL BUT SWITCHES [537]
IORM T3,.FXMOM(T1) ;INDICATE SET
MOVEI T4,-.FXBFR(T2) ;COUNT OF EXTRA WORDS
CAILE T4,F.EMZR-F.MZER ;SEE IF MORE THAN WE UNDERSTAND
MOVEI T4,F.EMZR-F.MZER ;YES--SET TO OUR LIMIT
MOVNS T4 ;MAKE NEGATIVE
HRLZS T4 ;SET IN LEFT HALF AS COUNT
OSDFS1: MOVE T3,.FXBFR(T1) ;GET EXISTING VALUE
CAMN T3,[-1] ;SEE IF DEFAULT
MOVE T3,F.MZER(T4) ;YES--GET OSCAN VALUE
MOVEM T3,.FXBFR(T1) ;STORE VALUE
AOS T1 ;ADVANCE POINTER
AOBJN T4,OSDFS1 ;LOOP UNTIL DONE
POPJ P, ;RETURN
>
;SUBROUTINE TO TYPE OUT F.XXX AREA
IFN ECHO$P,<
TFILE: PUSHJ P,.PSH4T##
MOVE T2,F.DEV
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /:/]
MOVE T2,F.NAM
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /./]
HLLZ T2,F.EXT
PUSHJ P,.TSIXN##
MOVE T1,F.DIR
PUSHJ P,.TPPNW
MOVE T1,F.MOD
PUSHJ P,.TXWDW
OUTSTR [ASCIZ /
MASKS: /]
MOVE T2,F.NAMM
PUSHJ P,.TSIXN##
OUTSTR [ASCIZ /./]
HRLZ T2,F.EXT
PUSHJ P,.TSIXN##
MOVE T1,F.DIRM
PUSHJ P,.TPPNW
MOVE T1,F.MODM
PUSHJ P,.TXWDW
PUSHJ P,.TCRLF##
PJRST .POP4T##
>
;CLERST -- CLEAR STICKY DEFAULTS
;.CLSNS -- DITTO EXCLUDING SWITCHES
CLERST: SETOM P.MZER ;CLEAR SWITCHES [346]
MOVE T1,[P.MZER,,P.MZER+1]
BLT T1,P.EZER
SETZM FLFLLP ;CLEAR ( SWITCH [543]
SKIPE CLRSTK ;SEE IF USER WANTS CONTROL [534]
PUSHJ P,@CLRSTK ;YES--GO TO HIM [534,551]
SETZM P.MOD ;CLEAR [551]
SETZM P.MODM ; SMALL SWITCHES [551]
.CLSNS::PUSH P,P.MOD ;SAVE SWITCHES [551,553]
PUSH P,P.MODM ; .. [551]
SETZM P.ZER ;CLEAR STICKY DEFAULTS [551]
MOVE T1,[P.ZER,,P.ZER+1]
BLT T1,P.MZER-1
POP P,P.MODM ;RESTORE SMALL [551]
POP P,P.MOD ; SWITCHES [551]
IF TOPS-10,<
MOVX T1,FX.NDV!FX.NUL!FX.DIR!FX.DFX!FX.TRM
> ;END TOPS-10
IF TOPS-20,<
MOVX T1,FX.TRM
> ;END TOPS-20
ANDCAM T1,P.MOD ;CLEAR NON-SWITCH [552]
ANDCAM T1,P.MODM ; INFORMATION [552]
POPJ P, ;NO--JUST RETURN [534]
IF TOPS-20,<
;SUBROUTINE TO DO A JFNS JSYS TO STRING TEMP
;CALL WITH:
; T2 = LH: JFN FLAGS (OPTIONAL), RH: JFN
; T3 = JFNS CONTROL BITS
; PUSHJ P,DOJFNS
; RETURN HERE WITH ANSWER IN .STEMP
;
DOJFNS: STORE T1,.STEMP,.STEMP+.STEML-1,0 ;CLEAR BLOCK
HRROI T1,.STEMP## ;POINT TO BLOCK
JFNS ;GET THE STRING
POPJ P,0 ;RETURN
;SUBROUTINE TO CALL GTJFN AND HANDLE ERROR
;CALL WITH:
; T1 AND T2 SET FOR GTJFN
; PUSHJ P,GETJFN
; RETURN HERE JFN AND FLAGS IN T1
;
DEFINE GJERR(CODE,PFX,TEXT),<
E$$'PFX:MOVE T2,[''PFX'',,[ASCIZ "TEXT "]]
XLIST
CAIN T1,CODE
JRST GTJFNF
LIST
>
GETJFN: MOVE T4,T2 ;REMEMBER STRING POINTER
GTJFN ;GET THE JFN
SKIPA ;FAILED
POPJ P,0 ;WON--RETURN TO CALLER
GJERR (GJFX5,FTL,Field in file specification is too long)
GJERR (GJFX6,DNF,Device not first)
GJERR (GJFX7,DWP,Directory is specified in the wrong place)
GJERR (GJFX8,IUB,Illegal use of brackets)
GJERR (GJFX9,DNI,Duplicate name illegal)
GJERR (GJFX10,IGN,Illegal generation number)
GJERR (GJFX11,DGI,Duplicate generation illegal)
GJERR (GJFX12,DAI,Duplicate account illegal)
GJERR (GJFX13,DPI,Duplicate protection illegal)
GJERR (GJFX14,IPF,Illegal protection field)
GJERR (GJFX22,MSF,Monitor storage (JSB) full during GTJFN)
GJERR (GJFX31,IUW,Illegal use of wildcards)
PUSHJ P,.TJERR## ;NOT SPECIAL ERROR CODE
PUSHJ P,.TSPAC## ;ADD SPACE
MOVE T1,T4 ;PUT POINTER IN RIGHT PLACE
JRST GTJNF1 ;ADD ON FILE SPEC
GTJFNF: PUSH P,T4 ;SAVE POINTER
MOVE T1,T2 ;COPY ERROR MESSAGE
PUSHJ P,.TERRP ;PREFIX MESSAGE
TXNN T1,JWW.FL ;WANT FIRST LINE
PJRST .FMSGE ;NO--END ERROR PROCESSING
POP P,T1 ;RESTORE STRING POINTER
GTJNF1: TLC T1,-1 ;IF LH IS EXACTLY
TLNN T1,-1 ; MINUS 1
PUSHJ P,.TSTRG## ;PRINT STRING
PUSHJ P,.TCRLF## ;ADD CRLF
PJRST .FMSGE ;COMPLETE ERROR PROCESSING
> ;END TOPS-20
SUBTTL SUBROUTINES FOR COMMAND INPUT -- SWITCH OR VERB PROCESSING
;.KEYWD -- SWITCH/VERB SCANNER
;CALL: PUSHJ P,.KEYWD
;NON-SKIP RETURN IF NO KEYWORD PRESENT
;SKIP RETURN IF KEYWORD AFTER ARGUMENTS ARE SCANNED
; WITH LH(T1)=SWITCH SPECIFIC FLAGS, RH(T1)=0
;USES T1-4
;GLOBAL USAGE-- P1=SWITCH OFFSET
; P2=POINTER FOR INTERNAL VS. EXTERNAL
.KEYWD::PUSHJ P,.SAVE2## ;SAVE P1 (SWITCH INDEX)
; AND P2 (LOCAL/REMOTE INDEX)
PUSHJ P,.SIXSW ;GET NAME
JUMPE N,.POPJ ;RETURN IF NO KEYWORD
AOS SWTCNT ;COUNT RECURSION
;THIS NEXT CODE SEARCHES USER AND STANDARD SWITCH TABLES TO
;FIND A POSSIBLY ABBREVIATED MATCH. USER OVERRIDES STANDARD.
;IN ANY TABLE, SEVERAL MATCHING CAUSES DUPLICATE MESSAGE,
;AS DOES ONE ABBREV. IN EACH TABLE.
;EXACT IN EITHER TABLE WINS.
AOS (P) ;SET FOR SKIP RETURN (WE FOUND A KEYWORD)
PUSHJ P,SWTNAM ;GO LOOK UP NAME [316]
SKIPA ;CAN'T FIND, TRY HARDER [316]
JRST KEYWDG ;GOT IT--PROCEED [316]
JUMPG T1,E$$ABS ;AMBIGUOUS IF MORE THAN ONE [316]
TLC N,'NO ' ;SEE IF /NOXYZ [316]
TLNE N,(7777B11) ; .. [316]
JRST [TLC N,'NO ' ;NO--RESTORE WORD [316]
JRST E$$UKS] ;ISSUE ERROR [316]
TLC N,'NO ' ;RESTORE WORD [316]
PUSH P,N ;SAVE WORD [316]
LSH N,^D12 ;STRIP "NO" [316]
PUSHJ P,SWTNAM ;AND TRY AGAIN [316]
JRST [POP P,N ;ERROR--RESTORE WORD [316]
JUMPG T1,E$$ABS ;GIVE AMBIGUOUS [316]
JRST E$$UKS] ;OR UNKNOWN MESSAGE [316]
POP P,N ;RESTORE NAME [316]
MOVX T1,FS.OBV!FS.NOS ;SEE IF BIT VALUE [316]
TDNN T1,@SWD(P2) ; IN WHICH CASE, MEANS "NONE" [316]
JRST E$$UKS ;ELSE, PRETEND UNKNOWN [316]
HRLI P2,-1 ;SET FLAG /NOXYZ [316]
KEYWDG: SETZM FLMULS ;CLEAR MULTIPLE SWITCH FLAG
MOVE T1,SWTCNT ;GET SWITCH DEPTH [357]
CAIG T1,1 ;IF TOP LEVEL, [357]
JRST KEYWDM ; GO PROCESS SWITCH [357]
HRRZ T1,@SWP(P2) ;ELSE, MUST BE VERB MODE [357]
CAIL T1,F.ZER ; ALLOW ONLY [357]
CAILE T1,F.EMZR ; IF LOCAL OR [357]
SKIPA ; NO--TRY REMOTE [357]
JRST KEYWDM ;LOCAL FILE MODIFIER SO OK [357]
CAML T1,SWTPFF ; OR IF [357]
CAMLE T1,SWTPFL ; REMOTE FILE MODIFIER [357]
JRST E$$UKS ;NEITHER--UNKNOWN [357]
;BACK HERE ON MULTIPLE SWITCH VALUES
; I.E., IF /SWITCH:(VAL1,VAL2,VAL3,...VALN)
; THEN, THE SWITCH DISPATCH WILL NOTICE
; THE LEFT PAREN. THEN AT EACH SWDONE, THE COMMA
; WILL BE NOTICED AND IT WILL LOOP BACK HERE. WHEN
; THE RIGHT PAREN IS SEEN AT SWDONE, THE NORMAL EXIT
; WILL BE TAKEN WITH THE BREAK SET TO SPACE.
KEYWDM: MOVE T2,@SWD(P2) ;GET SWITCH FLAGS
HRRZ N,T2 ;GET DEFAULT VALUE
TXNE T2,FS.LRG ;SEE IF LARGE VALUES
TRNN N,-1 ; AND SOMETHING THERE
SKIPA ;NO--LEAVE ALONE
MOVE N,(N) ;YES--GET IT
TXNE T2,FS.OBV ;SEE IF OR-BITS [531]
HRLI N,1 ;YES--SET SPECIAL FLAG [531]
MOVEM N,.NMUL ;SET ALSO INTO MULTI-WORD AREA
SETZM .NMUL+1 ;AND CLEAR REST
MOVE T1,[.NMUL+1,,.NMUL+2]
BLT T1,.NMUE
MOVE T1,@SWM(P2) ;GET PROCESSOR OR TABLE POINTER
TXNE T2,FS.NOS ;SEE IF "NO" SWITCH
JRST [HLRZ N,P2 ;IF SN STYLE, GET NO INDICATOR [316]
MOVEI N,1(N) ;SET N=0 IF NO, 1 IF NOT NO [316]
JRST KEYWDA] ;GO STUFF RESULT [316,342]
JUMPL P2,KEYWD7 ;ELSE, NOXYZ IS BIT VALUE [316]
TXNE T2,FS.LRG ;SEE IF LARGE MODE
HRLI T1,1 ;YES--NOTE A VALUE (ONLY A FLAG HERE)
SKIPE FLMULS ;SEE IF INSIDE (,,,,)
JRST KEYWD3 ;YES--GO DISPATCH
CAIN C,":" ;SEE IF VALUE SPECIFIED
JRST KEYWD2 ;YES--GO CHECK INTO IT
SKIPL FLVERB ;SEE IF VERB MODE
JRST KEYWD1 ;NO--PROCEED
JUMPLE C,KEYWD1 ;YES--IF NULL, PROCEED
MOVE T3,SWTCNT ;GET ITERATION COUNT [547]
CAIE T3,1 ;SEE IF NESTED [547]
JRST KEYWD1 ;NO--DON'T REEAT [547]
CAIE C," " ;UNLESS SPACE,
PUSHJ P,.REEAT ; CAUSE RESCAN OF CHARACTER
JRST KEYWD2 ;THEN GO GET ARGS
;HERE WHEN DEFAULT NEEDED
KEYWD1: TXNE T2,FS.VRQ ;SEE IF VALUE REQUIRED
JRST E.SVR ;YES--GIVE ERROR
TLNN T1,-1 ;SEE IF MAX SET
JUMPN T1,KEYWDJ ;NO--DIRECT ACTION [343]
JUMPGE T1,SWDPBE ;YES--GO STORE DEFAULT [343]
JUMPE N,E.UDS ;IF NO DEFAULT, ERROR
JRST KEYWD8 ;ELSE, STORE IT [316]
;HERE WHEN VALUE SPECIFIED BY USER (MAY BE NULL)
KEYWD2: JUMPE T1,E.NMA ;IF NO VALUE LEGAL, GIVE ERROR
SKIPGE FLVERB ;IF VERB MODE,
JRST KEYWD3 ; GO HANDLE VALUE
MOVE T4,C ;SAVE EXISTING BREAK
PUSHJ P,.TIALT ;ELSE, LOOK AT NEXT CHAR
PUSHJ P,.REEAT ;AND SET TO REEAT IT
EXCH T4,C ;RESTORE ORIGINAL CHAR
CAIE T4,"(" ;SEE IF MULTIPLE VALUE COMING
JRST KEYWD3 ;NO--GO HANDLE SINGLE VALUE
SETZM SAVCHR ;YES--GOBBLE PAREN
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]
MOVEI T1,0 ;CLEAR ACCUMULATOR [316]
MOVE T2,N ;COPY WORD [316]
LSHC T1,^D12 ;SPLIT "NO" [316]
MOVX T4,FS.OBV ;SEE IF OR-STYLE [316]
TDNN T4,@SWD(P2) ; OF BIT VALUES [316]
JRST KEYWD6 ;NO--NO MORE POSSIBILITIES [341]
CAMN N,['NONE '] ;YES--SEE IF :NONE [341]
JRST [MOVSI N,-1 ;RIGHT--INDICATE THAT [341]
JRST KEYWD8] ;GO DISPATCH [341]
CAMN N,['ALL '] ;SEE IF :ALL [341]
JRST [MOVEI N,-1 ;RIGHT--INDICATE THAT [341]
JRST KEYWD8] ;GO DISPATCH [341]
CAIE T1,' NO' ;AND "NO" [316]
JRST KEYWD6 ;IF NOT, GO TRY SIMPLE CASE [316]
PUSH P,N ;YES--SAVE NAME [316]
MOVE N,T2 ;COPY XYZ OF NOXYZ [316]
MOVE T1,@SWM(P2) ;GET LIST AGAIN [316]
PUSHJ P,.NAME ;TRY TO FIND [316]
JRST KEYWD5 ;NO LUCK--RESTORE N AND TRY SIMPLE CASES [316]
POP P,N ;RESTORE NAME [316]
SUB T1,@SWM(P2) ;DETERMINE INDEX AS VALUE [316]
HRROI N,(T1) ;INDICATE NO,,(1,2,...) [316]
JRST KEYWD8 ;AND GO STORE [316]
;HERE IF SN SWITCH TO LOOK FOR VALUES
KEYWDA: JUMPE N,KEYWD8 ;IF NO, PROCEED (NO VALUES) [342]
CAIN C,":" ;SEE IF VALUE COMING [342]
JRST KEYWDB ;YES--GO HANDLE [342]
SKIPGE FLVERB ;SEE IF VERB MODE [342]
CAIE C," " ;YES--SEE IF ANOTHER WORD [342]
JRST KEYWD8 ;NO--THAT'S IT [342]
KEYWDB: PUSHJ P,.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 [343]
JRST SWDPBE ;AND GO STORE
;HERE TO GO TO SWITCH PROCESSOR
KEYWDJ: PUSHJ P,(T1) ;GO DO IT [343]
JRST SWDPBE ;GO STORE [343]
JRST SWDONE ;HE STORED--JUST CLEAN UP [343]
;TABLE OF YES/NO VALUES--MUST BE NO/YES PAIRS
YNTAB: SIXBIT /0/
SIXBIT /1/
SIXBIT /NO/
SIXBIT /YES/
SIXBIT /OFF/
SIXBIT /ON/
YNTABL==.-YNTAB
;SWTNAM -- ROUTINE TO LOOK UP NAME IN USER AND LOCAL SWITCH TABLES
;BEHAVIOUR IS JUST LIKE .NAME ROUTINE
;USES T1-4
;SUCCESSFUL RETURN WITH P1, P2 SETUP
; P1=INDEX IN CORRECT TABLE
; P2=INDICATOR OF WHICH TABLE
SWTNAM: MOVEI P1,0 ;FLAG NOTHING FOUND YET [316]
MOVE T1,SWTPTR ;POINTER TO USER'S SWITCHES
PUSHJ P,.NAME ;SEE IF USER'S SWITCH
JRST [JUMPL T1,SWTNMU ;IF NO MATCH, JUST SEARCH STANDARD ONES
SETOM P1 ;IF SEVERAL, SET FLAG
JRST SWTNMU] ; AND SEARCH STANDARD
MOVEI P2,SWTCHC ;POINT TO USER'S SWITCH TABLES
MOVE P1,T1 ;SAVE SOLUTION
JUMPL T1,SWTNMR ;DONE IF EXACT MATCH ON USER
SWTNMU: MOVE T1,[IOWD STSWTL,STSWTN] ;IOWD PTR TO LIST OF SWITCHES
PUSHJ P,.NAME ;LOOK-UP NAME IN TABLE
JRST [JUMPG T1,.POPJ ;IMPRECISE--GIVE UP
JUMPL P1,RETONE ;FIRST TIME WAS IMPRECISE--GIVE UP
JUMPE P1,RETMIN ;NOT FOUND--IF NOT USER EITHER, GIVE UP
MOVE T1,P1 ;IF USER, GET HIS POINTER BACK
JRST SWTNMR] ; AND GO PROCESS IT
SKIPL T1 ;IF EXACT, GO PROCESS IT
JUMPN P1,RETONE ;IF ABBR OF BOTH TABLES, AMBIGUOUS
MOVE P1,T1 ;SET INDEX IN TABLE
MOVEI P2,STDSWC ;POINT TO STANDARD SWITCH TABLES
;HERE TO RETURN SUCCESSFULLY
SWTNMR: MOVEI P1,0 ;CLEAR INDEX
MOVEI T2,@SWN(P2) ;GET START OF NAME TABLE
MOVEI P1,(T1) ;GET ADDRESS OF SWITCH
SUBI P1,(T2) ;GET OFFSET OF SWITCH
JRST .POPJ1 ;AND RETURN SUCCESSFULLY
;RETURN WITH T1=1
RETONE: MOVEI T1,1 ;SET VALUE 1
POPJ P, ;RETURN
;RETURN WITH T1=-1
RETMIN: SETOM T1 ;SET VALUE -1
POPJ P, ;RETURN
;HERE WHEN SWITCH VALUE IS A DECIMAL NUMBER
.SWDEC::PUSHJ P,.DECNW ;GET THE NUMBER
JRST .SWMAX ;AND STORE IT
;HERE WHEN SWITCH IS AN OCTAL NUMBER
.SWOCT::PUSHJ P,.OCTNW ;GET OCTAL WORD
JRST .SWMAX ;AND STORE AWAY
;HERE WHEN SWITCH IS A CORE VALUE
.SWCOR::PUSHJ P,.COREW ;GET CORE WORD
JRST .SWMAX ;AND STORE AWAY
;HERE WHEN SWITCH VALUE IS AN ASCII STRING
.SWASQ==:.ASCQW
;HERE WHEN SWITCH VALUE IS A SIXBIT STRING
.SWSXQ==:.SIXQW
;HERE WHEN SWITCH VALUE IS A MULTIPLE WORD SIXBIT QUANTITY
; OF ONLY ALPHA-NUMERICS (NO SPECIAL SYMBOLS, NO QUOTING)
.SWSXM==:.SIXMW
;HERE WHEN SWITCH VALUE IS A ONE WORD SIXBIT QUANTITY
.SWSIX==:.SIXSW
;HERE WHEN SWITCH VALUE IS A DATE/TIME FIELD IN THE PAST
.SWDTP==:.DATIP
;HERE WHEN SWITCH VALUE IS A DATE/TIME FIELD IN THE FUTURE
.SWDTF==:.DATIF
;HERE WHEN SWITCH VALUE IS A DATE/TIME FIELD
.SWDTM==:.DATIM
;HERE WHEN SWITCH TAKES A FILE SPECIFICATION AS ITS VALUE
.SWFIL::MOVE T1,[F.ZER,,G.ZER]
BLT T1,G.EZER ;SAVE CURRENT SPEC
PUSHJ P,.FILIN ;GO GET FILE SPEC
MOVE T2,@SWP(P2) ;GET POINTER AS STARTING POINT
SKIPE STRSWT ;SEE IF USER'S
CAIN P2,STDSWC ;AND HE WANTS CONTROL
SKIPA
JRST [MOVE T3,@SWD(P2) ;GET FLAGS
TXNE T3,FS.NUE ;SEE IF NO EXIT
JRST .+1 ;RIGHT--PROCEED
PUSHJ P,@STRSWT ;YES--GO TO HIM(T1=0 IF NULL,T2=LOC,T3=FLAGS)
PJRST SWFILX ;ALL DONE
JRST .+1]
HRRZ T1,T2 ;USE POINTER AS STARTING POINT
HLRZ T2,@SWM(P2) ;USE MAX AS LENGTH
SKIPL FLVERB ;SEE IF VERB
SKIPN .FXZER(T1) ;NO--SEE IF ALREADY SET
JRST SWFIL1 ;NO--OK TO STORE
IFN M$INDP,<
SKIPE OPTNAM ;BAD--SEE IF IN OPTION FILE
JRST SWFILX ;YES--SKIP STORE
>
JRST E.DSI ;ERROR--DUPLICATE SWTICH
SWFIL1: PUSHJ P,.GTSPC ;COPY RESULTS
SWFILX: MOVE T1,[G.ZER,,F.ZER]
BLT T1,F.EZER ;RESTORE ORIGINAL SPECIFICATION
PJRST .POPJ1 ;GO FINISH UP [343]
;HERE TO HANDLE /LENGTH SWITCH
;FORMAT OF VALUE IS TWO BLOCK SIZES SEPARATED BY COLON
;FIRST IS THE MINIMUM FILE SIZE
;SECOND IS THE MAXIMUM FILE SIZE
;IF FIRST IS NULL, DEFAULTS TO 0
;IF SECOND IS NULL, DEFAULTS TO UNSET (+INFINITY)
SWLEN: PUSHJ P,.BLOKW ;GET MINIMUM FILE SIZE
SKIPL F.FLI ;SEE IF ALREADY SET
CAMN N,F.FLI ; TO A DIFFERENT VALUE
JRST SWLEN1 ;NO--OK TO USE
SKIPL FLVERB ;YES--SEE IF VERB MODE
JRST [IFN M$INDP,<
SKIPE OPTNAM> ;NO--SEE IF OPTION FILE
JRST SWLEN2 ;YES--IGNORE ENTRY
JRST E.DSI] ;NO--DUPLICATE
SWLEN1: MOVEM N,F.FLI ;OK--STORE MINIMUM
MOVE T4,SWTCNT ;GET DEPTH [557]
SKIPGE FLVERB ;SEE IF VERB MODE [557]
CAIE T4,1 ;SEE IF TOP LEVEL [557]
JRST SWLEN2 ;NO [557]
MOVEM N,P.FLI ;STORE IN P.XXX AREA ALSO [557]
SWLEN2: CAIE C,":" ;SEE IF SECOND ARGUMENT
JRST .POPJ1 ;NO--RETURN WITH NO STORE
PUSHJ P,.BLOKW ;YES--GET MAXIMUM FILE SIZE
CAMGE N,F.FLI ;SEE IF GREATER THAN MINIMUM
JRST E$$LVI ;NO--ERROR
POPJ P, ;YES--RETURN AND STORE
;HERE TO HANDLE /EXIT SWITCH
SWEXIT: MOVE T1,@SWP(P2) ;GET POINTER [506]
SKIPN .FXZER(T1) ;IF NOT SET, [506]
SETOM .FXZER(T1) ; INDICATE FOR STORE ROUTINE [506]
MOVEI N,1 ;SET VALUE [506]
POPJ P, ;RETURN--INDICATE STORE NEEDED [506]
IF TOPS-20,<
;HANDLE /ACCOUNT SWITCH
SWACCT: PUSHJ P,.ASCQW ;READ AN ASCII STRING
MOVE T1,[.NMUL,,F.ACT] ;COPY TO
BLT T1,F.ACT+7 ; F AREA
POPJ P,0 ;RETURN
> ;END TOPS-20
;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
IF TOPS-10,<
IFN M$INDP,<
PUSH P,T2 ;SAVE IOWD
INIT IND,.IODMP ;OPEN
SIXBIT /DSK/ ; FILE
0,,0 ; ..
JRST E$$CWT ;ERROR
MOVSS T1 ;POSITION NAME
HLL T1,CCLNAM ;GET JOB NUMBER
MOVSI T2,'TMP' ;STANDARD EXTENSION
SETZB T3,T4 ;CLEAR REST OF ENTER
ENTER IND,T1 ;ENTER FILE
JRST E$$CWT ;ERROR IF CAN'T
POP P,T1 ;GET IOWD
MOVEI T2,0 ;CLEAR IOWD LIST
OUTPUT IND,T1 ;WRITE FILE
CLOSE IND, ;COMPLETE
RELEAS IND, ;CLEAR CHANNEL
JRST .POPJ1 ;RETURN WITHOUT STORE
>
>
M$FAIL (CWT,Can't write tmpfile)
M$FAIL (ITF,Incorrect tmpfile argument format)
;HERE ON A HELP SWITCH
; ARG TO SCAN IS TYPE AND ADDRESS OF HELP PROCESSOR
; LH CONTAINS TYPE OF PROCESSOR, RH CONTAINS VALUE
; TYPE 0=NO HELP AVAILABLE
; TYPE 1=ASCIZ STRING, RH=ADDR OF STRING
; TYPE 2=SUBROUTINE TO BE CALLED, RH=ADDR OF SUBROUTINE
.SWHLP::CAIN N,HELPSWITCHES ;SEE IF /HELP:SWITCHES
JRST FILHLS ;YES--GO LIST THEM
SKIPN T1,SWTHLP ;SKIP IF HELP PROCESSOR SPECIFIED
JRST FILNOH ;NO, CANT HELP HIM
HLRZ T2,T1 ;YES, GET CODE
CAIN T2,1 ;SKIP IF NOT ASCIZ STRING
JRST FILTXH ;GO TYPE STRING
CAIN T2,2 ;SKIP IF NOT SUBROUTINE TO BE CALLED
PJRST (T1) ;CALL SUBROUTINE
CAILE T2,77 ;SEE IF NAME CODE
JRST FILHLP ;YES--GO DO IT
HALT FILSHX ;UNKNOWN TYPE
FILTXH: TLZA T1,-1 ;WORD=ADDR OF TEXT STRING
FILNOH: MOVEI T1,[ASCIZ /% I can't help you, please read the manual/]
PUSHJ P,.TSTRG## ;TYPE STRING
PUSHJ P,.TCRLF## ;AND TOP OFF WITH CRLF
JRST FILSHX
FILHLP: PUSHJ P,.HELPR## ;GO CALL HELPER TO READ SYS: FILE
JRST FILSHX ;AND RESTART
;HERE WHEN /HELP:SWITCHES TYPED TO LIST THE SWITCHES
FILHLS: MOVEI P2,2 ;SET COUNTER
FILHLA: MOVEI T1,[ASCIZ /Switches are:/]
CAIN P2,1 ;SEE IF SECOND PASS
MOVEI T1,[ASCIZ /Standard ones:/]
PUSHJ P,.TSTRG## ;TYPE HEADER
MOVE P1,SWTPTR ;GET POINTER
CAIN P2,1 ;UNLESS SECOND SHOT
MOVE P1,[IOWD STSWTL,STSWTN]
JUMPE P1,FILHLD ;JUMP IF NULL LIST
MOVEI N,7 ;PRESET COUNT FOR FIRST LINE
JRST FILHLC ;GO START TYPEOUTS
FILHLB: PUSHJ P,.TCOMA## ;SEPARATE SWITCHES BY A COMMA
SOJG N,FILHLC ;COUNT OFF SWITCHES IN LINE
MOVEI T1,[ASCIZ /
/]
PUSHJ P,.TSTRG## ;START NEW LINE
MOVEI N,^D8 ;RESET COUNTER
FILHLC: PUSHJ P,.TSPAC## ;PRECEDE EACH SWITCH BY A SPACE
MOVE T1,1(P1) ;GET NEXT SWITCH
PUSHJ P,.TSIXN## ;TYPE IT
AOBJN P1,FILHLB ;LOOP UNTIL DONE
FILHLD: PUSHJ P,.TCRLF## ;TYPE END OF LINE
SOJG P2,FILHLA ;LOOP FOR TWO SHOTS
;HERE AT END OF HELP OUTPUT
FILSHX: PUSHJ P,CLRBFN ;SKIP TO EOL ON INPUT
JRST .FMSGX ;GO CLEAN UP AND RESTART
;HERE 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
LDB T1,T3 ;SEE IF ALREADY SOMETHING THERE
CAMN N,T1 ;IF SAME AS NEW VALUE, [325]
JRST FILSWN ; LEAVE IT ALONE [325]
SKIPL FLVERB ;IN VERB, ALLOW CHANGES
CAMN T1,[-1] ;IF -1,
JRST FILSWN ; THEN NOTHING YET
CAIGE T4,^D36 ;SEE IF FULL WORD
JUMPE T1,FILSWN ;NO--OK IF MASK ABSENT
TXNE P1,FS.OBV ;SEE IF OR BIT VALUES [277]
JRST [HLRZ T1,(T2) ;YES--GET MASK FROM LH [277]
CAIE T1,-1 ;IF WAS ALL OR NONE, OK [503]
TRNN T1,(N) ;SEE IF THIS BIT SET [277]
JRST FILSWN ;NO--OK TO PROCEED [277]
HRRZ T1,(T2) ;GET BIT TO MODIFY [503]
TLNE N,-1 ;SEE IF NOT THIS TIME [503]
TRC T1,-1 ;YES--CHANGE VALUE [503]
TRNE T1,(N) ;SEE IF SET SAME LAST TIME [503]
JRST FILSWN ;YES--OK TO UPDATE [503]
JRST .+1] ;ELSE CONTINUE WITH TESTS [277]
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.ZER ;SEE IF IN LOCAL [357]
CAILE T2,F.EMZR ; FILE SPEC AREA [357]
JRST FILSW1 ;NO--TRY BELOW
SUBI T2,F.MOD-P.MOD ;YES--SWITCH TO [357]
SUBI T3,F.MOD-P.MOD ; PXXX AREA [357]
JRST FILSW2 ;AND STORE THERE ALSO [357]
FILSW1: CAML T2,SWTPFF ;SEE IF
CAMLE T2,SWTPFL ; USER FXXX
PJRST SWDONE ;NO--JUST FINISH
ADD T2,SWTPFO ;SHIFT TO PXXX
ADD T3,SWTPFO ; ..
FILSW2: HLL T2,T3 ;RESTORE POINTER
DPB T1,T3 ;STORE MASK
DPB N,T2 ;STORE VALUE
PJRST SWDONE ;AND COMPLETE
;HERE WHEN STORE IS TO MULTIPLE WORDS
FILSWW: LDB T1,[POINT 6,T2,11] ;GET NUMBER OF WORDS
MOVN T1,T1 ;COMPLEMENT
HRLI T2,.NMUL ;GET SOURCE
ADDI T1,77+2-1(T2) ;SET LENGTH TO LAST ADDRESS (77 IS TWO WORDS)
MOVE T3,T2 ;MAKE COPY JUST IN CASE
BLT T2,(T1) ;TRANSFER DATA
MOVE T4,SWTCNT ;GET DEPTH [357]
SKIPGE FLVERB ;SEE IF VERB MODE [357]
CAIE T4,1 ;SEE IF TOP LEVEL VERB [357]
PJRST SWDONE ;NO--FINISH UP
CAML T1,SWTPFF ;YES--SEE IF
CAMLE T1,SWTPFL ; IN FXXX AREA
PJRST SWDONE ;NO--FINISH UP
ADD T3,SWTPFO ;YES--POINT TO
ADD T1,SWTPFO ; PXXX AREA
BLT T3,(T1) ;AND MAKE A COPY THERE
;HERE AT END OF SWITCH OR VERB PROCESS
SWDONE: SKIPN FLMULS ;SEE IF MULTIPLE VALUE
JRST SWDONX ;NO--FINISH UP
CAIN C," " ;SEE IF SPACE [566]
PUSHJ P,.TIALT ;GET COMMAND CHARACTER [566]
CAIN C,"," ;SEE IF ANOTHER VALUE
JRST [PUSHJ P,.TIALT;YES--CHECK NEXT COMMAND CHARACTER [566]
CAIE C," " ;SEE IF SPACE [566]
PUSHJ P,.REEAT;NO--RE-EAT [566]
JRST KEYWDM];LOOP TO GET VALUE
CAIE C,")" ;NO--SEE IF DONE YET
JUMPG C,E.MRP ;NO--ERROR
SETZM FLMULS ;YES--CLEAR FLAG
SKIPLE C ;IF NOT END OF LINE,
MOVEI C," " ; RETURN SPACE
MOVEM C,LASCHR ;UPDATE LAST CHARACTER [366]
SWDONX: HLLZ T1,@SWD(P2) ;GET SWITCH FLAGS
SOS SWTCNT ;BACK UP RECURSION
POPJ P, ;AND RETURN TO CALLER
.SWDON==:.POPJ1
;HERE WE DEFINE STANDARD SWITCHES PROCESSED IN SCAN
DEFINE SWTCHS,<
SP ABEFORE,F.ABF,.SWDTP,,FS.VRQ
IF TOPS-20,<
SP ACCOUNT,F.ACT,SWACCT,,FS.VRQ
>
SP ASINCE,F.ASN,.SWDTP,,FS.VRQ
SP BEFORE,F.BFR,.SWDTP,,FS.VRQ
SL DENSITY,<POINTR (F.MOD,FX.DEN)>,DENS,DENSIN
SS ERNONE,<POINTR (F.MOD,FX.NOM)>,0
SS ERPROTECTION,<POINTR (F.MOD,FX.PRT)>,0
SS ERSUPERSEDE,<POINTR (F.MOD,FX.SUP)>,1
IF TOPS-10,<
SP ESTIMATE,F.EST,.BLOKW,,FS.VRQ
>
IFN M$INDP,<
SP EXIT,N.ZER,SWEXIT,,FS.NFS!FS.NCM
> ;END M$INDP
SL *HELP,<-1,,.SWHLP>,HELP,HELPTEXT,FS.NFS!FS.NCM
SP LENGTH,F.FLM,SWLEN,,FS.VRQ
SL MESSAGE,<*F,.FLVRB##>,VRB,PD.MSG,FS.OBV!FS.NFS!FS.NCM
IFN M$INDP,<
SS NOOPTION,OPTION,0,FS.NFS!FS.NCM
>
SS OKNONE,<POINTR (F.MOD,FX.NOM)>,1
SS OKPROTECTION,<POINTR (F.MOD,FX.PRT)>,1
SS OKSUPERSEDE,<POINTR (F.MOD,FX.SUP)>,0
IFN M$INDP,<
SP OPTION,OPTION,.SWSIX,OPT,FS.NFS!FS.NCM
>
SL PARITY,<POINTR (F.MOD,FX.PAR)>,PAR,PARODD
SN PHYSICAL,<POINTR (F.MOD,FX.PHY)>
IF TOPS-10,<
SP PROTECTION,<POINTR (F.MOD,FX.PRO)>,.SWOCT,PRO
> ;END TOPS-10
IF TOPS-20,<
SP PROTECTION,F.PRO,.PRONW,PRO,FS.LRG
> ;END TOPS-20
IFN M$INDP,<
SP RUN,N.ZER,.SWFIL,RNL,FS.NFS!FS.NCM!FS.VRQ
IF TOPS-10,<
SP RUNCORE,N.CORE,.SWCOR,RNC,FS.LRG!FS.NFS!FS.NCM
SP RUNOFFSET,N.OFFS,.SWOCT,RUN,FS.NFS!FS.NCM
>
>
SP SINCE,F.SNC,.SWDTP,,FS.VRQ
SN STRS,<POINTR (F.MOD,FX.STR)>
IF TOPS-20,<
SN TEMP,<POINTR (F.MOD,FX.TMP)>
>
SP TMPFILE,,SWTMP,,FS.VRQ!FS.NFS!FS.NCM
SP VERSION,F.VER,.VERSW,,FS.VRQ
>
;NOW BUILD THE TABLES FROM THE SWTCHS MACRO
IFN M$INDP,<
MX.OPT==1
PD.OPT==0
MX.RNL==N.EZER-N.ZER+1
PD.RNL==0
>
DOSCAN (STSWT)
;HERE WE BUILD THE KEYS
KEYS (DENS,<200,556,800,1600,6250,%%,$$,INSTALLATION>)
IFN DENSIN-1-<FX.DEN_-<ALIGN. (FX.DEN)>>,<PRINTX ? DENSITY:INSTALLATION IS WRONG>
KEYS (HELP,<SWITCHES,TEXT>)
KEYS (PAR,<EVEN,ODD>)
; --DUMMIES-- [321]
KEYS (VRB,<PREFIX,FIRST,CONTINUATION,$$,$%,%$,%%,ADDRESS>)
IFN VRBADX-VRBADD,<PRINTX ? DEFINE VRBADX TO BE VRBADD VALUE>
;FILE SPECIFICATION ERROR MESSAGES
IF TOPS-20,<
M$FAIL (DFN,Double file specification illegal)
> ;END TOPS-20
IF TOPS-10,<
M$FAIN (DFN,Double file name illegal)
M$FAIN (WDV,Device wildcard illegal)
M$FAIL (NDV,Null device illegal)
M$FAIN (DDV,Double device illegal)
M$FAIN (DEX,Double extension illegal)
E.CDR: HLRZS N
M$FAIO (CDR,Comma required in directory)
E.DDR: PUSHJ P,.NOCTW ;GRAB PROGRAMMER NUMBER FOR MESSAGE
M$FAIO (DDR,Double directory illegal)
E.RDR: HLRZS N
M$FAIO (RDR,Right bracket required in directory)
E.IPJ: TRNN N,-1 ;DON'T POSITION IF OK
HLRZS N
M$FAIO (IPJ,Improper project number)
E.IPG: TRNN N,-1 ;DON'T POSITION IF OK
HLRZS N
M$FAIO (IPG,Improper programmer number)
> ;END TOPS-10
IFN FT$SFD,<
E.SFD: MOVEI N,F.ZER
MOVEI T2,.FXLND-1
M$FAIF (SFD,SFD depth greater than)
M$FAIL (NSF,Null SFD illegal)
>
M$FAIN (UKS,Unknown switch)
M$FAIN (ABS,Ambiguous switch)
M$FAIL (NSS,No switch specified)
E.UKK:: JUMPGE T1,E$$ASV ;SEE IF AMBIGUOUS
M$FAIN (USV,Unknown switch value)
M$FAIN (ASV,Ambiguous switch value)
E.UDS: MOVE N,@SWN(P2)
M$FAIN (UDS,Unknown default for switch)
E.DSI::
IFN M$INDP,<
SKIPE OPTNAM ;SEE IF OPTION FILE
JRST SWDONE ;YES--JUST GIVE UP SINCE ALREADY SET
>
MOVE N,@SWN(P2)
M$FAIN (DSI,Double switch illegal)
E.NMA: MOVE N,@SWN(P2)
M$FAIN (NMA,No modifier allowed on switch)
E.SVTL::M$FAID (SVL,Switch value too large)
E.SVNG::M$FAID (SVN,Switch value negative)
E.MRP==E.ILSC ;GIVE ILLEGAL CHARACTER MESSAGE
E.SENS==E.ILSC ;GIVE ILLEGAL CHARACTER MESSAGE
E.SVR:: MOVE N,@SWN(P2)
M$FAIN (SVR,Switch value required on)
M$FAIL (LVI,<Length values inconsistent; specify min:max>)
M$FAIL (PND,Parenthesis nesting too deep)
E.UOP: SETZM FLFLLP ;CLEAR ( SWITCH AND GIVE ERROR [543]
M$FAIL (UOP,Unmatched open parenthesis)
;FILSTK -- MEMORIZE STICKY DEFAULTS
;CALL: PUSHJ P,FILSTK
; RETURNS AFTER NON-ZERO F.XXX COPIED TO P.XXX
;USES T1, T2
FILSTK: SKIPE SWTCNT ;SEE IF NESTED SWITCH
SKIPGE FLVERB ;NO--SEE IF VERB MODE
SKIPA
POPJ P, ;YES--DON'T SAVE
IF TOPS-10,<
SKIPE T1,F.DEV ;COPY DEVICE
MOVEM T1,P.DEV
SKIPE T1,F.NAM ;GET DEFAULT NAME [534]
MOVEM T1,P.NAM ;IF SET, STORE FOR DEFAULTER [534]
MOVE T2,F.NAMM ;GET DEFAULT NAME MASK [534]
SKIPE T1 ;IF NAME SET, [534]
MOVEM T2,P.NAMM ; SET MASK ALSO [534]
SKIPE T1,F.EXT ;COPY EXTENSION
MOVEM T1,P.EXT
MOVE T2,[F.DIR,,P.DIR]
MOVX T1,FX.DIR ;SET DIRECTORY FLAG
TDNE T1,F.MODM ;SEE IF SET
BLT T2,P.EZER ;YES--COPY DIRECTORY
> ;END TOPS-10
IF TOPS-20,<
MOVE T1,[F.ZER,,P.ZER] ;IF F AREA IS
SKIPE F.ZER ; SETUP COPY
BLT T1,P.ZER+.FXLNF-1 ; TO P AREA
> ;END TOPS-20
MOVE T1,F.MOD ;COPY FILE MODIFIERS
MOVE T2,F.MODM
ANDCAM T2,P.MOD
IORM T1,P.MOD
IORM T2,P.MODM
MOVSI T2,P.MZER-P.EZER ;GET LENGTH OF SWITCHES [346]
FILST1: MOVE T1,F.MZER(T2) ;GET CURRENT VALUE [346]
CAME T1,[-1] ;SEE IF SET [255,346]
MOVEM T1,P.MZER(T2) ;YES--UPDATE STICKY VALUE [346]
AOBJN T2,FILST1 ;LOOP OVER SWITCHES [346]
SKIPE MEMSTK ;SEE IF USER WANTS CONTROL
PJRST @MEMSTK ;YES--GO TO HIM
POPJ P, ;RETURN
SUBTTL SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME
;.DATIF -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN FUTURE
;.DATIG -- DITTO (CHARACTER ALREADY IN C)
;CALL: PUSHJ P,.DATIF/.DATIG
; RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4 UPDATES C (SEPARATOR)
.DATIF::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DATIG::SETZM FLFUTR ;CLEAR FUTURE RELATIVE
SETZM FLFUTD ;SET DEFAULT
AOS FLFUTD ; TO FUTURE
CAIE C,"+" ;SEE IF FUTURE RELATIVE
JRST DATIF1 ;NO--JUST GET DATE-TIME
AOS FLFUTR ;YES--SET FUTURE REL FLAG
PUSHJ P,.TIAUC ;GET ANOTHER CHARACTER
DATIF1: PUSHJ P,DATIM ;GET DATE/TIME
CAMGE N,NOW ;SEE IF IN FUTURE
JRST E$$NFT ;NO--NOT FUTURE ERROR
POPJ P, ;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::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
CAMLE N,NOW ;SEE IF IN PAST
JRST E$$NPS ;NO--NOT PAST ERROR
POPJ P, ;RETURN
;.DATIM -- ROUTINE TO SCAN DATE AND TIME ARGUMENT
;.DATIC -- DITTO (CHARACTER ALREADY IN C)
;CALL: PUSHJ P,.DATIM/.DATIC
; RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4 UPDATES C (SEPARATOR)
.DATIM::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DATIC::SETZM FLFUTR ;CLEAR RELATIVE FLAG
SETZM FLFUTD ;CLEAR DEFAULT FLAG
CAIE C,"+" ;SEE IF FUTURE RELATIVE
JRST DATIC1 ;NO--PROCEED
AOS FLFUTR ;YES--SET FLAG
JRST DATIC2 ;AND PROCEED
DATIC1: CAIE C,"-" ;SEE IF PAST RELATIVE
PJRST DATIM ;NO--JUST GET ABS DATE
SOS FLFUTR ;YES--SET FLAG
DATIC2: PUSHJ P,.TIAUC ;GET NEXT CHAR
;AND FALL INTO DATE/TIME GETTER
;DATIM -- ROUTINE TO INPUT DATE/TIME
;CALL: SET FLFUTR TO -1 IF PAST RELATIVE, 0 IF ABSOLUTE, +1 IF FUTURE RELATIVE
; SIMILARLY FOR FLFUTD TO INDICATE DEFAULT DIRECTION IF FLFUTR=0
; GET NEXT CHARACTER IN C
; PUSHJ P,DATIM
;RETURN WITH TRUE DATE/TIME IN N IN INTERNAL SPECIAL FORMAT
; SETS NOW TO CURRENT DATE/TIME
;USES T1-4, UPDATES C
;
;TYPE-IN FORMATS:
; (THE LEADING +- IS HANDLED BY CALLER)
;
; [ [ DAY IN WEEK ] ]
; [ [ NNND ] ]
; [ [ [ MM-DD [-Y ] ] : ] [HH[:MM[:SS]]] ]
; [ [ [ MMM-DD [-YY ] ] ] ]
; [ [ [ DD-MMM [-YYYY] ] ] ]
; [ MNEMONIC ]
;WHERE:
; D LETTER D
; DD DAY IN MONTH (1-31)
; HH HOURS (00-23)
; MM MONTH IN YEAR (1-12)
; OR MINUTES (00-59)
; MMM MNEMONIC MONTH OR ABBREV.
; SS SECONDS (0-59)
; Y LAST DIGIT OF THIS DECADE
; YY LAST TWO DIGITS OF THIS CENTURY
; YYYY YEAR
; DAY IN WEEK IS MNEMONIC OR ABBREVIATION
; MNEMONIC IS A SET OF PREDEFINED TIMES
;DESCRIBED ABOVE
;FALL HERE FROM .DATIC
DATIM: SKIPE T1,FLFUTR ;SEE IF FORCED DIRECTION
MOVEM T1,FLFUTD ; YES--THAT IMPLIES DEFAULT
SETOM VAL1 ;CLEAR RESULT WORDS
MOVE T1,[VAL1,,VAL2]
BLT T1,VAL9 ; ..
PUSHJ P,.GTNOW## ;GET CURRENT DATE/TIME
MOVEM T1,NOW ;SAVE FOR LATER TO BE CONSISTENT
CAIL C,"0" ;SEE IF DIGIT
CAILE C,"9" ; ..
JRST .+2 ;NO--MNEMONIC FOR SOMETHING
JRST DATIMD ;YES--GO GET DECIMAL
;HERE IF STARTING WITH ALPHA, MIGHT BE DAY, MONTH, OR MNEMONIC
PUSHJ P,.SIXSC ;GET SIXBIT WORD
JUMPE N,E$$DTM ;ILLEGAL SEPARATOR IF ABSENT [274]
MOVE T1,MNDPTR ;POINT TO FULL TABLE
PUSHJ P,.NAME ;LOOKUP IN TABLE
JRST E$$UDN ;ERROR IF NOT KNOWN
MOVEI N,(T1) ;GET
SUBI N,DAYS ; DAY INDEX
CAIL N,7 ;SEE IF DAY OF WEEK
JRST DATIMM ;NO--LOOK ON
;HERE WHEN DAY OF WEEK RECOGNIZED
SKIPN T1,FLFUTD ;GET DEFAULT DIRECTION
JRST E$$NPF ;ERROR IF NONE
MOVEM T1,FLFUTR ;SET AS FORCED DIRECTION
HLRZ T2,NOW ;GET DAYS
IDIVI T2,7 ;GET DAY OF WEEK
SUB N,T3 ;GET FUTURE DAYS FROM NOW
SKIPGE N ;IF NEGATIVE,
ADDI N,7 ; MAKE LATER THIS WEEK
HLLZ T1,NOW ;CLEAR CURRENT
SKIPL FLFUTD ;SEE IF FUTURE
TROA T1,-1 ;YES--SET MIDNIGHT MINUS EPSILON
SUBI N,7 ;NO--MAKE PAST
HRLZ N,N ;POSITION TO LEFT HALF
ADD N,T1 ;MODIFY CURRENT DATE/TIME
DATIMW: PUSH P,N ;SAVE DATE
PUSHJ P,DATIC ;GO CHECK TIME
HRRZ N,(P) ;NO--USE VALUE IN DATE
POP P,T1 ;RESTORE DATE
HLL N,T1 ; TO ANSWER
JRST DATIMX ;CHECK ANSWER AND RETURN
;HERE IF MONTH OR MNEMONIC
DATIMM: MOVEI N,(T1) ;GET MONTH
SUBI N,MONTHS-1 ; AS 1-12
CAILE N,^D12 ;SEE IF MONTH
JRST DATIMN ;NO--MUST BE MNEMONIC
MOVEM N,VAL6 ;YES--STORE MONTH
CAIE C,"-" ;MUST BE DAY NEXT
JRST E$$MDD ;NO--ERROR
PUSHJ P,.DECNW ;YES--GET IT
JUMPLE N,E$$NND ;ERROR IF NEGATIVE
CAILE N,^D31 ;VERIFY IN RANGE
JRST E$$DFL ;ERROR IF TOO LARGE
MOVEM N,VAL5 ;SAVE AWAY
JRST DATIY0 ;AND GET YEAR IF PRESENT
;HERE IF MNEMONIC
DATIMN: HRRZ T2,T1 ;GET COPY [305]
CAIN T2,SPLGTM ;SEE IF "LOGIN" [505]
SKIPG N,LOGTIM ;AND WE KNOW IT [505]
SKIPA ;NO--PROCEED [505]
JRST DATIMX ;YES--GO GIVE ANSWER [505]
CAIN T2,SPNOON ;SEE IF "NOON" [520]
JRST [HLLZ N,NOW ;YES--GET TODAY [520]
HRRI N,1B18 ;SET TO NOON [520]
JRST DATIMW] ;GO FINISH UP [520]
CAIN T2,SPMIDN ;SEE IF "MIDNIGHT" [520]
JRST [HLLZ N,NOW ;GET TODAY [520]
JRST DATIMO] ;GO SET TO MIDNIGHT [520]
SUBI T2,SPCDAY ;SUBTRACT OFFSET TO SPECIAL DAYS [305]
CAILE T2,2 ;SEE IF ONE OF THREE [305]
JRST E.MDS ;NO--UNSUPPORTED [305]
HLRZ N,NOW ;YES--GET TODAY [305]
ADDI N,-1(T2) ;OFFSET IT [305]
HRLZS N ;POSITION FOR ANSWER [305]
DATIMO: SKIPL FLFUTD ;SEE IF FUTURE [305]
TRO N,-1 ;YES--SET TO MIDNIGHT MINUS EPSILON [305]
JRST DATIMW ;AND GO FINISH UP [305]
;HERE IF UNSUPPORTED MNEMONIC
E.MDS: MOVE N,(T1) ;GET NAME OF SWITCH
M$FAIN (MDS,Mnemonic date/time switch not implemented)
;HERE IF STARTING WITH DECIMAL NUMBER
DATIMD: PUSHJ P,.DECNC ;YES--GO GET FULL NUMBER
JUMPL N,E$$NND ;ILLEGAL IF NEGATIVE
CAIE C,"D" ;SEE IF DAYS
JRST DATIN ;NO--MUST BE -
MOVE T1,FLFUTD ;YES--RELATIVE SO GET FORCING FUNCTION
MOVEM T1,FLFUTR ; AND FORCE IT
JUMPE T1,E$$NPF ;ERROR IF DIRECTION UNCLEAR
CAIL N,1B18 ;VERIFY NOT HUGE
JRST E$$DFL ;ERROR--TOO LARGE
MOVEM N,VAL5 ;SAVE RELATIVE DATE
PUSHJ P,.TIAUC ;GET NEXT CHARACTER (SKIP D)
PUSHJ P,DATIC ;GO CHECK FOR TIME
MOVEI N,0 ;0 IF NONE
HRL N,VAL5 ;INCLUDE DAYS IN LH
JRST DATITR ;GO DO RELATIVE RETURN
;HERE WHEN DIGITS SEEN WITHOUT A FOLLOWING D
DATIN: CAIE C,"-" ;SEE IF DAY/MONTH COMBO
JRST DATIT ;NO--MUST BE INTO TIME
CAILE N,^D31 ;MUST BE LESS THAN 31
JRST E$$DFL ;NO--ERROR
JUMPE N,E$$DFZ ;VERIFY NOT ZERO
MOVEM N,VAL5 ;SAVE VALUE
PUSHJ P,.TIAUC ;SKIP OVER MINUS
CAIL C,"0" ;SEE IF DIGIT NEXT
CAILE C,"9" ; ..
JRST DATMMM ;NO-- MUST BE MNEMONIC MONTH
PUSHJ P,.DECNC ;YES-- MUST BE MM-DD FORMAT
JUMPLE N,E$$NND ;BAD IF LE 0
CAILE N,^D31 ;VERIFY LE 31
JRST E$$DFL ;BAD
EXCH N,VAL5 ;SWITCH VALUES
CAILE N,^D12 ;VERIFY MONTH OK
JRST E$$DFL ;BAD
JRST DATMM1 ;GO STORE MONTH
;HERE WHEN TIME SEEN BY ITSELF
DATIT: PUSHJ P,DATIG ;GET REST OF TIME
HALT . ;CAN NOT GET HERE
SKIPN FLFUTR ;SEE IF RELATIVE
JRST DATIRN ;NO--GO HANDLE AS ABS.
;HERE WITH DISTANCE IN N
DATITR: SKIPGE FLFUTR ;IF PAST,
MOVN N,N ; COMPLEMENT DISTANCE
ADD N,NOW ;ADD TO CURRENT DATE/TIME
JRST DATIMX ;CHECK ANSWER AND RETURN
;HERE WHEN DD- SEEN AND MNEMONIC MONTH COMING
DATMMM: PUSHJ P,.SIXSC ;GET MNEMONIC
MOVE T1,MONPTR ;GET POINTER TO MONTH TABLE
PUSHJ P,.NAME ;LOOKUP IN TABLE
JRST E$$UDM ;NO GOOD
MOVEI N,(T1) ;GET MONTH
SUBI N,MONTHS-1 ; AS 1-12
;HERE WITH MONTH INDEX (1-12) IN T1
DATMM1: MOVEM N,VAL6 ;SAVE FOR LATER
DATIY0: CAIE C,"-" ;SEE IF YEAR NEXT
JRST DATIRA ;NO--GO HANDLE TIME
;HERE WHEN YEAR NEXT AS ONE, TWO, OR FOUR DIGITS
SETZB N,T1 ;CLEAR DIGIT AND RESULT COUNTERS
DATIY: PUSHJ P,.TIAUC ;GET NEXT DIGIT
CAIL C,"0" ;SEE IF NUMERIC
CAILE C,"9" ; ..
JRST DATIY1 ;NO--MUST BE DONE
IMULI N,^D10 ;ADVANCE RESULT
ADDI N,-"0"(C) ;INCLUDE THIS DIGIT
AOJA T1,DATIY ;LOOP FOR MORE, COUNTING DIGIT
DATIY1: JUMPE T1,E$$ILR ;ERROR IF NO DIGITS
CAIE T1,3 ;ERROR IF 3 DIGITS
CAILE T1,4 ;OK IF 1,2, OR 4
JRST E$$ILR ;ERROR IF GT 4 DIGITS
MOVE T2,N ;GET RESULT
IDIVI T2,^D100 ;SEP. CENTURY
IDIVI T3,^D10 ;SEP. DECADE
CAIG T1,2 ;IF ONE OR TWO DIGITS,
SETOM T2 ; FLAG NO CENTURY KNOWN
CAIN T1,1 ;IF ONE DIGIT,
SETOM T3 ; FLAG NO DECADE KNOWN
MOVEM T4,VAL7 ;SAVE UNITS
MOVEM T3,VAL8 ;SAVE DECADE
MOVEM T2,VAL9 ;SAVE CENTURY
;HERE WITH VAL5-9 CONTAINING DAY, MONTH, YEAR, DECADE, CENTURY
DATIRA: SOS VAL5 ;MAKE DAYS 0-30
SOS VAL6 ;MAKE MONTHS 0-11
PUSHJ P,DATIC ;GET TIME IF PRESENT
SKIPG FLFUTD ;IGNORE ABSENCE
JRST DATIRN ; UNLESS FUTURE
;HERE IF FUTURE WITHOUT TIME
MOVEI T1,^D59 ;SET TO
MOVEM T1,VAL2 ; 23:59:59
MOVEM T1,VAL3 ; ..
MOVEI T1,^D23 ; ..
MOVEM T1,VAL4 ; ..
;HERE WITH VAL2-9 CONTAINING PARSE OR -1 IF TO BE FILLED IN
; STRATEGY IS TO FILL-IN HOLES LESS SIGNIFICANT THAN
; MOST SIGN. FIELD WITH 0; AND TO FILL IN MORE SIGNIFICANT
; HOLES WITH CURRENT VALUE. THEN IF WRONG DIRECTION FROM
; NOW, ADD/SUB ONE TO FIELD JUST ABOVE MOST SIGNIFICANT DIFFERENT
; (FIELD CARRY NOT NEEDED SINCE IT WILL HAPPEN IMPLICITLY).
DATIRN: PUSHJ P,.TICAN ;MAKE SURE NEXT CHAR IS SEPARATOR [542]
SKIPA ;YES--OK [542]
JRST E$$ILC ;NO--FLAG ERROR BEFORE DEFAULTING [542]
MOVE T1,NOW ;GET CURRENT DATE/TIME
PUSHJ P,.CNTDT## ;CONVERT TO EASY FORMAT
MOVE T3,T1 ;SAVE MSTIME
IDIVI T3,^D1000 ; AS SECONDS
ADD T2,[^D1964*^D12*^D31] ;MAKE REAL
MOVEI T4,8 ;TRY 8 FIELDS [250]
DATIRB: MOVE T1,T2 ;POSITION REMAINDER
IDIV T1,[1
^D60
^D60*^D60
1
^D31
^D31*^D12
^D31*^D12*^D10
^D31*^D12*^D10*^D10]-1(T4) ;SPLIT THIS FIELD FROM REST [250]
SKIPL VAL1(T4) ;SEE IF DEFAULT [250]
JRST [TLNN T3,-1 ;NO--FLAG TO ZERO DEFAULTS [250]
HRL T3,T4 ; SAVING INDEX OF LAST DEFAULT [250]
JRST DATRIC] ;AND CONTINUE LOOP
SETZM VAL1(T4) ;DEFAULT TO ZERO [250]
TLNN T3,-1 ;SEE IF NEED CURRENT [250]
MOVEM T1,VAL1(T4) ;YES--SET THAT INSTEAD [250]
DATRIC: CAME T1,VAL1(T4) ;SEE IF SAME AS CURRENT [250]
JRST DATIRD ;NO--REMEMBER FOR LATER
CAIN T4,4 ;SEE IF TIME FOR TIME [250]
HRRZ T2,T3 ;YES--GET IT
SOJG T4,DATIRB ;LOOP UNTIL ALL DONE [250]
;HERE WHEN FILLED IN CURRENT FOR SIGNIFICANT DEFAULTS
DATIRD: SKIPGE VAL1(T4) ;SEE IF DEFAULT [250]
SETZM VAL1(T4) ;CLEAR DEFAULT [250]
SOJG T4,DATIRD ;LOOP UNTIL DONE [250]
HLRZ N,T3 ;RECOVER LAST SIGN. DEFAULT-1 [250]
JUMPE N,DATIRR ;DONE IF NONE [250]
PUSHJ P,DATIRM ;MAKE CURRENT DATE, TIME
MOVE T4,FLFUTD ;GET DEFAULT DIRECTION
XCT [CAMGE T1,NOW
JFCL
CAMLE T1,NOW]+1(T4) ;SEE IF OK
JRST DATIRR ;YES--GO RETURN
SKIPG FLFUTD ;NO--SEE WHICH DIRECTION
SOSA VAL2(N) ;PAST
AOS VAL2(N) ;FUTURE
DATIRR: PUSHJ P,DATIRM ;REMAKE ANSWER
MOVE N,T1 ;MOVE TO ANSWER
;HERE WITH FINAL RESULT, CHECK FOR OK
RADIX 10
DATIMX: MOVEI T1,.TDTTM## ;SET DATE-TIME [314]
MOVEM T1,.LASWD ; OUTPUTER [314]
CAML N,[<1964-1859>*365+<1964-1859>/4+<31-18>+31,,0] ;[261]
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
RADIX 8
M$FAIL (DOR,Date/time out of range)
;SUBROUTINE TO MAKE DATE/TIME
DATIRM: MOVE T1,VAL4 ;GET HOURS
IMULI T1,^D60 ;MAKE INTO MINS
ADD T1,VAL3 ;ADD MINS
IMULI T1,^D60 ;MAKE INTO SECS
ADD T1,VAL2 ;ADD SECS
IMULI T1,^D1000 ;MAKE INTO MILLISECS
MOVE T2,VAL9 ;GET CENTURIES
IMULI T2,^D10 ;MAKE INTO DECADES
ADD T2,VAL8 ;ADD DECADES
IMULI T2,^D10 ;MAKE INTO YEARS
ADD T2,VAL7 ;ADD YEARS
IMULI T2,^D12 ;MAKE INTO MONTHS
ADD T2,VAL6 ;ADD MONTHS
IMULI T2,^D31 ;MAKE INTO DAYS
ADD T2,VAL5 ;ADD DAYS
SUB T2,[^D1964*^D12*^D31] ;REDUCE TO SYSTEM RANGE
PJRST .CNVDT## ;CONVERT TO INTERNAL FORM AND RETURN
;SUBROUTINE TO GET TIME IF SPECIFIED
;RETURNS CPOPJ IF NO TIME, SKIP RETURN IF TIME
; WITH TIME IN RH(N) AS FRACTION OF DAY
;USES T1-4, N
DATIC: CAIE C,":" ;SEE IF TIME NEXT
POPJ P, ;NO--MISSING TIME
PUSHJ P,.DECNW ;GET DECIMAL NUMBER FOR TIME
;HERE WITH FIRST TIME FIELD IN N
DATIG: JUMPL N,E$$NND ;ERROR IF NEGATIVE [326]
CAIL N,^D24 ; AND GE 24,
JRST E$$DFL ;GIVE ERROR--TOO LARGE
MOVEM N,VAL4 ;SAVE HOURS
CAIE C,":" ;SEE IF MINUTES COMING
JRST DATID ;NO--DONE
PUSHJ P,.DECNW ;YES--GET IT
CAIL N,^D60 ;SEE IF IN RANGE
JRST E$$DFL ;NO--GIVE ERROR
JUMPL N,E$$NND ;ERROR IF NEG
MOVEM N,VAL3 ;SAVE MINUTES
CAIE C,":" ;SEE IF SEC. COMING
JRST DATID ;NO--DONE
PUSHJ P,.DECNW ;GET SECONDS
CAIL N,^D60 ;CHECK RANGE
JRST E$$DFL ;NO--GIVE ERROR
JUMPL N,E$$NND ;ERROR IF NEG
MOVEM N,VAL2 ;SAVE SECONDS
;HERE WITH TIME IN VAL2-4
DATID: SKIPGE T1,VAL4 ;GET HOURS
MOVEI T1,0 ; UNLESS ABSENT
IMULI T1,^D60 ;CONV TO MINS
SKIPL VAL3 ;IF MINS PRESENT,
ADD T1,VAL3 ; ADD MINUTES
IMULI T1,^D60 ;CONV TO SECS
SKIPL VAL2 ;IF SECS PRESENT,
ADD T1,VAL2 ; ADD SECONDS
MOVEI T2,0 ;CLEAR OTHER HALF
ASHC T1,-^D17 ;MULT BY 2**18
DIVI T1,^D24*^D3600 ;DIVIDE BY SECONDS/DAY
MOVE N,T1 ;RESULT IS FRACTION OF DAY IN RH
JRST .POPJ1 ;RETURN
;DATE/TIME ERRORS
M$FAIL (NFT,Date/time must be in the future)
M$FAIL (NPS,Date/time must be in the past)
M$FAIL (NND,Negative number in date/time)
M$FAIL (NPF,Not known whether past or future in date/time)
M$FAIL (DFL,Field too large in date/time)
M$FAIL (DFZ,Field zero in date/time)
M$FAIL (UDM,Unrecognized month in date/time)
M$FAIL (ILR,Illegal year format in date/time)
M$FAIL (UDN,Unrecognized name in date/time)
M$FAIL (MDD,Missing day in date/time)
M$FAIL (DTM,Value missing in date/time)
;MNEMONIC WORDS IN DATE/TIME SCAN
DEFINE XX($1),<
EXP <SIXBIT /$1/>>
DAYS: XX WEDNESDAY
XX THURSDAY
XX FRIDAY
XX SATURDAY
XX SUNDAY
XX MONDAY
XX TUESDAY
MONTHS: XX JANUARY
XX FEBRUARY
XX MARCH
XX APRIL
XX MAY
XX JUNE
XX JULY
XX AUGUST
XX SEPTEMBER
XX OCTOBER
XX NOVEMBER
XX DECEMBER
SPCDAY: XX YESTERDAY
XX TODAY
XX TOMORROW
SPLGTM: XX LOGIN
SPNOON: XX NOON
SPMIDN: XX MIDNIGHT
SPDATM: XX LUNCH
XX DINNER
LSPDTM==.-DAYS
;POINTERS
MONPTR: IOWD ^D12,MONTHS
MNDPTR: IOWD LSPDTM,DAYS
SUBTTL SUBROUTINES FOR COMMAND INPUT -- GET WORD/STRING
;.NOCTW -- INPUT AN OCTAL NAME FROM COMMAND STRING
;.NOCTC -- DITTO (CHARACTER ALREADY IN C)
;DIFFERS FROM .NAMEW IN THAT OCTAL IS NORMAL
;
;NAME IS OCTAL IF LEAD # OR ? OR 0-7, NAME IF LEAD A-Z
;
;CALL: PUSHJ P,.NOCTC/.NOCTW
; RETURN WITH VALUE IN N AND MASK
;NOTE--ON NULL FIELD, N=0 MASK=0 FLNULL=0
;USES T1-T4 UPDATES C (SEPARATOR)
.NOCTW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.NOCTC::SETZB N,FLNULL ;INITIALIZE MASK AND WORD
CAIE C,"*" ;LOOK FOR WILD-CARD
JRST NOCST ;NO--TRY THE HARD WAY
TRO N,377777 ;YES--FUDGE A SUITABLE NAME
PJRST NAMEWX ;AND GO FINISH UP
NOCST: SETOM T2 ;INITIALIZE MASK
CAIL C,"A" ;SEE IF NUMBER
PJRST NAMST ;NO--GO GET NAME FORMAT
PJRST NAMNU1 ;YES--GO GET IT
;.NAMEW -- INPUT A SIXBIT NAME FROM COMMAND STRING
;.NAMEC -- DITTO (CHARACTER ALREADY IN C)
;NAME CAN BE:
; * MASK WILL BE 0
; #NN?N MASK WILL BE 0 FOR 3-BITS AT EACH ?
; AA?A MASK WILL BE 0 FOR 6-BITS AT EACH ?
; 'STRING' OR "STRING" OF SIXBIT CHARACTERS WITHOUT
; ANY WILD-CARDS
;# PRECEEDS AN OCTAL FIELD. OPTIONAL SINGLE SUFFIX OF
; K,M,G FOR 2**9,18,27
;
;CALL: PUSHJ P,.NAMEC/.NAMEW
; RETURN WITH WORD IN N AND MASK
;NOTE--ON NULL FIELD N=0, MASK=0, FLNULL=0
;USES T1, T2, T3, T4 UPDATES C (SEPARATOR)
.NAMEW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.NAMEC::SETZB N,FLNULL ;SET NULL TYPEIN FLAG
CAIE C,"*" ;LOOK FOR FULL WILD-CARD
JRST NAMST ;NO--GO GET NAME
HRLZI N,'* ' ;PUT IN NAME FOR THE RECORD
NAMEWX: MOVEI T2,0 ;SET WILD MASK
PUSHJ P,.TIAUC ;GO GET ANOTHER CHARACTER
SETOM FLNULL ;INDICATE NOT NULL
JRST NAMER ;AND GO FINISH UP
;HERE TO READ THE NAME IN
NAMST: SETOM T2 ;INITIALIZE TO FULL MASK
CAIE C,"#" ;SEE IF OCTAL SPECIFICATION
JRST NAMWD ;NO--GET ALPHANUMERIC
NAMNUR: SETOM FLNULL ;INDICATE SOMETHING FOUND
NAMNU: PUSHJ P,.TIAUC ;YES--GET NEXT ODGIT
NAMNU1: CAIE C,"?" ;SEE IF WILD CARD
JRST NAMNU2 ;NO--STUFF
LSH T2,3 ;YES--GET 0 INTO MASK
LSH N,3 ;UPDATE NAME
TRO N,7 ;FORCE NAME NON-ZERO
JRST NAMNUR ;LOOP BACK FOR MORE
NAMNU2: CAIL C,"0" ;SEE IF OCTAL
CAILE C,"7"
JRST NAMNUE ;NO--MUST BE AT END
ROT T2,3 ;ADVANCE MASK
TRO T2,7 ;FORCE THE BITS ON
LSH N,3 ;ADVANCE ACCUMULATOR
ADDI N,-"0"(C) ;ADD IN THIS ODGIT
JRST NAMNUR ;AND LOOP BACK FOR MORE
;HERE WHEN COMPLETED AN OCTAL FIELD
NAMNUE: SETZM FLNEG ;CLEAR NEGATIVE FLAG [544]
PUSHJ P,OCTMUL ;ALLOW OCTAL SUFFIX
SKIPE T1 ;SEE IF SOMETHING THERE
SETOM FLNULL ;YES--SET FLAG
SETOM T3
LSHC T2,(T1)
JRST NAMER ;RETURN
;HERE WHEN TIME TO READ AN ALPHA-NUMERIC FIELD
NAMWD: MOVEI T1,.TSIXN## ;INDICATE SIXBIT FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVEI T1,0 ;CONSTANT TO STORE IN MASK
MOVE T4,[POINT 6,N] ;INITIALIZE NAME POINTER
MOVE T3,[POINT 6,T2] ;INITIALIZE MASK POINTER
PUSHJ P,.TICQT ;CHECK FOR QUOTE
PUSHJ P,.TIMUC ;FORCE TO UPPER CASE
NAMWDC: SKIPE .QUOTE ;SEE IF QUOTE SET
JRST NAMWDS ;YES--JUST STORE
CAIE C,"?" ;SEE IF WILD CARD
JRST NAMWD1 ;NO--STUFF
TLNE T3,(77B5) ;YES--UPDATE MASK
IDPB T1,T3
JRST NAMWDS ;GO UPDATE NAME
NAMWD1: PUSHJ P,.TICAN ;SEE IF ALPHA-NUMERIC
JRST NAMWDD ;RETURN IF NOT
TLNE T3,(77B5) ;PREVENT OVERFLOW
IBP T3 ;UPDATE MASK
NAMWDS: SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T4,(77B5) ;PREVENT OVERFLOW
IDPB C,T4 ;UPDATE NAME
ADDI C," "-' ' ;BACK TO ASCII
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
SETOM FLNULL ;FLAG THAT SOMETHING IS THERE
JRST NAMWDC ;LOOP BACK TO PROCESS
NAMWDD: CAIE C,"*" ;SEE IF ENDING WITH * [512]
JRST NAMER ;NO--JUST EXIT [512]
SUBI C," "-' ' ;YES--CONVERT TO SIXBIT [512]
TLNE T4,(77B5) ;IF ROOM, [512]
IDPB C,T4 ; STORE AWAY [512]
PUSHJ P,.TIAUC ;GET ANOTHER CHARACTER [512]
SETOM FLNULL ;INDICATE NOT NULL [512]
NAMWD2: TLNN T3,(77B5) ;SEE IF DONE WITH WORD YET [512]
JRST NAMER ;YES--FINISH UP [512]
IDPB T1,T3 ;NO--INSERT A WILD MASK [512]
JRST NAMWD2 ;LOOP [512]
NAMER: SKIPN FLNULL ;SEE IF SOMETHING PRESET
MOVEI T2,0 ;NO--CLEAR MASK
MOVEM T2,MASK
IFN ECHO$W,<
NAMER1: MOVE T2,N
PUSHJ P,.TSIXW
OUTSTR [ASCIZ / :: /]
HLRZ T1,MASK
PUSHJ P,.TOCTW##
OUTSTR [ASCIZ /,,/]
HRRZ T1,MASK
PUSHJ P,.TOCTW##
PUSHJ P,.TCRLF##
>
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
;.NAME -- LOOKUP NAME IN TABLE ALLOWING FOR UNIQUE ABBREVIATIONS
;ALWAYS CHECK FOR EXACT MATCH FIRST.
;CALL: MOVE N,NAME
; MOVE T1,[IOWD LENGTH,START OF TABLE]
; PUSHJ P,.NAME
; ERROR RETURN IF UNKNOWN OR DUPLICATE
; AND WITH T1.LT.0 IF NOT MATCH, .GT.0 IF SEVERAL MATCHES
; SKIP RETURN IF FOUND WITH T1 POINTING TO ENTRY
; AND WITH LH(T1)=0 IF ABBREVIATION, OR T1.LT.0 IF EXACT MATCH
;USES T2, T3, T4
.NAME:: MOVE T2,N ;SET NAME FOR ROUTINE
PJRST .LKNAM## ;GO HANDLE IT
;.VERSW -- INPUT A VERSION NUMBER FROM COMMAND STRING
;.VERSC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-VERSION CHARACTER
;GIVES ILLEGAL CHAR MESSAGE IF VERSION NUMBER NOT IN CORRECT FORMAT OR TOO LONG
;CALL: PUSHJ P,.VERSC/.VERSW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.VERSW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.VERSC::PUSHJ P,.TICQT ;SEE IF QUOTING STRING
SETZB N,T1 ;CLEAR VERSION #
VERMJR: CAIL C,"0" ;ONLY ALLOW OCTAL
CAILE C,"7"
JRST VERMIN ;MUST BE SOMETHING ELSE
TLNE N,(7B5) ;GONE TOO FAR?
JRST E$$VER ;YES
LSH N,3 ;MAKE SPACE FOR NEW CHAR
DPB C,[POINT 3,N,11] ;STORE
PUSHJ P,.TIAUC ;GET NEXT CHAR
JRST VERMJR ;SEE IF MORE FOR MAJOR FIELD
;HERE FOR MINOR FIELD, ALPHABETICS ONLY
VERMIN: PUSHJ P,.TICAN ;SEE IF ALPHA-NUMERIC
JRST VEREDT ;NO
CAIL C,"0" ;BUT NOT NUMERIC
CAILE C,"9"
CAIA ;EITHER UPPER OR LOWER CASE ALPHABETIC
JRST E$$VER ;DIGITS NOT ALLOWED HERE
PUSHJ P,.TIMUC ;MAKE LOWER CASE
MOVEI T2,1-"A"(C) ;RELATIVE TO "A"
JUMPE T1,[MOVEI T1,(T2) ;SAVE FIRST CHAR
DPB T2,[POINT 6,N,17] ;STORE IT
PUSHJ P,.TIAUC ;GET ANOTHER
JRST VERMIN] ;CONTINUE
IMULI T1,^D26 ;RADIX 26
ADD T1,T2 ;ADD IN NEW CHAR
CAIL T1,100 ;MAKE SURE NOT TOO LARGE
JRST E$$VER ;SOMETHING WRONG
DPB T1,[POINT 6,N,17]
PUSHJ P,.TIAUC ;GET NEXT
;AND FALL INTO EDIT FIELD
;FALL HERE FROM ABOVE
VEREDT: CAIE C,"(" ;CHECK FOR EDIT FIELD
JRST VERWHO ;NO, TRY CUST FIELD
SETZ T1, ;MULTIPLE DIGIT COUNTER
VEREVR: PUSHJ P,.TIAUC ;GET NEXT CHAR
PUSHJ P,.TICAN ;SEE IF ALPHA-NUMERIC
JRST [CAIE C,")" ;MUST END CORRECTLY
JRST E$$VER ;NO
PUSHJ P,.TIAUC ;YES, BYPASS
JRST VERWHO] ;AND SEE IF DONE
CAIL C,"0" ;ONLY OCTAL ALLOWED
CAILE C,"7"
JRST E$$VER ;ILC
MOVEI T2,-"0"(C) ;RELATIVE TO "0"
LSH T1,3 ;MAKE SPACE FOR NEW CHAR
ADD T1,T2 ;ADD NEW CHAR
TLNE T1,-1 ;TOO BIG?
JRST E$$VER ;YES
HRR N,T1 ;STORE NEW EDIT #
JRST VEREVR ;LOOP BACK
;HERE FOR CUSTOMER FIELD OR EXIT
VERWHO: CAIE C,"-" ;ONLY CHAR ALLOWED HERE
JRST VERXIT ;ALL DONE
PUSHJ P,.TIAUC ;GET RID OF IT
PUSHJ P,.TIMUC ;CONVERT LOWER CASE TO UPPER
CAIL C,"0" ;SEE IF OCTAL
CAILE C,"7"
JRST E$$VER ;ILC
DPB C,[POINT 3,N,2] ;STORE
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
VERXIT: MOVEI T1,.TVERW## ;INDICATE VERSION FORMAT
MOVEM T1,.LASWD ; FOR ERROR TYPER
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
;HERE FOR ILLEGAL CHAR ERROR
M$FAIL (VER,Illegal character or field too large in /VERSION)
;.LEFTX -- FORCE NAME AND MASK INTO LEFT HALF WORD IF NEEDED
;NEEDED BECAUSE OCTAL INPUT IS RIGHT ADJUSTED
;CALL: MOVE N,WORD
; PUSHJ P,.LEFTX
; RETURN WITH N,MASK UPDATED (RH JUNK)
; AND WITH T1=MASK
;USES NO ACS
.LEFTX::MOVE T1,MASK ;SETUP MASK
TLNE N,-1 ;SEE IF LH=0 (NEED TO SWITCH)
POPJ P, ;NO
SKIPN FLNULL ;YES--SEE IF NULL [254]
SETOM T1 ;YES--SET NO WILD IN MASK [254]
HRLZ N,N ;REVERSE NAME
HRLO T1,T1 ;REVERSE MASK ALSO
MOVEM T1,MASK ;AND STORE IT AWAY
POPJ P,
;.COREW/.BLOKW -- INPUT A DECIMAL OR OCTAL CORE OR FILE SIZE ARGUMENT
;.COREC/.BLOKC -- DITTO (CHARACTER ALREADY IN C)
;IF IT STARTS WITH #, THEN OCTAL TYPEIN
;CAN BE SUFFIXED WITH K OR P TO MULTIPLY BY 1024 OR 512
;CAN BE SUFFIXED WITH B TO MULTIPLY BY 128
;CAN BE SUFFIXED WITH W (DEFAULT) TI INDICATE WORDS
;RESULT IS IN WORDS
;ENDS WITH FIRST NON-DIGIT
;THROWS AWAY ANY DIGITS EXCEPT THE LAST 10 OR SO
;CALL: PUSHJ P,.COREW/.COREC/.BLOKW/.BLOKC
; RETURN WITH NUMBER OF WORDS IN N
;IF CORE, USUALLY THE SEMANTICS ROUTINES WILL CHECK IF RESULT
; IS .LT. ^D256 AND IF SO, MULT BY 1024.
;USES T1 UPDATES C (SEPARATOR)
.BLOKW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.BLOKC::PUSHJ P,.COREC ;GET ARGUMENT
SKIPN T1 ;SEE IF SUFFIX
IF TOPS-10,<
LSH N,7 ;NO--ASSUME BLOCKS
> ;END TOPS-10
IF TOPS-20,<
LSH N,9 ;NO--ASSUME PAGES
> ;END TOPS-20
MOVEI T1,.TBLOK## ;INDICATE FILE BLOCKS
MOVEM T1,.LASWD ; FOR ERROR PRINTER
PJRST STRNML ;STORE IN .NMUL AND RETURN [314]
.COREW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.COREC::MOVEI T1,^D10 ;SET DECIMAL MULTIPLIER
CAIN C,"#" ;SEE IF OCTAL FLAG
MOVEI T1,10 ;YES--USE OCTAL MULTIPLIER
CAIN C,"#" ;IF OCTAL FLAG,
PUSHJ P,.TIAUC ; GET NEXT CHAR
MOVEI N,0 ;CLEAR ACCUMULATOR
CORE1: CAIL C,"0" ;SEE IF DIGIT
CAIL C,"0"(T1) ; ..
JRST CORES ;NO--CHECK SUFFIX
IMULI N,(T1) ;YES--MULTIPLY ACCUMULATOR
ADDI N,-"0"(C) ;ADD DIGIT
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST CORE1 ;LOOP UNTIL DONE
;HERE AT END OF DIGIT STRING
CORES: MOVEI T1,.TCORW## ;INDICATE CORE ARGUMENT
MOVEM T1,.LASWD ; FOR ERROR TYPER
CAIN C,"P" ;SEE IF PAGES
LSH N,^D9 ;YES--MULT BY 512
CAIN C,"K" ;SEE IF K
LSH N,^D10 ;YES--MULT BY 1024.
CAIN C,"B" ;SEE IF B
LSH N,7 ;YES--MULT BY BLOCK SIZE OF 128
CAIE C,"B" ;IF BLOCKS,
CAIN C,"W" ; OR WORDS,
JRST CORES1 ; GO SKIP CHARACTER
CAIE C,"P" ;SEE IF EITHER
CAIN C,"K" ; ..
CORES1: SKIPA T1,. ;INDICATE SUFFIX
TDZA T1,T1 ;INDICATE NO SUFFIX
PUSHJ P,.TIAUC ;YES--GET NEXT CHAR
JRST STRNML ;STORE IN .NMUL AND RETURN [314]
;.DECNW -- INPUT A DECIMAL WORD FROM COMMAND STRING
;.DECNC -- DITTO (CHARACTER ALREADY IN C)
;IF IT STARTS WITH #, THEN OCTAL TYPEIN
;TERMINATES AT FIRST NON-DECIMAL CHARACTER
;THROWS AWAY ANY CHARACTERS BEFORE THE LAST 10 OR SO
;CALL: PUSHJ P,.DECNC/.DECNW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.DECNW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.DECNC::CAIN C,"#" ;SEE IF OCTAL FLAGGED
PJRST .OCTNW ;YES--GO READ OCTAL FIELD
PUSHJ P,.CKNEG ;CHECK IF NEGATIVE
CAIN C,"#" ;NOW CHECK FOR OCTAL
PJRST OCTIN2 ;YES--GO READ CHAR AND GET OCTAL
DECIN1: CAIL C,"0" ;SEE IF DECIMAL
CAILE C,"9" ; ..
PJRST DECMUL ;NO--AT END, SO HANDLE SUFFIX
IMULI N,^D10 ;YES--MULTIPLY NUMBER
ADDI N,-"0"(C) ;INCORPORATE DIGIT
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST DECIN1 ;LOOP BACK FOR MORE
;DECMUL -- HANDLE DECIMAL SUFFIX MULTIPLIER
; K,M,G FOR 10**3,6,9
;CALL: MOVE N,NUMBER
; PUSHJ P,DECMUL
; RETURN WITH NUMBER MULTIPLIED BY SUFFIX
;USES T1 (MULTIPLIER--RETURNED) UPDATES C (SEPARATOR)
DECMUL: CAIN C,"." ;SEE IF FORCING DECIMAL [273]
PUSHJ P,.TIAUC ;YES--GET NEXT CHARACTER [273]
MOVEI T1,.TDECW## ;SET DECIMAL FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVEI T1,1 ;INITIALIZE SUFFIX MULTIPLIER
CAIN C,"K" ;K = 1 000
MOVEI T1,^D1000
CAIN C,"M" ;M = 1 000 000
MOVE T1,[^D1000000]
CAIN C,"G" ;G =1 000 000 000
MOVE T1,[^D1000000000]
IMUL N,T1 ;APPLY TO NUMBER
CAILE T1,1 ;SEE IF SUFFIX
PUSHJ P,.TIAUC ;YES--GET ONE MORE CHARACTER
PJRST .SENEG ;SEE IF NEGATIVE AND RETURN
;.OCTNW -- INPUT AN OCTAL WORD FROM COMMAND STRING
;.OCTNC -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-DIGIT
;THROWS AWAY ANY CHARACTERS BEFORE THE LAST TWELVE
;CALL: PUSHJ P,.OCTNC/.OCTNW
; RETURN WITH WORD IN N
;USES T1 UPDATES C (SEPARATOR)
.OCTNW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.OCTNC::PUSHJ P,.CKNEG ;CHECK IF NEGATIVE
PUSH P,P1 ;SAVE ACCUMULATOR [273]
MOVEI P1,0 ;CLEAR ACCUMULATOR FOR DECIMAL [273]
OCTIN1: CAIL C,"0" ;SEE IF OCTAL
CAILE C,"9" ; .. [273]
PJRST OCTIN3 ;NO--AT END, SO HANDLE SUFFIX [273]
LSH N,3 ;YES--MULTIPLY NUMBER
ADDI N,-"0"(C) ;INCORPORATE DIGIT
IMULI P1,^D10 ;ACCUMULATE IN DECIMAL [273]
ADDI P1,-"0"(C) ; .. [273]
OCTIN2: PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST OCTIN1 ;LOOP BACK FOR MORE
OCTIN3: CAIN C,"." ;SEE IF FORCING DECIMAL [273]
MOVE N,P1 ;YES--SAVE DECIMAL VALUE [273]
POP P,P1 ;RESTORE ACCUMULATOR [273]
CAIN C,"." ;SEE IF DECIMAL [273]
PJRST DECMUL ;YES--GO HANDLE DECIMAL WRAP-UP [273]
;OCTMUL -- HANDLE OCTAL SUFFIX MULTIPLIER
; K,M,G FOR 2**9,18,27
;CALL: MOVE N,NUMBER
; PUSHJ P,OCTMUL
; RETURN WITH NUMBER MULTIPLIED BY SUFFIX
;USES T1 (LEFT SHIFT--RETURNED) UPDATES C (SEPARATOR)
OCTMUL: MOVEI T1,.TOCTW## ;SET OCTAL FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVEI T1,0 ;INITIALIZE SUFFIX MULTIPLIER
CAIN C,"K" ;K = 1 000
MOVEI T1,^D9
CAIN C,"M" ;M = 1 000 000
MOVEI T1,^D18
CAIN C,"G" ;G = 1 000 000 000
MOVEI T1,^D27
LSH N,(T1) ;APPLY TO NUMBER
SKIPE T1 ;SEE IF SUFFIX
PUSHJ P,.TIAUC ;YES--GET SEPARATOR
;FALL INTO .SENEG
;FALL HERE FROM ABOVE
;.SENEG -- SEE IF NEGATIVE FOUND BY .CKNEG AND APPLY IT
;CALL: MOVE N,VALUE SO FAR
; PUSHJ P,.SENEG
;RETURNS WITH N COMPLEMENTED IF NUMBER PRECEEDED BY -
.SENEG::SKIPE FLNEG ;SEE IF NEGATIVE
MOVNS N ;YES--COMPLEMENT RESULT
IFN ECHO$W,<
PUSHJ P,NAMER
>
;HERE TO EXIT FROM MOST ONE WORD INPUT ROUTINES TO
;STORE A COPY OF THE RESULT IN .NMUL FOR LONG TERM STORAGE
;PURPOSES SUCH AS SOME ERROR MESSAGES
STRNML: MOVEM N,.NMUL ;STORE VALUE FOR ERROR PRINTER [314]
POPJ P, ;RETURN
;.CKNEG -- CHECK IF NEGATIVE NUMBER COMING
;ALSO CLEARS N
;CALL: MOVEI C,NEXT CHAR
; PUSHJ P,.CKNEG
;USES NO ACS
.CKNEG::SETZB N,FLNEG ;CLEAR N AND NEGATIVE FLAG
CAIE C,"-" ;CHECK IF NEGATIVE NUMBER
POPJ P, ;NO--RETURN
SETOM FLNEG ;YES--SET FLAG
PJRST .TIAUC ;GET NEXT CHAR AND RETURN
IF TOPS-20,<
;GET FILE SPECIFICATION STRING
;^THIS ROUTINE IS USED TO SCAN AN ASCII STRING ALLOWING ANY
;COMBINATION OF THE CHARACTERS ALLOWED IN THE DEC STANDARD
;COMMAND LANGUAGE. ^IT IS ASSUMED THAT THE ACTUAL SYNTAX
;AND SEMANTICS WILL BE CHECKED WHEN THE STRING IS USED.
; ENTRY
;.FSPW, .FSPC
; USAGE
;FOLLOWS ALL CONVENTIONS FOR .WSCAN MODULE. VALUE IS
;A STRING IN ASCII IN .NMUL AND THE FIRST FIVE CHARACTERS
;IN ASCII IN ACCUMULATOR 7 (N). THE SCAN TERMINATES ON
;THE FIRST CHARACTER NOT IN THE SYNTAX IF NOT A QUOTED
;STRING, AND THE END OF THE QUOTED STRING IF QUOTED.
.FSPW:: PUSHJ P,.TIALT ;PRIME THE PUMP
.FSPC:: HRROI T1,.TSTRG## ;INDICATE STRING
SETOM FSPCFL ;NOTE THAT WE ARE EATING A FILE NAME
PUSHJ P,.WSCIN ; FORMAT
PUSHJ P,.TICQT ;CHECK FOR QUOTING
MOVE T1,[POINT 7,.NMUL] ;INITIALIZE BYTE POINTER
MOVEI T2,0 ;INITIALIZE BRACKET DEPTH
FSPC.1: JUMPLE C,FSPC.2 ;EXIT LOOP IF END OF LINE
SKIPLE .QUOTE ;IF QUOTING,
JRST FSPC.3 ; READ ON
CAIE C,"]"
CAIN C,076
SOJGE T2,FSPC.3 ;COUNT DOWN BRACKET DEPTH
PUSHJ P,.TICAN ;ELSE, CHECK FOR ALPHA-NUM
SKIPA ;NO--NEED MORE ANALYSIS
JRST FSPC.3 ;YES--PROCESS IT
CAIE C,":" ;CHECK LEGAL CHARS
CAIN C,"." ; ..
JRST FSPC.3
CAIE C,";"
CAIN C,"-"
JRST FSPC.3
CAIE C,"*"
CAIN C,"?"
JRST FSPC.3
CAIE C,"["
CAIN C,074
AOJA T2,FSPC.3 ;COUNT UP BRACKET DEPTH
FSPC.2: MOVE N,.NMUL ;RETURN FIRST WORD
SETZM FSPCFL ;NOTE THAT WE ARE NOT IN A FILE NAME
POPJ P,0 ;EXIT
FSPC.3: CAME T1,[POINT 7,.NMUE,34] ;SEE IF OVERFLOW
IDPB C,T1 ;STORE CHARACTER
PUSHJ P,.TIALT ;GET NEXT CHARACTER
JRST FSPC.1 ;LOOP
;STILL IN TOPS-20
;+.HL2 GET A FILE PROTECTION
;THIS ROUTINE IS USED TO INPUT THE PROTECTION FIELD FOR
;A FILE SPECIFICATION. IT IS A STRING OF EXACTLY THREE OCTAL
;DIGITS WITHOUT ANY SPECIAL PUNCTUATION.
;IF THESE RULES ARE VIOLATED, ONE OF THE ERRORS SCNDDO,
;SCNPTL, OR SCNPTS IS TAKEN.
;.HL3 ENTRY
;.PRONW, .PRONC
;.HL3 USAGE
;FOLLOWS ALL CONVENTIONS FOR .WSCAN MODULE. VALUE RETURNED
;IS A WORD IN .NMUL AND IN ACCUMULATOR 7 (N). THE SCAN TERMINATES
;AT THE END OF THE DIGIT STRING.
;.HL3 STATE VARIABLES AFFECTING BEHAVIOUR
;.HL3 STATE VARIABLES CHANGED
;.HL3 NOTE
;IF THE DIGIT STRING INCLUDES THE WRONG NUMBER OF DIGITS, EITHER
;SCNPTS "PROTECTION TOO SHORT" OR SCNPTL
;"PROTECTION TOO LONG" IS TAKEN.
;-
.PRONW::PUSHJ P,.TIAUC ;PRIME THE PUMP
.PRONC::MOVEI T1,.TOCTW## ;SET FOR OCTAL
PUSHJ P,.WSCIN ; TYPEOUT
PUSHJ P,.DGSTR ;GET DIGIT STRING
MOVE N,T2 ;GET OCTAL
CAILE T3,7 ;IF DECIMAL,
JRST E$$DDO ; GIVE ERROR
CAIGE T4,6 ;IF TOO SHORT,
JRST E$$PTS ; GIVE ERROR
CAILE T4,6 ;IF TOO LONG,
JRST E$$PTL ; GIVE ERROR
JRST STRNML ;STORE IN .NMUL AND RETURN
M$FAIN (PTS,Protection too short)
M$FAIN (PTL,Protection too long)
M$FAIN (DDO,Decimal digit in octal field)
;STILL IN TOPS-20
;+.HL2 HELPER TO INITIALIZE THE SCAN FOR A WORD
;THIS ROUTINE IS CALLED AUTOMATICALLY FROM EACH OF THE
;SCAN ROUTINES IN .WSCAN. IT INITIALIZES THE STORAGE
;LOCATIONS USED DURING THE WORD SCANNING PROCESS.
;.HL3 ENTRY
;.WSCIN
;.HL3 USAGE
;CALL WITH ACCUMULATOR 1 (T1) CONTAINING THE ADDRESS OF THE
;MATCHING TYPEOUT ROUTINE. THE LEFT HALF OF 1 SHOULD
;BE 0 IF A ONE-WORD FORMAT AND LESS THAN 0 IF A STRING.
;ON RETURN, ACCUMULATOR 7 (N) WILL BE 0 TO START THE SCAN.
;.HL3 STATE VARIABLES AFFECTING BEHAVIOUR
;.HL3 STATE VARIABLES CHANGED
;ALL STATE VARIABLES INITIALIZED
;.HL3 NOTE
;-
.WSCIN::STORE T2,WZER,WEZER,0 ;INITIALIZE
MOVEM T1,.LASWD ;STORE FORMAT
MOVEI N,0 ;INITIALIZE NORMAL ANSWER
POPJ P, ;RETURN
;STILL TOPS-20
;+.HL2 HELPER TO INPUT A DIGIT STRING
;THIS ROUTINE INPUTS A DIGIT STRING AND COMPILES VALUES
;FOR BOTH DECIMAL AND OCTAL RADICES. IT HAS NO SEMANTICS
;SO THAT IT CAN BE USED IN ANY INPUT ROUTINE. IT ALSO DOES NOT
;ALTER ACCUMULATOR 7 (N) FOR THE SAME REASON. IT RETURNS THE
;LENGTH OF THE STRING AND THE LARGEST DIGIT SEEN FOR THE CALLER
;TO PERFORM ANY DESIRED ERROR CHECKING.
;.HL3 ENTRY
;.DGSTR
;.HL3 USAGE
;CALL WITH THE FIRST DIGIT IN ACCUMULATOR 10 (C). ON RETURN,
;ACCUMULATOR 1 (T1) WILL CONTAIN THE DECIMAL VALUE,
;ACCUMULATOR 2 (T2) THE OCTAL VALUE, ACCUMULATOR 3 (T3)
;THE LARGEST DIGIT (WITH "0" REMOVED), AND ACCUMULATOR 4 (T4)
;THE NUMBER OF DIGITS.
;.HL3 STATE VARIABLES AFFECTING BEHAVIOUR
;.HL3 STATE VARIABLES CHANGED
;.HL3 NOTE
;OVERFLOW IS NOT INDICATED OR GUARDED AGAINST.
;-
.DGSTR::SETZB T1,T2 ;INITIALIZE DECIMAL, OCTAL VALUES
SETZB T3,T4 ;INITIALIZE HIGHEST DIGIT, CHAR COUNT
DGST.1: CAIL C,"0" ;IF NOT
CAILE C,"9" ; A DIGIT,
POPJ P, ; RETURN
CAIGE T3,-"0"(C) ;IF HIGHER THAN PREVIOUS HIGH,
MOVEI T3,-"0"(C) ; UPDATE HIGHEST
LSH T2,3 ;ADVANCE OCTAL ACCUMULATOR
ADDI T2,-"0"(C) ;ACCUMULATE OCTAL VALUE
IMULI T1,^D10 ;ADVANCE DECIMAL ACCUMULATOR
ADDI T1,-"0"(C) ;ACCUMULATE DECIMAL VALUE
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
AOJA T4,DGST.1 ;LOOP, COUNTING CHARACTERS
> ;END TOPS-20
;.ASCQW -- INPUT A POSSIBLY QUOTED ASCII MULTIPLE WORD
;.ASCQC -- DITTO (FULL CASE CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE BUFFER
;CALL: PUSHJ P,.ASCQW/.ASCQC
; RETURN WITH STRING IN .NMUL
;USES T1 UPDATES C (SEPARATOR)
.ASCQW::PUSHJ P,.TIALT ;PRIME THE PUMP
.ASCQC::PUSHJ P,.TICQT ;CHECK FOR QUOTING
SETZM .NMUL ;CLEAR ACCUMULATOR
MOVE T1,[.NMUL,,.NMUL+1]
BLT T1,.NMUE ; ..
HRROI T1,.TSTRG## ;SET ASCII STRING FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVE T1,[POINT 7,.NMUL] ;INITIALIZE BYTE POINTER
ASCM1: SKIPLE .QUOTE ;SEE IF IN QUOTED STRING
JRST ASCM2 ;YES--JUST GO STORE
PUSHJ P,.TICAN ;SEE IF LEGITIMATE ALPHA-NUMERIC
POPJ P, ;NO--MUST BE DONE
ASCM2: CAME T1,[POINT 7,.NMUE,34] ;SEE IF OVERFLOW
IDPB C,T1 ;NO--STORE
PUSHJ P,.TIALT ;GET NEXT CHARACTER
JRST ASCM1 ;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::MOVEI N,0 ;CLEAR NAME
MOVEI T1,.TSIXN## ;SET SIXBIT FORMAT [314]
MOVEM T1,.LASWD ; FOR ERROR PRINTING [314]
MOVE T1,[POINT 6,N] ;INITIALIZE BYTE POINTER FOR WORD
SIXS1: PUSHJ P,.TICAN ;SEE IF CHARACTER IS ALPHA-NUMERIC
JRST STRNML ;STORE IN .NMUL AND RETURN [314]
SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;DON'T OVERFLOW
IDPB C,T1 ;STORE CHARACTER
PUSHJ P,.TIAUC ;GO GET ANOTHER CHARACTER
JRST SIXS1 ;LOOP BACK TO PROCESS IT
;.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,.TICAN ;SEE IF LEGITIMATE ALPHA-NUMERIC
POPJ P, ;NO--MUST BE DONE
SIXM2: CAIL C,40 ;SEE IF IN RANGE
CAILE C,137 ; ..
JRST E.QSX ;NO--GIVE ERROR
SUBI C," "-' ' ;CONVERT TO SIXBIT
CAME T1,[POINT 6,.NMUE,35] ;SEE IF OVERFLOW
IDPB C,T1 ;NO--STORE
ADDI C," "-' ' ;BACK TO ASCII
PUSHJ P,.TIAUC ;GET NEXT CHARACTER
JRST SIXM1 ;LOOP BACK TO PROCESS IT
E.QSX==E.ILSC ;GIVE ILL CHAR MESSAGE
SUBTTL SUBROUTINES FOR COMMAND INPUT -- GET NEXT CHARACTER
;.TICAN -- CHECK CHARACTER FOR ALPHA-NUMERIC
;ALPHA-NUMERIC IS A-Z OR 0-9
;CALL: MOVEI C,ASCII CHARACTER
; PUSHJ P,.TICAN
; RETURN IF NOT ALPHA-NUMERIC
; SKIP RETURN IF ALPHA-NUMERIC
;PRESERVES ALL ACS
.TICAN::CAIL C,"A"+40 ;SEE IF
CAILE C,"Z"+40 ; LOWER CASE ALPHA
SKIPA ;NO--CONTINUE CHECKS
JRST .POPJ1## ;YES--GIVE ALPHA RETURN
IFL FT$UEQ,<
CAIN C,"_" ;UNDERSCORE?
JRST .POPJ1## ;YES--IT IS AN ALPHA
> ;END FT$UEQ
CAIL C,"0" ;SEE IF BELOW NUMERICS
CAILE C,"Z" ;OR IF ABOVE ALPHABETICS
POPJ P, ;YES--RETURN
CAILE C,"9" ;SEE IF NUMERIC
CAIL C,"A" ;OR IF ALPHABETIC
AOS (P) ;YES--SKIP RETURN
POPJ P, ;RETURN
;.TIAUC -- INPUT ONE COMMAND CHARACTER HANDLING LOWER CASE CONVERSION
;CALL: PUSHJ P,.TIAUC
; RESULT IN C
;USES NO ACS
.TIAUC::PUSHJ P,.TIALT ;GO GET NEXT CHAR
;.TIMUC -- CONVERT LOWER CASE CHARACTER TO UPPER CASE
;CALL: MOVEI C,CHARACTER
; PUSHJ P,.TIMUC
; RETURN WITH UPDATED C
;USES NO ACS
.TIMUC::CAIGE C,"A"+40 ;SEE IF LOWER CASE
POPJ P, ;NO--RETURN
CAIG C,"Z"+40
SUBI C,40 ;YES--CONVERT
POPJ P, ;RETURN
;.TICQT -- CHECK FOR " AND SET QUOTING
;CALL: MOVEI C,CHARACTER
; PUSHJ P,.TICQT
;RETURN WITH NEXT CHARACTER (UPPER OR LOWER CASE) IN C
;USES NO ACS
.TICQT::CAIN C,"""" ;SEE IF " [265]
SKIPE .QUOTE ;YES--SET QUOTE UNLESS SET
POPJ P, ;NO--JUST RETURN
;FALL INTO .TISQT
;.TISQT -- SET ARBITRARY QUOTE CHARACTER
;CALL: MOVEI C,QUOTE CHARACTER
; PUSHJ P,.TISQT
;RETURN WITH NEXT CHARACTER (UPPER OR LOWER CASE) IN C
;USES NO ACS
.TISQT::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::
IFN FT$ESC,<
SKIPN C ;SEE IF IN ALT-MODE
POPJ P, ;YES--RETURN
> ;END FT$ESC
;NO--FALL INTO .TICHG
;FALL HERE FROM .TIALT
;.TICHG -- GET CHARACTER, CONVERTING GUIDE WORDS TO SINGLE CHARACTER
;CALL: PUSHJ P,.TICHG
; RESULT IN C
;USES NO ACS
;GUIDE WORDS ARE ENCLOSED IN SINGLE ' AND ARE FROM A PREDEFINED LIST
.TICHG::PUSHJ P,.TICHR ;GET NEXT CHARACTER
SKIPN .QUOTE ;UNLESS IN A QUOTE, [541]
CAIE C,"'" ;SEE IF START OF GUIDE
POPJ P, ;NO--JUST RETURN TO CALLER
PUSHJ P,.PSH4T## ;YES--SAVE SOME TEMPS
MOVE T1,[POINT 6,T2] ;SET POINTER FOR WORD
MOVEI T2,0 ;CLEAR WORD
TICHG1: PUSHJ P,.TICHR ;GET NEXT LETTER OF GUIDE
JUMPLE C,TICHG2 ;EXIT IF END OF LINE
CAIN C,"'" ;SEE IF END OF GUIDE YET
JRST TICHG2 ;YES--EXIT
PUSHJ P,.TIMUC ;FORCE UPPER CASE
CAIL C,"A" ;SEE IF
CAILE C,"Z" ; ALPHABETIC
JRST TICHGI ;NO--USER ERROR
SUBI C," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;SEE IF OVERFLOW
IDPB C,T1 ;NO--STORE IN RESULT
JRST TICHG1 ;LOOP OVER WORD
TICHG2: CAIE C,"'" ;UNLESS CLOSE QUOTE,
PUSHJ P,.REEAT ; SET TO GET AGAIN
MOVSI T1,GUIDM.## ;NEG COUNT OF GUIDE WORDS
HRRI T1,GUIDT.##-1 ;LOC-1 OF GUIDE WORDS
PUSHJ P,.LKNAM## ;LOOKUP NAME IN TABLE
JRST TICHGB ;ERROR
SUBI T1,GUIDT.## ;DETERMINE ORDINAL OF GUIDE WORD
MOVEI C,4000(T1) ;CONVERT TO META REPRESENTATION
PUSHJ P,.POP4T## ;RESTORE TEMPS
POPJ P, ;RETURN
TICHGB: MOVE N,T2 ;POSITION WORD FOR ERROR MESSAGE
JUMPGE T1,E$$AGW ;JUMP IF AMBIGUOUS
M$FAIN (UGW,Unknown guide word)
M$FAIN (AGW,Ambiguous guide word)
TICHGI: MOVE N,T2 ;COPY WORD FOR MESSAGE
M$FAIN (IGW,Incorrectly formatted guide word)
;.TICHR -- INPUT ONE COMMAND CHARACTER HANDLING SPACING, CONTINUATION,
;AND CONTROL CHARACTERS
;ALT-MODE AND LINE-FEED ARE KEPT DISTINCT
;CALL: PUSHJ P,.TICHR
; RESULT IN C
;USES NO ACS
.TICHR::PUSH P,T1 ;SAVE TEMP
;TYI--COROUTINE TO HANDLE SPECIAL BLANK COMPRESSION,
; HYPHENATION, AND COMMENTS
;THE TRICK IS TO :
; 1-COMPRESS MULTIPLE SPACES
; 2-IGNORE LEADING SPACES ON EACH LINE
; 3-IGNORE TRAILING SPACES ON EACH LINE
; 4-IGNORE COMMENTS ON EACH LINE (;FOO)
; 5-IGNORE LINE FEEDS PRECEEDED BY HYPHEN (CONTINUATION)
;
;ONE SPECIAL STORAGE AREA IS USED--SCANCH
; RH CONTAINS THE LAST CHARACTER IN SOME CASES
;THE COROUTINE PC IS IN SCANPC
; THIS IS 0 UNTIL A NON-SPACE IS SEEN IN A LINE
; IT IS RESET TO 0 AT THE TOP LEVEL
;BY CONVENTION, T1 IS USED FOR CALLS AND IS PRESERVED ACROSS
; THE ENTIRE ROUTINE
SKIPE SAVCHR ;SEE IF ANYTHING SAVED
JRST [MOVE C,SAVCHR ;YES--RE-USE IT
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
IFN M$INDP,<
SKIPN A.ZER ;UNLESS INDIRECT FILE, [530]
>
HRREI C,.CHEOL ; REMOVE ANY EOF COMING [530]
JRST TYIN ;DON'T DISCARD LEADING SPACE OF NEXT LINE [527]
;HERE WITH LITERAL TO GIVE USER IN LH(C)
; RH(C) HAS LAST CHAR READ FROM INPUT
TYIL: HRROM C,SCANCH ;SAVE LAST CHAR FOR LATER
HLRES C ;GET LITERAL FOR CALLER
PJRST TYIP ;RETURN CHARACTER TO USER
;HERE AT END OF NON-NULL LINE
TYIE: JSP T1,TYIP ;RETURN IT TO USER
SKIPE SAVCHR ;SEE IF REEATING
JRST TYIN ;YES--GO REAT IT
IFN DEBUG$,<
HALT TYIF ;ERROR IF USER SCREWS UP
>
;HERE WITH CHARACTER TO GIVE USER
; T1=PLACE TO RETURN TO ON NEXT ENTRY TO COROUTINE
TYIP: MOVEM T1,SCANPC ;SAVE COROUTINE PC FOR NEXT TIME
MOVEM C,LASCHR ;SAVE AS LAST CHARACTER
;HERE TO RETURN FROM THE TYI COROUTINE
TYIX: POP P,T1 ;RESTORE TEMP
IFN ECHO$C,<
OUTCHR C
>
POPJ P,
;TISCN--SUBROUTINE USED BY TYI TO STRIP COMMENTS AND DISPATCH
;ALSO HANDLES QUOTED STRINGS (UP TO END-OF-LINE)
; DOUBLE OCCURANCE OF QUOTE RETURNS ONE; END RETURNS SPACE
;CALL: JSP T1,TISCN
; HERE IF EOL
; HERE IF SPACE
; HERE IF HYPHEN
; HERE FOR ALL ELSE
;ALWAYS GIVES CHARACTER IN C
;USES NO ACS
TISCN: SKIPE SAVCHR ;SEE IF CHAR LEFT FROM BEFORE
JRST [MOVE C,SAVCHR ;YES--GET IT
SETZM SAVCHR ;CLEAR OUT REMEMBERED CHARACTER
CAIN C,C.TE ;SEE IF FUNNY EOL CODE
HRREI C,.CHEOL ;YES--SET REAL CODE
JRST .+2] ;AND PROCEED
PUSHJ P,.TICHT ;NO--GET ONE FROM INPUT
;HERE TO SEE IF QUOTING
SKIPG .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
JUMPLE C,TISCNE ;NO--IF END OF LINE, RETURN IT
PUSHJ P,.REEAT ;NO--SAVE FOR LATER
MOVEI C," " ;SET A SPACE
;HERE AT END OF QUOTED STRING
TISCNE: SETZM .QUOTE ;CLEAR QUOTE FLAG
;HERE TO DETERMINE CHARACTER HANDLING
TISCNQ: JUMPLE C,(T1) ;GIVE EOL RETURN
CAIN C," " ;TRY SPACE
JRST 1(T1) ;SKIP ONCE
CAIN C,"-" ;TRY HYPHEN
JRST 2(T1) ;SKIP TWICE
IF TOPS-20,<
CAIN C,";" ;IS THIS A SEMI?
JRST TISCNS ;YES--SEE WHAT CONTEXT
> ;END TOPS-20
IF TOPS-10,<
CAIE C,";" ;SEE IF COMMENT [272]
> ;END TOPS-10
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
IF TOPS-20,<
TISCNS: SKIPE FSPCFL ;ARE WE EATING A FILE STRING?
JRST 3(T1) ;YES--ASSUME ;T ;P OR ;A
PUSH P,T1 ;SAVE T1
MOVEI T1,[ASCIZ "
% SEMICOLON TAKEN AS START OF COMMENT, HOWEVER, YOU WOULD BE
BETTER OFF IF YOU USED ! INSTEAD.
"]
PUSHJ P,.TSTRG##
POP P,T1
> ;END TOPS-20
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: 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.ZER ;SEE IF INDIRECT FILE
JRST [SKIPN FLIIND ;SEE IF @TTY:
POPJ P, ;NO--NO PROMPT NEEDED
HRRZI T1,"#" ;YES--SET # PROMPT
JRST .+1] ;PROCEED
>
CLEARO ;DEFEAT ^O
SKIPE PROMPT ;SEE IF USER EXIT
PJRST @PROMPT ;YES--GO LET HIM DO IT
SKIPGE T1 ;SEE IF CONTINUATION
MOVEI T1,"#" ;YES--SET CODE
IF TOPS-20,<
DPB T1,[POINT 7,CNTRLR,6] ;SAVE FOR CONTROL-R
> ;END TOPS-20
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 CHARCTER
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
IFN FT$ESC,<
CAIN C,.CHESC ;OR STANDARD ONE
HRREI C,.CHALX ;YES--SET CODE
CAIN C,.CHALX ;IF SOME TYPE OF ALT-MODE,
PUSHJ P,.TCRLF## ; GIVE A FREE CR/LF
> ;END FT$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,<
IF TOPS-20,<
SKIPE FLIIND ;DID HE SAY @TTY:
JRST TIGET1 ;YES--THAT IS A DUMB THING TO SAY
> ;END TOPS-20
SKIPE A.ZER ;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]
IF TOPS-10,<
INCHWL C ;NO--GET FROM USER
>
IF TOPS-20,<
TIGET1: ILDB C,TXTPTR ;GET INPUT BYTE
JUMPN C,TIGET2 ;JUMP IF SOMETHING
PUSHJ P,.PSH4T## ;SAVE T1 - T4
STORE T1,TXTZER,TXTEZR,0 ;CLEAR BUFFER
HRROI T1,TXTBUF ;DESTINATION POINTER
MOVX T2,RD%TOP!RD%RND+LTXTBF
HRROI T3,CNTRLR ;CNTRLR BUFFER
RDTTY ;READ LINE FROM TTY
HALT . ;ILLEGAL CALL
MOVE T1,[POINT 7,TXTBUF]
MOVEM T1,TXTPTR ;STORE FOR FUTURE
HRROI T1,CNTRLR ;RETYPE THE *
SKIPN TXTBUF ; IF THE BUFFER IS
PSOUT ; EMPTY DUE TO CONTROL-U
PUSHJ P,.POP4T## ;RESTORE AC'S
JRST TIGET1 ;GET BYTE
TIGET2:
> ;END TOPS-20
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]
IFN FT$ESC,<
CAIE C,.CHESC ;SEE IF END [313]
> ;END FT$ESC
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]
;HERE TO GET NEXT CHAR FROM INDIRECT OR CCL FILE
IFN M$INDP,<
IF TOPS-10,<
TYIIND: SKIPE B.IND+1 ;SKIP IF INDIRECT OR CCL FILE NOT SET UP
PJRST TYIIGT ;READY TO READ NEXT CHAR
;HERE TO OPEN INDIRECT OR CCL FILE
SETZM INDUSI ;CLEAR USETI POINTER
MOVE C,A.DEV ;GET DEVICE
DEVCHR C, ;GET ITS CHARACTERISTICS
TXNN C,DV.DSK ;SEE IF DISK
TXNN C,DV.DIR ;OR NOT DIRECTORY DEVICE [320]
JRST .+2 ;OK
HRROS INDUSI ;NO--NO USETI LOGIC ON DECTAPE
PUSHJ P,.PSH4T## ;SAVE T1-4
MOVEI T1,A.ZER ;POINT TO INDIRECT SPEC
MOVEI T2,A.OPEN ;POINT TO OPEN BLOCK
MOVEI T3,A.LOOK ;POINT TO LOOKUP BLOCK
PUSHJ P,.STOPN ;SETUP OPEN
JRST E.IWI ;ERROR IF WILD-CARDS
MOVEI T1,5 ;SET LENGTH OF LOOKUP
MOVEM T1,A.LOOK ; FOR FILSER
MOVEI T1,B.IND ;POINT TO BUFFER HEADERS
MOVEM T1,A.OPEN+2 ; FOR OPEN
;STILL UNDER M$INDP
MOVE T1,A.LOOK+.RBPPN ;GET DIRECTORY
HRL T2,T1 ;GET POSSIBLE SFD POINTER
HRRI T2,A.PATH ;POINT TO BACKUP PLACE
JUMPE T1,TYINI1 ;IF DEFAULT, LEAVE ALONE
TLNN T1,-1 ;SEE IF PATH
BLT T2,A.PTHE ;YES--COPY TO BACKUP AREA
MOVEI T2,A.PATH ;POINT TO IT
TLNN T1,-1 ;SEE IF NEEDED
MOVEM T2,A.LOOK+.RBPPN ;YES--CHANGE POINTER
TYINI1: PUSHJ P,.POP4T## ;RESTORE T1-4
PUSHJ P,TYIINL ;GO LOOK AT FILE
JRST TYINGF ;CAN'T--RETURN EOF
;HERE TO GET INDIRECT CHARACTER
TYIIGT: SKIPL C,B.IND+1 ;SEE IF AT END OF WORD
TLNN C,(76B5) ; ..
SKIPE FLSOL ;YES--SEE IF END OF LINE
PJRST TYIIGC ;NO--JUST GET CHARACTER
PUSHJ P,TYIIGC ;YES--MIGHT BE A SEQUENCE NUMBER
; SO GET NEXT CHARACTER
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
MOVE T1,@B.IND+1 ;GET FIRST WORD OF LINE
TRNN T1,1 ;SEE IF FLAG SET
TYIIGN: JRST [POP P,T1 ;NO--RESTORE TEMP
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
POP P,T1 ;RESTORE T1
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
MOVE T1,A.LOOK+.RBPRV ;GET PROTECTION
LSH T1,-<ALIGN.(RB.PRV)> ;POSITION PROTECTION
HRLI T1,.ACRED ;SET FUNCTION "READ"
MOVE T3,.MYPPN ;GET THIS PPN [312]
SKIPN T2,A.LOOK+.RBPPN ;GET FILE'S DIRECTORY
MOVE T2,T3 ;USE USER IF DEFAULTED
TLNN T2,-1 ;SEE IF PATH
MOVE T2,.PTPPN(T2) ;YES--GET UFD
MOVEI T4,T1 ;POINT TO ARGS
CHKACC T4, ;ASK MONITOR IF READ OK
MOVEI T4,0 ;ASSUME YES IF NOT IMPLEMENTED
MOVEI T2,ERPRT% ;PRESET PROTECTION FAILURE
JUMPN T4,E.IFL ;IF PROTECTED, GO GIVE ERROR
PUSH P,.JBFF
MOVEI T1,A.BUF
MOVEM T1,.JBFF
INBUF IND,1
IFN DEBUG$,<
MOVE T1,.JBFF ;SEE HOW MUCH MONITOR GRABBED
CAILE T1,A.BUFE ;COMPARE WITH OUR FIXED ALLOCATION
HALT .+1 ;GIVE UP IF MONITOR IS A HOG
>
POP P,.JBFF
TYIIN4: PUSHJ P,.POP4T## ;RESTORE T1-4
JRST .POPJ1 ;SKIP RETURN
TYININ: MOVE T2,A.LOOK+.RBEXT ;GET ERROR CODE
SKIPLE INDUSI ;SEE IF FIRST TIME HERE
JRST E.IFL ;NO--JUST GIVE UP
MOVX T4,FX.NUL ;PRESET FOR TEST
TDNE T4,A.MOD ;SEE IF NULL EXTENSION SPECIFIED
TLZN T2,-1 ;YES--SKIP IF NOT A NULL EXTENSION
JRST E.IFL ;NO--GIVE LOOKUP ERROR
JUMPN T2,E.IFL ;JUMP IF STRANGE ERROR
HLRZ T2,A.LOOK+.RBEXT ;NO--GET EXTENSION [253]
CAIE T2,'CCL' ;SEE IF .CCL [253]
TDZA T2,T2 ;NO--FORCE TO NULL [253]
MOVEI T2,'CMD' ;YES--TRY .CMD NEXT [253]
HRLZM T2,A.LOOK+.RBEXT ;STUFF INTO BLOCK [253]
JRST TYIIN2 ;AND TRY AGAIN
;STILL UNDER M$INDP
;HERE ON INDIRECT ERRORS
E.IFL: TLZ T2,-1 ;LOOKUP ERROR--CLEAR JUNK FROM CODE
SKIPE OPTNAM ;SEE IF OPTION MODE
PUSHJ P,EINDLS ;YES--SEE IF FILE NOT FOUND [324]
SKIPA ;NO--GO GIVE ERROR [324]
JRST EINDL2 ;YES--SUPPRESS ERROR [324]
SKIPLE FLCCL ;SEE IF CCL MODE
PUSHJ P,EINDLS ;YES--SEE IF FILE NOT FOUND [324]
JRST EINDL1 ;NO--GO ISSUE ERROR [324]
SETZM FLCCMD ;YES--CLEAR COMMAND MODE [324]
SETZM FLCCL ;CLEAR CCL MODE [324]
SOS .JBSA ;RESTORE STARTING ADDRESS [324]
JRST EINDL2 ;AND SUPPRESS ERROR MESSAGE [324]
EINDL1: MOVEI N,A.ZER ;GET POINTER TO FILE SPEC
SETOM FLKLIN ;INDICATE TO KILL
M$FAIF (IFL,Indirect file LOOKUP error)
EINDL2: HRREI C,.CHEOF ;FLAG EOF
PUSHJ P,.POP4T## ;RESTORE T1-4
POPJ P, ;RETURN
E.IFO: HLRZ T1,A.OPEN+1 ;GET DEVICE NAME FIRST HALF
CAIE T1,'TMP' ;SEE IF TMPXXX:
JRST EINDO1 ;NO--JUST GIVE ERROR
HRLM T1,A.LOOK+.RBEXT ;YES--SET AT EXTENSION
MOVEI T1,'DSK' ;GET DSK:
HRLM T1,A.OPEN+1 ;CHANGE DEVICE TO DSKXXX:
HLRZ T1,A.LOOK+.RBNAM ;GET ORIGINAL FILE NAME
SKIPN T1 ;SEE IF BLANK
HRRZ T1,CCLNAM ;YES--GET CCL NAME
HLL T1,CCLNAM ;GET JOB NUMBER
MOVEM T1,A.LOOK+.RBNAM ;SET AS FILE NAME
SETZM A.LOOK+.RBPPN ;CLEAR PPN
HRRZS INDUSI ;INDICATE USETI WORKS [260]
JRST TYIIN0 ;GO TRY AGAIN
EINDO1: MOVEI N,A.ZER ;GET FILE SPEC
SETOB T2,FLKLIN ;NO ERROR CODE
M$FAIF (IFO,Can't OPEN indirect device)
;SUBROUTINE TO DETERMINE IF FILE NOT FOUND LEGITIMATELY
;CALL: T2/ERROR CODE
; PUSHJ P,EINDLS
; RETURN +1 IF SOME OTHER ERROR WITH T2 UNCHANGED
; RETURN +2 IF FILE NOT FOUND
EINDLS: CAIE T2,ERSNF% ;SEE IF SFD NOT FOUND
CAIN T2,ERSLE% ; OR SEARCH LIST EMPTY
JRST .POPJ1 ;RIGHT--FILE NOT FOUND
SOJLE T2,.POPJ1 ;IF NO FILE OR UFD, NOT FOUND
AOJA T2,.POPJ ;ELSE, GIVE ERROR
> ;END TOPS-10
IF TOPS-20,<
TYIIND: PUSH P,T1 ;SAVE T1 (SCANPC)
SKIPN T1,A.JFN ;FILE OPEN? (IF OPEN PUT JFN IN T1)
JRST TYIINI ;NO--OPEN INDIRECT FILE
TYIBIN: BIN ;READ ONE BYTE
ERJMP TYIINE ;JUMPE ON EOF OR ERROR
MOVE C,T2 ;PUT BYTE IN C
POP P,T1 ;RESTORE T1
POPJ P,0 ;RETURN
TYIINE: MOVE T1,A.JFN ;INDIRECT JFN
GTSTS ;GET FILE STATUS
TXNE T2,GS%EOF ;END OF FILE?
JRST TYINGF ;YES--GO PROCESS
MOVEI N,A.ZER ;POINT TO FILE SPEC
SETOB T2,FLKLIN ;NO ERROR CODE
M$FAIF (ERI,ERROR READING INDIRECT FILE)
TYINGF: HRREI C,.CHEOF ;RETURN END OF FILE
POP P,T1 ;RESTORE T1
POPJ P,0
;HERE TO OPEN INDIRECT FILE
TYIINI: MOVEI T1,A.ZER ;MAKE SURE THERE ARE
PUSHJ P,.STOPN ; ARE NO * IN SPEC
JRST E.IWI ;STARS FOUND GIVE ERROR MESSAGE
MOVEI T1,INDJFB ;GTJFN BLOCK
HRROI T2,A.FIL ;STRING POINTER
GTJFN ;GET A JFN
JRST E$$IFE ;CAN NOT FIND FILE
HRRZM T1,A.JFN ;SAVE JFN
TLZ T1,-1 ;CLEAR FLAGS
MOVX T2,7B5+OF%RD ;READ 7 BIT BYTES
OPENF ;GO OPEN FILE
SKIPA ;FAILED GO PRINT MESSAGE
JRST TYIBIN ;ALL SET
E$$IFE: SKIPE OPTNAM ;DOING SWITCH.INI
CAIN T1,GJFX37 ;FILE NOT FOUND
SKIPA
JRST TYINGF ;NO SWITCH.INI RETURN EOF
PUSH P,T1 ;SAVE ERROR CODE
MOVE T1,['IFE',,[ASCIZ /INDIRECT FILE ERROR /]]
PUSHJ P,.TERRP ;START ERROR MESSAGE
TXNN T1,JWW.FL ;WANT FIRST LINE?
JRST .FMSGE ;NO--END ERROR PROCESSING
HRRZ T1,(P) ;GET ERROR CODE
PUSHJ P,.TOCTW## ;PRINT IT
PUSHJ P,.TSPAC## ;ADD SPACE
MOVEI T1,A.ZER ;POINT TO SPEC
PUSHJ P,.TFBLK## ;PRINT FILE SPEC
PUSHJ P,.TCRLF## ;END LINE
HRRZ T1,(P) ;REMEMBER ERROR CODE
PUSHJ P,.TJERR## ;PRINT ERROR TEXT
PJRST .FMSGE ;END ERROR PROCESSING
INDJFB: EXP GJ%OLD
XWD 377777,377777
XWD -1,[ASCIZ "DSK"]
0
0
XWD -1,[ASCIZ "CCL"]
0
0
> ;END TOPS-20
;.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.ZER ;IF NOT AN INDIRECT FILE,
POPJ P, ;RETURN GRACEFULLY
IF TOPS-10,<
SKIPE B.IND+1 ;SEE IF INDIRECT OPEN
> ;END TOPS-10
IF TOPS-20,<
SKIPE A.JFN ;SEE IF INDIECT FILE OPEN
>
SKIPG FLCCL ;SEE IF CCL FILE
JRST KILINE ;YES--GO RELEASE I/O
SETOM FLCCL ;SET TO NORMAL CCL MODE
IF TOPS-20,<
HLRZ T1,A.JFN ;SEE IF TEMP CORE
JUMPN T1,KILIN1 ;LH .NE. 0 IF BYTE POINTER
HRRZ T1,A.JFN ;GET JFN
TXO T1,1B1 ;EXPUNGE CONTENTS
DELF ;DELETE FILE
JFCL ;IGNORE FAILURE
>
IF TOPS-10,<
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
> ;END TOPS-10
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.ZER ;CLEAR INDIRECT DEVICE
SETZM FLKLIN ;INDICATE KILLED
IF TOPS-20,<
HRRZ T1,A.JFN ;CLOSE INPUT FILE
CLOSF
JFCL
SETZM A.JFN ;MARK FILE CLOSED
SETZM A.ZER ;DO NOT TRY TO OPEN AGAIN
>
IF TOPS-10,<
RELEAS IND, ;RELEASE CHANNEL
>
MOVE C,INDSVC ;RECOVER TOP LEVEL CHARACTER [350]
SETZM INDSVC ;CLEAR MEMORY [535]
IF TOPS-10,<
SETZM B.ZER ;CLEAR INDIRECT STUFF
MOVE T1,[B.ZER,,B.ZER+1]
BLT T1,B.EZER ; ..
> POPJ P, ;RETURN
E.IWI: MOVEI N,A.ZER ;POINT TO FILE SPEC
SETOB T2,FLKLIN ;FLAG FOR NO ERROR CODE
M$FAIF (IWI,Wildcard illegal in indirect specification)
> ;END OF M$INDP
SUBTTL ROUTINE TO CONVERT SCAN BLOCKS
;.STOPN -- ROUTINE TO TURN SCAN BLOCK INTO OPEN/LOOKUP BLOCKS
; WILD-CARDS ARE ILLEGAL
;CALL: MOVEI T1,SCAN BLOCK
; MOVEI T2,OPEN BLOCK (3 WORDS)
; MOVEI T3,LOOKUP BLOCK (6 WORDS OR MORE)
; PUSHJ P,.STOPN
;ERROR RETURN IF WILD-CARDS
;SKIP RETURN IF SETUP OK
;USES T1-4
.STOPN::
IFN FT$SFD,<
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)
FMES: 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
IFN M$INDP,<
PUSHJ P,KILINE ;YES--KILL IT WITHOUT DELETE
>
HRREI T1,.CHEOF ;PREPARE AN EOF MARKER [322]
IFN M$INDP,<
SKIPG FLVERB ;SEE IF VERB MODE
SKIPN A.ZER ;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]
IFN M$INDP,<
SKIPN OPTNAM ;UNLESS OPTION FILE,
SETZM N.ZER ; CLEAR /RUN
>
MOVE P,SAVPDP ;RESTORE P
SKIPGE FLVERB ;SKIP IF VERB FORM
JRST VRSTRT ;VERB RESTART
SKIPN T2,SAVCAL ;SEE IF SOME CALL SAVED
JRST FMSGEX ;NO--GO DIE
MOVEM T2,(P) ;YES--RESTORE IT
MOVEI T1,0 ;CLEAR ARG POINTER TO LEAVE ALONE [370]
SKIPN FLVERB ;SEE IF TRAD. MODE
JRST .PSCAN ;NO--PART. MODE SO START IT OVER [322]
MOVEM T2,-5(P) ;YES--RESTORE BEFORE .SAVE4 AREA
HRRI T2,.SAVX4## ;RESET .SAVE4 RETURN POINT
MOVEM T2,(P) ; ..
JRST RESTRT ;AND GO START OVER
FMSGEX: PUSHJ P,.MONRT ;RETURN
EXIT ;TOLERATE NO NONSENSE
;.CLRBF -- ROUTINE TO CLEAR TYPE-AHEAD
;.CCLRB -- DITTO BUT ONLY IF ERROR ROUTINES SET FLAG TO DO SO
; IF INDIRECT, IT GOES TO END OF THIS LINE
;CALL: PUSHJ P,.CLRBF/.CCLRB
;PRESERVES ALL AC'S
.CCLRB::SKIPN .FLCBF## ;SEE IF NEED TO CLEAR BUFFER [322]
POPJ P, ;NO--RETURN [322]
.CLRBF::SETZM .FLCBF## ;CLEAR ERROR FLAG [322]
IF TOPS-20,<
SETZM A.FIL ;IF THERE WAS A BAD INDIRECT SPEC
; A.JFN WILL BE ZERO BUT A.FIL WILL
; STILL BE SETUP.
>
PUSH P,C ;SAVE CHARACTER AC [322]
MOVE C,LASCHR ;GET LAST CHARACTER [322]
IFN M$INDP,<
IF TOPS-10,<
SKIPE B.IND+1 ;SEE IF INDIRECT OPEN
> ;END TOPS-10
IF TOPS-20,<
SKIPE A.JFN ;SEE IF INDIRECT OPEN
> ;END TOPS-20
JRST CLRBFL ;YES--GO DO IT
>
IF TOPS-10,<
CLRBFI ;NO--CLEAR TYPE AHEAD
>
IF TOPS-20,<
CFIBF ;NO--CLEAR INPUT BUFFER
STORE T3,TXTZER,TXTEZR,0 ;CLEAR RDTXT BUFFER
>
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: PUSHJ P,SKPCHR ;SEE IF TTY INPUT
IFN M$INDP,<
IF TOPS-10,<
SKIPE B.IND+1 ;SEE IF INDIRECT OPEN
> ;END TOPS-10
IF TOPS-20,<
SKIPE A.JFN ;SEE IF INDIRECT OPEN
> ;END TOPS-20
>
IFE M$INDP,<SKIPA>
JUMPG C,[PUSHJ P,.TICHR ;YES--GET NEXT CHAR [366,524]
JRST CLRBFL] ;CONTINUE UNTIL DONE [366]
CAME C,[.CHEOF] ;NO--UNLESS EOF, [322]
HRREI C,.CHEOL ; DUMMY UP EOL
CLRBFX: SETZM SAVCHR ;CLEAR SAVED CHARACTER
SETZM SCANPC ;CLEAR BLANK COMPRESSOR
SETZM SCANCH ;CLEAN OUT JUNK [364]
SETZM .QUOTE ;CLEAR ANY QUOTING
CAME C,[.CHEOF] ;IF NOT EOF,
HRREI C,.CHEOL ; SET EOL
MOVEM C,LASCHR ;SAVE AS LAST CHAR
POP P,C ;RESTORE CHARACTER AC [322]
POPJ P, ;AND RETURN
;.MONRT -- EITHER RETURN TO MONITOR OR, IF NOT LOGGED IN, DO A KJOB
;CALL: PUSHJ P,.MONRT
;PRESERVES ALL ACS
.MONRT::PUSHJ P,.CCLRB ;CONDITIONALLY CLEAR TYPE-AHEAD
IFN M$INDP,<
PUSHJ P,.KLIND ;CLEAR INDIRECT STUFF
SETZM FLCCL ;CLEAR CCL MODE
>
SETZM FLCCMD ;CLEAR COMAND MODE
SETZM FLRCMD ;CLEAR RUN COMMAND MODE
SKIPE MONRT ;SEE IF CALLER WANTS CONTROL
PJRST @MONRT ;YES--GIVE IT TO HIM
;.MNRET -- ROUTINE WHICH UNCONDITIONALLY GOES TO MONITOR
; (TO BE CALLED BY USER'S MONRT EXIT ROUTINE)
.MNRET::
IF TOPS-10,<
PUSHJ P,.ISLGI## ;SEE IF WE ARE LOGGED IN [251,263,347]
JRST MONRT1 ;NO--MUST GO KJOB [251]
RESET ;CLEAR ALL I/O
MONRT. ;YES--RETURN TO MONITOR
> ;END TOPS-10
IF TOPS-20,<
HALTF
> ;END TOPS-20
POPJ P, ;IN CASE OF CONTINUE
IF TOPS-10,<
MONRT1: SKIPG T1 ;SEE IF NOT KNOWN IF LOGGED IN [347]
E$$KJB: OUTSTR [ASCIZ /
.KJOB
./] ; [262]
LOGOUT ;KILL THE JOB
> ;END TOPS-10
;.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
IFN M$INDP,<
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
IFN M$INDP,<
PUSH P,C ;PRESERVE C [366]
SKIPE OPTNAM ;IF OPTION,
PUSHJ P,.KLIND ; KILL OPTION FILE
POP P,C ;RESTORE C [366]
> ;END M$INDP
PUSHJ P,.POP4T## ;RESTORE TEMPS
POPJ P, ;RETURN
SUBTTL STORAGE
STDSWC: ;POINTERS TO STANDARD (LOCAL) SWITCH TABLES
STSWTN(P1)
STSWTP(P1)
STSWTM(P1)
STSWTD(P1)
;OFFSETS FOR TABLES
SWN==0 ;NAME TABLE
SWP==1 ;POINTERS TABLE
SWM==2 ;MAX,,PROCESSOR TABLE
SWD==3 ;DEFAULT TABLE
XLIST ;LITERALS
LIT
LIST
RELOC ;SWITCH TO LOW SEG
.SCANZ::! ;START OF SCAN LOW SEG
ZCOR:! ;START OF AREA TO ZERO ON INITIAL LOAD
.MYPPN::BLOCK 1 ;THIS JOB'S PROJECT-PROGRAMMER NUMBER
;THESE LOCATIONS ARE USED TO FETCH AND STORE PARAMETERS
SWTPTR: BLOCK 1 ;POINTER TO NAMES OF SWITCHES
SWTCHC:! ;POINTERS TO USER'S SWITCH TABLES
SWTCHN: BLOCK 1 ;TABLE OF SWITCH NAMES
SWTCHP: BLOCK 1 ;TABLE OF POINTERS FOR STORING
SWTCHM: BLOCK 1 ;TABLE OF MAX,,PROCESSOR
SWTCHD: BLOCK 1 ;TABLE OF DEFAULTS
SWTPFF: BLOCK 1 ;FIRST LOCATION OF USER FXXX
SWTPFL: BLOCK 1 ;LAST LOCATION OF USER FXXX
SWTPFO: BLOCK 1 ;OFFSET PXXX-FXXX
SWTHLP: BLOCK 1 ;ADDR OF HELP PROCESSOR
CLRANS: BLOCK 1 ;ROUTINE TO CLEAR ANSWERS
CLRSTK: BLOCK 1 ;ROUTINE TO CLEAR STICKY DEFAULTS
CLRFIL: BLOCK 1 ;ROUTINE TO CLEAR FILE
ALLIN: BLOCK 1 ;ROUTINE TO ALLOCATE INPUT FILE
ALLOUT: BLOCK 1 ;ROUTINE TO ALLOCATE OUTPUT FILE
MEMSTK: BLOCK 1 ;ROUTINE TO MEMORIZE STICKY DEFAULTS
APPSTK: BLOCK 1 ;ROUTINE TO APPLY STICKY DEFAULTS
USRFLG: BLOCK 1 ;USER SUPPLIED FLAGS
STRSWT: BLOCK 1 ;USER ROUTINE FOR SWITCH HANDLING
SAVCOR: BLOCK 1 ;INITIAL VALUE OF LOW SEG CORE SIZE
IFN M$INDP,<
CCLNAM: BLOCK 1 ;NAME OF CCL INDIRECT FILE
USRIND: BLOCK 1 ;USER POINTER TO IND SPEC
OPTNAM: BLOCK 1 ;CODE NAME IN SWITCH.INI
VOPTN: BLOCK 1 ;OPTNAM FOR VERB MODE
>
LOGTIM: BLOCK 1 ;TIME OF LAST LOGIN
TYPIN: BLOCK 1 ;ROUTINE TO INPUT ONE CHARACTER
MONRT: BLOCK 1 ;ROUTINE TO RETURN TO MONITOR
PROMPT: BLOCK 1 ;ROUTINE TO PROMPT FOR INPUT
INIFLG: BLOCK 1 ;.ISCAN FLAGS [366]
SAVCHR: BLOCK 1 ;SAVED CHARACTER IN .TICHR FOR SPACE/HYPHEN
CALCNT: BLOCK 1 ;CALL COUNTER FOR .TSCAN
LASCHR: BLOCK 1 ;LAST CHARACTER READ
SCANPC: BLOCK 1 ;PC IN CHARACTER SCAN (0=START OF LINE)
SCANCH: BLOCK 1 ;CHARACTER IN SCAN
.QUOTE::BLOCK 1 ;QUOTING CHARACTER IN EFFECT
IFN M$INDP,<
N.ZER::! ;BLOCK FOR /RUN COMMAND
IF TOPS-10,<
N.DEV: BLOCK 1 ;DEVICE (=1 IF /EXIT)
N.NAM: BLOCK 2 ;NAME
N.EXT: BLOCK 1 ;EXTENSION
> ;END TOPS-10
IF TOPS-20,<
N.FIL: BLOCK .FXLNF ;FILE SPEC
N.JFN: BLOCK 1 ;JFN
N.PRO: BLOCK 1 ;PROTECTION
N.ACT: BLOCK 8 ;ACCOUNT
>
N.MOD: BLOCK 2 ;MODIFIERS
IF TOPS-10,<
N.DIR: BLOCK 2*.FXLND ;DIRECTORY
>
N.EZER==:.-1
IF TOPS-10,<
N.CORE::BLOCK 1 ;CORE ARG
N.OFFS::BLOCK 1 ;OFFSET
N.OPEN: BLOCK 3 ;OPEN BLOCK
N.LOOK: BLOCK 7 ;LOOKUP BLOCK
>
A.ZER:! ;BLOCK FOR INDIRECT COMMAND
IF TOPS-10,<
A.DEV: BLOCK 1 ;DEVICE
A.NAM: BLOCK 1 ;NAME
A.NAMM: BLOCK 1 ;NAME MASK
A.EXT: BLOCK 1 ;EXTENSION AND MASK
>
IF TOPS-20,<
A.FIL: BLOCK .FXLNF ;FILE SPEC
A.JFN: BLOCK 1 ;JFN
A.PRO: BLOCK 1 ;PROTECTION
A.ACT: BLOCK 8 ;ACCOUNT
>
A.MOD: BLOCK 1 ;MODIFIERS
A.MODM: BLOCK 1 ;MODIFIER MASK
IF TOPS-10,<
A.DIR: BLOCK 1 ;DIRECTORY
A.DIRM: BLOCK 2*.FXLND-1 ;DIRECTORY MASK
>
A.EZER==.-1
IF TOPS-10,<
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
IF TOPS-10,<
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
> ;END TOPS-10
FLIIND: BLOCK 1 ;FLAG FOR INTERACTIVE INDIRECT
INDUSI: BLOCK 1 ;USETI FOR INDIRECT FILE
B.EZER==.-1
>
INDSVC: BLOCK 1 ;TOP LEVEL EOL CHAR (AFTER @)
IFG M$INDP,<
INDCNT: BLOCK 1 ;COUNT OF @ SINCE TTY: INPUT
>
P.ZER:! ;START OF AREA FOR FILE DEFAULTS
IF TOPS-10,<
P.DEV: BLOCK 1 ;LAST STICKY DEVICE TYPED BY USER
P.NAM: BLOCK 1 ;LAST STICKY NAME
P.NAMM: BLOCK 1 ;LAST STICKY NAME MASK
P.EXT: BLOCK 1 ;LAST STICKY EXT,,MASK TYPED BY USER
>
IF TOPS-20,<
P.FIL: BLOCK .FXLNF ;FILE NAME
P.JFN: BLOCK 1 ;JFN
P.PRO: BLOCK 1 ;PROTECTION
P.ACT: BLOCK 8 ;ACCOUNT
>
P.MOD: BLOCK 1 ;LAST STICKY FILE SWITCHES TYPED BY USER
P.MODM: BLOCK 1 ;LAST STICKY FILE SWITCHES MASK TYPED BY USER
IF TOPS-10,<
P.DIR: BLOCK 1 ;LAST STICKY DIRECTORY TYPED BY USER
P.DIRM: BLOCK 2*.FXLND-1 ;LAST STICKY DIRECTORY MASK TYPED BY USER
>
P.MZER:!
P.BFR: BLOCK 1 ;LAST STICKY /BEFORE
P.SNC: BLOCK 1 ;LAST STICKY /SINCE
P.ABF: BLOCK 1 ;LAST STICKY /ABEFORE
P.ASN: BLOCK 1 ;LAST STICKY /ASINCE
P.FLI: BLOCK 1 ;LAST STICKY FILE MIN
P.FLM: BLOCK 1 ;LAST STICKY FILE MAX
P.EST: BLOCK 1 ;LAST STICKY /ESTIMATE
P.VER: BLOCK 1 ;LAST STICKY /VERSION
P.EZER==.-1
F.ZER:! ;START OF AREA FOR FILE TYPE-INS
IF TOPS-10,<
F.DEV: BLOCK 1 ;DEVICE (ALWAYS NON-ZERO IF ANYTHING TYPED)
F.NAM:: BLOCK 1 ;NAME (NON-ZERO IF NAME TYPED)
F.NAMM: BLOCK 1 ;NAME MASK
F.EXT: BLOCK 1 ;EXT,,MASK (NON-ZERO IF DOT TYPED)
> ;END TOPS-10
IF TOPS-20,<
F.FIL: BLOCK .FXLNF ;FILE SPEC
F.JFN: BLOCK 1 ;JFN
F.PRO: BLOCK 1 ;PROTECTION
F.ACT: BLOCK 8 ;ACCOUNT
>
F.MOD: BLOCK 1 ;FILE SWITCHES
F.MODM: BLOCK 1 ;FILE SWITCH MASK (ON IF TYPED)
IF TOPS-10,<
F.DIR: BLOCK 1 ;DIRECTORY (DIR!DIRM ZERO IF DEFAULT DIRECTORY)
F.DIRM: BLOCK 2*.FXLND-1 ;DIRECTORY MASK
> ;END TOPS-10
F.MZER:!
F.BFR: BLOCK 1 ;/BEFORE
F.SNC: BLOCK 1 ;/SINCE
F.ABF: BLOCK 1 ;/ABEFORE
F.ASN: BLOCK 1 ;/ASINCE
F.FLI: BLOCK 1 ;FILE MIN
F.FLM: BLOCK 1 ;FILE MAX
F.EST: BLOCK 1 ;/ESTIMATE
F.VER: BLOCK 1 ;/VERSION
F.EMZR==.-1
FLFSP: BLOCK 1 ;FLAG SOMETHING FOUND
F.EZER==.-1
SWTCNT: BLOCK 1 ;RECURSION COUNTER FOR FILIN
FLFLLP: BLOCK 1 ;RECURSION COUNTER FOR (...) IN FILIN
G.ZER: BLOCK F.EZER-F.ZER+1 ;PUSH DOWN FOR FILE SWITCHES
G.EZER==.-1
FE.ZER: BLOCK F.EZER-F.ZER+1 ;FOR SECOND = [515]
FE.EZR==.-1
IF TOPS-10,<
FXNOTD==FX.NDV!FX.NUL!FX.DIR!FX.DFX!FX.TRM ;NOT DEFAULTED IN .OSDFS
FXNOTI==FX.PRO!FX.SUP ;ILLEGAL ON INPUT FILE
>
IF TOPS-20,<
FXNOTD==FX.TRM
FXNOTI==FX.SUP
>
FXNOTO==FX.NOM!FX.STR ;ILLEGAL ON OUTPUT FILE
IFN M$INDP,<
OPTION: BLOCK 1 ;NAME OF /OPTION (-1 IF DEFAULT, 0 IF /NOOPTION)
>
SAVPDP: BLOCK 1 ;SAVE PUSH DOWN POINTER IN CASE FATAL ERROR
SAVCAL: BLOCK 1 ;SAVE LOCATION OF CALL
WZER:!
.NMUL:: BLOCK ^D42 ;MULTIPLE WORD RESULT
.NMUE==:.-1
WEZER==.NMUE
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
IFN FT$SFD,<
STOPTH: BLOCK .PTMAX ;SFDS FOR .STOPN [565]
> ;END FT$SFD
FLCCL: BLOCK 1 ;CCL MODE (-1 AFTER @ SEEN, 1 BEFORE)
FLCCMD: BLOCK 1 ;CCL OR COMMAND MODE
FLFUTD: BLOCK 1 ;FUTURE/PAST DEFAULT
FLFUTR: BLOCK 1 ;FUTURE/PAST RELATIVE
;BOTH: -1 PAST, 0 ABS, +1 FUT
FLJCNM: BLOCK 1 ;PSCAN AFTER RESCAN OF JUST COMMAND
;-1=RESCAN; +1=FIRST PSCAN THEN [365]
FLKLIN: BLOCK 1 ;NEED TO KILL INDIRECT FILE
FLMULS: BLOCK 1 ;FLAG FOR MULTIPLE SWITCH VALUES
FLNEG: BLOCK 1 ;FLAG FOR NEGATIVE NUMBER
FLNULL: BLOCK 1 ;-1 IF FIELD NOT NULL
FLOUT: BLOCK 1 ;FLAG FOR = SEEN
FLRCMD: BLOCK 1 ;RUN COMMAND MODE (-1=()
FLSECE: BLOCK 1 ;INDICATES SECOND EQUAL SEEN
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
IF TOPS-20,<
CNTRLR: BLOCK 1 ;PROMPT FOR CONTROL-R
TXTZER:! ;ZERO ON EACH LINE
TXTPTR: BLOCK 1 ;BYTE POINTER TO TEXT
TXTBUF: BLOCK LTXTBF/5+1 ;TEXT BUFFER
TXTEZR==.-1 ;LAST WORD IN BUFFER
FSPCFL: BLOCK 1 ;-1 IF IN .FSPC
> ;END TOPS-20
EZCOR==.-1 ;END OF AREA TO ZERO
.SCANL==:.-.SCANZ ;LENGTH OF SCAN LOW SEG
PRGEND
TITLE .VERBO -- ROUTINE TO RETURN /MESSAGE SETTINGS
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .VERBO,.ERMSA,.ERMSG
;.ERMSG/.ERMSA -- ROUTINES TO ISSUE STANDARD ERROR MESSAGE PREFIXES
;CALL: 1/ MODULE CODE (0=SYSTEM),,MESSAGE CODE IN SIXBIT
; 2/ (11) ??? (7) LEAD CHAR,,[ASCIZ TEXT]
; 3/ ???,,ADDRESS OF ERROR IF .ERMSA
; PUSHJ P,.ERMSG/.ERMSA
;RETURN +1 WITH 1/ LH(ARG 2),,/VERBOS BITS
;USES T2-4
.ERMSG::MOVEI T3,0 ;CLEAR ADDRESS
.ERMSA::PUSH P,T2 ;SAVE CONTROL BITS
PUSH P,T3 ;SAVE ADDRESS
PUSH P,T1 ;SAVE PREFIXES
HLRZ T1,T2 ;GET PREFIX CHARACTER
ANDI T1,177 ;MASK TO JUST LEAD CHARACTER
CAIN T1,"?" ;IF FATAL ERROR,
SKIPE .FLCBF ;SEE IF FIRST FATAL ERROR [354,567]
JRST ERMSG1 ;NO, PROCEED [567]
CLEARO ;YES--CLEAR ^O [567]
SETOM .FLCBF ; INDICATE TO CLEAR TYPE-AHEAD
ERMSG1: PUSHJ P,.TNEWL## ;GO TO START OF LINE [355]
PUSHJ P,.TCHAR## ;ISSUE LEAD CHARACTER
PUSHJ P,.VERBO ;GET /MESSAGE
MOVE T4,T1 ;COPY TO SAFER PLACE
POP P,T1 ;GET PREFIX
TLNN T1,-1 ;SEE IF SYSTEM CODE
HRLZS T1 ;YES--REMOVE SPACES
TXNE T4,JWW.PR ;SEE IF /VERBOS:PREFIX
PUSHJ P,.TSIXN## ;YES--ISSUE PREFIX
POP P,T3 ;GET ADDRESS OF CALL
TRNE T3,-1 ;SEE IF CALL ADDRESS SET
TXNN T4,1_<VRBADX-1> ; AND IF USER ASKED FOR IT
JRST ERMSG2 ;NO--PROCEED BELOW
MOVEI T1,"(" ;YES--INDICATE
PUSHJ P,.TCHAR## ; ADDRESS
HRRZ T1,T3 ;GET ADDRESS
PUSHJ P,.TOCTW## ; TYPE IN OCTAL
MOVEI T1,")" ;GET END
PUSHJ P,.TCHAR## ; AND INDICATE
ERMSG2: PUSHJ P,.TSPAC## ;SPACE OVER TO TEXT AREA
HRRZ T1,(P) ;GET TEXT ADDRESS
TXNE T4,JWW.FL ;SEE IF /MESSAGE:FIRST
PUSHJ P,.TSTRG## ;YES--ISSUE TEXT
POP P,T1 ;RESTORE FLAGS (???)
ANDX T4,JWW.CN!JWW.FL ;REMOVE JUNK BITS
HRR T1,T4 ;MOVE TO ANSWER
POPJ P, ;RETURN
;.VERBO -- ROUTINE TO RETURN /MESSAGE SETTING
;CALL: PUSHJ P,.VERBO
;RETURNS T1/BITS IN JWW.?? FORMAT
.VERBO::
IF TOPS-10,<
HRROI T1,.GTWCH ;GET FROM MONITOR
GETTAB T1, ;THE USER'S DEFAULT
MOVEI T1,0 ;(DEFAULT TO 0)
TXNN T1,JW.WMS ;SEE IF SET
TXO T1,.JWWPO_<ALIGN. (JW.WMS)> ;NO--DEFAULT TO PREFIX,FIRST
ANDX T1,JW.WMS ;REMOVE JUNK
LSH T1,^D18-<ALIGN.(JW.WMS)> ;ALIGN IN LEFT HALF
> ;END TOPS-10
IF TOPS-20,<
MOVSI T1,JWW.PR!JWW.FL
>
ANDCM T1,.FLVRB ;CLEAR ANY SET IN SWITCH
HLRZS T1 ;POSITION TO RIGHT
IOR T1,.FLVRB ;INCLUDE ANY SET IN SWITCH
TLZ T1,-1 ;CLEAR JUNK
TRNE T1,JWW.PR ;SEE IF CONTINUATION
TRO T1,JWW.FL ;YES--SET FIRST
SKIPN T1 ;SEE IF ANYTHING LEFT
TRO T1,JWW.CN!JWW.FL;NO--SET FIRST,PREFIX
POPJ P, ;RETURN
RELOC
.VRBOZ::! ;START OF LOW CORE AREA
.FLVRB::BLOCK 1 ;MASK,,SET OF /MESSAGE BITS
.FLCBF::BLOCK 1 ;FLAG TO CLEAR TYPEAHEAD
.VRBOL==:.-.VRBOZ ;LENGTH OF LOW CORE AREA
RELOC
PRGEND
TITLE .TNEWL -- ROUTINE TO FORCE OUTPUT TO START OF LINE
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .TNEWL
.TNEWL==.TCRLF## ;DEFINE AS TYPE <CRLF>
; UNLESS USER SUPPLIES HIS OWN
PRGEND
TITLE .TOUTS -- SUBROUTINES FOR OUTPUT
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .TYOCH
;.TYOCH -- INITIALIZE TYPEOUT ROUTINE
;CALL: MOVEI T1,ADDR. OF ROUTINE
; PUSHJ P,.TYOCH
;RETURNS PREVIOUS ADDR. IN T1
.TYOCH::EXCH T1,TYPOUT ;SWAP ADDR.
POPJ P,
IF TOPS-10,<
;.TOLEB -- TYPE ENTER/LOOKUP BLOCK
;CALL: 1/ ADDRESS OF OPEN BLOCK
; 2/ ADDRESS OF EXTENDED LOOKUP/ENTER BLOCK
; PUSHJ P,.TOLEB
;USES T1-4
.TOLEB::MOVE T4,T2 ;MAKE SAFE COPY
MOVE T1,.OPDEV(T1) ;GET DEVICE
PUSHJ P,.TSIXN ;ISSUE IT
PUSHJ P,.TCOLN ;ISSUE SEPARATOR
MOVE T1,.RBNAM(T4) ;GET FILE NAME
HLRZ T2,.RBEXT(T4) ;GET EXTENSION
CAIN T2,'UFD' ;SEE IF UFD
JUMPG T1,[PUSHJ P,.TPPNW ;YES--TYPE AS P,PN
JRST .+2] ;PROCEED
PUSHJ P,.TSIXN ;ELSE ISSUE IN SIXBIT
MOVEI T1,"." ;INDICATE EXTENSION
PUSHJ P,.TCHAR ;ISSUE IT
HLLZ T1,.RBEXT(T4) ;GET EXTENSION
PUSHJ P,.TSIXN ;ISSUE THAT
MOVEI T1,.RBPPN(T4) ;POINT TO DIRECTORY
PJRST .TDIRB ;GO TYPE THAT AND RETURN
;.TFBLK -- TYPE SCANER STYLE FILE BLOCK
;CALL: MOVEI T1,ADDR OF BLOCK
; PUSHJ P,.TFBLK
;USES T1-4
.TFBLK::MOVE T4,T1 ;SAVE AWAY ARGUMENT
SKIPN T1,.FXDEV(T4)
JRST TFBLK1
PUSHJ P,.TSIXN ;TYPE DEVICE
PUSHJ P,.TCOLN ;TYPE COLON
TFBLK1: MOVE T1,.FXNAM(T4)
PUSHJ P,.TSIXN ;TYPE NAME
HLLZ T3,.FXEXT(T4) ;GET EXTENSION
MOVX T2,FX.NUL ;SEE IF USER
TDNE T2,.FXMOM(T4) ; ..
TDNE T2,.FXMOD(T4) ; TYPED A DOT
JUMPE T3,TFBLK2 ;YES--IS THIS A NULL EXTENSION
MOVEI T1,"." ;GET DOT
PUSHJ P,.TCHAR ;TYPE IT
MOVE T1,T3 ;GET EXTENSION
PUSHJ P,.TSIXN
TFBLK2: MOVEI T1,.FXDIR(T4) ;POSITION TO DIRECTORY
TLO T1,2 ;FLAG FOR BIWORDS
;FALL INTO .TDIRB
;STILL TOPS-10
;.TDIRB -- TYPE A DIRECTORY BLOCK
;CALL: MOVEI T1,ADDRESS OF DIRECTORY WORD OR PATH OR BIWORDS
; TLO T1,0 FOR WORD, 1 FOR PATH, 2 FOR BIWORDS
; PUSHJ P,.TDIRB
;USES T1-4
.TDIRB::
IFE FT$SFD,<
SKIPE T1,(T1) ;SEE IF SOMETHING
PJRST .TPPNW ;YES--PRINT IT
POPJ P,
>
IFN FT$SFD,<
MOVE T4,T1 ;SAVE POINTER
SKIPN T1,(T4) ;SEE IF SOMETHING THERE
JRST [HLRZ T2,T4 ;NO--SEE IF BIWORDS
CAIN T2,2 ; ..
SKIPN 2(T4) ;YES--SEE IF SOMETHING LATER ON
POPJ P, ;NO--RETURN
JRST TDIRB1] ;PROCEED WITH OUTPUT
TLNE T4,-1 ;SEE IF STRAIGHT
JRST TDIRB1 ;NOPE--DO IT THE HARD WAY
TLNE T1,-1 ;YES--SEE IF SFD
PJRST .TPPNW ;NO--JUST UFD
MOVEI T4,2(T1) ;YES--CHANGE POINTER
TDIRB1: HLRZ T1,T4 ;GET LENGTH
SUBI T1,2 ;SET FLAG -1 FOR SINGLE, 0 FOR BIWORDS
PUSH P,T1 ;SAVE FOR LATER TESTING
HRLI T4,-.FXLND ;SET LENGTH [256]
MOVEI T1,"[" ;OUTPUT BREAK
PUSHJ P,.TCHAR ; ..
MOVE T1,(T4) ;GET UFD
CAME T1,[-1] ;UNLESS -1 OR POSITIVE, USE SIXBIT [560]
JUMPL T1,[PUSHJ P,.TSIXN
JRST TDIRB2]
SKIPL (P) ;SEE IF DOUBLE
JRST [MOVE T2,1(T4) ;YES--GET MASK
PUSHJ P,.TXWWW ;OUTPUT MASKED OCTAL XWD
JRST TDIRB2] ;AND PROCEED
PUSHJ P,.TXWDW ;TYPE IT
TDIRB2: AOBJP T4,TDIRB3 ;LOOP UNTIL DONE
SKIPL (P) ;IF BIWORDS,
AOS T4 ; MOVE UP ONE EXTRA
SKIPN (T4) ; ..
JRST TDIRB3 ;YES--RETURN TYPING LAST BREAK
PUSHJ P,.TCOMA ;TYPE A COMMA
MOVE T1,(T4) ;GET SFD NAME
PUSHJ P,.TSIXN ;TYPE IT
JRST TDIRB2 ; AND LOOP UNTIL DONE
TDIRB3: POP P,(P) ;THROW AWAY FLAG
JRST .TRBRK ;AND FINISH UP
>
;STILL TOPS-10
;.TXWWW -- TYPE A MASKED (WILD) OCTAL WORD IN XWD FORMAT
;CALL: MOVE T1,WORD
; MOVE T2,MASK
; PUSHJ P,.TXWWW
;USES T1-3
.TXWWW::MOVSS T2 ;T1,T2=LH(V),RH(V),RH(M),LH(M)
ROTC T1,-^D18 ;T1,T2=LH(M),LH(V),RH(V),RH(M)
PUSH P,T2 ;SAVE SECOND HALF (V,,M)
MOVSS T1 ;T1=LH V,,M
PUSHJ P,.TMOHW ;TYPE MASKED OCTAL HALF-WORD
PUSHJ P,.TCOMA ;TYPE COMMA
POP P,T1 ;RESTORE RH V,,M
;FALL INTO .TMOHW
;.TMOHW -- TYPE MASKED OCTAL HALF-WORD
;CALL: MOVE T1,[VALUE,,MASK]
; PUSHJ P,.TMOHW
;USES T1-3
.TMOHW::TRCN T1,-1 ;MAKE MASK BIT 0 IF NOT WILD
PJRST .TASTR ;TYPE * IF ALL WILD
MOVE T2,T1 ;MOVE TO CONVENIENT PLACE
MOVEI T3,6 ;SET LOOP COUNT
TMOHW1: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;POSITION FIRST DIGIT
JUMPN T1,TMOHW3 ;GO IF NON-ZERO
SOJG T3,TMOHW1 ;LOOP UNTIL ALL DONE
TMOHW2: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;GET NEXT DIGIT
TMOHW3: ADDI T1,"0" ;CONVERT TO ASCII
TLNE T2,7 ;CHECK MASK
MOVEI T1,"?" ;CHANGE TO ? IF WILD
PUSHJ P,.TCHAR ;TYPE CHARACTER
SOJG T3,TMOHW2 ;LOOP UNTIL DONE
POPJ P, ;RETURN
> ;END TOPS-10 (FROM WAY BACK)
IF TOPS-20,<
.TFBLK::PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,T1 ;P1 IS SPEC POINTER
MOVE T1,.FXJFN(P1) ;GET JFN
GTSTS ;GET STATUS
TXNN T2,1B10 ;VALID JFN?
JRST TFBLK1 ;NO--PRINT INPUT STRING
HRROI T1,.STEMP ;YES--HAVE MONITOR PUT NAME IN
HRRZ T2,.FXJFN(P1) ; .STEMP
MOVEI T3,0 ;DEFAULT FORMAT
JFNS ;DO IT
MOVEI T1,.STEMP ;PRINT OUT THE
PJRST .TSTRG ; STRING
TFBLK1: MOVEI T1,.FXFIL(P1) ;POINT TO STRING
PJRST .TSTRG ;PRINT IT
;SUBROUTINE TO PRINT THE STRING ASSOCIATED WITH AN ERROR CODE
;CALL WITH:
; T1 = CODE
; PUSHJ P,.TJERR
; RETURN HERE
;
.TJERR::HRRZ T2,T1 ;COPY CODE
HRLI T2,.FHSLF ;USE THIS FORK
HRROI T1,.STEMP ;WHERE TO PUT ANSWER
MOVSI T3,-5*.STEML ;BYTE COUNT
ERSTR ;GET THE STRING
JRST TJERR1 ;ERROR NOT FOUND
JFCL ;MESSAGE TRUNCATED
MOVEI T1,.STEMP ;POINT TO STRING
PJRST .TSTRG ;PRINT THE TEXT
TJERR1: PUSH P,T2 ;SAVE CODE
MOVEI T1,[ASCIZ "NO ERROR MESSAGE FOR ERROR CODE "]
PUSHJ P,.TSTRG ;PRINT PREFIX
POP P,T1 ;RESTORE CODE
TLZ T1,-1 ;CLEAR FORK NUMBER
PUSHJ P,.TOCTW ;PRINT ERROR CODE
PJRST .TCRLF ;ADD ON CRLF
>
;.TDTTM -- TYPE DATE AND TIME IN UNIVERSAL FORMAT
;CALL: T1/ DATE-TIME IN INTERNAL FORMAT
; PUSHJ P,.TDTTM
;USES T1-4
.TDTTM::PUSHJ P,.CNTDT## ;TAKE APART
PUSH P,T1 ;SAVE TIME
MOVE T1,T2 ;POSITION DATE
PUSHJ P,.TDATE ;TYPE DATE
PUSHJ P,.TCOLN ;TYPE COLON
POP P,T1 ;RESTORE TIME
PJRST .TTIME ;TYPE TIME AND RETURN
;.TDATN -- TYPE TODAY'S DATE IN STANDARD FORMAT
;.TDATE -- TYPE DATE IN STANDARD FORMAT OF DD-MMM-YY
;CALL: MOVEI T1,DATE IN SYSTEM FORMAT FROM DATE UUO
; PUSHJ P,.TDATE/.TDATN
;USES T1-4
.TDATN::IF TOPS-10,<
DATE T1, ;GET TODAY'S DATE
>
IF TOPS-20,<
GTAD
PUSHJ P,.CNTDT## ;CONVERT FORMAT
MOVE T1,T2 ;MOVE DATE
>
.TDATE::PUSHJ P,.SAVE1## ;SAVE P1
IDIVI T1,^D31 ;GET DAYS
MOVE T4,T1 ;SAVE REST
MOVEI T1,1(T2) ;GET DAYS AS 1-31
MOVEI T2," " ;FILL WITH SPACE
PUSHJ P,.TDEC2 ;TYPE IN DECIMAL
IDIVI T4,^D12 ;GET MONTHS
MOVEI T1,[ASCIZ /-Jan/
ASCIZ /-Feb/
ASCIZ /-Mar/
ASCIZ /-Apr/
ASCIZ /-May/
ASCIZ /-Jun/
ASCIZ /-Jul/
ASCIZ /-Aug/
ASCIZ /-Sep/
ASCIZ /-Oct/
ASCIZ /-Nov/
ASCIZ /-Dec/](P1) ;GET ASCII
PUSHJ P,.TSTRG ;TYPE IT
MOVEI T1,^D64(T4) ;GET YEAR SINCE 1900
IDIVI T1,^D100 ;GET JUST YEARS IN CENTURY [257]
MOVN T1,T2 ;NEGATE TO GET - SIGN [257]
PJRST .TDECW ;TYPE IT AND RETURN
;.TTIMN -- TYPE CURRENT TIME IN STANDARD FORMAT
;.TTIME -- TYPE TIME IN STANDARD FORMAT OF HH:MM:SS
;CALL: MOVEI T1,TIME IS MILLISEC SINCE MIDNIGHT
; PUSHJ P,.TTIME/.TTIMN
;USES T1-4
.TTIMN::
IF TOPS-10,<
MSTIME T1, ;GET CURRENT TIME
>
IF TOPS-20,<
GTAD
PUSHJ P,.CNTDT## ;CONVERT TIME AND DATE
>
.TTIME::IDIV T1,[^D3600000] ;GET HOURS
MOVE T4,T2 ;SAVE REST
MOVEI T2," " ;FILL WITH SPACE
PUSHJ P,.TDEC2 ;TYPE TWO DIGITS
PUSHJ P,.TCOLN ;TYPE COLON
MOVE T1,T4 ;RESTORE REST
IDIVI T1,^D60000 ;GET MINS
MOVE T4,T2 ;SAVE REST
PUSHJ P,TDEC2Z ;TYPE TWO DIGITS WITH 0 FILLER
PUSHJ P,.TCOLN ;TYPE COLON
MOVE T1,T4 ;RESTORE THE REST
IDIVI T1,^D1000 ;GET SECONDS
TDEC2Z: MOVEI T2,"0" ;FILL WITH 0
;FALL INTO .TDEC2
;.TDEC2 -- TYPE DECIMAL AT LEAST TWO DIGITS
;CALL: SAME AS .TDECW WITH T2=FILLER CHAR (" " OR "0")
.TDEC2::JUMPL T1,.TDECW ;JUMP IF NEGATIVE
CAILE T1,^D9 ;SEE IF ONE DIGIT
PJRST .TDECW ;NO--JUST OUTPUT
EXCH T1,T2 ;GET FILLER
PUSHJ P,.TCHAR ;TYPE
MOVEI T1,"0"(T2) ;CONVERT DIGIT
PJRST .TCHAR ;OUTPUT IT AND RETURN
;.TFCHR -- TYPE POSSIBLY FUNNY CHARACTER
;CALL: MOVEI T1,CHARACTER
; PUSHJ P,.TFCHR
;USES T1, T2
.TFCHR::CAIL T1,40 ;SEE IF CONTROL CHARACTER
JRST TFCHR5 ;NO--PROCEED
MOVSI T2,-LNSPCH ;SET SCAN LOOP
TFCHR2: HLL T1,SPCH(T2) ;MAKE T1 AGREE
CAME T1,SPCH(T2) ;SEE IF MATCH
AOBJN T2,TFCHR2 ;NO--LOOP
JUMPGE T2,TFCHR3 ;NO MATCH--PROCEED
MOVEI T1,"<" ;MATCH--TYPE INDICATOR
PUSHJ P,.TCHAR ; ..
HLLZ T1,SPCH(T2) ;GET MNEMONIC
PUSHJ P,.TSIXN ;TYPE IT
MOVEI T1,076 ;CLOSE
PUSHJ P,.TCHAR ; INDICATOR
POPJ P, ;AND RETURN
TFCHR3: ADDI T1,100 ;CONVERT
PUSH P,T1 ; AND SAVE CHAR
MOVEI T1,"^" ;SET INDICATOR
JRST TFCHR7 ;AND GO FINISH UP
TFCHR5: CAIGE T1,4000 ;SEE IF GUIDE WORD [507]
JRST TFCHR6 ;NO--PROCEED [507]
SUBI T1,4000 ;REMOVE OFFSET [507]
PUSH P,GUIDT.(T1) ;SAVE GUIDE WORD [507]
MOVEI T1,"'" ;YES--INDICATE [507]
PUSHJ P,.TCHAR ;OUTPUT GUIDE PREFIX [507]
POP P,T1 ;GET GUIDE WORD [507]
PUSHJ P,.TSIXN ;OUTPUT AS SIXBIT [507]
MOVEI T1,"'" ;ADD CLOSING [507]
PJRST .TCHAR ; QUOTE [507]
TFCHR6: CAIGE T1,140 ;SEE IF LOWER CASE
PJRST .TCHAR ;NO--JUST TYPE IT
SUBI T1,40 ;YES--CONVERT TO UPPER
PUSH P,T1 ;SAVE FOR A MINUTE
MOVEI T1,"'" ;SET INDICATOR
TFCHR7: PUSHJ P,.TCHAR ;ISSUE INDICATOR
POP P,T1 ;RESTORE FIXED CHAR
PJRST .TCHAR ;AND TYPE IT
;TABLE OF MNEMONIC,,CHARACTER
SPCH: 'EOF',,.CHEOF
'EOL',,.CHEOL
'ALT',,.CHALX
'BEL',,.CHBEL
'TAB',,.CHTAB
'LF ',,.CHLFD
'VT ',,.CHVTB
'FF ',,.CHFFD
'CR ',,.CHCRT
'ESC',,.CHESC
LNSPCH==.-SPCH
;TABLE OF KNOWN GUIDE WORDS
; MUST BE IN ORDER OF VALUES OF THE META-CHARACTER
; (I.E., 4000, 4001, 4002, ETC.)
DEFINE YY($GUIDE),<
EXP <SIXBIT \$GUIDE\>
>
GUIDT.::YY AND
YY OR
YY NOT
YY TO
YY FROM
YY INPUT
YY OUTPUT
YY SOURCE
YY LIST
YY OBJECT
GUIDL.==:.-GUIDT.
GUIDM.==:-GUIDL.
;.TVERW -- TYPE WORD IN VERSION NUMBER FORMAT
;CALL: T1/ WORD
; PUSHJ P,.TVERW
;USES T1-4
.TVERW::MOVE T4,T1 ;PUT IN SAFE PLACE
LDB T1,[POINT 9,T4,11] ;GET MAJOR VERSION
SKIPE T1 ;IF NON-ZERO,
PUSHJ P,.TOCTW ; PRINT IN OCTAL
LDB T1,[POINT 6,T4,17] ;GET MINOR VERSION
JUMPE T1,TVER2 ;IF NON-ZERO,
SOS T1 ; PRINT IN MODIFIED
IDIVI T1,^D26 ; RADIX 26 ALPHA
JUMPE T1,TVER1 ; JUMP IF ONE CHAR
MOVEI T1,"A"-1(T1) ; ISSUE FIRST OF TWO
PUSHJ P,.TCHAR ; CHARACTERS
TVER1: MOVEI T1,"A"(T2) ; ISSUE "UNITS"
PUSHJ P,.TCHAR ; CHARACTER
TVER2: HRRZ T1,T4 ;GET EDIT NUMBER
JUMPE T1,TVER3 ;IF NON-ZERO,
MOVEI T1,"(" ; ISSUE
PUSHJ P,.TCHAR ; AS OCTAL
HRRZ T1,T4 ; WITHIN
PUSHJ P,.TOCTW ; PARENTHESES
MOVEI T1,")" ; ..
PUSHJ P,.TCHAR ; ..
TVER3: LDB T2,[POINT 3,T4,2] ;GET "WHO" FIELD
JUMPE T2,.POPJ ;IF NON-ZERO,
MOVEI T1,"-" ; PRINT -
PUSHJ P,.TCHAR ; AND THEN
MOVE T1,T2 ; THE FIELD
PJRST .TOCTW ; AS OCTAL
;.TBLOK -- TYPE NUMBER IN BLOCKS, ETC.
;.TCORW -- TYPE NUMBER IN CORE SIZE
;CALL: 1/ SIZE TO TYPE
; PUSHJ P,.TBLOK/.TCORW
;USES T1-4
.TBLOK::TRNE T1,177 ;SEE IF EVEN BLOCKS
PJRST TCORWD ;NO--ISSUE IN WORDS
MOVE T4,["B",,177] ;ELSE INDICATE BLOCKS
JRST TCORTP ;AND GO OUTPUT
.TCORW::JUMPE T1,TCORWD ;IF NULL, DO IN WORDS
MOVE T4,["K",,1777] ;PRESET FOR K
JUMPPT (T2,TCORKA,TCORKA) ;IF PDP-6 OR KA-10, DO IN K
MOVE T4,["P",,777] ;ELSE, INDICATE PAGES
TCORKA: TDNE T1,T4 ;SEE IF ROUND UNITS
JRST TCORWD ;NO--DO IN WORDS
TCORTP: IDIVI T1,1(T4) ;YES--DIVIDE BY UNITS
SKIPA ; AND OUTPUT
TCORWD: MOVSI T4,"W" ;INDICATE WORDS
PUSHJ P,.TDECW ;ISSUE SIZE
HLRZ T1,T4 ;GET SIZE UNIT INDICATOR
PJRST .TCHAR ;ISSUE THAT AND RETURN
;.TCRLF -- TYPE CARRIAGE RETURN/LINE FEED
;CALL: PUSHJ P,.TCRLF
;PRESERVES ALL ACS
.TCRLF::PUSH P,T1 ;SAVE CHARACTER
MOVEI T1,.CHCRT ;GET CARRIAGE RETURN
PUSHJ P,.TCHAR
MOVEI T1,.CHLFD ;GET LINE FEED
PUSHJ P,.TCHAR ;TYPE IT
TPOPJ: POP P,T1 ;RESTORE CHARACTER
POPJ P, ;RETURN
;.TPPNW -- SUBROUTINE TO TYPE A PPN
;CALL: MOVE T1,PPN
; PUSHJ P,.TPPNW
;USES T1, T2, T3
IF TOPS-10,<
.TPPNW::PUSH P,T1 ;SAVE ARGUMENT
MOVEI T1,"["
PUSHJ P,.TCHAR
POP P,T1 ;RECOVER ARGUMENT
JUMPL T1,[PUSHJ P,.TSIXN
JRST .TRBRK]
PUSHJ P,.TXWDW ;TYPE XWD
> ;END TOPS-10
.TRBRK::MOVEI T1,"]"
PJRST .TCHAR
;.TSIXN -- TYPE OUT SIXBIT WORD
;CALL: MOVE T1,WORD
; PUSHJ P,.TSIXN
;USES T1, T2
.TSIXN::MOVE T2,T1 ;MOVE ARGUMENT
TSIXN1: JUMPE T2,.POPJ ;LOOP UNTIL ONLY BLANKS LEFT
MOVEI T1,0 ;CLEAR NEXT CHARACTER
LSHC T1,6 ;GET NEXT CHARACTER
ADDI T1," "-' ' ;CONVERT TO ASCII
PUSHJ P,.TCHAR ;TYPE IT
JRST TSIXN1 ; ..
;.TXWDW -- TYPE OUT N AS TWO OCTAL HALF-WORDS
;CALL: MOVE T1,WORD
; PUSHJ P,.TXWDW
;USES T1, T2, T3
.TXWDW::PUSH P,T1 ;PRESERVE ARGUMENT
HLRZ T1,T1
PUSHJ P,.TOCTW
PUSHJ P,.TCOMA ;ISSUE COMMA
POP P,T1 ;RESTORE ARGUMENT
HRRZ T1,T1
;FALL INTO .TOCTW
;.TDECW -- TYPE OUT SIGNED DECIMAL NUMBER
;.TOCTW -- TYPE OUT SIGNED OCTAL NUMBER
;.TRDXW -- TYPE OUT SIGNED NUMBER (RADIX IN T3)
; (IF RADIX .GT. 9, WILL USE ALPHAS AFTER DIGITS)
;CALL: MOVE T1,NUMBER
; PUSHJ P,.TOCTW/.TDECW/.TRDXW
;USES T1, T2, T3
.TOCTW::SKIPA T3,[10] ;INITIALIZE FOR OCTAL RADIX
.TDECW::MOVEI T3,^D10 ;INITIALIZE FOR DECIMAL RADIX
.TRDXW::JUMPGE T1,TRDXW1 ;CHECK FOR NEGATIVE
MOVE T2,T1 ;SAVE AWAY ARGUMENT
MOVEI T1,"-" ;YES--GET MINUS
PUSHJ P,.TCHAR ;PRINT IT
MOVE T1,T2 ;RESTORE NUMBER
TRDXW1: IDIV T1,T3 ;DIVIDE BY RADIX
MOVMS T2 ;GET MAGNITUDE
HRLM T2,(P) ;SAVE REMAINDER
SKIPE T1 ;SEE IF ANYTHING LEFT
PUSHJ P,TRDXW1 ;YES--LOOP BACK WITH PD LIST
HLRZ T1,(P) ;GET BACK A DIGIT
ADDI T1,"0" ;CONVERT TO ASCII
CAILE T1,"9" ;SEE IF OVERFLOW DIGITS
ADDI T1,"A"-"9" ;YES--SWITCH TO ALPHABETICS
PJRST .TCHAR ;TYPE IT AND RETURN
;.TSTRG -- TYPE ASCIZ STRING
;CALL: MOVEI T1,LOCTN. OF STRING
; PUSHJ P,.TSTRG
;USES T1
.TSTRG::HRLI T1,(POINT 7) ;CONVERT ADDRESS TO POINTER
TRNN T1,-1 ;SEE IF SOMETHING THERE
POPJ P, ;NO--RETURN EMPTY HANDED
PUSH P,T1 ;STORE IN SAFE PLACE [501]
TSTRG1: ILDB T1,(P) ;GET NEXT CHARACTER [501]
JUMPE T1,TPOPJ ;RETURN WHEN DONE [501]
PUSHJ P,.TCHAR ;OUTPUT CHARACTER
JRST TSTRG1 ;LOOP UNTIL DONE
;.TCHAR -- TYPE ASCII CHARACTER
;CALL: MOVEI T1,CHARACTER
; PUSHJ P,.TCHAR
;PRESERVES ALL ACS
;.TSPAC -- TYPE ASCII SPACE
;.TTABC -- TYPE ASCII TAB
;.TCOMA -- TYPE ASCII COMMA
;.TCOLN -- TYPE ASCII COLON
;.TRBRK -- TYPE ASCII RIGHT BRACKET
;.TASTR -- TYPE ASCII ASTERISK
;CALL: PUSHJ P,.TXXXX
;USES T1
.TASTR::MOVEI T1,"*" ;GET ASTERISK
PJRST .TCHAR ;ISSUE AND RETURN
.TCOLN::MOVEI T1,":" ;GET COLON
PJRST .TCHAR ;ISSUE AND RETURN
.TCOMA::MOVEI T1,"," ;GET COMMA
PJRST .TCHAR ;ISSUE AND RETURN
.TTABC::MOVEI T1,.CHTAB ;GET TAB
PJRST .TCHAR ;ISSUE AND RETURN
.TSPAC::MOVEI T1," " ;GET SPACE
.TCHAR::TRNN T1,177 ;SEE IF NULL
POPJ P, ;YES--IGNORE
SKIPE TYPOUT ;SEE IF SPECIAL ROUTINE
PJRST @TYPOUT ;YES--GO DO IT INSTEAD
OUTCHR T1 ;LET MONITOR DO IT
.POPJ: POPJ P, ;AND RETURN
;DATA STORAGE AREA
RELOC
.TOUTZ::! ;START OF LOW CORE AREA
TYPOUT: BLOCK 1 ;ROUTINE TO TYPE ONE CHARACTER
IF TOPS-20,<
.STEMP::BLOCK .STEML ;GENERAL STRING TEMP (AS PRESERVED AS T1)
> ;END TOPS-20
.TOUTL==:.-.TOUTZ ;LENGTH OF LOW CORE AREA
RELOC
PRGEND
TITLE .STOPB -- ROUTINE TO CONVERT SCAN BLOCKS TO MONITOR
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INTIALIZE LISTINGS, ETC.
;ENTRY POINTS
ENTRY .STOPB
SUBTTL ROUTINE TO CONVERT SCAN BLOCKS
;.STOPB -- ROUTINE TO TURN SCAN BLOCK INTO OPEN/LOOKUP BLOCKS
; WILD-CARDS ARE ILLEGAL
;CALL: MOVEI T1,SCAN BLOCK
; LH(T1)=LENGTH IF .GT. 24
; MOVEI T2,OPEN BLOCK (3 WORDS)
; MOVEI T3,LOOKUP BLOCK (6 WORDS OR MORE)
; LH(T3)=LENGTH IF .GT. 6
; MOVEI T4,PATH BLOCK (9 WORDS)
; PUSHJ P,.STOPB
;ERROR RETURN IF WILD-CARDS
;SKIP RETURN IF SETUP OK
;USES T1-4
IF TOPS-10,<
.STOPB::PUSHJ P,.SAVE3## ;SAVE P1-3
SKIPN P3,.FXDEV(T1) ;GET DEVICE
MOVSI P3,'DSK' ;DEFAULT IF BLANK
MOVEM P3,1(T2) ;STORE IN OPEN BLOCK
MOVE P1,.FXMOD(T1) ;GET SWITCHES
MOVSI P2,'SYS' ;GET A GOOD NAME
DEVCHR P2,UU.PHY ;DO PHYSICAL CALL
TRNN P2,-1 ;SEE IF ANYTHING SET
TXZ P1,FX.PHY ;NO--CLEAR /PHYSICAL
MOVE P2,[DEVCHR P3,] ;GET UUO
TXNE P1,FX.PHY ;SEE IF /PHYSICAL
TXO P2,UU.PHY ;YES--CHANGE UUO
XCT P2 ;DO IT
MOVEI P2,0 ;CLEAR FIRST WORD
TXNE P1,FX.PHY ;SEE IF /PHYSICAL
MOVX P2,UU.PHS ;SET OPEN PHYSICAL BIT
TXNN P3,DV.MTA ;SEE IF MAG TAPE
JRST STOPNM ;NO--PROCEED
TXNE P1,FX.PAR ;SEE IF /PARITY:EVEN
TXO P2,IO.PAR ;YES--SET FOR OPEN
LDB P3,[POINTR (P1,FX.DEN)] ;GET /DENSITY
DPB P3,[POINTR (P2,IO.DEN)] ;SET FOR OPEN
STOPNM: MOVEM P2,(T2) ;SET FIRST WORD OF OPEN BLOCK
SKIPE P3,.FXNAM(T1) ;IF NAME NOT BLANK,
SETCM P3,.FXNMM(T1) ;GET NAME MASK
JUMPN P3,.POPJ## ;ERROR IF WILD
MOVE P3,.FXNAM(T1) ;GET NAME
MOVEM P3,.RBNAM(T3) ;STORE IN LOOKUP BLOCK
SKIPE P3,.FXEXT(T1) ;GET EXTENSION
TRC P3,-1 ;UNLESS BLANK, CHECK MASK
TRNE P3,-1 ;SEE IF WILD
POPJ P, ;YES--ERROR
MOVEM P3,.RBEXT(T3) ;STORE IN LOOKUP BLOCK
LDB P3,[POINTR (.FXMOD(T1),FX.PRO)] ;GET PROTECTION
LSH P3,<ALIGN.(RB.PRV)> ;POSITION FOR LOOKUP
MOVEM P3,.RBPRV(T3) ;STORE IN LOOKUP BLOCK
;STILL TOPS-10
MOVEI P3,0 ;CLEAR DIRECTORY
MOVX P1,FX.DIR ;GET DIRECTORY BIT
TDNN P1,.FXMOD(T1) ;SEE IF SET
JRST STOPND ;NO--USE [-]
SETCM P3,.FXDIM(T1) ;GET UFD MASK
JUMPN P3,.POPJ## ;ERROR IF WILD
MOVE P3,.FXDIR(T1) ;GET UFD
TLNN P3,-1 ;SEE IF PROJECT
HLL P3,.MYPPN## ;NO--USE LOGGED IN NUMBER [312]
TRNN P3,-1 ;SEE IF PROGRAMMER
HRR P3,.MYPPN## ;NO--USE LOGGED IN NUMBER [312]
MOVEM P3,.FXDIR(T1) ;STORE FOR ERROR MESSAGES
SKIPN .FXDIR+2(T1) ;SEE IF SFDS
JRST STOPND ;NO--GO STORE AND RETURN
SETZM (T4) ;CLEAR PATH
HRLZI P1,(T4) ; ..
HRRI P1,1(T4) ; ..
BLT P1,.PTMAX-1(T4) ; .. [565]
MOVEM P3,.PTPPN(T4) ;STORE UFD
MOVEI P1,.FXDIR+2(T1) ;POINT TO ARGUMENT SFD
MOVSI P2,-.FXLND+1 ;COUNT SFDS
HRRI P2,(T4) ;INDICATE START OF SFD BLOCK
STOPNS: SKIPN P3,(P1) ;SEE IF DONE
JRST STOPNT ;YES--FINISH UP
MOVEM P3,.PTPPN+1(P2) ;NO--STORE IN PATH
SETCM P3,1(P1) ;GET MASK
JUMPN P3,.POPJ## ;ERROR IF WILD
ADDI P1,2 ;ADVANCE FETCH
AOBJN P2,STOPNS ;LOOP UNTIL DONE
STOPNT: MOVEI P3,(T4) ;INDICATE SFD
STOPND: MOVEM P3,.RBPPN(T3) ;SET INTO LOOKUP
HLRZ P1,T1 ;GET SCAN BLOCK LENGTH [346]
MOVX P2,RB.NSE ;GET NON-SUPERSEDING ENTER BIT
MOVX P3,FX.SUP ;GET /ERSUPERSEDE BIT
TDNE P3,.FXMOD(T1) ;SEE IF USER SET
IORM P2,.RBCNT(T3) ;SET FOR ENTER
HLRZ P2,T3 ;GET LOOKUP BLOCK LENGTH [346]
CAILE P1,.FXEST ;SEE IF /ESTIMATE [346]
SKIPGE P3,.FXEST(T1) ;YES--GET /ESTIMATE SIZE [346]
MOVEI P3,0 ;NO OR MISSING--CLEAR SETTING [346]
LSH P3,-7 ;CONVERT TO BLOCKS [346]
CAILE P2,.RBEST ;SEE IF LOOKUP BLOCK LONG ENOUGH [346]
MOVEM P3,.RBEST(T3) ;YES--STORE IN CASE ENTER [346]
CAILE P1,.FXVER ;SEE IF /VERSION [346]
SKIPA P3,.FXVER(T1) ;YES--GET /VERSION [346]
MOVEI P3,0 ;MISSING--CLEAR SETTING [346]
CAILE P2,.RBVER ;SEE IF LOOKUP BLOCK LONG ENOUGH [346]
CAMN P3,[-1] ;YES--SEE IF SET BY USER [346]
SKIPA ;NO [346]
MOVEM P3,.RBVER(T3) ;YES--STORE IN CASE ENTER [346]
JRST .POPJ1## ;SKIP RETURN
> ;END TOPS-10
IF TOPS-20,<
.STOPB::HRROI T2,.FXFIL(T1) ;STRING POINTER
MOVX T1,GJ%OFG!GJ%FLG!GJ%SHT ;JUST PARSE FILE SPEC.
GTJFN ;GET A JFN
JRST .POPJ1## ;SAY NO WILD CARDS
TXNN T1,GJ%DEV!GJ%UNT!GJ%DIR!GJ%NAM!GJ%EXT!GJ%VER ;*S
AOS (P) ;NO--GIVE SKIP RETURN
RLJFN ;RETURN JFN
HALT . ;INVALID OR STILL OPEN
POPJ P,0 ;ALL DONE
>
PRGEND
TITLE .CNTDT -- GENERALIZED DATE/TIME SUBROUTINE
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INTIALIZE LISTINGS, ETC.
;ENTRY POINTS
ENTRY .CNTDT,.CNVDT,.GTNOW
;.CNTDT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL: MOVE T1,DATE/TIME
; PUSHJ P,.CNTDT
; RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0)
;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
;USES T1-4
.CNTDT::PUSH P,T1 ;SAVE TIME FOR LATER
JUMPL T1,CNTDT6 ;DEFEND AGAINST JUNK INPUT
HLRZ T1,T1 ;GET DATE PORTION (DAYS SINCE 1858)
RADIX 10 ;**** NOTE WELL ****
ADDI T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
;T1=DAYS SINCE JAN 1, 1501 [311]
IDIVI T1,400*365+400/4-400/100+400/400
;SPLIT INTO QUADRACENTURY [311]
LSH T2,2 ;CONVERT TO NUMBER OF QUARTER DAYS [311]
IDIVI T2,<100*365+100/4-100/100>*4+400/400
;SPLIT INTO CENTURY [311]
IORI T3,3 ;DISCARD FRACTIONS OF DAY [311]
IDIVI T3,4*365+1 ;SEPARATE INTO YEARS [311]
LSH T4,-2 ;T4=NO DAYS THIS YEAR [311]
LSH T1,2 ;T1=4*NO QUADRACENTURIES [311]
ADD T1,T2 ;T1=NO CENTURIES [311]
IMULI T1,100 ;T1=100*NO CENTURIES [311]
ADDI T1,1501(T3) ;T1 HAS YEAR, T4 HAS DAY IN YEAR [311]
MOVE T2,T1 ;COPY YEAR TO SEE IF LEAP YEAR
TRNE T2,3 ;IS THE YEAR A MULT OF 4? [311]
JRST CNTDT0 ;NO--JUST INDICATE NOT A LEAP YEAR [311]
IDIVI T2,100 ;SEE IF YEAR IS MULT OF 100 [311]
SKIPN T3 ;IF NOT, THEN LEAP [311]
TRNN T2,3 ;IS YEAR MULT OF 400? [311]
TDZA T3,T3 ;YES--LEAP YEAR AFTER ALL [311]
CNTDT0: MOVEI T3,1 ;SET LEAP YEAR FLAG [311]
;T3 IS 0 IF LEAP YEAR
;UNDER RADIX 10 **** NOTE WELL ****
CNTDT1: SUBI T1,1964 ;SET TO SYSTEM ORIGIN
IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS
JUMPN T3,CNTDT2 ;IF NOT LEAP YEAR, PROCEED
CAIGE T4,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29
JRST CNTDT5 ;NO--JUST INCLUDE IN ANSWER
SOS T4 ;YES--BACK OFF ONE DAY
CNTDT2: MOVSI T2,-11 ;LOOP FOR 11 MONTHS
CNTDT3: CAMGE T4,MONTAB+1(T2) ;SEE IF BEYOND THIS MONTH
JRST CNTDT4 ;YES--GO FINISH UP
ADDI T1,31 ;NO--COUNT SYSTEM MONTH
AOBJN T2,CNTDT3 ;LOOP THROUGH NOVEMBER
CNTDT4: SUB T4,MONTAB(T2) ;GET DAYS IN THIS MONTH
CNTDT5: ADD T1,T4 ;INCLUDE IN FINAL RESULT
CNTDT6: EXCH T1,(P) ;SAVE ANSWER, GET TIME
TLZ T1,-1 ;CLEAR DATE
MUL T1,[24*60*60*1000] ;CONVERT TO MILLI-SEC.
ASHC T1,17 ;POSITION RESULT
POP P,T2 ;RECOVER DATE
POPJ P, ;RETURN
;.GTNOW -- COMPUTE CURRENT TIME IN SPECIAL FORMAT
;CALL: PUSHJ P,.GTNOW
;RETURNS WITH RESULT IN T1
;USES T2, T3, T4
IF TOPS-^O10,<
.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
>
IF TOPS-^O20,<
.GTNOW::GTAD ;ASK MONITOR
POPJ P,0 ;ALWAYS TELLS US
>
;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
HRL T1,T4 ;INCLUDE DATE
GETNWX: POPJ P, ;RETURN
;UNDER RADIX 10 **** NOTE WELL ****
MONTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
RADIX 8
PRGEND
TITLE .GTPUT -- ROUTINES TO GET AND PUT IN A COUNTED LIST
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .GTWRD,.PTWRD,.MKMSK,.LKNAM,.ISLGI
;.LKNAM -- LOOKUP NAME IN TABLE ALLOWING FOR UNIQUE ABBREVIATIONS
;ALWAYS CHECK FOR EXACT MATCH FIRST.
;CALL: MOVE T1,[IOWD LENGTH,START OF TABLE]
; MOVE T2,NAME
; PUSHJ P,.LKNAM
; ERROR RETURN IF UNKNOWN OR DUPLICATE
; AND WITH T1.LT.0 IF NOT MATCH, .GT.0 IF SEVERAL MATCHES
; SKIP RETURN IF FOUND WITH T1 POINTING TO ENTRY
; AND WITH LH(T1)=0 IF ABBREVIATION, OR T1.LT.0 IF EXACT MATCH
;USES T3, T4
;PRESERVES T2
.LKNAM::JUMPGE T1,[SETOM T1 ;FLAG UNKNOWN
POPJ P,] ;ERROR RETURN
PUSHJ P,.SAVE2## ;SAVE P1, P2
PUSH P,T1 ;SAVE ARGUMENT
MOVE T3,T2 ;SET ARG TO MASK MAKER
PUSHJ P,.MKMSK ;MAKE MASK
MOVE T2,T3 ;RESTORE NAME
MOVE P1,T1 ;SAVE FOR MATCHING
POP P,T1 ;RECOVER ARGUMENT
SETOM P2 ;SET ABBREVIATION MATCH COUNTER
AOS T1 ;POSITION POINTER
NAME1: MOVE T3,(T1) ;FETCH TABLE ENTRY
TLNE T3,(3B1) ;NOTE THAT * IS 12 IN SIXBIT
JRST NAME2 ;NOT FORCED MATCH
LSH T3,6 ;SEE IF IT MATCHES
XOR T3,T2 ;EVEN IN AN ABBR.
TRZ T3,77 ;CLEAR LAST CHAR SINCE WE DON'T KNOW IT
AND T3,P1 ; ..
JUMPE T3,.POPJ1## ;YES--GIVE MATCH RETURN
JRST NAME3 ;NO--LOOP
NAME2: XOR T3,T2 ;SEE IF EXACT MATCH
JUMPE T3,.POPJ1## ;YES--A WINNER
AND T3,P1 ;SEE IF A SUITABLE ABBREVIATION
JUMPN T3,NAME3 ;NO--LOOP BACK FOR MORE
MOVE T4,T1 ;SALT AWAY THE LOCATION JUST IN CASE
AOS P2 ;YES--COUNT
NAME3: AOBJN T1,NAME1 ;ADVANCE--LOOP IF NOT DONE YET
HRRZ T1,T4 ;RESTORE LOCATION OF A WINNER
JUMPE P2,.POPJ1## ;DONE--JUMP IF ONE ABBREVIATION
MOVE T1,P2 ;GIVE FLAG TO CALLER
POPJ P, ;NONE OR TWO, SO FAIL
;.GTWRD -- SUBROUTINE TO GET NEXT WORD FROM USER'S PARAMETER LIST
;CALL: MOVE T1,ADDRESS OF TABLE
; MOVE T2,COUNTER OF LENGTH TO GO
; PUSHJ P,.GTWRD
;RETURNS WITH T1 INCREMENTED, T2 DECREMENTED, T3=CONTENTS OR 0
.GTWRD::SOJL T2,GETWRX ;DECREMENT COUNTER--CHECK OVERRUN
SKIPA T3,(T1) ;GET USER'S VALUE
GETWRX: MOVEI T3,0 ;GET 0 DUE TO OVERRUN
AOS T1 ;ADVANCE POINTER FOR NEXT TIME
POPJ P, ;RETURN
;.PTWRD -- STORE WORD IN USER PARAMETER AREA IF ROOM
;CALL: MOVE T1,LOCATION (WILL BE INCREMENTED BY ONE)
; MOVE T2,LENGTH TO GO (WILL BE DECREMENTED BY ONE)
; MOVE T3,DATA ITEM
; PUSHJ P,.PTWRD
;RETURNS WITH T1=T1+1, T2=T2-1, WORD STORED (OLD T1) IF OLD T2.GT.0
.PTWRD::SOSL T2 ;DECREMENT COUNT
MOVEM T3,(T1) ;STORE VALUE
AOS T1 ;ADVANCE LOCATION
POPJ P, ;RETURN
;.MKMSK -- MAKE MASK CORRESPONDING TO NON-BLANKS IN SIXBIT WORD
;CALL: MOVE T3,WORD
; PUSHJ P,.MKMSK
;RETURN WITH MASK IN T1
;USES T2
.MKMSK::MOVEI T1,0 ;CLEAR MASK
MOVSI T2,(77B5) ;START AT LEFT END
MAKMS1: TDNE T3,T2 ;SEE IF SPACE HERE
IOR T1,T2 ;NO--IMPROVE MASK
LSH T2,-6 ;MOVE RIGHT ONE CHAR
JUMPN T2,MAKMS1 ;LOOP UNTIL DONE
POPJ P, ;RETURN
;.ISLGI -- ROUTINE TO SEE IF JOB IS LOGGED IN
;CALL: PUSHJ P,.ISLGI
; RETURN +1 IF NOT (1/-1) OR UNKNOWN (1/1)
; RETURN +2 IF KNOWN LOGGED IN
IF TOPS-10,<
.ISLGI::PJOB T1, ;GET JOB NUMBER
MOVNS T1 ;COMPLEMENT
JOBSTS T1, ;GET OUT STATUS
JRST [MOVEI T1,1 ;DOESN'T WORK--INDICATE PROBLEM
POPJ P,] ;ERROR RETURN
TXNE T1,JB.ULI ;SEE IF LOGGED IN
AOSA (P) ;YES--GIVE SKIP RETURN
SETOM T1 ;NO--INDICATE NOT
POPJ P, ;RETURN
> ;END TOPS-10
IF TOPS-20,<
.ISLGI::MOVEI T1,1 ;SAY DO NOT KNOW
POPJ P,0 ;RETURN
>
PRGEND
TITLE .SAVE -- SUBROUTINES TO SAVE AND RESTORE P1-P4
SEARCH $SCNDC ;GET SCAN DECLARATIONS
$SCNDC ;INITIALIZE LISTING, ETC.
;ENTRY POINTS
ENTRY .SAVE1,.SAVE2,.SAVE3,.SAVE4
ENTRY .PSH4T,.POP4T
ENTRY .POPJ1,.POPJ
;.SAVE1 -- SUBROUTINE TO SAVE P1 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE1
;RETURN POPJ OR .POPJ1, RESTORES P1 AND EXITS AS SKIP OR NON-SKIP
.SAVE1::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
SOS -1(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
JRST RET1 ;RESTORE P1 AND EXIT
;.SAVE2 -- SUBROUTINE TO SAVE P1 AND P2 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE2
;RETURN POPJ OR .POPJ1, RESTORES P1 AND P2 AND EXITS AS SKIP OR NON-SKIP
.SAVE2::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSH P,P2 ;SAVE P2
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
SOS -2(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
JRST RET2 ;RESTORE P1 AND P2 AND EXIT
;.SAVE3 -- SUBROUTINE TO SAVE P1 AND P2 AND P3 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE3
;RETURN POPJ OR .POPJ1, RESTORES P1-3 AND SKIPS OR NOT
.SAVE3::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
SOS -3(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
JRST RET3 ;RESTORE P1-3 AND EXIT
;.SAVE4 -- SUBROUTINE TO SAVE P1-4 FOR A SUBROUTINE
;CALL: PUSHJ P,.SAVE4
;RETURN POPJ OR .POPJ1, RESTORES P1-4 AND SKIPS OR NOT
.SAVE4::EXCH P1,(P) ;SAVE P1, GET CALLER PC
HRLI P1,(P) ;GET ADDRESS WHERE P1 IS SAVED [307,521]
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSH P,P4 ;SAVE P4
PUSHJ P,SAVJMP ;STACK NEW RETURN PC AND JUMP [521]
.SAVX4:: SOS -4(P) ;NON-SKIP RETURN, COMPENSATE .POPJ1 [521]
RET4: POP P,P4 ;RESTORE P4
RET3: POP P,P3 ;RESTORE P3
RET2: POP P,P2 ;RESTORE P2
RET1: POP P,P1 ;RESTORE P1
.POPJ1::AOS (P) ;INCREMENT PC [521]
.POPJ:: POPJ P, ;RETURN
;THE FOLLOWING INSTRUCTION RETSTORES P1 AND DISPATCHES TO THE CALLER.
SAVJMP: JRA P1,(P1) ;RETURN TO CALLER [521]
;.PSH4T -- PUSH T1-T4 ONTO STACK
;.POP4T -- POP T1-T4 FROM STACK
;CALL: PUSHJ P,.PSH4T/.POP4T
;USES NO ACS
.PSH4T::PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
EXCH T1,-3(P) ;SAVE T1/GET RETURN
PUSH P,T1 ;PUT INTO SAFE PLACE
MOVE T1,-4(P) ;RESTORE T1
POPJ P, ;RETURN
.POP4T::POP P,T1 ;GET RETURN
POP P,T4 ;RESTORE T4
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
EXCH T1,(P) ;RESTORE T1/SAVE RETURN
POPJ P, ;RETURN
END