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