SUBTTL Text Editor and COrrector RC CLEMENTS/PMH/CAM/JMP/GSB/RCM/CBD/JCS/Nothead SUBTTL Introduction ;Version number TECVER==124 TECMIN==1 TECEDT==355 TECWHO==2 SEARCH JOBDAT,MACTEN,UUOSYM ;UNIVERSAL FILES .DIRECTIVE .XTABM ;TENEX STYLE MACRO'S TWOSEG 400K ;TWO SEGMENTS SALL SHOW. %%JOBD ;JOBDAT VERSION NUMBER SHOW. %%MACT ;MACTEN VERSION NUMBER SHOW. %%UUOS ;UUOSYM'S VERSION NUMBER ;COPYRIGHT 1970,1971,1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ;COPYRIGHT 1975 SNEVETS CORP.,BOHOKEN, J.N. ;COPYRIGHT 1976 ARMADILLO U., AUSTINTATIOUS, USA ;Copyright 1978 Privateer U, Bourbon Strut, Nude Oleander, Lousyanna IFN 0 < THE FOLLOWING SYMBOL IS USED BY THE 'EE' COMMAND CONTINUE ROUTINE TO DECIDE WHETHER THE VERSION OF TECO.SHR THAT IT GOTSEG WILL WORK PROPERLY WITH THE LOW FILE THAT GOTSEG IT. IT MUST BE INCREMENTED EVERY TIME THE LOW SEGMENT OF TECO IS ALTERED > XP %TECOV, 26 LOC .JBVER VRSN. TEC ;VERSION NUMBER LOC .JBREN EXP REE ;REENTRY ADDRESS RELOC 400K SUBTTL Table of Contents ; Table of Contents for TECO ; ; ; Section Page ; ; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1 ; 2. Table of Contents . . . . . . . . . . . . . . . . . . 2 ; 3. REVISION HISTORY . . . . . . . . . . . . . . . . . . . 3 ; 4. MACRO DEFINITIONS ; 4.1 .CLNAM . . . . . . . . . . . . . . . . . . . . 4 ; 4.2 CHKEO, ERROR . . . . . . . . . . . . . . . . . 5 ; 5. DEFAULT ASSEMBLY PARAMETERS . . . . . . . . . . . . . 6 ; 6. ACCUMULATOR ASSIGNMENTS . . . . . . . . . . . . . . . 7 ; 7. CONTROL FLAGS ; 7.1 AC FF . . . . . . . . . . . . . . . . . . . . 8 ; 7.2 AC F2 . . . . . . . . . . . . . . . . . . . . 9 ; 8. I-O CHANNELS . . . . . . . . . . . . . . . . . . . . . 10 ; 9. MISC PARAMETERS . . . . . . . . . . . . . . . . . . . 11 ; 10. PSEUDO RUN UUO IF NEEDED . . . . . . . . . . . . . . . 12 ; 11. STARTUP TIME INITIALIZATION . . . . . . . . . . . . . 13 ; 12. TEXT BUFFER INITIALIZATION . . . . . . . . . . . . . . 15 ; 13. REENTER COMMAND . . . . . . . . . . . . . . . . . . . 16 ; 14. INITIALIZATION OF JOB DEPENDENT PARAMETERS . . . . . . 17 ; 15. CCL Command processor . . . . . . . . . . . . . . . . 18 ; 16. RETURN NON-NULL TTY CHARACTER IN CH. . . . . . . . . . 22 ; 17. TYPE A CHARACTER. . . . . . . . . . . . . . . . . . . 24 ; 18. MESSAGE TYPE-OUT & NUMBER TYPE-OUT . . . . . . . . . . 27 ; 19. RETURN NEXT COMMAND CHAR AT CURRENT LEVEL . . . . . . 29 ; 20. SCAN COMMAND STRING FOR CHARACTER IN TT . . . . . . . 30 ; 21. SKAN ROUTINE DISPATCH TABLES . . . . . . . . . . . . . 33 ; 22. ACCEPT COMMAND STRING ROUTINE . . . . . . . . . . . . 35 ; 23. EXPAND THE COMMAND BUFFER . . . . . . . . . . . . . . 37 ; 24. PROCESS SPECIAL COMMAND EDITING CHARACTERS . . . . . . 39 ; 25. BACK UP BYTE POINTER IN AA, LOAD APPROPRIATE CHARACT . 41 ; 26. SPECIAL "IMMEDIATE" COMMAND PROCESSOR . . . . . . . . 42 ; 27. RUBOUT PROCESSOR . . . . . . . . . . . . . . . . . . . 44 ; 28. VIDEO RUBOUT PROCESSOR . . . . . . . . . . . . . . . . 46 ; 29. COMMAND DECODER . . . . . . . . . . . . . . . . . . . 50 ; 30. NUMERIC INPUT, VALRET, & ALTMODE PROCESSOR . . . . . . 51 ; 31. COMMA & PARENTHESES PROCESSOR . . . . . . . . . . . . 52 ; 32. MATHEMATICAL & LOGICAL OPERATORS . . . . . . . . . . . 53 ; 33. FLAGS - EOF, FORM FEED & . H Z POSITIONS . . . . . . . 54 ; 34. = & ^T COMMANDS . . . . . . . . . . . . . . . . . . . 55 ; 35. ^H, ^F AND ^^ COMMANDS . . . . . . . . . . . . . . . . 56 ; 36. EXTENDED ^T OPERATIONS . . . . . . . . . . . . . . . . 57 ; 37. BACKSLASH PROCESSOR . . . . . . . . . . . . . . . . . 58 ; 38. nA COMMAND . . . . . . . . . . . . . . . . . . . . . . 59 ; 39. Q-REGISTER COMMANDS ; 39.1 U & Q . . . . . . . . . . . . . . . . . . . . 60 ; 39.2 % . . . . . . . . . . . . . . . . . . . . . . 62 ; 39.3 X . . . . . . . . . . . . . . . . . . . . . . 63 ; 39.4 G . . . . . . . . . . . . . . . . . . . . . . 65 ; 39.5 M, W, [ & ] . . . . . . . . . . . . . . . . . 66 ; 40. MISCELLANEOUS CHARACTER DISPATCHER . . . . . . . . . . 67 ; 41. ^G COMMAND (GETTAB OR EXIT) . . . . . . . . . . . . . 68 ; 42. E COMMANDS ; 42.1 DISPATCH ROUTINE & TABLE . . . . . . . . . . . 69 ; 42.2 EL (SETUP AND OUTPUT ROUTINES) . . . . . . . . 70 ; 42.3 EE (SAVE TECO'S STATE) . . . . . . . . . . . . 72 ; 42.4 NEL & EE (LOW CORE) . . . . . . . . . . . . . 74 ; 42.5 EE (RESTART CODE) . . . . . . . . . . . . . . 75 ; 42.6 EI & EP (EDIT INSERT & EDIT PUT) . . . . . . . 76 ; 42.7 EX & EXIT ROUTINES . . . . . . . . . . . . . . 80 ; 42.8 ED (RUN UUO ON EXIT) . . . . . . . . . . . . . 82 ; 42.9 ET, EO & EU . . . . . . . . . . . . . . . . . 83 ; 42.10 ES . . . . . . . . . . . . . . . . . . . . . . 84 ; 42.11 EH (CHANGE ERROR MESSAGE LEVEL) . . . . . . . 85 ; 42.12 EV (SET TERMINAL CHARACTERISTICS) . . . . . . 86 ; 42.13 TERMINAL CHARACTERISTICS TABLES . . . . . . . 88 ; 42.14 EK (KILL) AND EN (RENAME) . . . . . . . . . . 90 ; 42.15 ER (PREPARE TO READ A FILE) . . . . . . . . . 91 ; 42.16 FILE SPEC SETUP . . . . . . . . . . . . . . . 93 ; 42.17 EB (EDIT BACKUP PROCESSOR) . . . . . . . . . . 94 ; 42.18 I/O ERROR ROUTINES . . . . . . . . . . . . . . 97 ; 42.19 EW (EDIT WRITE) . . . . . . . . . . . . . . . 98 ; 42.20 EZ & EF . . . . . . . . . . . . . . . . . . . 102 ; 42.21 EM (MTAPE UUO'S) . . . . . . . . . . . . . . . 103 ; 42.22 EB (FINISH UP COMMAND) . . . . . . . . . . . . 104 ; 42.23 EW (SUBROUTINES FOR EW) . . . . . . . . . . . 107 ; 42.24 MISC. ROUTINES . . . . . . . . . . . . . . . . 108 ; 43. ^V, ^W, ^X COMMANDS . . . . . . . . . . . . . . . . . 110 ; 44. ROUTINE TO PARSE FILE DESIGNATOR . . . . . . . . . . . 111 ; 45. TABLES FOR FILSPEC PARSER . . . . . . . . . . . . . . 115 ; 46. Y . . . . . . . . . . . . . . . . . . . . . . . . . . 118 ; 47. ^Y ! ^P - QUICK PAGE SCAN COMMANDS . . . . . . . . . . 120 ; 48. READ A CHARACTER FROM INPUT FILE . . . . . . . . . . . 121 ; 49. INSERT COMMAND . . . . . . . . . . . . . . . . . . . . 122 ; 50. ALPHA CASE CONVERTED . . . . . . . . . . . . . . . . . 126 ; 51. CHECK FOR NON-CONTROL CHARACTERS . . . . . . . . . . . 127 ; 52. NI . . . . . . . . . . . . . . . . . . . . . . . . . . 128 ; 53. T COMMAND . . . . . . . . . . . . . . . . . . . . . . 129 ; 54. V COMMAND . . . . . . . . . . . . . . . . . . . . . . 130 ; 55. PUT A CHARACTER IN THE OUTPUT FILE . . . . . . . . . . 131 ; 56. PW . . . . . . . . . . . . . . . . . . . . . . . . . . 135 ; 57. NJ, NC, & NL COMMANDS . . . . . . . . . . . . . . . . 137 ; 58. ROUTINE TO RETURN CURRENT ARGUMENT IN B . . . . . . . 138 ; 59. ND . . . . . . . . . . . . . . . . . . . . . . . . . . 139 ; 60. Searches ; 60.1 Commands . . . . . . . . . . . . . . . . . . . 140 ; 60.2 pattern source setup . . . . . . . . . . . . . 141 ; 60.3 set up search matrix . . . . . . . . . . . . . 143 ; 60.4 New fast search routine . . . . . . . . . . . 158 ; 60.5 Old slow but sure routine . . . . . . . . . . 161 ; 60.6 pattern found . . . . . . . . . . . . . . . . 163 ; 60.7 Autotype after succesful searches . . . . . . 164 ; 60.8 Pattern not found in this buffer . . . . . . . 165 ; 61. <> . . . . . . . . . . . . . . . . . . . . . . . . . . 167 ; 62. OTAG$ . . . . . . . . . . . . . . . . . . . . . . . . 169 ; 63. " ' PROCESSING . . . . . . . . . . . . . . . . . . . . 171 ; 64. EXECUTE INDIVIDUAL " COMMANDS . . . . . . . . . . . . 172 ; 65. ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z . . . . . 173 ; 66. ERROR MESSAGE PRINTOUT . . . . . . . . . . . . . . . . 174 ; 67. ROUTINE TO TYPE C(TT) IN SIXBIT . . . . . . . . . . . 179 ; 68. ERROR PROCESSING ROUTINES . . . . . . . . . . . . . . 180 ; 69. DISPATCH TABLE FOR SPECIAL INFORMATION TYPEOUT . . . . 181 ; 70. SPECIAL INFORMATION TYPEOUT ROUTINES . . . . . . . . . 182 ; 71. UUO HANDLER . . . . . . . . . . . . . . . . . . . . . 184 ; 72. COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND . . 185 ; 73. ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS. . 186 ; 74. ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT O . 187 ; 75. ROUTINES TO MOVE CHARACTERS AROUND . . . . . . . . . . 188 ; 76. GARBAGE COLLECTOR . . . . . . . . . . . . . . . . . . 191 ; 77. AUTOMATIC MEMORY EXPANSION . . . . . . . . . . . . . . 195 ; 78. COMMAND DISPATCH TABLE . . . . . . . . . . . . . . . . 197 ; 79. LOW SEGMENT . . . . . . . . . . . . . . . . . . . . . 198 SUBTTL REVISION HISTORY COMMENT { START OF VERSION 123A 205 FIX LOOPING EEE. 206 FIX FILE SPEC SCANNER WHEN TRACE MODE USED. 207 CHANGE CORE ERROR MESSAGE. 210 ADD ^G WITH NO ARGUMENT TO RETURN MY JOB NUMBER. 211 FIX :EP SO IT WORKS. 212 IMPLEMENT ^Y. 213 SO PEOPLE WITHOUT TECO.INI CAN ^G^G *I$$ FIRST COMMAND. 214 EI-EP SEES DEVICE. 215 NO TYPEOUT AFTER ^C^C REE. 216 EP[P,PN] INTERFERED WITH EB. 217 REMOVE FEATURE TO APPEND LOOKUP/ENTER/RENAME ERROR CODE TO PDL OV'S. 220 FIX RANDOM CORE MESSAGES FROM INI FILES. 221 INTERFACE TO JOBDAT.UNV AND CORRECT MISC BUGS. A) FIX 'MAKE' OR 'TECO' FILE.'.' WORK CORRECTLY B) SUPPORT SOS PAGE MARKS C) SET TTY NO ALT COMPATIBLITY D) DELAY IN CLEARING EB AND OUTPUT FLAGS ON EX COMMAND IN CASE ERROR OCCURS IN PROCESSING 222 SEARCH MACTEN AS WELL AS JOBDAT 223 INTERFACE WITH MACTEN MORE COMPLETELY. CLEAN UP THE SUBTTLS AND CHANGE NUMERICS TO BE THE INSTRUCTIONS 224 FIX ENTER ERROR 17'S FOR PEEPLE WHO HAVE FANCY DISK ALLOCATION ON IN THE MONITOR. 225 FIX PROBLEM WITH U MACRO. ADD TED: AS THE DEFAULT DEVICE ON AN EI OR EP COMMAND. 226 MAKE EP DEFAULT TO DSK: INSTEAD OF TED: 227 MAKE ERROR MESSAGE FINDER FASTER 230 FIX ^Y WITH NO ARG TO NOT THROW AWAY CURRENT PAGE 231 ADD USETI ON ER'D FILE FOR CONVENIENCE. 232 FIX EA TO WORK IF FILE NO EXIST, MAKE TE FILE[NOT ME] TO WRITE FILE ON [DEFAULT] 233 PREVENT S^ES$ FROM ALLOWING "." TO ESCAPE THE TEXT BUFFER. 234 FIX :SEARCH IN AN ITERATION TO NOT LEAVE GARBAGE AROUND. 235 FIX PROBLEMS WITH TECENT-20 ERRORS. EXTENDED ENTER USED THE SAME AREA AS DID THE SEARCH MATRIX. THEREFORE TO SOLVE THE PROBLEM MAKE THAT AND THE DSKCHR BLOCK SEPERATE AREAS. ***START OF U. TX. REVISIONS**** (236-249 NOT USED;PATCHES ONLY, SEE TEC124.DIF FOR NEW FEATURES) 250 INSTALLED DEBUG SWITCH TO SAVE SYMBOL TABLE AND READ TECO.ERR FROM [-] RATHER THAN SYS:. (= DEC #140) 251 PATCH FOR LARGE Q-REG STACK (SPR # 13756) 252 DO AN INITIAL CORE UUO IF .JBFF > .JBREL-202 TO PREVENT ILL MEM REF'S. 253 MAKE ^G IGNORE ET SETTING AND ALWAYS USE ARROW MODE 254 FIX ^ BUG (SPR # 18802) 255 FIX ILL Q-REG NAME (DEC EDIT # 170) 256 MAKE BYTE PTR. BACKUP MORE EFFICIENT 257 DONT LET EXTRA BLANKS IN AN ARITHMETIC EXPRESSION CAUSE TROUBLE (DEC EDIT # 167) 260 MAKE SURE M,NP FLAGS BIT 35 OF FIRST SEQ. NUMBER. REMOVE DEC #122 WHICH ONLY DID IT FOR HP. 261 MORE SEQ# FIXING: /SUPLSN NEEDS TO USE SLOW PUNCH ROUTINE FILES PROCESSED BY SOS NO LONGER MESSED UP. INSTALL EQUIVALENTS OF DEC #'S 115, 141, 150. 262 STILL MORE SEQ# FIXING: DON'T ALLOW NULL CHARACTERS IN FILE (INTENDED FOR STARTING SEQ #'S ON WORD BOUNDARIES) IF /SUPLSN IS SET. 263 ZERO DOUBLE ARG FLAG IN SEARCHES SO THAT SUBSEQUENT COMMANDS DON'T GET CONFUSED. 264 FIX :FS...$$ SO IT RECOGNIZES DOUBLE ALTMODE. (SPR # 18199) 265 FIX GARBAGE COLLECTION BUG (DEC EDIT # 161) 266 FIX ?ILL COMMAND ^ (SPR # 18607) NOTE: ALL DEC EDITS THROUGH 171 OR THEIR EQUIVALENTS ARE IN. START OF VERSION 124 267 FIX ADDRESS CHECK ON LOOKUP OF TMP FILE WHEN TMPCOR FAILS. 270 MAKE UUO ERROR MSG TYPE ENTIRE INSTRUCTION (SPR#19879) 271 FIX GARBAGE COLLECTION FROM EC AND EP. Q-REGISTER STACK WASN'T GETTING COLLECTED SINCE AC 17 CLOBBERED. 272 FIX ILL. UUO MSG AFTER .REENTER WHILE AC'S HAVE FAST CODE TO MOVE CHARACTERS. FIX MINOR BUGS IN FILESPEC SCANNER AND /R. 273 MAKE EXTENDED CCL COMMAND STRING WORK WITH .TMP FILES 274 FIX ILL. UUO. BUG RIGHT THIS TIME...(EDIT 272 GOOFED). 275 FIX BAD ARG PROCESSING TO MAKE THINGS LIKE -1^F= AND :5-1^T== AND -1A== WORK PROPERLY. FINALLY GET EI ARG PROCESSING TO WORK PROPERLY. M,NEIFILE$ WORKS, AS WELL AS MEIFILE$ AS WELL AS M,EIFILE$ (WHERE FILE HAS THE SECOND ARG ALREADY). 276 FIX BUG IN ERROR MSG FILE ACCESS. MAKE ^G WITH ONLY ONE ARG DO A PEEK INSTEAD OF A GETTAB. 277 SAVE A WORD WASTED BY EDIT 261. INSTALL DEC EDIT 172 (PROPER BOUNDS CHECKING). INSTALL EQUIVALENT OF DEC EDIT # 174. 300 FIX FAILURE WHEN RENAMING THE .TMP FILE (EB) IN AN AREA NOT YOUR OWN. *** BACK TO STEVENS/RAPIDATA AGAIN 277A FIX BUG IN REENTER (P MAY NOT CONTAIN A PDL) 300A FIX ARGS FOR TRMOP. TO GET TTY WIDTH 301 CHANGE E SELECTION ALGORITHM 302 CHANGE .RB??? DEFINITIONS SO THAT THEY USE UUOSYM. 303 Removed. 304 CHANGE THE FLAG NAMES AND THE DEFINITIONS. NOW USE THE TX?? MACROS FROM MACTEN FOR THE FLAGS. FF FLAGS ==> F.???? F2 FLAGS ==> S.???? 305 BISSW was added to allow TECO to make limited use of the Business Instruction Set. The code will not be removed, but it will also not be used. It turns out to be considerably slower than TECO's old mechanism and move string backwards. is not possible. 306 Change the error code for Undefined Terminal Type 307 See edit 277. 310 Add /INPLACE so that EB will ER EW to same place. 311 Finish fixing the flags (Edit 304). 312 Remove the PDP6 feature test. ***BACK TO TEXAS... 313 Increase efficiency of FS when both strings are the same length by skipping character-moving code. 314 Work on CRT stuff some more. Make treatment of no wrap-around better. Add ^N20 to error routines to type list of valid CRT types. 315 Modify EW defaulting so that it won't use the ER device if it is an ersatz. (For the same reason that it won't use ER's PPN.) Equivalents of DEC EDITS up to 174 are in. Also 176. 316 Fix SKAN routine so that the character after a PW is not ignored and so that @FD/.../ gets scanned properly. 317 Fix /SUPLSN. Slow punch routine will be used on a sequenced file IF /SUPLSN not set for INPUT file. Minor bugs in default PPN handler, initalization, and edit 313. 320 Fix EA so that privileged programs don't bomb if the LOOKUP fails. (Monitor thinks USETI is a super.) Fix bug in *i command: X3 routine should not add the garbage collection constant in this case. Add ADDS 580 terminal by popular demand. Fix a very rare ill mem ref bug: if MEMSIZ falls exactly on a 1K boundary, and Z is allowed to equal MEMSIZ, then the routine at NROOM6 fails, since it must reference (Z/5)+1. So make sure Z always stays less than MEMSIZ. 321 Fix X command to allow buffer length of greater than 2**18 characters; i.e. do not use immediate instructions to perform necessary arithmetic. ***The following adapted from Storage Technology Corp.'s revisions. 322 Fix double OCT error if first character of new command is 8 or 9. 323 Add "\\" command which reads/writes same as "\" but in octal. 324 Add VT50 terminal. 325 Add three immediate commands which work if they are the first things typed: = 1LT, <^H> = -1LT, and, in the spirit of DDT, <;> = 0LT. Fix several bugs in log file processing: ^G's were getting inserted twice; * commands weren't being inserted at all; first character in log file (usually *) missing if previous command was ^G^G'ed. 326 Change INIT to OPEN in TTOPEN and CCLTMP. Fix an obscure search bug which makes S^ES$ blow up if the character after the end of the buffer HAPPENS to be a blank or tab. 327 Fix serious problem arising when ^P and ^Y are used on sequenced files. n^P usually threw away page n-1; ^Y went into an infinite loop. 330 Fix bug in \\. 331 Fix Ill Mem Ref in ";" immediate command. Add H1500, ADM3A, ACT-IV, ACT-V and HP2640 terminals. Improve handling of ; and ^H commands. Modify ET command: 2ET means image typeout. Clear digit string bit to prevent 2.5 or 3Z4 from returning wierd values. 332 Improve U command. m,nUi will now store the value n into Q-reg i, and return m. This allows m,nUiUj to store two values, such as those passed to a macro. Improve [ command. n[i now behaves like [inUi, allowing the Q-reg to be saved before a value is stored. m,n[i[j will work as described above. Issue error msg if attempt to store a number smaller than -377777,,0 octal. 333 Support File Daemon, improve protection logic for EB's. .BAK files will always be given a protection of 0xx or 4xx. 334 Replace complete searching algorithm. (U. of New Orleans) 335 Change EO level to 3, and restore several of the obolete DEC features for EO < 3, such as position of pointer after searches, etc. (NSA) 336 Don't shrink too much after an EI file is processed, so that the purpose of "R TECO 50K" isn't defeated by the initial EITECO.INI. 337 Change EI-EP file defaulting. If no device or directory is specified, first look on [-], then on [,,TEC]/SCAN, and finally on TED:. Add /DEFAULT I/O switch to clear sticky defaults. Read TECO.ERR from the device and PPN that TECO was run from; if that fails, try SYS:. Other minor changes to error message processing. Change /READ to /READONLY. 340 Add warning message for ER and EB when file is found in directory other than the one specified (LIB: or /SCAN). Fix /INPLACE so it will really overwrite the file in these cases. Fix EN so file stays in the same directory unless a new directory is explicitly given. 341 Fix Ill mem ref in ^N processing for new search. 342 Fix backwards bounded searches which occur after the pointer. For example, HK IA12345$ J 6,0S123$$ shouldn't fail. Fix core problem preventing REENTER after ^Z. 343 Modify CCL command handler to support MAKE A=B command. Change our pseudo altmode character from % to $ (dollar sign). Make EWfile/APPEND$ equivalent to EAfile$. Make EBfile/READONLY$ equivalent to ERfile$. 344 Fix several bugs in slow search algorithm. Due to overwhelming popular demand, finally remove DEC's "feature" which treats all searches inside iterations as colon searches. Such searches will never issue an error message, but if EO > 2, they will now return no value. Semi-colons will still work correctly, since a ; with no arg looks at what happened in the last search. Searches using a previous string will now remember the exact match setting. 345 Fix LSN routines to properly handle page marks. (DEC edit 217). 346 Implement generalized nA command, which returns the ASCII value of the nth character to the right of the pointer. 0A returns the character to the left, and -nA returns the n+1st character to the left of the pointer. If .+n-1 is out of bounds, a 0 is returned. An m,nA command will cause m to be returned if the character is out of bounds. Implement :nA command to append n lines to the buffer. 347 Implement the nV command equivalent to n-1TnT. *** Start of Version 124A *** NOTE: All applicable DEC edits through 226 have been installed. 350 Make sure there is room for at least 5000 characters when TECO starts up. 351 Don't issue "Superseding existing file" message if /INPLACE. Fix V command for negative numbers. 352 Fix Ill mem ref in CCL command processor when TMP file doesn't end with or "}". 353 Fix problem with EB close routine so that it doesn't get fooled by old .BAK and .TMP files not in the default path. 354 Fix Ill. Mem. Ref. after TECO runs out of core. 355 Fix another Ill. Mem. Ref in EP command. Make EP a little faster. { SUBTTL MACRO DEFINITIONS -- .CLNAM COMMENT \ MACRO TO GENERATE TEXT CONTAINING CORRECT VERSION INFORMATION DEFINE THE MACRO .NAME TO BE WHAT YOU WANT, FOR EXAMPLE: DEFINE .NAME(V,M,E,W)< TITLE PROGRAM %'V'M'('E')'W > THEN CALL THE .CLNAM MACRO: .CLNAM FOO WHERE THERE ARE SYMBOLS DEFINED AS THE VERSION, MINOR VERSION (1=A, 2=B, ETC), EDIT, AND "WHO" VALUE. IT WILL GENERATE EXACTLY WHAT'S IN THE .NAME DEFINITION, WITH THE DUMMY ARGS SUBSTITUTED APPROPRIATELY (INCLUDING THE MINOR VERSION). THE SYMBOLS "FOOVER", "FOOMIN", "FOOEDT", AND "FOOWHO" ARE USED SIMILAR TO THE WAY THE VRSN. MACRO WORKS. \ DEFINE .CLNAM(FOO)< DEFINE .CLNM(LETTER,WHO)< IRPC LETTER,< IFE "A"-"'LETTER'"+FOO'MIN-1,< STOPI IFIDN <@>,< IFE FOO'WHO< .NAME(\FOO'VER,,\FOO'EDT,)> IFN FOO'WHO< .NAME(\FOO'VER,,\FOO'EDT,-WHO)>> IFDIF <@>,< IFE FOO'WHO< .NAME(\FOO'VER,LETTER,\FOO'EDT,)> IFN FOO'WHO< .NAME(\FOO'VER,LETTER,\FOO'EDT,-WHO)>>>>> IFG FOO'MIN-^D26,< FOO'MIN==0 PRINTX %MINOR VERSION TOO LARGE - IGNORED> IFG FOO'WHO-7,< FOO'WHO==0 PRINTX %WHO VERSION TOO LARGE - IGNORED> .CLNM(@ABCDEFGHIJKLMNOPQRSTUVWXYZ,\FOO'WHO) > DEFINE .NAME(V,M,E,W),< TITLE TECO %'V'M(E)'W TEXT EDITOR AND CORRECTOR > .CLNAM TEC SUBTTL MACRO DEFINITIONS -- CHKEO, ERROR ;CHECK EO FLAG: CHKEO EO#,ADDR ;IF EOFLAG > EO#, RETURN AT CALL+1 ;OTHERWISE GO TO ADDR DEFINE CHKEO(E,A) <1B22+B30,,A> ;TYPE ERROR MSG: ERROR E.XXX ;TYPE MESSAGE CORRESPONDING TO 'XXX' ;THEN GO TO GO ;THE FOLLOWING IS THE DEFINITION OF THE REGULAR ERROR UUO DEFINE ERROR(X) <1B8+'X' 'X'=<''X''>&777777> ;THE FOLLOWING IS THE DEFINITION OF THE COLONABLE ERROR MESSAGES ;THIS IS USED FOR THE NEW ERROR HANDLING WITH COLON CONTRUCTION ;IF AN ERROR OCCURS AND THE ..ERROR UUO IS EXECUTED, THE COLON FLAG ;IS CHECKED TO SEE WHETHER YOU SHOULD RETURN A VALUE OF 0 OR PROCEED ;AND TYPE OUT THE ERROR MESSAGE DEFINE ..ERROR(X) <1B8+10B12+'X' 'X'=<''X''>&777777> OPDEF TYPR1 [2B8] SUBTTL DEFAULT ASSEMBLY PARAMETERS NDS. CCL, 1 ;CCL CAPABILITY NDS. TEMP, 1 ;TMPCOR UUO CAPABILITY NDS. RUBSW, 0 ;DON'T MIMIC MONITOR NDS. NORUNS, 0 ;RUN UUO CAPABILITY NDS. AUTOFS, 0 ;DEFAULT IS NON-AUTOTYPE AFTER SEARCHES NDS. TYCASW, 0 ;DEFAULT TYPE-OUT MODE CAUSES FLAGGING OF ;CHARACTERS IN THE LOWER CASE RANGE WITH ' NDS. SRCHSW, 0 ;DEFAULT PREVAILING SEARCH MODE IS ACCEPT ;EITHER LC OR UC ALPHABETICS AS A MATCH NDS. BUFSIZ, ^D128 ;128 WORD I/O BUFFERS NDS. LPDL, 120 ;80 WORD PDL NDS. LPF, 40 ;32 WORD Q-REGISTER PDL NDS. VC, 0 ;OLD V COMMAND NOT IMPLEMENTED, ;[347] USE NEW V COMMAND INSTEAD NDS. EOVAL, 3 ;[335] THE STANDARD SETTING OF THE EO FLAG FOR ;THIS VERSION IS 3 NDS. BUGSW, 0 ;STANDARD IS DON'T SAVE SYMBOLS NDS. CRT, 1 ;CRT RUBOUT HANDLING CAPABILITY NDS. BISSW, 0 ;SUPPORT BIS (SLOW...) ;FOR ANY OTHER VERSION ASSEMBLE AS FOLLOWS: ;.R MACRO ;*TECO_TTY:,DSK:TECO.MAC ;CCL=0 (IF CCL NOT WANTED) ;TEMP=0 (IF TMPCOR UUO NOT WANTED) ;ERRMSG=1 (IF SHORT ERROR MESSAGES WANTED OR ; =3 IF EXTRA LONG ERROR MESSAGES WANTED) ;NORUNS=1 (IF RUN UUO SIMULATION WANTED) ;AUTOFS=-1 (IF DEFAULT = AUTOTYPE AFTER SEARCHES WANTED) ;TYCASW=1 (IF TYPE-OUT CASE FLAGGING DEFAULT VALUE ; TO FLAG UPPER CASE INSTEAD OF LOWER CASE ; CHARS. WANTED) ;TYCASW=-1 (IF TYPE-OUT CASE FLAGGING DEFAULT VALUE ; FOR NO FLAGGING WANTED) ;SRCHSW=1 (IF EXACT MODE WANTED AS THE DEFAULT VALUE ; OF THE PREVAILING SEARCH MODE) ;BUFSIZ=^D256 (IF 256-WORD I/O BUFFERS WANTED. ANY ; OTHER CONSTANT BESIDES 256 MAY BE USED. ; TECO USES STANDARD MONITOR BUFFERING, ; BUT IF THE MONITOR PROVIDES BUFFERS ; LARGER THAN 128 WORDS, BUFSIZ MUST BE ; CHANGED SO THAT SUFFICIENT SPACE IS ; RESERVED. ;LPDL=N (WHERE N 120, IF LARGER PDL WANTED) ;LPF=N (WHERE N 40, IF LARGER Q-REGISTER PDL WANTED) ;EOVAL=N (WHERE 0 F.NNUL==1B14 ;NON-NULL INSERT STRING (MIGHT BE ONLY ^V, SAY) F.NEG== 1B13 ;MINUS SIGN SEEN AS AN OPERATOR F.XXXX==1B12 ;[343] **** FREE **** F.EOFI==1B11 ;INPUT CLOSED BY EOF F.IOPN==1B10 ;INPUT FILE IS OPEN F.OOPN==1B09 ;OUTPUT FILE IS OPEN F.EBTP==1B08 ;EB FUNCTION TEMPORARY FLAG F.FILE==1B07 ;AT LEAST ONE ELEMENT OF FILE SPEC GIVEN F.PROT==1B06 ;FILE PROTECTION WAS SPECIFIED F.INIT==1B05 ;INIT FILE READING F.UBAK==1B04 ;EB IN EFFECT F.TALK==1B03 ;MESSAGE TYPE OUT IN GRABAK? F.TYOF==1B02 ;NEED TO OUTPUT A BUFFER F.TCTL==1B01 ;ALLOW CONTROL CHARS TYPED WITHOUT "^" F.CCL== 1B00 ;TECO COMMAND REQUESTS Y AFTER EB SUBTTL CONTROL FLAGS -- AC F2 ;RIGHT HALF - AC F2 S.CTLV==1B35 ;^V SEEN INSIDE TEXT S.CTVV==1B34 ;DOUBLE ^V SEEN INSIDE TEXT S.CTLW==1B33 ;^W SEEN INSIDE TEXT S.CTWW==1B32 ;DOUBLE ^W SEEN INSIDE TEXT S.XMAT==1B31 ;EXACT MATCH SEARCH MODE S.EMAT==1B30 ;TEMPORARILY ACCEPT EITHER UPPER OR LOWER CASE S.LCTT==1B29 ;TTY LINE HAS LC BIT ON S.NCFL==1B28 ;TYPE MESSAGE WITH NO CASE FLAGGING S.OCTL==1B27 ;OCTAL RADIX S.CTLR==1B26 ;^R SEEN AT INPUT TIME S.SKMR==1B25 ;WATCH FOR ^R WHEN SKIMMING S.SKMQ==1B24 ;WATCH FOR ^Q WHEN SKIMMING S.NTRC==1B23 ;DISABLE TRACING S.TXTC==1B22 ;TYPE , ETC INSTEAD OF PRINTER CONTROLS S.SFSN==1B21 ;SKANNING FS OR FN S.NCCT==1B20 ;NO CONTROL COMMANDS IN TEXT EXCEPT ^T, ^R S.LCAS==1B19 ;CONVERT UPPER CASE TO LOWER CASE BY DEFAULT S.UCAS==1B18 ;CONVERT LOWER CASE TO UPPER CASE BY DEFAULT ;LEFT HALF - AC F2 S.GOIN==1B17 ;A COMMAND STRING HAS BEEN SEEN S.CTLN==1B16 ;^N IN SEARCH ARGUMENT S.NALT==1B15 ;DON'T CONVERT OLD ALTMODES TO 033 ;**** S.NRAD & S.YANK ARE EQUAL, THIS IS OK S.NRAD==1B14 ;NULL REPLACEMENT ALTMODE DELIMITED S.YANK==1B14 ;^Y NOT ^P IN PROGRESS S.LOPN==1B13 ;LOG FILE OPEN S.INFO==1B12 ;INFORM USER OF ANY CORE CHANGE WHEN DONE S.DOIT==1B11 ;M AS OPPOSED JUST HX* S.XXXX==1B10 ;[331] ***FREE*** S.EA== 1B09 ;EDIT APPEND IN PROGRESS S.MINS==1B08 ;MINUS SEARCH S.DELS==1B07 ;TO DELETE TO FROM START TO PT SEARCH S.ASTR==1B06 ;DON'T PRINT STAR S.SSEQ==1B05 ;SUPPRESS SEQUENCE NOS ON INPUT S.SLOG==1B04 ;UNDER NO CIRCUMSTANCES SEN CHARACTER TO LOG FILE S.OLOG==1B03 ;WHEN AT TYOA, STICK IT IN THE LOG FILE ONLY S.LIN== 1B02 ;PUT YOUR TYPE IN IN THE LOG FILE S.LOUT==1B01 ;PUT TECO'S TYPE OUT IN THE LOG FILE S.DPPN==1B00 ;REMEMBER TO DEFAULT TO ZERO PPN SUBTTL I-O CHANNELS ;I-O CHANNELS INCHN== 2 OUTCHN==3 TTY== 4 ;CHANNEL FOR TTY IO CCLCHN==5 ;CHANNEL FOR THE CCL TMP FILE ERRCHN==6 ;CHANNEL FOR ERROR MESSAGE FILE LOGCHN==7 ;CHANNEL TO WRITE LOG FILE ON (IF ANY) SAVCHN==10 ;TO WRITE LOW SEG SAVE ON INICHN==11 ;TO READ INI FILE ON SUBTTL MISC PARAMETERS BEGPAG==200 ;FAKE ASCII CHAR = BEGINNING OF BUFFER ENDPAG==201 ;FAKE ASCII CHAR = END OF BUFFER IF NO EOL AT END SPCTAB==202 ;FAKE ASCII CHAR = SIGNAL TO SEARCH FOR A STRING OF SPACE/TABS SMATLN==^D131 ;Number of characters in the search matricies BITMLN==SMATLN/^D36+1 ;Number of words needed to hold SMATLN bits STABLN==^D131 ;Length of Otag$ build table GCTBL== LPF+40 EE1==1B12 ;PRINT UUO ERROR CODE AFTER ?XXX EE2==2B12 ;PRINT I/O ERROR CODE AFTER ?XXX EE3==3B12 ;PRINT NOTHING AFTER ?XXX BECAUSE NO CORE FOR ERROR FILE EO21== 1 ;TURN OFF SPECIAL VERSION 22+ FEATURES IF EO VALUE = 1 EODEC== 2 ;[335] Same for version 124+ SUBTTL PSEUDO RUN UUO IF NEEDED IFN NORUNS,< IFN CCL,< NORUN1: IOWD .-.,INHERE ;MODIFIED FOR LENGTH 0 NORUN2: CORE 15, EXIT ;NOT ENOUGH CORE TO GET COMPIL IN CCLCHN,NORUN1 ;READ THE FILE JRST NORBLT ;TO THE ACS EXIT ;NO GOOD. INHERE: ;WHERE CODE APPEARS NORAC: ;WHERE TO READ AC DATA FROM PHASE 0 NORBLT: BLT NORTOP,.-. ;ADR MODIFIED RESET AOS 1,.JBSA ;ADR + 1 JRST (1) ;START COMPIL NORTOP: XWD INHERE+1,75 ;MOVE COMPIL DOWN DEPHASE >> SUBTTL STARTUP TIME INITIALIZATION JRST RST ;THIS MUST BE IN 400010 WHEN SSAVED ;THIS IS USED BY THE EE COMMAND ROUTINE ;SAVED IN THE LOW SEGMENT TO START TECO ;AFTER A SAVE TECO: IFN CCL,< TDZA B,B MOVNI B,1 ;THE CCL ENTRY > RESET ;INITIALIZE ALL IO SETZB F2,LOCORE ;CLR DATA IN CASE OF ^C,ST & CLEAR F2 MOVE A,[XWD LOCORE,LOCORE+1] IFE BUGSW, IFN BUGSW, IFN CCL, MOVEM 11,ERRDEV ;[337] Save device we RUN from, for TECO.ERR MOVEM 7,ERRPPN ;[337] Save PPN as well MOVE A,[PUSHJ P,UUOH] ;SET UUO TRAP MOVEM A,.JB41 MOVE P,[XWD -LPDL,PDL] ;START ONE WORD DOWN HRRZ B,.JBFF ;MAKE SURE WE HAVE AT LEAST 1000. FREE WDS ADDI B,^D1000 ;[350] CAML B,.JBREL CORE B, JFCL ;KEEP GOING...WITH LUCK WE WILL AT LEAST GET ;THE PROPER ?COR MESSAGE HRRZ A,.JBREL ;.JBFF=.JBREL-202 SUBI A,47 ;[352] Buffer space for TMPCOR, etc. EXCH A,.JBFF IFN BUGSW, ADD A,[677,,-1] ;CBUF=[000700,,FF-1] MOVEM A,CBUF MOVEI A,201(A) IMULI A,5 MOVEM A,BEG ;BEG:=(CBUF+200)*5 MOVEM A,PT ;PT:=(CBUF+200)*5 MOVEM A,Z ;Z:=(CBUF+200)*5 MOVEM A,QRBUF ;QRBUF:=(CBUF+200)*5 PUSHJ P,SETUP ;SET UP STUFF ;Fall through to next page... HRREI A,TYCASW ;GET WHATEVER IS DEFAULT TYPE-OUT CASE FLAGGING MODE MOVEM A,TYCASF ;AND MAKE IT CURRENT HRRZI A,EOVAL ;INITIALIZE EO FLAG MOVEM A,EOFLAG HRREI A,AUTOFS ;INIT AUTOTYPE-AFTER-SEARCHES FLAG MOVEM A,AUTOF IFN CRT,< HLRZ A,CRTGEN ;GET "GENERAL CRT" FLAGS MOVEM A,CRTTYP ;STORE MOVEI A,BACRUB HRLI A,VCRT BLT A,CTUSEQ > SETOM INI ;REMEMBER TO DO INI FILE IFN BISSW,< ;BIS SUPPORT SETZM A ;SEE IF KL10 BLT A,0 ;... MOVEM A,BIS ;NOTE RESULT > ;END IFN BISSW ;Fall through to next page... SUBTTL TEXT BUFFER INITIALIZATION ;COMPUTE A VALUE WHICH IS 2/3 THE SIZE OF THE CHARACTER BUFFER.IF ;1/3 IS LESS THAN 128 CHARACTERS, THE BUFFER WILL BE 2/3 FILLED ON ;A "Y" OR "A" COMMAND,OTHERWISE, THE BUFFER WILL BE FILLED TO THE ;TOTAL AVAILABLE BUFFER - 128 CHARACTERS. PAYING ATTENTION TO THE ;FORM FEED AND LF OPERATORS. ;IT SHOULD BE NOTED THAT IN THE CASE OF AUTOMATIC ;MEMORY EXPANSION, THESE INSTRUCTIONS MUST BE RE-EXECUTED ;TO INSURE PROPER MEMORY BOUNDS. PUSH P,INITG ;FOR IN LINE CODING POPJ CRE23: MOVE A,.JBFF ;LATEST VALUE OF FF IMULI A,5 ;5 CHARACTERS PER MEM WORD MOVEM A,MEMSIZ ;MEMSIZ:=C(.JBFF)*5 INITG: POPJ P,.+1 ;EXIT OR CONTINUE MOVE A,CBUF MOVEI A,100(A) MOVEM A,CBUFH ;CBUFH:=CBUF+77 MOVEI A,SYL MOVEM A,DLIM ;DLIM:=SYL HRLOI A,10014 MOVEM A,NROOM2 ;NROOM2:=XWD 10014,-1 MOVEI FF,0 ;CLEAR FLAG REGISTER SKIPE SRHMOD ;IF DEFAULT SEARCH MODE IS NOT 0, TXOA FF,F.PMAT ;MAKE EXACT MODE CURRENT GOE: TXZA FF,777777-F.TRAC-F.EMSG-F.FORM-F.SEQ GO: TXZ FF,777777-F.TRAC-F.FORM-F.SEQ TXZ F2,S.SSEQ!S.SLOG!S.NTRC!S.OCTL ;[322] MOVE P,[XWD -LPDL,PDL] ;INITIALIZE PUSHDOWN LIST MOVEM P,PDLSAV SETZM PDL ;FLAG PDL TOP - NOTE: PDL FLAGS ARE ;0 = TOP OF PDL ;-1= LAST ITEM IS AN ITERATION ;+1= LAST ITEM IS A PARENTHESIS ;>1= LAST ITEM IS A MACRO SETZM XCTING ;NO LONGER DOING ANYTHING SETZM EQM ;CLEAR THE MACRO LEVEL COUNT MOVE PF,[XWD -LPF-1,PFL-1] AOSE INI ;TO DO THE INI FILE? JRST CLIS MOVSI E,(MOVE B,) ;FIX ILL UUO PROB IN INI FILES HLLM E,DLIM PUSHJ P,CLREXT ;SET UP EXTENDED LOOKUP BLOCK TXO F2,S.DOIT ;DO INI FILE SETOM XCTING ;SO IT DO IT PUSHJ P,TTOPEN ;OPEN THE TTY MOVSI E,'INI' ;SET UP EXTENSION PUSHJ P,INIFIL ;GET IT INTO CORE JRST CLIS ;GO DO REST SUBTTL REENTER COMMAND REE: CLRBFO ;STOP TYPEOUT MOVEM P,TEMPP ;PRESERVE P MOVE P,[IOWD 4,TEMPDL] ;SET UP STACK FOR SURE PUSH P,E ;SAVE AN AC MOVEI E,TTY ;CLOSE TTY RESDV. E, ;RESET TTY JFCL PUSHJ P,TTOPEN ;REOPEN TTY POP P,E ;RESTORE E, AFTER USE BY TTOPEN MOVE P,TEMPP ;RESTORE P RELEAS ERRCHN, ;FIX ADR CHECK AOSE XCTING ;COMMAND IN PROGRESS? JRST GO ;NO, GO AND LISTEN FOR INPUT JRSTF @.JBOPC ;CONTINUE ;ROUTINE TO FIX PDL OV'S PDLOV: MOVSI D,'PDL' ;FAKE AN ERROR MESSAGE TLNE P,-1 ;MAIN PDL ERROR? MOVSI D,'PDQ' ;Q REG STACK HLRZM D,.JBUUO ;PDL OV MOVEI B,"[" ;IN CASE PDQ SKIPE CTGLEV ;WERE WE IN THE MIDDLE OF A ^G SEARCH? MOVEI B,7 ;YES MOVEM B,ARGSTO ;SAVE IT SETZ D, ;DON'T APPEND A LOOKUP/ENTER/RENAME ERROR CODE! JRSTF ERRPDL ;CAUSE ERROR UUO TO HAPPEN SUBTTL INITIALIZATION OF JOB DEPENDENT PARAMETERS SETUP: MOVEI A,PDLOV ;WHERE TO GO ON PDLOV MOVEM A,.JBAPR ;SAVE MOVX A,AP.REN!AP.POV ;ENABLE FOR PDL OV TRAPPING APRENB A, ;SET TRAP GETPPN A, ;GET USER'S PROJ-PROG # JFCL ;[317]IN CASE SKIP RETURN MOVEM A,USRPPN SETOM DEFPTH ;GET DEFAULT PATH MOVE E,[11,,DEFPTH] PATH. E, MOVEM A,DEFPTH+2 ;IF NOT, JUST PPN MOVSI A,'DSK' ;DEFAULT DEVICE MOVEM A,ERSPEC ;SAVE FOR DEFAULT ER COMMAND SETOM MONITR ;GET MONITOR SERIES NUMBER MOVX A,%CNSTS GETTAB A, ;WHICH MONITOR? JRST TECO2 ;3 SERIES (MONITR=-1) TXNE A,ST%TDS ;WHAT MONITOR ? AOS MONITR ;5 SERIES (MONITR=+1) AOS MONITR ;4 SERIES (MONITR=0) TECO2: MOVE A,[F%FDAE&LH.ALF!.GTFET] ;[333] See if FILDAE is there GETTAB A, ;[333] SETZ A, ;[333] Assume not SETZM FDAEM ;[333] Ditto TXNE A,F%FDAE&RH.ALF ;[333] Well? SETOM FDAEM ;[333] Yes PJOB A, ;GET JOB # MOVEM A,JOBN MOVEI C,3 ;SET CTR JOBLUP: IDIVI A,12 ;CONVERT JOB# TO DECIMAL ASCII IN LEFT HALF ADDI AA,20 LSHC AA,-6 SOJG C,JOBLUP HRRI B,(SIXBIT /TEC/) ;FORM NAME ###TEC MOVEM B,TMPTEC ;SAVE HRROI A,.GTWCH ;GOING TO GET ERROR MESSAGE LEVEL BITS GETTAB A, ;GET WATCH BITS SETZ A, TXNN A,JW.WMS TXO A,JW.WPR!JW.WFL ;ASSUME FIRST LINE!PREFIX TXNE A,JW.WCN TXO A,JW.WFL MOVEM A,ERRLEN ;-1=SHORT, 0=MEDIUM, +1=LONG MOVEM A,PRMERR ;SAVE FOR DEFAULT POPJ P, SUBTTL CCL Command processor IFN CCL,< TTYPT: XWD 440700,TTYBFS ;CCL COMMAND BUFFER PTR TTYPT2: XWD 260700,TTYBFS ;TO INSERT FILE NAME AFTER EW OR EB CCLIN: IFN TEMP,< SETZ I, ;CLEAR TO DENOTE NO TMPCOR MOVE A,[XWD 2,TT] ;SET UP FOR TMPCOR READ & DELETE HRLZI TT,'EDT' ;SET UP READ BLOCK FOR TMPCOR UUO HRRZ TT1,.JBFF ;[343] Get first free location ADDI TT1,46 ;[343] Allow more than enough space CAML TT1,.JBREL ;[343] Do we have it? CORE TT1, ;[343] No - expand JFCL ;[343] Do the best we can HRRZ TT1,.JBFF ;[343] Where to put it SUB TT1,[XWD 46,1] ;[343] Make an IOWD TMPCOR A, ;READ AND DELETE FILE EDT JRST CCLTMP ;NO FILE EDT OR NO TMPCOR UUO HRRZ AA,.JBFF ;[343] Start of buffer area HRLI AA,350700 ;PICK UP EDT CHARACTERS, SKIP LINED "S" JSP I,CCLTM1 ;[343] Denote we have TMPCOR and continue below >;END OF IFN TEMP ;Here if TMPCOR failed. Read DSK:nnnEDT.TMP. CCLTMP: HLLZ B,TMPTEC ;GET SIXBIT JOB # HRRI B,(SIXBIT /EDT/) ;REST OF NAME MOVEM B,XFILNM+.RBNAM MOVSI B,(SIXBIT /TMP/) MOVEM B,XFILNM+.RBEXT SETZM XFILNM+.RBSIZ ;USE DEFAULT PATH, PREVENT ADR. CHK. MOVE T,.JBFF ;USE BUFFER SPACE BRIEFLY OPEN CCLCHN,[EXP .IOASC ;[326] SIXBIT /DSK/ ;[326] TO READ THE FILE EXP CCLB] ;[326] INPUT BUFFER JRST TECO ;IF NO DSK, SAY "*" INBUF CCLCHN,1 ;DONT ADR CHECK LOOKUP CCLCHN,XFILNM+.RBNAM ;OPEN THE FILE JRST TECO ;IT WASNT THERE? INPUT CCLCHN,0 MOVEM T,.JBFF ;GIVE BACK SPACE IBP CCLB+.BFPTR ;SKIP THE LINED S MOVE AA,CCLB+.BFPTR ;[343] Get byte pointer to input ;Fall back into normal process on next page ;Here when we have the command, either from TMP: or from DSK:. CCLTM1: MOVE T,TTYPT2 ;[343] Get output byte pointer MOVEI C,2 ;[343] Initialize the character count HRLI C,-<<46*5>-4> ;[343] Max of 186. chars MOVEI A,"=" ;[343] Flag no equals sign seen SETZ TT1, ;[343] Flag no dollar sign seen ;Loop back here on each new character in TMP file CCLIL: ILDB B,AA ;[343] Get next EDT character CAIN B,"$" ;[343] Is it a dollar sign? (Our pseudo altmode) JRST CCLALT ;[343] Yes CAMN B,A ;[343] First equals sign seen? JRST CCLEQL ;[343] Yes CAIE B,.CHCRT ;[343] CR? CAIN B,.CHALT ;[343] Old altmode? JRST CCLNUL ;[343] Assume we're done SKIPE B ;[352] Ignore nulls CCLIL1: IDPB B,T ;[343] Else store the character AOBJN C,CCLIL ;[343] Loop for all characters ; Fall through if too many characters; we can't overflow TTYBFS CCLOVF: JUMPN B,CCLOV1 ;[352] Is current char a null? LDB B,T ;[352] Yes, assume we're OK, pick up last char ADD T,[7B5] ;[352] Backup byte pointer JUMPG T,CCLNUL ;[352] SUB T,[430000,,1] ;[352] Fixup if necessary JRST CCLNUL ;[352] Go wrap things up CCLOV1: ERROR E.CTL ;[343] CCL command too long ; Here when a dollar sign seen CCLALT: MOVEI B,.CHESC ;[343] Change it into a real altmode JUMPN TT1,CCLIL1 ;[343] Is this the first one we've seen? MOVE TT1,AA ;[343] Yes, save input byte pointer JUMPL A,CCLIL1 ;[343] Was there a prior equal sign? MOVNI A,2 ;[343] No, so flag to ignore all future equal signs JRST CCLIL1 ;[343] Return to loop ; Here on the first "=" in the command string (unless $ seen first) CCLEQL: MOVEI B,.CHESC ;[343] Replace first equals sign IDPB B,T ;[343] with ER AOBJP C,CCLOVF ;[343] Count the escape MOVE D,T ;[343] Save T & C MOVE E,C ;[343] In case .TE A=B ADD C,[2,,2] ;[343] Count the "ER" we will add JUMPGE C,CCLOVF ;[343] Error if too many characters MOVEI B,"E" ;[343] Since we expect IDPB B,T ;[343] an input file MOVEI B,"R" ;[343] spec to follow IDPB B,T ;[343] the first one. SETO A, ;[343] Prevent finding later equals TXO FF,F.CCL ;[343] Do a EY in any case JRST CCLIL ;[343] and loop back for next character ; Here on a null (End of command). See if it was MAKE or TECO CCLNUL: MOVEI TT,"W" ;[343] Prepare for EW command CAILE B,.CHCRT ;WAS BREAK A CRLF? JRST CCLDUN ;NO. ALTMODE ASSUMED TXO FF,F.CCL ;REQUEST Y AFTER EB MOVEI TT,"B" ;[343] Now prepare for EB AOJN A,CCLDUN ;[343] continue unless EB and "=" was seen MOVE T,D ;[343] If .TE A=B, we never saw the "=" MOVE C,E ;[343] In case .MA A=B, then .TE JUMPE TT1,CCLDUN ;[343] Jump ahead unless there was a $ after "A=B" MOVE AA,TT1 ;[343] There was, so restore input BP to that point MOVNI A,-2 ;[343] Reset A so we don't do this again JRST CCLIL ;[343] And return to that point, leaving out the "=B" CCLDUN: MOVEI B,.CHESC IDPB B,T ;[343] TERMINATING TWO ALT'S IDPB B,T ;LAST ALT ADDI C,3 ;[343] COUNT BOTH ALTS & ADD 1 TO FOOL TYI0 MOVEI B,"E" ;NOW FILL IN THE EB OR EW MOVE T,TTYPT ;AT THE BEGINNING OF STRING MOVEM T,TIB+.BFPTR ;ALSO INITIALIZE TO READ THIS IDPB B,T ;STORE "E" IDPB TT,T ;[343] And either W or B HRRZM C,TIB+.BFCNT ;SET BUFR CTR IFN TEMP, ;[343] IF TMPCOR THEN DON'T HAVE TO CLOSE SETZM XFILNM+.RBNAM ;BY RENAME TO 0 RENAME CCLCHN,XFILNM ;GO. JFCL ;NOGO? CCLDU2: RELEAS CCLCHN, POPJ P, >;END OF IFN CCL SUBTTL RETURN NON-NULL TTY CHARACTER IN CH. ;CALL PUSHJ PDP,TYI ; RETURN TYI: TXZE FF,F.TYOF ;NEED A TYO? OUTPUT TTY,0 ;YES. DO SO. TYI0: SOSG TIB+.BFCNT ;CHARS IN NORMAL MODE? JRST TYI1 ;NONE LEFT TYI2: ILDB CH,TIB+.BFPTR ;YES. GET ONE JUMPE CH,TYI0 ;FLUSH NULLS TYI3: TXZ FF,F.DDTM ;CLR TTCALL REQUEST FLAG IFN RUBSW,< SETO A, ;AIM AT THIS TTY GETLCH A ;GETSTS TXNN A,GL.LCP ;SUPPRESS ECHO? > CAIE CH,.CHBEL ;BELL? JRST ALTLIN ;NO, BUT WATCH OUT FOR OLD ALTMODES TXO F2,S.SLOG ;DON'T PUT THE ^G IN THE LOG FILE JSP A,CONMES ;ECHO AN "^G" TOO ASCIZ /^G/ TXZ F2,S.SLOG MOVEI CH,.CHBEL ;GET BACK BELL POPJ P, TYI1: TXNE FF,F.DDTM ;SHOULD TYI BE TTCALL? JRST TYIDDT ;YES INPUT TTY,0 ;NO. ORDINARY. STATO TTY,IO.EOF ;END OF FILE? JRST TYI2 PUSHJ P,TTOPEN ;CLEAR EOF THE HARD WAY JRST TYI0 ;^Z WAS SEEN ALREADY. GET ANOTHER CH ;CONVERT 175 & 176 TO ALTMODE (033) UNLESS TTY LC IS ON ALTLIN: CAIL CH,.CHALT ;OLD ALTMODE? CAILE CH,.CHAL2 POPJ P, ;NO TXNN F2,S.NALT ;TEST TTY NO ALT BIT ALTX: MOVEI CH,.CHESC ;NOT ON, SO CONVERT TO 033 POPJ P, ;CONVERT 175 & 176 TO ALTMODE (033) IF EO = 1 ALTEO: CAIE CH,.CHALT ;OLD ALTMODE? CAIN CH,.CHAL2 CHKEO EO21,ALTX ;RUNNING OLD MACRO? IF SO, CONVERT POPJ P, ;NO, 175=RIGHT BRACE, 176=TILDE TYIDDT: TXZE FF,F.TYOF ;CHARACTERS WAITING FOR OUTPUT? OUTPUT TTY,0 ;YES, FORCE THEM OUT INCHRW CH ;WAIT FOR A SINGLE CHARACTER JRST TYI3 ;USE E INSTEAD OF T IN THIS ROUTINE, SINCE IT MAY BE CALLED ; AFTER A REENTER, WHILE T IS BEING USED TO MOVE CHARACTERS ; (FAST AC CODE). E HAS BEEN SAVED AT REE:. TTOPEN: MOVEI E,TTYBFS EXCH E,.JBFF ;SET .JBFF AND SAVE IT OPEN TTY,TTYBLK ;[326] INIT THE CONSOLE JRST .-1 ;[326] I REALLY WANT TTY INBUF TTY,1 OUTBUF TTY,1 ;KEEP IT SMALL MOVEM E,.JBFF ;RESTORE .JBFF IFN CCL,< SETZM TYIPT ;SIGNAL CCL BUFFER EMPTY > POPJ P, TTYBLK: EXP IO.FCS!.IOASC ;[326] TTY OPEN BLOCK SIXBIT /TTY/ TOB,,TIB SUBTTL TYPE A CHARACTER. ;FOR TYPING TEXT: FOR TYPING MESSAGES: ; MOVE CH,CHARACTER MOVE CH,CHARACTER ; PUSHJ P,TYO PUSHJ P,TYOM ; RETURN RETURN TYOS: TXOA F2,S.TXTC ;TYPE , ETC INSTEAD OF PRINTER CONTROLS TYOM: TXZ F2,S.TXTC ;CLR SPECIAL TYPEOUT FLAG TXOA F2,S.NCFL ;SET NO-CASE-FLAGGING FLAG TYO: TXZ F2,S.NCFL+S.TXTC ;CLR NO-CASE-FLAGGING FLAG & SPECIAL FLAG PUSH P,CH ;SAVE CHAR IN CASE ^ OR ' NEEDED TXZ FF,F.TCTL!F.IMAG ;[331] Zero literal and image flags SKIPN ETVAL ;[331] ET = 0? JRST TYOF ;[331] It's 0, so use up-arrow mode PUSH P,A ;[331] Save a #%&ing AC! MOVE A,ETVAL ;[331] Get ET value CAIN A,1 ;[331] ET=1? TXO FF,F.TCTL ;[331] Yes CAIN A,2 ;[331] ET=2? TXO FF,F.IMAG ;[331] Yes, set image mode POP P,A ;[331] Retore A JRST TYOB ;[331] Go type character TYOF: PUSHJ P,ALTEO ;[331] CONVERT OLD ALTMODES IF EO=1 IFN CRT, IFE CRT, JRST TYO1 ;BELOW TAB TXZN F2,S.TXTC ;WANT , ETC INSTEAD OF PRINTER CONTROLS? JRST TYOJ ;NO CAIG CH,.CHCRT ;IS IT A PRINTER CONTROL? JRST TYOH ;YES CAIE CH,.CHESC ;OR AN ALTMODE? JRST TYOG ;NO, DO NORMAL THING MOVEI CH,16 ;ADJUST INDEX FOR ALTMODE TYOH: MOVEI A,5 ;5 CHAR. CTR MOVE AA,[POINT 7,TSPTAB-10] ;& PTR TO RIGHT COMBINATION ADDI AA,(CH) TYOI: ILDB CH,AA ;TYPE OR WHATEVER SOJLE A,TYOB ;LAST CHAR GOES OUT VIA TYOB (TO POP CH) PUSHJ P,TYOA JRST TYOI TYOJ: CAIG CH,.CHCRT ;NO, TAB, LF, VT, FF, OR CR? JRST TYOB ;YES. TYPE IT AND RETURN CAIN CH,.CHESC MOVEI CH,"$" ;YES TYPE DOLLAR SIGN TYOG: CAIGE CH," " ;NO. ANY OTHER CONTROL CHARACTER? JRST TYO1 ;YES. TYOC: TXNE F2,S.LCTT+S.NCFL ;TTY LC ON? OR TYPING A MESSAGE? JRST TYOB ;YES, NO CASE FLAGGING MOVE A,TYCASF ;WHAT SHOULD BE FLAGGED? JUMPL A,TYOB ;NOTHING JUMPG A,TYOD ;UPPER CASE RANGE CAIGE CH,"A"+" "-1 ;LOWER CASE. IS THIS LC? JRST TYOB ;NO, SO DON'T FLAG IT TYOE: MOVEI CH,"'" ;YES, FLAG IT WITH ' PUSHJ P,TYOA MOVE CH,(P) ;GET BACK THE CHARACTER TXZ CH,40 ;MAKE IT UPPER CASE TYOB: PUSHJ P,TYOA ;TYPE CH. POP P,CH ;RESTORE CH TXZN FF,F.TCTL!F.IMAG ;[331] CLEAR LITERAL AND IMAGE FLAGS CAIE CH,.CHBEL ;[331] IF BELL, WE NEED A DING POPJ P, ;NO, RETURN JRST TYOA1 ;[325] BUT DON'T PUT THE DING INTO LOG FILE TYOA: TXNE F2,S.OLOG!S.LOUT ;PUT CHARACTER IN LOG FILE PUSHJ P,LOGOUT ;RIGHT! TYOA1: TXNE FF,F.IMAG ;[331] Do we want image typeout? JRST TYOK ;[331] Yes TXO FF,F.TYOF ;[325] MARK WILL NEED TO OUTPUT SOSG TOB+.BFCNT ;OUTPUT SPACE AVAIL? OUTPUT TTY,0 ;NO. OUTPUT. IDPB CH,TOB+.BFPTR CAILE CH,.CHFFD ;FORCE OUTPUT ON LF,FF ETC POPJ P, ;NO OUTPUT TTY,0 TXZ FF,F.TYOF ;NO LONGER NEED TO OUTPUT POPJ P, TYOK: TXZE FF,F.TYOF ;[331] If output pending... OUTPUT TTY,0 ;[331] put it out IONEOU CH ;[331] Output the image character POPJ P, ;[331] Return TYO1: PUSH P,CH ;TYPE CONTROL CHARACTER IN FORM "^CH" MOVEI CH, "^" PUSHJ P,TYOA ;TYPE ^ POP P,CH ADDI CH,100 ;CONVERT TO PRINTING CHARACTER JRST TYOB ;AND TYPE IT. TYOD: CAIL CH,100 ;IS THIS UPPER CASE? CAILE CH,137 JRST TYOB ;NO JRST TYOE ;YES, FLAG IT WITH ' ;PRINT THESE INSTEAD OF PRINTER CONTROLS IF S.TXTC FLAG IS ON TSPTAB: ASCII /^H/ ASCII // ASCII // ASCII // ASCII // ASCII // ASCII // SUBTTL MESSAGE TYPE-OUT & NUMBER TYPE-OUT ;CALL JSP A,CONMES ; ASCIZ /MESSAGE/ ; RETURN CONMES: HRLI A,(POINT 7,,) ;A=POINT 7,MESSAGE-ADDR ILDB CH,A ;GET MSG CHAR JUMPE CH,1(A) ;RETURN WHEN 0 FOUND PUSHJ P,TYOM ;TYPE WITH NO CASE FLAGGING JRST .-3 ;ROUTINE TO OUTPUT DECIMAL (OCTAL IF S.OCTL IS ON) INTEGER ;CALL MOVE B,INTEGER ; MOVEI A,ADDRESS OF OUTPUT ROUTINE ; PUSHJ P,DPT ; RETURN DPT: MOVEM A,LISTF5 JUMPGE B,DPT1 ;NUMBER > 0? MOVEI CH,"-" ;NO. OUTPUT - PUSHJ P,@LISTF5 MOVMS B ;B:=ABSOLUTE VALUE OF B DPT1: MOVEI A,12 ;RADIX 10 TXZE F2,S.OCTL ;[323] OCTAL RADIX? MOVEI A,10 ;YES, CHANGE TO RADIX 8 IDIVI B,(A) ;E:=DIGIT HRLM E,(P) ;PUT DIGIT ON LEFT HALF OF TOP OF PUSH DOWN LIST JUMPE B,.+2 ;DONE? PUSHJ P,.-3 ;NO. PUSH THIS DIGIT AND PRINT RETURN ADDRESS. HLRZ CH,(P) ;YES. CH:=DIGIT ADDI CH,"0" ;CONVERT IT TO ASCII. JRST @LISTF5 ;PRINT IT ;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED ;CALL PUSHJ P,CRR ; RETURN CRR: JSP A,CONMES ;OUTPUT CRLF ASCIZ / / POPJ P, ;ROUTINE TO TYPE A STRING LITERALLY OUTIMG: TXO FF,F.IMAG ;[331] Use image mode OUTMES: HRLI A,(POINT 7,,) ;THIS ROUTINE WILL OUTPUT A STRING LITERALLY OUTMS1: ILDB CH,A JUMPE CH,OUTMS2 ;[331] PUSHJ P,TYOA TLNE A,700000 ;NO MORE THAN 5 CHARACTERS, THOUGH JRST OUTMS1 OUTMS2: TXZ FF,F.IMAG ;[331] Clear image flag POPJ P, SUBTTL RETURN NEXT COMMAND CHAR AT CURRENT LEVEL ;CALL: PUSHJ P,SKRCH ; ERROR RETURN IF NO MORE CHARS AT THIS LEVEL ; NORMAL RETURN WITH CHAR IN CH SKRCH: SKIPG COMCNT ;ANY CHARS LEFT? POPJ P, ;NO, TAKE ERROR RETURN PUSHJ P,RCH ;YES, GET NEXT CPOPJ1: AOS (P) ;SKIP RETURN POPJ P, ;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER. ;CALL PUSHJ P,RCH ; RETURN ALWAYS WITH CHARACTER IN CH RCH: SOSGE COMCNT ;DECREMENT COMMAND BUFFER CHARACTER COUNT ;IS COMMAND BUFFER EMPTY? JRST RCH2 ;YES. POP UP TO HIGHER MACRO LEVEL. ILDB CH,CPTR ;NO. GET COMMAND CHARACTER IN CH PUSHJ P,ALTEO ;CONVERT OLD ALTMODES IF EO = 1 HRRM CH,EATCH ;IN CASE OF FAILURE DURING COLON ANYTHING TXNE FF,F.TRAC ;IN TRACE MODE? TXNE F2,S.NTRC ;TRACE ENABLED? POPJ P, ;NO, RETURN JRST TYO ;YES, TYPE THE COMMAND RCH2: POP P,CH ;SAVE RETURN FOR POPJ IN CH POP P,COMCNT ;GET RID OF FLAG SOSGE EQM ;DECREMENT THE MACRO COUNT SETZM EQM ;NEVER ALLOW IT TO GO NEG OR PEOPLE WILL SCREW UP SOSGE COMCNT ;IF ANG BRAK ON PDL, ITS A INCOMPLETE MACRO ERROR E.IAB POP P,COMCNT ;GET COUNT FROM NEXT MACRO LEVEL POP P,CPTR ;CURRENT POINTER TOO POP P,COMAX ;NUMBER OF COMMANDS PUSH P,CH ;GET RETURN BACK ON PDL. JRST RCH ;TRY AGAIN. ;GET NEXT CHAR FROM CURRENT COMMAND LEVEL WHERE A CHAR IS ;KNOWN TO BE THERE, AND NO TRACING IS WANTED GCH: SOS COMCNT ;REDUCE CHAR COUNT ILDB CH,CPTR ;GET CHAR. JRST ALTEO ;CONVERT OLD ALTMODES AND RETURN SUBTTL SCAN COMMAND STRING FOR CHARACTER IN TT ;IGNORING PAIRS STARTING WITH CHAR. IN TT1 AND ENDING WITH (TT) ;ASSUMED THAT CPTR IS SET ;NON-SKIP RETURN IF (TT) CAN'T BE FOUND ;SKIP RETURN IF FOUND ;CPTR LEFT SET FOR NEXT CHAR. IN COMMAND STRING SKAN: TXO F2,S.NTRC ;INHIBIT TRACE ACTION WHILE SKANNING MOVEI C,0 ;CTR FOR <> AND "...' PAIRS SKAN0: TXZ F2,S.SKMQ+S.SKMR+S.SFSN ;CLR SKIM FLAGS PUSHJ P,SKRCH2 ;GET COMMAND CHAR. SKAN01: CAIN CH,(TT1) ;SECONDARY CHARACTER? AOJA C,SKAN1 ;YES, COUNT IT CAIN CH,(TT) ;PRIMARY CHAR? JRST SKAN10 ;YES! SKAN1: CHKEO EO21,SKAN0 ;OLD STYLE SKAN IF EO = 1 MOVEI T,SKNTAB ;NO, WATCH OUT FOR TEXT STRINGS SKAN00: PUSHJ P,DISPAT JRST SKAN0 ;NOT A TEXT-ARG COMMAND, IGNORE IT SKAN2: PUSHJ P,SKRCH2 ;GET CHAR AFTER "^" CAIE CH,"A"+" " ;COULD BE LOWER CASE CAIN CH,"A" JRST SKAN7 ;^A COMMAND CAIN CH,"^" JRST SKAN11 ;^^ COMMAND JRST SKAN0 ;ORDINARY CTRL-COMMAND, FORGET IT SKAN3: PUSHJ P,SKRCH2 MOVEI T,SK3TAB ;WHICH E COMMAND? JRST SKAN00 SKAN4: PUSHJ P,SKRCH2 ;WHAT FOLLOWS @? MOVEI T,SK4TAB PUSHJ P,DISPAT JRST SKAN4 ;MUST BE 1 OF THESE 4 SKAN09: TXZ F2,S.SFSN ;FOR FD CASE JRST SKAN12 SKAN9: PUSHJ P,SKIM ;IGNORE TO $ JRST SKAN0 SKAN7: MOVEI T,1 ;IGNORE TO ^A JRST SKAN5 SKAN8: MOVEI T,"!" ;IGNORE TO ! SKAN5: PUSHJ P,SKIM1 ;IGNORE TO CHAR IN T JRST SKAN0 SKAN66: TXZ F2,S.SFSN ;FOR @FD CASE SKAN6: PUSHJ P,SKRCH2 ;GET SEARCH DELIMITER SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE SKAN12: MOVEI T,.CHESC ;DELIMITER IS ALTMODE PUSHJ P,SKIMRQ ;SKIP TO DELIMITER & WATCH OUT FOR ^Q,^R JRST SKAN0 SKAN13: PUSHJ P,SKRCH2 ;GET INSERT DELIMITER SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE SKAN14: MOVEI T,.CHESC ;DELIMITER IS ALTMODE PUSHJ P,SKIM.R ;SKIP TO DELIMITER & WATCH OUT FOR ^R JRST SKAN0 SKAN11: PUSHJ P,SKRCH2 ;IGNORE NEXT CHAR. JRST SKAN0 SKAN16: MOVEI T,SK5TAB ;TABLE FOR @F JRST SKAN17 SKAN15: MOVEI T,SK1TAB ;TABLE FOR F COMMANDS SKAN17: TXO F2,S.SFSN ;SIGNAL FS OR FN IN PROGRESS PUSHJ P,SKRCH2 ;GET CHAR AFTER F JRST SKAN00 SKAN18: PUSHJ P,SKRCH2 ;CHECK FOR POSSIBLE "PW" CAIE CH,"W" CAIN CH,"W"+" " JRST SKAN0 ;IT IS...FORGET IT JRST SKAN01 ;IT'S NOT...WE MUST CHECK THIS CHAR FURTHER SKAN10: SOJGE C,SKAN0 ;IF MATCH JUST ENDS A PAIR, LOOP BACK TXZ F2,S.NTRC ;ENABLE TRACING JRST CPOPJ1 ;OTHERWISE, WE HAVE WHAT WE WANT ;SKIM OVER TEXT ;ENTER AT SKIM TO SKIP TO NEXT ALTMODE, GIVING ^R & ^Q NO SPECIAL TREATMENT ;ENTER AT SKIM1 TO SKIP OVER ARBITRARY CHAR IN T, GIVING ^R & ^Q NO SPECIAL TREATMENT ;ENTER AT SKIM.R TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER ^R ;ENTER AT SKIMRQ TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER EITHER ^R OR ^Q SKIMRQ: TXO F2,S.SKMQ ;CK FOR ^Q AND ^R SKIM.R: TXOA F2,S.SKMR ;CK FOR ^R SKIM: MOVEI T,.CHESC ;SKIP TO NEXT ALTMODE SKIM1: PUSHJ P,SKRCH ;GET NEXT TEXT CHAR. JRST APOPJ ;ERROR RETURN FROM SKAN ROUTINE CAIN CH,(T) ;CHARACTER WE WANT? JRST SKIM3 ;YES CAIN CH,.CHCNQ ;^Q? TXNN F2,S.SKMQ ;YES, CK FLAG ON? JRST .+2 ;NO JRST SKIM2 ;YES CAIN CH,.CHCNR ;^R? TXNN F2,S.SKMR ;YES, CK FLAG ON? JRST SKIM1 ;NO, KEEP LOOKING SKIM2: PUSHJ P,SKRCH ;GOBBLE UP NEXT CHARACTER JRST APOPJ ;ERROR RETURN FROM SKAN JRST SKIM1 ;CONTINUE SKIMMING SKIM3: TXZE F2,S.SFSN ;SKIMMING OVER FS OR FN? JRST SKIM1 ;YES, IGNORE 1ST DELIMITER POPJ P, ;GET A SINGLE CHARACTER FROM COMMAND STRING ;TAKE ERROR RETURN FROM SKAN IF THERE ARE NO MORE SKRCH2: PUSHJ P,SKRCH ;GET A COMMAND CHAR. APOPJ: POP P,A ;ERROR RETURN FROM SKAN IF NO MORE CHARS. POPJ P, SUBTTL SKAN ROUTINE DISPATCH TABLES SKNTAB: XWD SKAN15,"F" XWD SKAN14,"I" XWD SKAN14,.CHTAB ;TAB XWD SKAN12,"_" XWD SKAN9,"O" XWD SKAN8,"!" XWD SKAN7,.CHCNA ;^A XWD SKAN11,.CHCCF ;^^ XWD SKAN2,"^" XWD SKAN3,"E" XWD SKAN11,"U" XWD SKAN11,"Q" XWD SKAN11,"X" XWD SKAN11,"G" XWD SKAN11,"W" XWD SKAN11,"M" XWD SKAN11,"%" XWD SKAN11,"[" XWD SKAN11,"]" XWD SKAN4,"@" XWD SKAN11,"""" ;" XWD SKAN12,"S" XWD SKAN12,"N" XWD SKAN18,"P" XWD 0,0 SK1TAB: XWD SKAN12,"S" ;S OR FS XWD SKAN12,"N" ;N OR FN XWD SKAN09,"D" XWD 0,0 ;LIST TERMINATOR SK3TAB: XWD SKAN9,"I" XWD SKAN9,"P" XWD SKAN9,"B" ;EB XWD SKAN9,"R" ;ER XWD SKAN9,"W" ;EW XWD SKAN9,"Z" ;EZ XWD SKAN9,"D" XWD SKAN9,"L" XWD SKAN9,"E" XWD SKAN9,"N" XWD SKAN9,"A" XWD SKAN9,"V" XWD 0,0 SK4TAB: XWD SKAN16,"F" ;@F XWD SKAN13,"I" ;@I XWD SKAN6,"_" ;@_ XWD SKAN6,"S" ;@S XWD SKAN6,"N" ;@N XWD 0,0 SK5TAB: XWD SKAN6,"S" ;@FS XWD SKAN6,"N" ;@FN XWD SKAN66,"D" ;@FD XWD 0,0 SUBTTL ACCEPT COMMAND STRING ROUTINE CLIS1: PUSHJ P,CRR ;TYPE CRLF CLIS: IFN CCL,< SKIPN CCLSW ;NEED CCL COMMAND? JRST LIS0 ;NO PUSHJ P,CCLIN ;GET THE CCL COMMAND TO TYI BUFFER JRST LIS02 ;AND DONT SAY STAR > LIS0: AOS INI ;ALLOW ^G^G *I$ ON FIRST COMMAND PUSHJ P,TTOPEN ;GET TELETYPE TXNE FF,F.EMSG ;1ST CHARACTER IN ALREADY? JRST LIS01 ;YES MOVEI CH,"*" TXZ F2,S.LCTT ;CLR TTY LC BIT SETO A, ;GETLCH ON THIS LINE GETLCH A TXNE A,GL.LCM ;TTY LC ON? TXO F2,S.LCTT ;YES, SET TTY LC BIT TXNN F2,S.LIN ;WANT OUTPUT? TXO F2,S.SLOG ;SUPPRESS * IN LOG FILE TXZ FF,F.CCL ;NOT THIS AGAIN HRRZ TT1,A ;GET UNIVERSAL I/O INDEX MOVEI TT,.TOALT ;CODE FOR ALT TESTING MOVE A,[XWD 2,TT] ;SET UP FOR TRMOP TRMOP. A, ;GET ALTMODE INFO FROM MONITOR LDB A,[POINTR (F2,S.LCTT)] ;IF THIS FAILS USE LC BIT SKIPE A ;SHOULD WE CHANGE TO OLD ALTMODES? TXOA F2,S.NALT ;DON'T CONVERT TXZ F2,S.NALT ;DO CONVERT IFN CRT,< MOVX TT,.TOWID ;GET WIDTH OF TTY MOVE A,[XWD 2,TT] ;USING A TRMOP. TRMOP. A, MOVEI A,^D72 ;ASSUME 72 IF NO TRMOP. MOVEM A,TTYWID ;STORE IT > PUSHJ P,TYOM ;TYPE * LIS01: TXZ F2,S.SLOG!S.ASTR ;[325] LOG FILE IS FULLY ACTIVE AGAIN TXOE FF,F.EMSG ;[325] IS ONE ALREADY IN? JRST LIS01A ;[325] YES TXO FF,F.DDTM ;[325] NO, FORCE CHARACTER MODE ON IT PUSHJ P,TYI LIS01A: CAIN CH,.CHLFD ;[325] IF 1ST CHAR IS LF, JRST IM1LT ;[325] DO A 1LT. CAIN CH,";" ;[325] IF IT'S A SEMI-COLON, JRST IM0LT ;[325] DO A 0LT. CAIN CH,.CHCNH ;[325] IF IT'S A BACKSPACE, JRST IMN1LT ;[325] DO A -1LT. CAIE CH,"*" ;1ST CHAR AN ASTERISK? JRST LIS02 ;NO, CONTINUE NORMALLY ;SAVE PREVIOUS COMMAND STRING IN NAMED Q-REGISTER TXNE F2,S.LIN ;[325] PUT THE * INTO LOG FILE? PUSHJ P,LOGOUT ;[325] YES SETZM EATCH ;NO CHARACTER READ YET TXNE F2,S.GOIN ;ANY CMD STRG SEEN YET? IF NOT, * IS ILLEGAL JRST LIS03 ;OK $NCS: PUSHJ P,CRR ;MUST PUT CR/LF BEFORE ?NCS ERROR E.NCS LIS03: MOVE C,COMLEN ;LENGTH OF STRING TXNE F2,S.NRAD ;IS IT AN FS...$$? ADDI C,1 ;YES, DON'T OMIT LAST ALTMODE ADDI C,2 ;OMIT LAST ALTMODE MOVEI B,CMDBFR ;POSITION OF FIRST CHAR. IN BYTES IFN BUGSW, IMULI B,5 PUSHJ P,X3 ;TRANSFER STRING TO Q-REG PUSHJ P,TYI ;GET Q-REG NAME FOR * COMMAND MOVEM CH,EATCH ;SAVE IN CASE ERROR TXNE F2,S.LIN ;[325] PUT IN LOG FILE? PUSHJ P,LOGOUT ;[325] YES MOVE A,TIB+.BFPTR ;GET POINTER TO CURRENT CH MOVEM A,CPTR ;STORE FOR POSSIBLE ERROR PUSHJ P,QREGV2 ;STORE 400000 IN QTAB MOVEM B,QTAB-"0"(CH) TXZ FF,F.EMSG ;NEXT INPUT CHAR NOT IN LIS02: SETZM COMCNT ;COMCNT:=0 TXZ F2,S.NRAD ;CLEAR FLAG SETZM SYMS MOVE T,[XWD SYMS,SYMS+1] BLT T,SYMEND-1 MOVE AA,CBUF MOVE B,CBUFH LI1: TXZ FF,F.ALT+F.BELL+F.XPLN+F.EM LI2: TXZ F2,S.SLOG ;THINGS MAY AGAIN ENTER LOG FILE CAILE B,(AA) ;COMMAND BUFFER EXCEEDED? JRST LI3 ;NO ;TO SEE IF TECO WILL NEED MORE CORE FOR COMMAND ;BUFFER EXPANSION. IF SO, GET IT MOVE C,Z ;GET THE NUMBER OF CHARACTERS NOW ADDI C,500 ;WILL WE OVERFLOW IF THIS IS REQUESTED? CAMGE C,MEMSIZ ;[320] WILL THIS OVERFLOW? JRST .+5 ;NO, FORGET THIS EVER HAPPENED MOVEM 17,AC2+15 ;[354] Will overflow, therefore save AC#17 MOVE 17,C ;THIS IS THE REQUEST FOR MEMORY PUSHJ P,GRABKQ ;GET THE NECESSARY CORE MOVE 17,AC2+15 ;[354] Restore AC#17 SUBTTL EXPAND THE COMMAND BUFFER ADDI B,100 ;YES. EXPAND COMMAND BUFFER 100 WORDS. MOVE C,Z IDIVI C,5 ;C:=DATA BUFFER END WORD ADDRESS. MOVE D,QRBUF PUSH P,F2 ;KLUDGE TO PROTECT F2 UNTIL AC'S ARE REORDERED IDIVI D,5 ;D:=Q-REG BUFFER BASE WORD ADDRESS. POP P,F2 ;RESTORE FLAGS SUBM C,D ;D:=NO. OF WORDS IN Q-REG BUFFER AND DATA BUFFER. MOVE CH,(C) MOVEM CH,100(C) ;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS. SOS C SOJGE D,.-3 MOVEI C,500 ADDM C,BEG ;BEG:=C(BEG)+500 ADDM C,PT ;PT:=C(PT)+500 ADDM C,Z ;Z:=C(Z)+500 ADDM C,QRBUF ;QRBUF:=C(QRBUF)+500 MOVE D,Z LI3: MOVEM B,CBUFH ;NO. RESET HIGH END OF COMMAND BUFFER. TXZN FF,F.EMSG ;1ST CHAR IN ALREADY? PUSHJ P,TYI ;GET A NON-NULL CHARACTER IN CH IFN CRT, CAIN CH,.CHDEL ;RUBOUT? JRST DELCHR ;YES LI3A: TXZ F2,S.SLOG AOS A,COMCNT ;NO. INCREMENT COMMAND CHARACTER COUNT IDPB CH,AA ;STORE CHARACTER IN COMMAND BUFFER. LI4: CAIE CH,.CHESC ;ALT-MODE? JRST LI5 ;NO TXZN F2,S.CTLR ;PREVIOUS CHAR. A ^R? JRST LI7 ;NO CHKEO EO21,LI7 ;IF EO=1, NEVERMIND ^R LI9: TXZ FF,F.BELL ;ALTMODE CLEARS BELL FLAG JRST LI2 LI7: TXON FF,F.ALT ;YES. SET ALT-MODE FLAG. WAS IT ON? JRST LI9 ;NO MOVEM A,COMAX ;SET COMMAND CHARACTER ADDRESS UPPER BOUND MOVEM A,COMLEN ;SAVE IN CASE OF * COMMAND NEXT MOVE AA,CBUF ;INIT COMMAND BYTE PTR MOVE B,AA ;IN CASE INTO LOG FILE MOVEM AA,CPTR SKIPE CCLSW ;READING CCL CMD? PUSHJ P,TTOPEN ;YES, INIT TTY TXNE F2,S.LIN ;PUT YOUR TYPIN IN LOG FILE? PUSHJ P,BUFTYP TXNN F2,S.LIN ;INPUT TO FILE TOO? TXO F2,S.SLOG ;NO, SO DON'T PUT THIS CRLF THERE PUSHJ P,CRR ;TYPE CRLF TXZ F2,S.SLOG SETZM CCLSW ;FINISHED WITH CCL READ SETOM XCTING ;SET NO SCREW I FLAG JRST CD ;RIGHT, SO DECODE COMMAND BUFTYP: MOVE A,COMCNT ;HOW MANY CHARACTERS TO TRANSFER BUFTY0: TXNE F2,S.LOUT ;[325] TXO F2,S.OLOG LOGLP: ILDB CH,B ;GET CHARACTER TXNN F2,S.LOUT ;SENDING OUTPUT TOO? PUSHJ P,LOGOUT ;NO, SEND VEBATIM TXNE F2,S.LOUT PUSHJ P,TYOM ;SEND TO LOG FILE SOJG A,LOGLP ;EMPTY BUFFER TXO F2,S.OLOG ;ONLY IN LOG FILE IF ANYWHERE TXNN F2,S.LOUT PUSHJ P,CRR TXZ F2,S.OLOG ;SO TYPE OUT HAPPENS CORRECTLY POPJ P, SUBTTL PROCESS SPECIAL COMMAND EDITING CHARACTERS LI5: CAIN CH,.CHCNR ;^R? JRST CNTRLR ;YES TXZ F2,S.CTLR ;NO, CLR FLAG IN CASE PRECEDING CHAR WAS TXO F2,S.SLOG ;DON'T TYPE ANYTHING INTO LOG FILE HERE CAIN CH,.CHCNU ;^U? JRST CNTRLU ;YES CAIN CH,.CHBEL ;BELL? JRST LI6 ;YES TXZN FF,F.BELL ;NO, PREVIOUS CHAR A BELL? JRST LI1 ;NO, GET NEXT CHARACTER CAIN CH,"." ;IS THIS A PERIOD? JRST [MOVE D,COMCNT SUBI D,2 SETZM COMCNT MOVE AA,CBUF ILDB CH,AA SKIPN D PUSHJ P,BACKUP PUSHJ P,RETYP3 JRST LI2] ;RETYPE ENTIRE COMMAND CAIE CH," " ;YES, IS THIS A SPACE? JRST LI1 ;NO PUSHJ P,RETYPE ;YES, GO DO A RETYPE JRST LI2 RETYPE: PUSHJ P,BACKUP ;BACK OFF ^G SOS D,COMCNT ;MARK CURRENT POSITION PUSHJ P,BACKLN ;BACK UP TO BEG OF LINE JRST RETYP3 ;HIT BEG OF COMMAND STRING JRST RETY3A ;[331] Found a CR-EOL RETYP3: PUSH P,CH ;SAVE 1ST CHAR PUSHJ P,CRR ;TYPE CR-LF BEFORE COMMAND LINE MOVEI CH,"*" ;RETYPE THE * PUSHJ P,TYOM POP P,CH ;RETRIEVE 1ST CHARACTER RETY3A: PUSH P,ETVAL ;[331] Save ET value SETZM ETVAL ;[331] ET=0 for retyping JUMPE CH,RETYP4 ;DON'T PRINT ^@ IF NULL COMMAND STRING RETYP1: SKIPL COMCNT ;SEE IF ANY COMMANDS PUSHJ P,TYOM ;TYPE A CHAR OF COMMAND LINE RETYP4: AOS C,COMCNT ;ADVANCE COMMAND CTR CAIL C,(D) ;BACK IN PLACE? JRST RETYP2 ;YES ILDB CH,AA ;NO, GET NEXT CHAR JRST RETYP1 RETYP2: POP P,ETVAL ;[331] Restore ET value CAIN CH,.CHESC ;LOOKING AT AN ALTMODE? TXO FF,F.ALT ;YES, BETTER SET FLAG POPJ P, ;RETURN LI6: TXOE FF,F.BELL ;YES. SET BELL FLAG. TWO SUCCESSIVE BELLS? SOJA A,LI8 ;YES, REJECT COMMAND TXO FF,F.DDTM ;GET ANOTHER CHAR WITH TTCALL 0 JRST LI2 LI8: MOVEM A,COMLEN PUSHJ P,CRR ;YES. TYPE A CRLF TXO F2,S.GOIN!S.ASTR ;SO YOU CAN DO *I AFTER ^G^G JRST GO ;AND CLEAR COMMAND BUFFER. SUBTTL BACK UP BYTE POINTER IN AA, LOAD APPROPRIATE CHARACTER IN CH, ;AND ADJUST COMCNT BACKUP: ADD AA,[7B5] ;BACK UP CHAR PTR JUMPG AA,.+2 ;OK NOW? SUB AA,[430000,,1] ;NO NEEDS FURTHER FIXING LDB CH,AA ;LOAD CHAR SOS C,COMCNT ;DECREMENT COMMAND COUNT POPJ P, ;BACKUP TO BEGINNING OF CURRENT LINE ;CALL: PUSHJ P,BACKLN ; RETURN IF BACKUP WENT TO BEGINNING OF COMMAND STRING ; RETURN IF CR-EOL COMBINATION FOUND BACKLN: PUSHJ P,BACKUP ;BACK UP ONE CHAR JUMPLE C,CPOPJ ;RETURN IF NOTHING LEFT BACKL1: PUSHJ P,CKEOL ;IS THIS AN EOL CHAR? JRST BACKLN ;NO, KEEP BACKING UP PUSHJ P,BACKUP ;YES, BACK UP ONE MORE CAIE CH,.CHCRT ;IS THIS A CR? JRST BACKL1 ;NO, MAYBE ANOTHER EOL? JRST CPOPJ1 ;YES, TAKE SKIP RETURN ;PROCESS CONTROL-U CNTRLU: PUSHJ P,TYOM ;ECHO THE ^U PUSHJ P,BACKLN ;BACK UP TO BEG OF LINE JUMPLE C,CTLU1 ;IF NOTHING LEFT, RETYPE * AOS COMCNT ;KEEP CRLF IBP AA CTLU1: IFN CRT, PUSHJ P,CRR ;OUTPUT A REGULAR CRLF JUMPLE C,CLIS ;IF NOTHING LEFT, START FROM SCRATCH JRST LI1 ;CONTINUE TYPE-IN ;CONTROL-R IN COMMAND MODE PREVENTS AN ALTMODE AFTER IT ;FROM BEING A TERMINATOR CNTRLR: TXZN F2,S.CTLR ;^R ON ALREADY? TXO F2,S.CTLR ;NO, SET FLAG JRST LI1 SUBTTL SPECIAL "IMMEDIATE" COMMAND PROCESSOR ;[325] HERE TO MAKE AN INITIAL DO A "1LT$$" IM1LT: TXO F2,S.SLOG ;TURN OFF LOG FILE BRIEFLY MOVEI CH,.CHCRT ;[331] Type a to get to left margin PUSHJ P,TYOA ;[331] IFN CRT,< SKIPE CRTTYP ;DO WE HAVE A SCREEN, SKIPN DELLF ;AND A WAY OF GOING UP? JRST IM1LTA ;NO MOVEI A,DELLF ;WE ARE ON A CRT, PUSHJ P,OUTIMG ;[331] CANCEL THE SO WE DON'T WASTE SPACE MOVEI A,BACSEQ ;NOW GET RID OF THE "*" IN CASE OF BLANK LINE PUSHJ P,OUTMES ;... > ;END OF CRT IM1LTA: HRRI B,[BYTE (7) "+","L","T",.CHESC,.CHESC] ;LOG FILE COMMAND JRST IMCOM ;GO TO THE COMMON CODE ;HERE TO MAKE A <^H> DO A "-LT$$" IMN1LT: HRRI B,[BYTE (7) "-","L","T",.CHESC,.CHESC] ;[331] COMMAND FOR LOG FILE TXOA FF,F.NEG ;[331] FAKE A -1 ARG ;AND FALL INTO IM0LT FOR A WHILE... ;HERE TO MAKE A <;> DO A "0LT$$" IM0LT: TXZ FF,F.NEG ;[331] MAKE SURE F.NEG IS OFF TXO F2,S.SLOG ;TURN OFF LOG FILE IFN CRT,< SKIPE CRTTYP ;[331] ARE WE ON A SCREEN? JRST [SKIPE CTUSEQ ;[331] YES, DO WE HAVE A LINE DELETE MECHANISM? JRST [MOVEI A,CTUSEQ ;[331] YES, WE MUST BE ON A SCREEN PUSHJ P,OUTMES ;[331] DELETE THE LINE JRST IM0LT1] ;[331] GET BACK IN LINE ;[331] NO EOL, SO WE DO IT WITH BACKSPACE TXNE FF,F.NEG ;[331] WAS THIS A ;? JRST [PUSHJ P,BACONE ;[331] YES, SO BLANK OUT THE * JRST IM0LT1] ;[331] AND JUMP BACK IN LINE MOVEI A,BACCHR ;[331] IT WAS A ; SO BACK OVER IT PUSHJ P,OUTMES ;[331] PUSHJ P,BACTWO ;[331] AND BLANK OUT THE *; JRST IM0LT1] ;[331] NOW PROCEED > ;END OF CRT PUSHJ P,CRR ;NOT A SCREEN--DO A CRLF IM0LT1: TXNE FF,F.NEG ;HAVE WE ALREADY FAKED A -1 ARG? JRST IMCOM ;YES, SKIP AHEAD TO COMMON CODE TXO FF,F.ARG ;FAKE THE PRESENCE OF A 0 ARG. HRRI B,[BYTE (7) "0","L","T",.CHESC,.CHESC] ;COMMAND FOR LOG FILE ;FALL INTO COMMON CODE IMCOM: HRLI B,(POINT 7,) ;FORM POINTER FOR LOG FILE COMMAND MOVEI A,5 ;FIVE CHARACTERS MOVEM A,COMLEN ;SAVE IN CASE OF * COMMAND MOVE AA,CBUF ;GET START OF COMMAND BUFFER POP B,1(AA) ;STORE COMMAND THERE AOBJP B,.+1 ;READJUST B TXZ F2,S.SLOG ;TURN LOG FILE BACK ON TXNN F2,S.LIN ;TO PUT IT INTO LOG FILE? JRST IMCOM1 ;NO, SKIP THIS PUSH P,F2 ;SAVE FLAGS TXZ F2,S.LOUT ;PRETEND /NOOUT SO CRLF GETS PUT IN PUSHJ P,BUFTY0 ;GO INSERT COMMAND IN LOG FILE POP P,F2 ;RESTORE FLAGS IMCOM1: SETZM B ;PUT ZERO INTO B IN CASE WE'RE DOING "0LT" PUSHJ P,GETARG ;COMPUTE +L/0L/-L XOR B,C ;APPLY L MOVEMENT TO POINTER XORM B,PT ;... TXZ FF,F.ARG!F.ARG2 ;FAKE NO ARGS PUSHJ P,TYPE ;GO TYPE THE LINE JRST GO SUBTTL RUBOUT PROCESSOR IFE CRT,< DELCHR: > RUBOUT: TXO F2,S.SLOG SKIPG COMCNT ;ANYTHING TYPED IN? JRST CLIS1 ;NO, RETYPE * IFN RUBSW,< SETO A, ;GETLCH ON THIS TTY GETLCH A ;SET TO SUPPRESS ECHOING TLO A,4 SETLCH A PUSHJ P,SPLAT ;ACT LIKE THE MONITOR JRST RUB4 RUB1: SKIPGE COMCNT ;PAST BEGINNING OF COMMAND STRING YET? JRST RUB3 ;YES PUSHJ P,TYIDDT ;GET ONE CHARACTER CAIE CH,.CHDEL ;RUBOUT? JRST RUB2 ;NO RUB4: > LDB CH,AA ;RELOAD THE CHAR. SKIPE COMCNT ;UNLESS AT BEGINNING OF COMMAND STRING, PUSHJ P,TYOM ;ECHO THE DELETED CHAR. PUSHJ P,BACKUP ;BACK OVER THE CHAR. IFN RUBSW, IFE RUBSW, CAIN CH,"R"-100 ;IF PREVIOUS CHARACTER WAS ^R TXO F2,S.CTLR ;RESET FLAG IFE RUBSW, ;RESUME TYPE-IN IFN RUBSW,< JRST RUB1 ;TRY NEXT INPUT CHAR. RUB2: PUSH P,CH ;SAVE THIS GOOD GUY PUSHJ P,SPLAT ;TYPE THE SECOND \ POP P,CH ;GET THAT CHAR. BACK CAIE CH,.CHCNU ;CTRL-U? PUSHJ P,TYOM ;NO, ECHO IT PUSHJ P,TTCREE ;RESET TTCALL FOR ECHOING JRST LI3A ;PROCESS THIS CHAR. RUB3: PUSHJ P,SPLAT ;SECOND \ PUSHJ P,TTCREE ;RESET TTCALL MODE TO NORMAL JRST CLIS1 ;START A NEW COMMAND STRING > ;TYPE BACKSLASH IFN RUBSW,< SPLAT: MOVEI CH,"\" JRST TYOM > ;RESET TTCALL FOR ECHOING IFN RUBSW,< TTCREE: SETO A, ;GETLCH ON THIS TTY GETLCH A TLZ A,GL.LCP ;TURN OFF NO ECHO BIT SETLCH A POPJ P, > SUBTTL VIDEO RUBOUT PROCESSOR IFN CRT,< DELCHR: MOVE A,CRTTYP ;GET CRT FLAGS CAIN CH,.CHDEL ;IF ITS A DELETE, TRNN A,.CRUB. ;AND IT GETS NORMAL TREATMENT SKIPN CRTTYP ;OR CRTTYP IS 0 JRST RUBOUT ;THEN GO TO OLD ROUTINE TXO F2,S.SLOG ;NOTHING GOES INTO LOG FILE MOVEI A,CANRUB ;CANCEL THE EFFECT, IF ANY, OF THE RUBOUT CAIE CH,.CHDEL MOVEI A,CANBAK ;OR THE BACKSPACE PUSHJ P,OUTMES SKIPG COMCNT ;HAS ANYTHING BEEN SEEN? JRST BACNON ;NO PUSHJ P,HORPOS ;GO FIGURE OUT HORIZONTAL POSITION LDB CH,AA ;GET DOOMED CHARACTER CAIG CH,.CHBEL ;^G OR LESS? JRST BACDUB ;YES, THEY ARE TWO WIDE CAIN CH,.CHCNH ;BACKSPACE? JRST BACBAK CAIN CH,.CHTAB ;TAB? JRST BACTAB CAIG CH,.CHFFD ;EOL? (LF, VT, FF) JRST BACEOL CAIN CH,.CHCRT ;CARRIAGE RETURN? JRST BACCR CAIE CH,.CHESC ;ALTMODE, CAIL CH," " ;BLANK OR GREATER? JRST BACNOR BACDUB: PUSHJ P,BACTWO ;HERE TO RUBOUT A CHAR OF WIDTH 2 TRNA ;[331] BACNOR: PUSHJ P,BACONE DELDON: PUSHJ P,BACKUP ;WIPE IT FROM COMMAND STRING CAIL E,(OU) ;ARE WE BACK TO A FREE CRLF? JRST LI1 ;NO, RETURN DELFIN: PUSHJ P,HORPOS ;YES, GO RECALCULATE LENGTH PUSHJ P,BACREW ;AND RETYPE ABOVE LINE JRST LI1 ;AND RETURN BACEOL: MOVEI T,1 ;GET MULTIPLIER (LF=1) CAIE CH,.CHLFD ;IF NOT LF, MOVE T,VTMUL-13(CH) ;GET REAL MULTIPLIER MOVEI TT,DELLF-12(CH) ;GET PROPER STRING MOVEI A,FORCHR ;GET READY TO UNDO THE BACKSPACE MOVE CH,CRTTYP ;GET THE FLAGS FOR THIS CRT TRNE CH,.CWAP. ;IF THIS CRT DOES WRAP AROUND, SKIPE E ;OR IF WE ARE NOT AT THE LEFT MARGIN PUSHJ P,OUTMES ;THEN CANCEL THE BACKSPACE EOL1: JUMPLE T,DELDON ;FINISHED? MOVE A,TT ;GET STRING PUSHJ P,OUTIMG ;[331] AND TYPE IT SOJA T,EOL1 ;LOOP BACCR: MOVEI A,DELCR PUSHJ P,OUTIMG ;[331] IBP AA AOS COMCNT PUSHJ P,RETYPE ;FAKE A ^G JRST LI2 ;WE'RE DONE BACBAK: MOVEI A,FORCHR ;CANCEL A BACKSPACE PUSHJ P,OUTMES PUSHJ P,BACKUP JRST LI1 BACNON: MOVE CH,CRTTYP ;GET FLAGS TRNE CH,.CNCR. ;SHOULD WE SEND A LONE CR? JRST CLIS ;NOPE MOVEI CH,.CHCRT ;TYPE A CR PUSHJ P,TYOA JRST CLIS ;AND RETYPE * HORPOS: MOVE TT1,COMCNT ;SAVE CURRENT CHARACTER COUNT SETZ E, ;INIT LINE WIDTH TO 0 LDB CH,AA ;GET CURRENT CHAR PUSHJ P,BACKL1 ;BACK UP TO THE BEGINNING OF CURRENT LINE AOS E ;IF INITIAL LINE, THEN ACCOUNT FOR * MOVE T,AA ;SAVE POINTER MOVE TT,COMCNT ;AND COMMAND COUNT IBP T ;BUMP THE POINTER UP, TO PLEASE RETYPE POS2: MOVE OU,E ;SAVE LENGTH ILDB CH,AA ;GET NEXT CHAR PUSHJ P,LENCHR ;CALCULATE LENGTH OF CHARACTER AOS D,COMCNT ;BUMP CHAR COUNT CAIL D,(TT1) ;ARE WE BACK IN PLACE YET? POPJ P, ;YES JRST POS2 BACTAB: PUSHJ P,BACKUP ;GET RID OF THE TAB CAIGE E,(OU) ;ARE WE AT A FREE CRLF? JRST DELFIN ;YES SUBI E,1(OU) ;GET LENGTH OF TAB-1 BTAB1: JUMPLE E,LI1 ;RETURN IF LENGTH IS 0 MOVEI A,BACCHR ;BACK UP PUSHJ P,OUTMES SOJA E,BTAB1 ;LOOP BACREW: MOVEM T,AA ;HERE WHEN WE BACK UP OVER A FREE CRLF MOVEM TT,COMCNT ;RESTORE AA AND COMCNT (LAST TIME POS=0) SKIPN DELLF ;IF DELLF IS NULL, DONT BOTHER WITH THIS JRST BACRW0 MOVEI A,DELLF PUSHJ P,OUTIMG ;MOVE UP TWO LINES PUSHJ P,OUTIMG PUSHJ P,CRR ;TYPE A CRLF TO RESET HOR. POS. BACRW0: MOVEI CH,"*" ;ARE WE AT THE BEGINING OF A COMMAND? SKIPN COMCNT PUSHJ P,TYOA ;YES BACRW1: LDB CH,AA PUSHJ P,CKEOL ;WE DONT WANT EOL'S PJRST RETY3A ;[331] GO FAKE ^G IBP AA ;GET THE NEXT ONE AOS COMCNT JRST BACRW1 ;LOOP BACONE: MOVEI A,BACSEQ ;TO BACK OVER AND BLANK OUT A CHARACTER PJRST OUTMES BACTWO: PUSHJ P,BACONE ;HERE TO DELETE A DOUBLE CHAR MOVEI A,BACCHR PUSHJ P,OUTMES PJRST BACONE ;[331] ONCE AGAIN ;ROUTINE TO CALCULATE THE WIDTH OF A CHARACTER LENCHR: SETZ D, CAIE CH,.CHESC ;AN ALTMODE CAIL CH," " ;OR ANYTHING " " OR OVER AOJA D,LEN1 ;IS OF WIDTH 1 CAIN CH,.CHCNH ;A BACKSPACE IS -1 SOJA D,LEN2 CAIN CH,.CHLFD ;A LINEFEED IS 0 JRST LEN1 CAIN CH,.CHVTB ;A VERTICAL TAB MAY BE SPECIAL JRST [ADD D,VTWID JRST LEN1] CAIN CH,.CHFFD ;A FORM FEED MIGHT ALSO JRST [ADD D,FFWID JRST LEN1] CAIE CH,.CHTAB ;A TAB? JRST [ADDI D,2 ;NOPE, ALL ELSE OF WIDTH 2 JRST LEN1] ADDI E,10 ;STANDARD TAB WIDTH TXZ E,7 ;BUT MUST BE MULTIPLE OF 8 MOVEI D,10 SKIPA LEN1: ADD E,D ;THIS IS THE NEW LENGTH LEN2: CAMG E,TTYWID POPJ P, MOVE E,D ;WE ARE AT A FREE CRLF MOVE T,AA ;SO SAVE THE BP AND THE COUNT MOVE TT,COMCNT POPJ P, > ;END OF CRT CONDITIONAL SUBTTL COMMAND DECODER STOP: MONRT. ;SIMULATE ^C AT MACRO LEVEL CD:RET: HRRZS EATCH ;FLAG NOT TO EAT AFTER : ANYTHING FAILS TXZE FF,F.COLN ;F.COLN WHATEVER? JRST FFOK ;RETURN -1, WHATEVER IT WAS IT WAS SUCCESSFUL RETRET: TXZ FF,F.EBTP!F.ARG2!F.ARG!F.LARW!F.NSRH!F.SQIN!F.SRCH TXZ F2,S.SSEQ!S.DPPN!S.OLOG!S.SLOG!S.MINS!S.DOIT!S.INFO!S.DELS SKIPE INI ;IF INI FILE IN PROGRESS, NO COMMAND SEEN TXO F2,S.GOIN ;A COMMAND STRING IS IN CD1: SETZM NUM ;NO ARGUMENT STRING SEEN SETZM SYL TXZ FF,F.NEG ;CLEAR MINUS SIGN FLAG MOVX A, ;STANDARD ARG OPERATOR IS MOVE B,SYL CD3: HLLM A,DLIM CD5: PUSHJ P,RCH CD9: SKIPN XCTING ;KEEP GOING? JRST GO ;NO STOP MOVE A,CH ;GET COMMAND CHARACTER CAIL CH,"0" ;IS IT A DIGIT? CAILE CH,"9" TRNA ;[331] No, go clear flags JRST CD91 ;[331] Yes, leave flags alone TXZ FF,F.SYL ;[331] Clear digit string bit TXZ F2,S.OCTL ;NO, CLEAR OCTAL RADIX FLAG CD91: CAIE A,140 ;[331] 140 IS ILLEGAL CAILE A,172 ;ALSO 173-177 ARE ILLEGAL MOVEI A,0 CAILE A,137 ;REDUCE LOWER CASE TO UPPER SUBI A,40 ROT A,-1 ;DIV BY 2 JUMPL A,CD92 ;ODD CHARACTER HLRZ A,DTB(A) ;GET CODE & ADDR FOR EVEN CHAR. JRST CD93 CD92: HRRZ A,DTB(A) ;GET CODE & ADDR FOR ODD CHAR. CD93: TXZ F2,S.DOIT!S.INFO!S.MINS!S.EA!S.DPPN!S.YANK ;CLEAR INI FILE FLAGS TXZ FF,F.INIT!F.FILE TRNN A,300000 ;IS IT A JRST DISPATCH WITH NO ARG PROCESSING? JRST (A) ;YES, DO IT MOVE B,NUM ;NO, TAKE CARE OF ARGUMENTS MOVE C,DLIM ;GET DLIM TLNE C,777K ;IF NO OPERATION DON'T DO IT! XCT C ;NUM:=NUM (DLIM OPERATOR) SYL MOVEM B,NUM SETZM SYL ;CLEAR OLD OPERAND MOVSI C,(MOVE B,) ;DON'T USE THE SAME OP TWICE! HLLM C,DLIM ;SO RESET DLIM MOVE C,SARG ;SAVE SECOND ARGUMENT IN C. TXZ F2,S.CTLV+S.CTVV+S.CTLW+S.CTWW+S.EMAT+S.NCCT ;[344] MOVEM P,PDLSAV TRZ A,100000 ;CLR PUSHJ DISPATCH BIT TRZE A,200000 ;JRST OR PUSHJ DISPATCH? JRST (A) PUSHJ P,(A) JRST RET SUBTTL NUMERIC INPUT, VALRET, & ALTMODE PROCESSOR ;DIGITS FORM DECIMAL INTEGERS. CDNUM: TXON FF,F.SYL ;DIGIT STRING ALREADY STARTED? SETZM SYL ;NO, INIT TO ZERO MOVEI A,12 ;RADIX 10 TXNN F2,S.OCTL ;OCTAL FLAG ON? JRST CDNUM1 ;NO MOVEI A,10 ;YES, RADIX 8 CAILE CH,"7" ;FLAG 8 OR 9 IN OCTAL STRING ERROR E.OCT CDNUM1: IMUL A,SYL ;SCALE PREVIOUS VALUE ADDI A,-60(CH) ;ADD IN NEW DIGIT ;SOME COMMANDS HAVE A NUMERIC VALUE VALRET: HRRZS EATCH ;CLEAR THE EAT FLAG MOVEM A,SYL CD7: TXO FF,F.ARG JRST CD5 ALTMOD: SKIPN COMCNT ;ANY COMMANDS LEFT? JRST ALTM2 ;NO MOVE T,CPTR ;IF NEXT COMMAND CHARACTER IS ALT-MODE, GO ILDB CH,T CAIE CH,.CHESC JRST CD ALTM1: TXNE FF,F.TRAC ;TRACING? PUSHJ P,CRR ;YES, TYPE CR/LF BEFORE * JRST GO ALTM2: SKIPN EQM ;WITHOUT A MACRO ? JRST GO ;NO JRST CD ;MACRO RETURN ;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER. UAR: PUSHJ P,SKRCH ;GET NEXT COMMAND CHARACTER. ERROR E.MEU TRZ CH,140 ;CHANGE IT TO CONTROL CHARACTER JRST CD9 ;DISPATCH SUBTTL COMMA & PARENTHESES PROCESSOR ;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM COMMA: MOVEM B,SARG ;SAVE CURRENT ARGUMENT IN SARG. TXZE FF,F.ARG ;WAS THERE A CURRENT ARGUMENT? TXOE FF,F.ARG2 ;YES. WAS THERE ALREADY A SECOND ARGUMENT? ERROR E.ARG JRST CD1 ;YES. CLEAR CURRENT ARGUMENT. ;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN FOR +,-,*,/,& AND #. OPENP: PUSH P,NUM ;PUSH CURRENT ARGUMENT. PUSH P,DLIM ;CURRENT OPERATOR PUSH P,[1] ;SET PAREN FLAG ON PDL JRST CD1 CLOSEP: POP P,T ;LAST THING ON PDL A LEFT PAREN? JUMPL T,CLOSE1 ;SOMETHING LIKE (...<...) SOJN T,CLOSE2 ;MISSING ( MOVEM B,SYL ;YES. SAVE CURRENT ARGUMENT. POP P,DLIM ;RESTORE OPERATOR POP P,NUM ;RESTORE ARGUMENT. JRST CD7 CLOSE1: ERROR E.PAR CLOSE2: ERROR E.MLP ;^O SETS FLAG FOR OCTAL RADIX INPUT OCTIN: TXO F2,S.OCTL JRST CD5 ;RETURN WITHOUT MESSING UP ARGUMENTS ;IF 'HE' CAN HAVE ^F READ THE SWITCHES I CAN HAVE N^F RETURN ;THE TTY NUMBER OF JOB N + 200000 OCTAL OR ZERO IF NONE!!!! WHERE: TRMNO. B, ;WHAT TTY HE ON JRST BEGIN ;ZERO, NOT ONE ONE MOVE A,B ;RETURN VALUE JRST VALRET ;... SUBTTL MATHEMATICAL & LOGICAL OPERATORS ;LOGICAL AND CAND: MOVSI A,(AND B,) ;DLIM = AND B,SYL JRST CD3 ;LOGICAL OR COR: MOVSI A,(OR B,) ;DLIM = OR B,SYL JRST CD3 ;ADD TAKES ONE OR TWO ARGUMENTS PLUS: MOVSI A,(ADD B,) ;DLIM = ADD B,SYL JRST CD3 ;SUBTRACT TAKES ONE OR TWO ARGUMENTS MINUS: MOVSI A,(SUB B,) ;DLIM = SUB B,SYL TXO FF,F.NEG ;SET FLAG FOR -L, -T, ETC... JRST CD3 ;MULTIPLY TAKES TWO ARGUMENTS TIMES: MOVSI A,(IMUL B,) ;DLIM = IMUL B,SYL JRST CD3 ;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS SLASH: MOVSI A,(IDIV B,) ;DLIM = IDIV B,SYL JRST CD3 SUBTTL FLAGS - EOF, FORM FEED & . H Z POSITIONS ;RETURNS THE VALUE OF THE FORM FEED FLAG FFEED: TXNE FF,F.FORM ;IS IT SET? JRST FFOK ;YES, RETURN A -1 JRST BEGIN ;NO, DO BEGIN ROUTINE ;RETURNS THE NUMERIC VALUE 0. ABEGIN: SKIPL EATCH ;TO MUNCH? JRST BEGIN ;NO, PIG! MOVEI B,.CHESC ;TECO'S ALTMODE HRRZS CH,EATCH ;GET LAST CHARACTER INPUT FROM COMMAND SAMECH: CAMN CH,B ;SAME? JRST BEGIN ;RETURN FAILURE VALUE READNT: PUSHJ P,SKRCH ;GET ANOTHER CHARACTER IF NOT ERROR E.UCS JRST SAMECH ;LOOP TIL U SEE IT BEGIN: MOVEI A,0 JRST VALRET ;^N RETURNS VALUE OF EOF FLAG EOF: TXNN FF,F.EOFI ;EOF SEEN? JRST BEGIN ;NO, RETURN 0 JRST FFOK ;YES, RETURN -1 ;AN ABBREVIATION FOR B,Z HOLE: SETZM SARG ;SET SECOND ARGUMENT TO 0. TXNE FF,F.ARG2 ;FLAG ANY ARGS BEFORE H ERROR E.ARG TXOA FF,F.ARG2 ;.=NUMBER OF CHARACTERS TO THE LEFT OF THE POINTER PNT: SKIPA A,PT ;Z=NUMBER OF CHARACTERS IN THE BUFFER END1: MOVE A,Z SUB A,BEG JRST VALRET ;RETURN LENGTH OF LAST TEXT STRING PROCESSED IFN VC,< VCMD: MOVE A,VVAL ;LENGTH OF LAST TEXT JRST VALRET > SUBTTL = & ^T COMMANDS ;N= CAUSES THE VALUE OF N TO BE TYPED OUT. PRNT: TXNN FF,F.ARG ;INSIST ON ARG BEFORE = ERROR E.NAE MOVE A,CPTR ;SNEAK A LOOK AT NEXT COMMAND CHAR. ILDB CH,A CAIE CH,"=" ;ANOTHER = SIGN? JRST PRNT9 ;NO TXO F2,S.OCTL ;YES, THAT MEANS OCTAL RADIX TYPE-OUT PUSHJ P,SKRCH ;SWALLOW THE EXTRA = TXZ F2,S.OCTL ;AT END OF MACRO PRNT9: PUSHJ P,PRNT9S ;PRINT NUMBER TXZN FF,F.ARG2 ;TWO ARGS? JRST CRR ;CRLF AND RETURN TO CALLER JUMPL C,CRR ;NEG ARG MEANS CRLF WANTED JUMPE C,CPOPJ ;NOTHING IF ZERO MOVE CH,C ;GET CHARACTER TO BE OUTPUT JRST TYO ;ELSE TYPE CHAR AND RETURN ;TYPE C(B) IN OCTAL OCTMS: TXOA F2,S.OCTL ;SET OCTAL RADIX DECMS: TXZ F2,S.OCTL ;DECIMAL RADIX PRNT9S: MOVEI A,TYO ;OUTPUT ON TTY PUSHJ P,DPT ;TYPE NUMBER ;[323] S.OCTL IS NOW CLEARED IN DPT ;[323] TXZ F2,S.OCTL ;CLR RADIX FLAG POPJ P, ;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER ;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN. SPTYI: SETZM XCTING ;SO NO WAIT FOR INPUT ON ^C REE TXZE FF,F.COLN ;EXTENDED TTY OPERATIONS? JRST EXTTTY ;YES TXO FF,F.DDTM PUSHJ P,TYI ;GET A SINGLE CHAR. SETOM XCTING ;RESET FLAG, HAVE CHARACTER SKIPA A,CH SUBTTL ^H, ^F AND ^^ COMMANDS ;HAS THE VALUE OF ELAPSED TIME, IN 60THS OF A SECOND, SINCE MIDNITE. GTIME: TIMER A, JRST VALRET ;HAS THE VALUE OF THE CONSOLE DATA SWITCHES. LAT: TXZE FF,F.ARG+F.ARG2 ;EITHER OF THESE ON GO TO WHERE JRST WHERE ;... SWITCH A, JRST VALRET ;HAS THE VALUE OF THE NEXT CHARACTER IN THE COMMAND STRING. CNTRUP: PUSHJ P,SKRCH ;^^ HAS VALUE OF CHAR FOLLOWING IT ERROR E.MUU MOVE A,CH JRST VALRET SUBTTL EXTENDED ^T OPERATIONS ;TABLE FOR EXTENDED TTY OPERATIONS ;FORMAT FIRST WORD 1B ON = LEGAL TTCALL ; SECOND WORD 1B ON = SHOULD SKIP (0 RETURNED IF NOT) ; THIRD WORD 1B ON = RETURNS A VALUE ELSE NOTHING TABLE1: ^B111011111111110000000000000000000000 TABLE2: ^B001001000001100000000000000000000000 TABLE3: ^B101011100000000000000000000000000000 EXTTTY: MOVE A,C ;I LIKE TO DO IT THIS WAY!! MOVN E,B ;GET - TTCALL NUMBER SKIPLE E ;WAS IT A NEGATIVE TTCALL? JRST HACK ;YES MOVSI CH,400K ;TO DETERMINE WHAT TO DO LSH CH,(E) ;GET IT TDNN CH,TABLE1 ;LEGAL? ERROR E.ITT CAIN B, ;RESCAN FUDGE FUNCTIONS? JRST REFUDG ;YES, DO THEM TXZ FF,F.ARG2 ;SO NO TWO ARGS RETURNS MOVE E,[TTCALL 0,A] ;FOR XCT DPB B,[POINT 4,E,12] ;MAKE A TTCALL N, XCT E ;DO IT JRST NOSKP ;SEE WHAT TO DO SETOM XCTING ;RESET I AM DOING SOMETHING FLAG TDNN CH,TABLE3 ;DOES HE GET -1 OR C(A) SETO A, ;-1 JRST VALRET ;MAKE IT AVAILABLR NOSKP: SETOM XCTING ;FIX ACTIVE FLAG TDNE CH,TABLE2 ;SHOULD HAVE SKIPPED JRST BEGIN ;RETURN ZERO TDNN CH,TABLE3 ;RETURN A VALUE? JRST RET ;NO JRST VALRET ;ELSE THROW THING IN A AT HIM REFUDG: SETOM XCTING ;KEEP GOING!!!! MOVE E,[RESCAN 1] ;ASSUME GOING TO RESCAN COMMAND LINE TXZE FF,F.ARG2 ;TWO ARGS = RETURN VALUE OF CCL FLAG MOVE E,[SKIPE CCLSW] ;TEST CCL SWITCH XCT E JRST FFOK ;COMMAND THERE = -1 JRST BEGIN ;0, NOTHING THERE HACK: SETOM XCTING CAILE E,2 ;LEGAL? ERROR E.ITT SETSTS TTY,@NOECHO-1(E) JRST RET NOECHO: EXP IO.SUP!IO.FCS!.IOASC ECHO: EXP IO.FCS!.IOASC SUBTTL BACKSLASH PROCESSOR ;HAS THE VALUE OF THE NUMBER REPRESENTED BY THE DIGITS (OR MINUS SIGN) ;FOLLOWING THE POINTER IN THE BUFFER. THE SCAN TERMINATES ON ANY OTHER ;CHARACTER. THE POINTER IS MOVED OVER THE NUMBER FOUND (IF ANY). BAKSL: MOVE A,CPTR ;[323] GET THE COMMAND BYTE POINTER ILDB CH,A ;[323] SNEAK A LOOK AT NEXT CHAR. CAIN CH,"\" ;[323] IS IT ANOTHER BACKSLASH? PUSHJ P,SKRCH ;[323] YES, TRY GETTING IT FOR REAL TXZA F2,S.OCTL ;[323] NOPE, CLEAR OCTAL FLAG TXO F2,S.OCTL ;[323] SET OCTAL FLAG TXZE FF,F.ARG ;WHICH KIND OF BACKSLASH? JRST BAKSL1 ;ARG TO MEMORY MOVEI A,^D10 ;[323] ASSUME DECIMAL RADIX TXZE F2,S.OCTL ;[323] IS IT REALLY OCTAL? MOVEI A,^D8 ;[323] YES, SET IT MOVE I,PT ;MEMORY TO VALRET CAML I,Z ;CAN WE READ ANOTHER? JRST BAKSL3 ;NO PUSHJ P,GETINC ;CK FOR +,- SIGN CAIN CH,"+" JRST BAKSLA ;IGNORE + CAIE CH,"-" JRST BAKSL0 ;NO SIGN TXO FF,F.ARG ;NEGATION FLAG BAKSLA: CAML I,Z ;OVERDID IT ? JRST BAKSL3 ;YES. EXIT PUSHJ P,GETINC ;NO. GET A CHAR BAKSL0: CAIGE CH,"0"(A) ;[330] DIGIT? CAIGE CH,"0" ;DIGIT? SOJA I,BAKSL2 ;NOT A DIGIT. BACKUP AND LEAVE LOOP SUBI CH,"0" ;CONVERT TO NUMBER EXCH CH,SYL IMULI CH,(A) ;[323] ADDM CH,SYL ;[323] SYL:= RADIX*SYL+CH JRST BAKSLA ;LOOP BAKSL3: MOVE I,Z ;HERE ON OVERFLOW BAKSL2: TXZE FF,F.ARG ;MINUS SIGN SEEN? MOVNS SYL ;YES. NEGATE MOVEM I,PT ;MOVE POINTER PAST # JRST CD7 ;DONE SUBTTL nA COMMAND ;nA (WHERE n IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE ;nTH CHARACTER TO THE RIGHT OF THE POINTER. 0A WILL RETURN THE ;CHARACTER TO THE LEFT OF THE POINTER, -NA WILL RETURN THE N+1st ;CHARACTER TO THE LEFT OF THE POINTER. IF .+N-1 IS NOT WITHIN ;BOUNDS, A 0 WILL BE RETURNED, EXCEPT IN THE CASE OF M,NA, IN ;WHICH CASE M IS RETURNED. ACMD: TXNE FF,F.ARG ;[346] No argument implies Append TXNE FF,F.COLN ;[346] Or is there a colon? JRST APPEND ;Yes. THIS IN AN APPEND COMMAND. SETZ CH, ;[346] Set up 0 for return value CHKEO EODEC,ACMD2 ;[346] If EO = 2, do old-style 1A TXZE FF,F.ARG2 ;[346] Was there a 2nd arg? MOVE CH,C ;[346] Yes, use it instead ACMD1: SOS I,B ;[346] Get arg-1 ADD I,PT ;[346] Add in point CAML I,BEG ;[346] Check bounds CAML I,Z ;BUFFER EMPTY OR PT=Z TRNA ;[346] Out of bounds PUSHJ P,GET ;CH:=CHARACTER TO THE RIGHT OF PT. MOVE A,CH ;RETURN CH AS VALUE. JRST VALRET ACMD2: MOVEI B,1 ;[346] IF EO < 3, make arg=1 JRST ACMD1 ;[346] SUBTTL Q-REGISTER COMMANDS -- U & Q ;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I. ;M,NUI PUTS N INTO Q-REGISTER I AND RETURNS M. USE: TXNN FF,F.ARG ;INSIST ON ARG BEFORE U ERROR E.NAU PUSHJ P,CRANGE ;[332] Go check range of argument USEA: PUSHJ P,QREGVI ;YES. CH:=Q-REGISTER INDEX. USEA1: MOVEM B,QTAB-"0"(CH) ;STORE ARGUMENT IN SELECTED Q-REG. TXZN FF,F.ARG2 ;[332] IS THERE A SECOND ARG? JRST RET ;[332] NO, RETURN MOVE A,C ;[332] YES, RETURN IT JRST VALRET ;[332] ;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I. QREG: PUSHJ P,QTXTST ;GET Q-REGISTER INDEX & CHECK FOR TEXT JRST VALRET PUSHJ P,QTEXEI ;GET Q REG ADR PUSHJ P,GTQCNT ;# CHARS IN Q REG MOVE B,CPTR ;GET COMMAND POINTER ILDB CH,B ;QA= (IE TYPE TEXT IN Q REG)? CAIE CH,"=" ;... ..ERROR E.NNQ PUSHJ P,SKRCH ;EAT = ..ERROR E.NNQ MOVE OU,I ;BEG OF Q REG MOVE B,OU ;START CHARACTER ADD B,C ;END MOVEI D,TYO ;ROUTINE TO TYPE CHARS SETZM XCTING ;SO ^C^C REE WORKS PROPERLY PUSHJ P,TYPEQ ;TYPE CONTENTS OF Q-REG SETOM XCTING ;DONE TYPING JRST RET ;DONE ;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A. QREGVI: PUSHJ P,SKRCH ;CH:=NEXT COMMAND STRING CHARACTER. ERROR E.MIQ QREGV2: CAIE CH,"*" ;EI REG? JRST NOTEI MOVEI CH,"Z"-<"A"-"9"-1>+1 ;INDEX INTO QTAB POPJ P, NOTEI: CAIL CH,"A"+" "-1 ;LC LETTER? TXZ CH,40 ;MAKE UC CAIGE CH,"0" ;DIGIT? ERROR E.IQN ;BAD NAME CAIG CH,"9" POPJ P, ;YES CAIL CH,"A" ;LETTER? CAILE CH,"Z" ERROR E.IQN ;BAD NAME SUBI CH,"A"-"9"-1 ;TRANSLATE LETTERS DOWN BY NUMBER OF POPJ P, ;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q-REG'S ;[332] Routine to check range of number to be stored in a Q-reg. CRANGE: TLNE B,400000 ;[332] Does arg look like a text pointer? TLNE B,377777 ;[332] (I.E. less than -377777,,0?) POPJ P, ;[332] OK, return ERROR E.AOR ;[337] Out of range SUBTTL Q-REGISTER COMMANDS -- % ;%I ADDS 1 TO THE QUANTITY IN Q-REGISTER I AND STANDS FOR THE ; NEW VALUE PCNT: PUSHJ P,QTXTST ;GET Q-REG AND CHECK FOR TEXT AOSA A,QTAB-"0"(CH) ;INCREMENT Q-REG. ..ERROR E.NNQ JRST VALRET ;RETURN NEW VALUE. QTXTST: PUSHJ P,QREGVI ;GET Q-REG INDEX MOVE A,QTAB-"0"(CH) ;GET Q-REG CONTENTS TLNE A,400000 ;DOES IT CONTAIN TEXT? TLNE A,377777 POPJ P, ;YES, NON-SKIP RETURN JRST CPOPJ1 ;ELSE CONTAINS TEXT SUBTTL Q-REGISTER COMMANDS -- X ;M,NXI COPIES A PORTION OF THE BUFFER INTO Q-REGISTER I. ; IT SETS Q-REGISTER I TO A DUPLICATE OF THE (M+1)TH ; THROUGH NTH CHARACTERS IN THE BUFFER. THE BUFFER IS UNCHANGED. ;NXI INTO Q-REGISTER I IS COPIED THE STRING OF CHARACTERS STARTING ; IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH ; THE NTH LINE FEED. X: IFN VC, ;CLR STRING LENGTH HOLD PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS ;B:=SECOND STRING ARGUMENT ADDRESS. COPYEI: PUSHJ P,CHK1 ;IS SECOND ARG. ADDR. > FIRST ARG. ADDR.? EXCH B,C ;YES. SUB C,B ;[321] C:=LENGTH OF STRING MOVE A,C ;[321] A:=LENGTH OF STRING SAVED ADDI C,3 ;[321] C:=LENGTH OF STRING+3. IFN VC, ADD B,C ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 PUSHJ P,X3 ;MOVE DATA TO Q-REG BUFR TXNN FF,F.INIT ;INI FILE THING? JRST X0 ;[332] NO, MAKE QTAB ENTRY NORMALLY. MOVEM B,QTAB-"0"+ ;INTO * Q-REG POPJ P, ;AND RETURN X0: PUSHJ P,QREGVI ;[332] CH:=Q-Register index MOVEM B,QTAB-"0"(CH) ;[332] Store argument in selected Q-reg JRST RET ;[332] Return ;TRANSFER DATA TO Q-REGISTER BUFR X3: PUSH P,PT ADDM C,(P) ;(P):=PT + LENGTH OF STRING + 3. MOVE D,BEG MOVEM D,PT ;PT:=BEG PUSHJ P,NROOM ;INSERT STRING AT BEG MOVE OU,RREL ;RREL CONTAINS RELOCATION CONSTANT IF ;GARBAGE COL. OCCURRED. ADDM OU,(P) ;RELOCATE TOP OF STRING POINTER. CAML B,BEG ;[320] IF WE ARE DOING A *I, DON'T CHANGE B!! ADD B,OU ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 + RREL MOVE OU,BEG ;OU:=ADDRESS OF Q-REG BUFFER ADDM C,BEG ;BEG:=C(BEG)+LENGTH OF STRING + 3 MOVE CH,C ;FIRST CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS PUSHJ P,PUT ;OF LENGTH OF STRING + 3 AOS OU ;SECOND CHAR = MIDDLE 7 BITS OF LENGTH ROT CH,-7 PUSHJ P,PUT ROT CH,-7 MOVE I,B ;THIRD CHAR OF BUFFER := MOST SIGNIFICANT 7 BITS ;OF LENGTH OF STRING + 3 AOS OU X1: PUSHJ P,PUT ;MOVE STRING TO Q-REG BUFFER. AOS OU CAIN C,3 JRST X2 PUSHJ P,GETINC SOJA C,X1 X2: MOVE B,PT ;QTAB ENTRY :=XWD 400000,Q-REG BUFFER ;ADDRESS RELATIVE TO C(QRBUF) SUB B,QRBUF TLO B,400000 POP P,PT ;MOVE PT PAST STRING. POPJ P, SUBTTL Q-REGISTER COMMANDS -- G ;GI THE TEXT IN Q-REGISTER I IS INSERTED INTO THE BUFFER ; AT THE CURRENT LOCATION OF THE POINTER. THE POINTER IS THEN PUT JUST ; TO THE RIGHT OF THE INSERTION. THE Q-REGISTER IS NOT CHANGED. QGET: IFN VC, ;CLR STRING LENGTH HOLD PUSHJ P,QTEXT ;INIT Q-REG ACCESS MOVE B,CH ;SAVE INDEX PUSHJ P,GTQCNT ;C:=LENGTH OF STRING PUSHJ P,NROOMC ;MOVE FROM PT THROUGH Z UP C POSITIONS MOVE OU,PT HRRZ I,QTAB-"0"(B) ADD I,QRBUF ADDI I,3 QGET1: JUMPE C,RET ;MOVE STRING INTO DATA BUFFER PUSHJ P,GETINC PUSHJ P,PUT AOS OU,PT SOJA C,QGET1 ;GET 21 BIT Q-REGISTER CHARACTER COUNT GTQCNT: PUSHJ P,GETINC ;LOW ORDER 7 BITS MOVEM CH,C PUSHJ P,GETINC ;MIDDLE 7 BITS ROT CH,7 IORM CH,C PUSHJ P,GETINC ;HIGH 7 BITS ROT CH,^D14 IORM CH,C SUBI C,3 ;LESS 3 WORDS USED TO STORE THIS COUNT POPJ P, ;INITIALIZE ACCESS OF TEXT FROM A Q-REGISTER QTEXT: PUSHJ P,QREGVI ;A=QTAB ENTRY, CH=Q-REG INDEX QTEXEI: MOVE A,QTAB-"0"(CH) TLZE A,400000 ;MAKE SURE IT CONTAINS TEXT TLZE A,377777 ..ERROR E.NTQ ;NO TEXT ADD A,QRBUF MOVE I,A ;I=Q-REG BUFFER ADDRESS POPJ P, SUBTTL Q-REGISTER COMMANDS -- M, W, [ & ] ;MI PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS. MJRST: SKIPE EQM ;W @ CMD LEVEL = M JRST QACCES ;ELSE OK MAC: PUSHJ P,QTEXT ;INIT Q-REG ACCESS MAC1: PUSH P,COMAX ;SAVE CURRENT COMMAND STATE PUSH P,CPTR PUSH P,COMCNT PUSH P,. ;FLAG MACRO ON PDL (LARGE POS. NO.) AOSA EQM ;INCREMENT THE MACRO LEVEL QACCES: PUSHJ P,QTEXT ;INIT Q REG ACCESS FOR W COMMAND PUSHJ P,GTQCNT ;GET NUMBER OF CHARACTERS IN MACRO MOVEM C,COMCNT ;THAT MANY COMMANDS TO COUNT MOVEM C,COMAX ;AND MAX. SUBI I,1 ;ADJUST TO SUIT BTAB IDIVI I,5 MOVE OU,BTAB(OU) ;MAKE A BYTE POINTER HRR OU,I MOVEM OU,CPTR ;PUT IT IN CPTR JRST CD5 ;DON'T FLUSH ANY ARGUMENTS ;]I POPS Q-REGISTER I OFF THE Q-REGISTER PUSHDOWN LIST. ; THE Q-REGISTER PUSHDOWN LIST IS CLEARED EACH TIME $$ IS TYPED. CLOSEB: HLRZ C,PF ;GET PDL COUNT MOVEI B,"]" ;POP CAIG C,-LPF-1 ;UNDERFLOW? ERROR E.PDQ PUSHJ P,QREGVI ;[332] GET Q-REG INDEX POP PF,QTAB-"0"(CH) ;[332] POP THE Q-REG JRST RET ;[332] RETURN ;[I PUSHES Q-REGISTER I ONTO THE Q-REGISTER PUSHDOWN LIST. ;n[i EQUIVALENT TO [i FOLLOWED BY nUi. ;m,n[I EQUIVALENT TO [I FOLLOWED BY m,nUi. OPENB: TXNE FF,F.ARG ;[332] Is there an argument? PUSHJ P,CRANGE ;[332] Yes, go check the range PUSHJ P,QREGVI PUSH PF,QTAB-"0"(CH) ;[332] PUSH Q-REG TXNN FF,F.ARG ;[332] WAS THERE AN ARG? JRST RET ;[332] NO, RETURN JRST USEA1 ;[332] YES, GO STORE IT SUBTTL MISCELLANEOUS CHARACTER DISPATCHER ;CALL: MOVE CH,CHARACTER ; MOVEI T,TABLE ADDR ; PUSHJ P,DISPAT ; NOT FOUND RETURN ;ENTER AT DISP1 TO AVOID CONVERTING LC TO UC DISPAT: CAIG CH,"Z"+" " ;CONVERT LC TO UC CAIG CH,137 JRST DISP1 TXZ CH,40 DISP1: PUSH P,A ;SAVE AC A WHILE WE USE IT DISP2: MOVE A,(T) ;GET TABLE ENTRY JUMPE A,APOPJ ;END OF TABLE CAIE CH,(A) ;SAME AOJA T,DISP2 ;NOT A MATCH HLRZM A,-1(P) ;GOT IT -- PUT DISPATCH ADDR ON PDL JRST APOPJ ;RESTORE AC A & DISPATCH ;USETI ON ER'D FILE PROCESSOR ;USETI ONLY LEGAL IF NOT EB AND ER IS TRUE IUSET: JUMPLE B,USTERR ;ARG LESS THAN OR = ZERO LOSES TXNN FF,F.UBAK ;MUST NOT BE EB IN FORCE TXNN FF,F.IOPN ;BUT MUST HAVE INPUT FILE OPEN USTERR: ERROR E.UST USETI INCHN,(B) ;DO THE USETI MOVX T,BF.IOU ;MUST CLEAR ALL THE USE BITS HRRZ A,IBUF ;STARTING HERE HRRZ B,A ;ENDING HERE TOO USTILP: ANDCAM T,(A) ;CLEAR THE BIT HRRZ A,(A) ;NEXT BUFFER CAME A,B ;DONE? JRST USTILP ;LOOP FOR ALL BUFFERS SETZM IBUF+.BFCNT ;FORCE A READ (IN) STATO INCHN,IO.ERR!IO.EOF ;ANY PROBLEM ARISE? POPJ P, ;NO, RETURN TO HIM USETI INCHN,1 ;BACK TO START OF FILE ERROR E.UST SUBTTL ^G COMMAND (GETTAB OR EXIT) ;ROUTINE TO EXIT IF EO = 1 (OLD ^G) OR DO GETTAB BELDMP: CHKEO EO21,DECDMP ;OLD EXIT TXNE FF,F.ARG ;IF NO ARG THEN RETURN JOB NUMBER JRST BELDP0 ;THERE IS AN ARG... PJOB A, ;JOB NUMBER JRST VALRET ;RETURN IT BELDP0: MOVE A,B ;GET ADR OR TABLE NO. TXZN FF,F.ARG2 ;TWO ARGS? JRST BELPEK ;NOPE, DO A PEEK HRL A,C ;FORM GETTAB WORD GETTAB A, ;DO THE GETTAB SETZ A, ;RETURN ZERO ON ERROR JRST VALRET ;ELSE RETURN WHATEVER BELPEK: PEEK A, ;WILL IT WORK? JRST VALRET ;WE'LL NEVER KNOW... SUBTTL E COMMANDS -- DISPATCH ROUTINE & TABLE ECMD: PUSHJ P,SKRCH ;GET CHAR AFTER E ERROR E.MEE CAIG CH,"Z"+" " ;LOWER CASE GOES TO UPPER CAIGE CH,"A"+" " ;... CAIA SUBI CH," " ;TO UPPER CASE HRREI TT,-"A"(CH) ;CONVERT TO TABLE OFFSET SKIPL TT ;NEG IS ERROR CAILE TT,"Z"-"A" ;IS BOUNDS E$$IEC: ERROR E.IEC LSHC TT,-1 ;CALCULATE TABLE WORD & HALF MOVE TT,ECTABL(TT) ;GET ADRS OF PROCESSORS SKIPL TT1 ;HAVE IT MOVSS TT ;NO, NEED OTHER HALF JRST (TT) ;GO ;E-COMMAND DISPATCH TABLE ECTABL: XWD OPNWRA,EBAKUP ;EA,EB XWD ECORE,RUNFX ;EC,ED XWD EECMD,CLOSEF ;EE,EF IFN CCL, XWD E$$IEC,ERRSET XWD EICMD,E$$IEC ;EI, XWD EKILL,MAKLOG ;EK,EL XWD EMTAPE,RENAM ;EM,EN XWD OLDMOD,EPCMD ;EO,EP XWD E$$IEC,OPNRD ;,ER XWD AUTOTY,TYOCTL ;ES,ET XWD TYCASE,VIDEO ;EU,EV XWD OPNWR,FINISH ;EW,EX XWD YANK,ZERDIR ;EY,EZ SUBTTL E COMMANDS -- EL (SETUP AND OUTPUT ROUTINES) LOGOUT: TXZN F2,S.ASTR TXNE F2,S.SLOG ;SKIP LOG FILE? POPJ P, ;RIGHT SOSG OLOG+.BFCNT ;DECREMENT BUFFER COUNTER OUTPUT LOGCHN, ;DUMP BUFFER IF NO ROOM IDPB CH,OLOG+.BFPTR ;PUT CHARACTER TXNE F2,S.OLOG ;MISUSING TYOM? POP P,CH ;YES, FORCE NICE RETURN POPJ P, ;AND RETURN MAKLOG: TXNE FF,F.ARG ;ARGUMENT? JRST CHANGL ;YES, CHANGE OUTPUT SPECIFICATION TXNE F2,S.LOPN ;DO WE HAVE AN OPEN LOG FILE? RENAME LOGCHN,LOGFL ;FINAL RENAME FOR PROTECTION JFCL ;"IMPOSSIBLE ERROR" SETZM LOGOPN+.OPMOD ;ASCII MODE FOR LOG FILE TXZ F2,S.LIN!S.LOUT!S.LOPN!S.OLOG PUSHJ P,DSPEC ;GET FILE SPEC AND DEFAULT MOVSI E,OLOG ;BUFFER HEADER MOVEM E,LOGOPN+.OPBUF ;SAVE MOVEI B,"L" ;TO MAKE CORRECT ERROR MESSAGE TYPE OPEN LOGCHN,LOGOPN ;OPEN DEVICE ..ERROR E.ODV MOVEI E,LOGCHN ;MUST BE A DSK!! DEVTYP E, ;WELL? JRST ERRILD TXNE E,77 ;DSK? JRST ERRILD SKIPN A,XFILNM+.RBEXT ;SPECIFY AN EXT? MOVSI A,'LOG' ;THIS IS DEFAULT MOVEM A,XFILNM+.RBEXT ;SAVE IT MOVE B,SWITC ;GET SWITCHES TLNN B,FS.APP ;TO SUPERSEDE OLD FILE? JRST ENTLOG ;YES MOVEI E,LOGCHN ;SET UP FOR CHKDEF LOOKUP LOGCHN,XFILNM ;SEE FILE SKIPA ;NOT THERE PUSHJ P,CHKPTH ;SEE IF FOUND ON SPECIFIED DIRECTORY ENTLOG: SETZM LOGOPN+1 ;NOPE ENT02: SKIPN LOGOPN+1 ;TO APPEND? CLOSE LOGCHN, ;NO, CLOSE FILE PUSHJ P,PPNSPC ;SET UP PPN IN CASE WIPED ENTER LOGCHN,XFILNM ;ENTER LOG FILE EE1+..ERROR E.ENT ;ENTER ERROR ON LOG FILE MOVEI E,LOGFL ;SAVE FILESPEC PUSHJ P,SPCSAV SKIPE LOGOPN+1 ;TO USETO? USETI LOGCHN,-1 ;DO IT MOVEI E,LOGSPC EXCH E,.JBFF OUTBUF LOGCHN,1 MOVEM E,.JBFF ;RESTORE .JBFF FOR LATER TXO F2,S.LIN!S.LOUT!S.LOPN ;ASSUME ALL INTO LOG FILE TLNE B,FS.NOO TXZ F2,S.LOUT TLNE B,FS.NOI TXZ F2,S.LIN POPJ P, ;AND RETURN DSPEC: PUSHJ P,FILSPC ;GET FILE SPEC DSPEC1: SKIPN E,XFILNM+.RBNAM ;SPECIFY A NAME? MOVE E,['TECO '] MOVEM E,XFILNM+.RBNAM SKIPN E,FILDEV ;HE SPECIFY A DEVICE MOVSI E,'DSK' ;ASSUME DSK MOVEM E,LOGOPN+1 ;SAVE IN OPEN BLOCK MOVEM E,FILDEV ;FIX IN CASE ERROR MOVEM E,SPCDEV POPJ P, ERRILD: RELEAS LOGCHN, ..ERROR E.ILD SUBTTL E COMMANDS -- EE (SAVE TECO'S STATE) EECMD: MOVEM 17,SAVEAC+17 ;PRESERVE 17 MOVEI 17,SAVEAC ;TO SAVE ALL AC'S BLT 17,SAVEAC+16 ;SAVE THEM MOVE 17,SAVEAC+17 ;RESTORE AC 17 MOVX E,S.LIN!S.LOUT!S.OLOG!S.LOPN ;CLEAR LOG FILE I-O FLAGS ANDCAM E,SAVEAC+F2 ;RESAVE FLAG MOVX E,F.OOPN!F.IOPN!F.UBAK ;NO FILES OPEN ANDCAM E,SAVEAC+FF ;SAVE IN LOW SEG PUSHJ P,DSPEC ;DEFAULT SKIPN E,XFILNM+.RBEXT ;SPECIFY AN EXT? MOVSI E,'SAV' ;DEFAULT MOVEM E,XFILNM+.RBEXT ;SAVE IT MOVSI E,OSAV ;FOR OUTPUT MOVEM E,LOGOPN+.OPBUF ;SAVE IT MOVE E,LOGOPN+.OPDEV ;GET DEVICE WE WILL OPEN DEVCHR E, ;WHAT IS IT JUMPE E,ERRNXD ;DOESN'T EXIST TXNE E,DV.OUT ;OUTPUT DEVICE MUST BE CAPABLE OF OUTPUT TXNN E,DV.M13 ;IN IMAGE BINARY ..ERROR E.ILD MOVEI E,.IOIBN ;IB FOR SAVE FILE MOVEM E,LOGOPN+.OPMOD ;SAVE IT OPEN SAVCHN,LOGOPN ;OPEN IT ..ERROR E.ODV MOVE E,[GETBLK,,STARTL] BLT E,STARTL+12 ;MAKE LITTLE PROGRAM IN LOW SEG ENTER SAVCHN,XFILNM ;ENTER THE OUTPUT FILE EE1+..ERROR E.ENT ;ERROR MOVEI E,EEFL ;SAVE FILE SPEC PUSHJ P,SPCSAV PUSH P,.JBSA ;SAVE FOR LATER RESTORE PUSH P,.JBCOR ;... MOVEI E,STARTL+6 ;WHERE TO START HRRM E,.JBSA ;FIX JOBSA MOVE E,.JBFF ;GET .JBFF NOW HRLM E,.JBSA HRLM E,.JBCOR ;SO SUBSEQUENT SAV-GET PAIRS WORK HRRZ A,.JBREL ;THIS IS OUR SIZE HRRM A,.JBCOR ;FIX ILL MEM REF PROB FOR EE OUTBUF SAVCHN,1 ;1 OUTPUT BUFFER MOVEM E,.JBFF ;SO WE NOT SAVE IT MOVEI A,.JBPFI+1 ;START SAVE AT 115 SAVTOP: SKIPN (A) ;ZERO? JSP E,MORE ;MORE TO GO? CAML A,.JBFF ;STOP? JRST SAVSTP ;RIGHT! MOVE B,A ;SAVE FIRST NON ZERO WORD SKIPE (A) ;ZERO? JSP E,MORE ;NO, SEE IF MORE SUBM B,A ;NEG NO OF WORDS MOVSS A ;FORM IOWD HRRI A,-1(B) ;FORMED PUSHJ P,SAVOUT ;SEND TO FILE MOVE E,A ;GET IOWD MOVE A,1(E) ;GET WORD PUSHJ P,SAVOUT ;SEND TO FILE AOBJN E,.-2 ;LOOP FOR THIS GROUP HRRZI A,1(E) ;NEXT WORD CAMGE A,.JBFF ;DONE? JRST SAVTOP ;NO, LOOP SAVSTP: MOVE A,[JRST STARTL+6] ;SO CORRECT THING HAPPENS PUSHJ P,SAVOUT ;OUTPUT IT RENAME SAVCHN,EEFL ;FINAL RENAME FOR PROTECTION JFCL ;"IMPOSSIBLE ERROR" RELEAS SAVCHN, ;CLOSE AND RELEASE CHANNEL FOR SAVE FILE POP P,.JBCOR POP P,.JBSA POPJ P, ;DONE SAVOUT: SOSGE OSAV+.BFCNT ;ROOM THIS BUFFER JRST OUTSAV ;NO, DUMP AND COME BACK IDPB A,OSAV+.BFPTR ;STICK WORD POPJ P, ;RETURN OUTSAV: OUT SAVCHN, ;DUMP BUFFER JRST SAVOUT ;GO BACK GETSTS SAVCHN,B ;ERROR STATUS POP P,.JBCOR POP P,.JBSA EE2+..ERROR E.OUT MORE: CAML A,.JBFF ;MORE? JRST (E) ;NO AOJA A,-2(E) ;NO RETURN .-2 SUBTTL E COMMANDS -- NEL & EE (LOW CORE) GETBLK: ('SYS') 'TECO ' REPEAT 4,<0> MOVEI E,STARTL GETSEG E, HALT MOVEI E,%TECOV ;TO MAKE SURE HI AND LOW SEG AGREE JRST 400010 ;ROUTINE TO CHANGE LOG FILE OUTPUT PARAMETERS CHANGL: PUSHJ P,SKRCH ;GET ANOTHER CHARACTER ..ERROR E.NAL CAIE CH,.CHESC ;MUST HAVE ALTMODE AFTER NEL ..ERROR E.NAL TXNN F2,S.LOPN ;HAVE A LOG FILE OPEN? ..ERROR E.NLF TXZ F2,S.LIN!S.LOUT ;ELSE CLEAR ALL TRNE B,1 ;OUTPUT? TXO F2,S.LOUT ;YES TRNE B,2 ;INPUT? TXO F2,S.LIN ;YES JUMPGE B,CPOPJ ;UNLESS B WAS NEGATIVE, RENAME LOGCHN,LOGFL ;RENAME FOR PROTECTION JFCL ;CANT HAPPEN RELEAS LOGCHN, ;IN WHICH CASE JUST CLOSE THE FILE TXZ F2,S.LIN!S.LOUT!S.LOPN!S.OLOG ;AND ZERO THE FLAGS POPJ P, ;OK, NOW DO THAT SUBTTL E COMMANDS -- EE (RESTART CODE) RST: CAIN E,%TECOV ;WILL THIS WORK JRST RST1 ;YES OUTSTR [ASCIZ .?TECWVT Wrong version of TECO GETSEG'd .] EXIT RST1: MOVEI E,REE ;RESET REN ADR MOVEM E,.JBREN ;SAVE MOVE E,[PUSHJ P,UUOH] ;FIX .JB41 MOVEM E,.JB41 ;... MOVSI 17,SAVEAC ;TO RESTORE AC'S BLT 17,17 ;DO IT PUSHJ P,TTOPEN ;REOPEN TTY PUSHJ P,SETUP ;RESET ALL DEFAULTS POP P,E ;THROW OUT WHERE YOU CAME FROM MOVEI A,TECO ;START ADR HRRM A,.JBSA ;SAVE IT JRST RET ;CONTINUE ;EDIT CORE (IE GARBAGE COLLECT AND SMALLIFY) ECORE: MOVEM PF,AC2+PF-2 ;[354] PUT PF WHERE GC EXPECTS IT ECORE1: MOVEI E,CORER ;[354] WHERE GC WILL RETURN MOVEM E,GCRET SETOM GCFLG ;GARBAGE COLLECT! MOVEM F2,SAVEAC ;PRESERVE FLAGS PUSH P,.JBREL ;SAVE SIZE NOW IN CASE NO CHANGE JRST GC ;DO IT CORER: HRRZ A,.JBCOR ;DON'T GET SMALLER THAN THIS MOVE F2,SAVEAC ;RESTORE FLAGS MOVE B,Z ;CHARACTER ADR OF LAST CHARACTER IDIVI B,5 ;WORD ADR AOJ B, ;YES CAMGE B,A ;WELL? MOVE B,A ;ELSE FORCE MIN TO (A) CORE B, ;DO IT JFCL MOVE A,.JBREL MOVEM A,.JBFF PUSHJ P,CRE23 ;RECOMPUTE SIZE OF TEXT BUFFER POP P,A ;GET OLD .JBREL BACK CAMN A,.JBREL ;DIFFERENT? POPJ P, ;NO, NO MESSAGE TXO FF,F.INIT ;FAKE OUT CORE ROUTINE JRST CORES ;SAY SIZE AND CONTINUE SUBTTL E COMMANDS -- EI & EP (EDIT INSERT & EDIT PUT) EICMD: TXOA F2,S.DOIT ;NOTE TO DO MI WHEN DONE READING EPCMD: TXZ F2,S.DOIT ;JUST READ IT INTO THE Q REG * PUSHJ P,FILSPC ;GET FILE SPEC MOVEI A,24 ;EI DEFAULT PUSHJ P,EIDFSP ;SET THEM UP SKIPN E,XFILNM+.RBEXT ;SPECIFY EXT? MOVSI E,'TEC' ;'TEC' IS DEFAULT FOR EI-EP TXOA F2,S.INFO ;TELL USER OF ANY CORE CHANGE WHEN THRU INIFIL: TXZ F2,S.INFO ;NEVER DO THIS! MOVEM E,XFILNM+.RBEXT ;SAVE IT ;***[337]*** ;Here to LOOKUP file for EI and EP. ;If no directory or device has been specified, then look for the ;file as follows: ; [-] ; [,,TEC]/SCAN ; TED: EPIGET: SETZM EPISEQ ;Clear search sequencer SKIPN FILPPN ;Directory specified? SKIPE FILDEV ;Or device? SETOM EPISEQ ;Yes, flag that no search sequence needed PUSHJ P,DSPEC1 ;DEFAULT DEVICE ETC SKIPGE EPISEQ ;Do we need a search sequence? JRST EPIG6 ;No, go read file TXNE F2,S.INFO ;Are we processing TECO.INI? JRST EPIG1 ;No, skip ahead MOVE E,USRPPN ;Yes, always use [,] MOVEM E,XFILNM+.RBPPN ;Store it JRST EPIG6 ;Go find the file EPIG1: MOVEI E,5 ;Initialize search sequencer MOVEM E,EPISEQ ;Store EPIG2: SOSG E,EPISEQ ;Get next step in search sequence JRST LOOKIN ;Finished. File was not found SETZM FILDEV ;Clear device for possible error msg. CAIE E,4 ;First step? JRST EPIG3 ;No MOVSI E,'DSK' ;Use DSK device MOVEM E,LOGOPN+1 ;Store SETZM XFILNM+.RBPPN ;Set default directory JRST EPIG6 ;Go straight to find it EPIG3: CAIE E,3 ;Second step? JRST EPIG3A ;No MOVEI E,FILPTH ;Set PATH pointer MOVEM E,XFILNM+.RBPPN ;in LOOKUP block MOVSI E,'TEC' ;Set [,,TEC] MOVEM E,FILSFD ;Store SETZM FILSFD+1 ;Set trailing 0 MOVE E,USRPPN ;Get logged-in PPN MOVEM E,FILPPN ;Store it CAMN E,DEFPTH+2 ;Same as default path PPN? SKIPE DEFPTH+3 ;And no SFD's? TRNA ;No, then search [,] also JRST EPIG7 ;Yes, don't bother setting /SCAN EPIG4: MOVEI E,2 ;Set /SCAN MOVEM E,FILPTH+1 ;Store JRST EPIG7 ;Go try EPIG3A: CAIE E,2 ;Third step? JRST EPIG5 ;No MOVE E,USRPPN ;Get logged-in PPN MOVEM E,XFILNM+.RBPPN ;Store CAMN E,DEFPTH+2 ;Same as default path? SKIPE DEFPTH+3 JRST EPIG7 ;No, go try JRST EPIG2 ;Yes, try next search EPIG5: ;Must be fourth step MOVSI E,'TED' ;Use TED: MOVEM E,LOGOPN+1 ;Store SETZM E,XFILNM+1 ;Clear directory spec SETZM FILPPN ;Clear this too for possible error msg. EPIG6: TXO FF,F.INIT ;INIT FILE READ IN PROGRESS SETZM LOGOPN+.OPMOD ;ASCII MODE MOVEI E,IINI ;INPUT BUFFER HEADER MOVEM E,LOGOPN+.OPBUF ;SAVE IT MOVE E,LOGOPN+.OPDEV ;DEVICE DEVCHR E, ;CHARACTERISTICS=? JUMPE E,ERRNXD ;NO SUCH DEVICE TXNE E,DV.IN ;INPUT DEVICE SHOULD BE CAPABLE OF INPUT TXNN E,DV.M0 ;IN ASCII MODE ..ERROR E.ILD OPEN INICHN,LOGOPN ;OPEN DEVICE ..ERROR E.IDV EPIG7: LOOKUP INICHN,XFILNM ;LOOK FOR FILE JRST EPIG2 ;Failed, go step the sequencer ;Found it...Fall through to next page PUSH P,.JBREL ;SAVE FOR LATER PUSH P,.JBFF ;[336] Save this too MOVE E,Z ;END OF TEXT BUFFER SUB E,BEG ;#CHARS IN IT MOVEM E,SAVEAC ;REMEMBER IT FOR LATER CLEAN UP MOVE TT,Z ;WHERE TO PUT BUFFER IDIVI TT,5 ;IN WORD ADR ADDI TT,2 ;ASSUME LEFT OVER + 1 MOVEM TT,.JBFF ;FIX IT INBUF INICHN,1 ;1 INPUT BUFFER MOVE OU,.JBFF ;WHERE WE WILL PUT THIS IMULI OU,5 ;ADR AS A NUMBER OF CHARACTERS MOVEM OU,SAVEAC+1 ;SAVE FOR LATER TRANSFER MOVEM 17,AC2+15 ;[354] Preserve 17 MOVE 17,(P) ;[355] Retrieve original .JBFF MOVEM 17,.JBFF ;[355] Put it back so it agrees with MEMSIZ SETZM 17 ;CLEAR FOR 1 K EXPAND INILP: SOSGE IINI+.BFCNT ;MORE TO READ? JRST [IN INICHN, ;NO, READ SOME JRST INILP ;AND CONTINUE GETSTS INICHN,B ;GET ERROR BITS TRNN B,IO.ERR ;ERROR? JRST INIDON ;NO JRST EE2ERR] ;SAY INPUT ERROR ILDB CH,IINI+.BFPTR ;GET CHARACTER JUMPE CH,INILP ;IGNORE IT CAML OU,MEMSIZ ;[355] FIT? PUSHJ P,GRABKQ ;[355] GET A K PUSHJ P,PUT ;[355] STICK IT IN TEXT BUFFER AOJA OU,INILP ;[355] DO REST OF IT CHKPUT: CAML OU,MEMSIZ ;FIT? PUSHJ P,GRABKQ ;GET A K PUSHJ P,PUT ;STICK IT IN TEXT BUFFER AOJA OU,CPOPJ ;DO REST OF IT INIDON: RELEAS INICHN, ;WE ARE DONE TXNE F2,S.INFO ;IF THIS OFF, INI FILE JRST SAVSIZ ;SAV SIZE MOVEI CH,.CHESC ;TECO'S ALTMODE PUSHJ P,CHKPUT PUSHJ P,CHKPUT SAVSIZ: MOVE 17,AC2+15 ;[354] Restore 17 MOVEM OU,Z ;SAVE ALL THAT STUFF MOVE C,SAVEAC+1 ;START OF IT MOVE B,Z ;END OF IT PUSHJ P,COPYEI ;COPY INTO * Q-REG MOVE B,BEG ;WHERE IT ALL STARTS ADD B,SAVEAC ;+ LENGTH MOVEM B,Z ;WHERE IT ENDS IDIVI B,5 ;FOR NEW .JBFF ADDI B,2 ;ASSUME LEFT OVER +1 IORI B,1777 ;MAKE LIKE A JOBREL SOJ B, ;SAFE POP P,E ;[336] Restore original .JBFF CAMLE E,B ;[336] If it is larger than our new one... MOVE B,E ;[336] then use old one so we don't shrink MOVEM B,.JBFF ;SAVE PUSHJ P,CRE23 ;YOU KNOW BY NOW!! POP P,E ;RESTORE OLD JOBREL CAMGE B,E ;E MOVEI A,CCLBLK ;RUN COMPIL HRLI A,1 ;AT START ADR PLUS ONE RUN A, ;RUN UUO JRST DECDMP ;JUST EXIT IF NO RUN. CCLBLK: SIXBIT /SYS/ SIXBIT /COMPIL/ ;RUN SYS:COMPIL REPEAT 4,<0> > SUBTTL E COMMANDS -- ED (RUN UUO ON EXIT) IFN NORUNS,< IFN CCL,< NORUN: MOVE 1,[SIXBIT /COMPIL/] MOVSI 2,SAVEXT ;SIXBIT FOR SAV OR DMP SETZB 3,4 INIT CCLCHN,.IODMP SIXBIT /SYS/ 0 EXIT LOOKUP CCLCHN,1 EXIT CALL 1,[SIXBIT /SETNAM/] HLRO 15,4 HRLM 15,NORUN1 MOVNS 15 MOVEI 16,73(15) ADDI 15,INHERE TXO 15,1777 MOVSI NORTOP,NORAC BLT NORTOP,NORTOP HRR NORBLT,16 JRST NORUN2 >> ;ROUTINE TO SET UP FOR RUN UUO ON EXIT RUNFX: HRLZM B,RUNIT+5 ;SAVE STARTING ADR INCREMENT PUSHJ P,FILSPC ;WHAT WE WILL RUN SKIPN E,FILDEV ;HE SPECIFY A DEVICE? MOVSI E,'SYS' ;DEFAULT TO 'SYS' MOVEM E,RUNIT ;PUT IT IN THE BLOCK MOVE A,[XFILNM+.RBNAM,,RUNIT+1] BLT A,RUNIT+4 ;SAVE FILE SPEC MOVE A,[FILPTH,,RUNIT+6] BLT A,RUNIT+17 ;SAVE PATH POPJ P, ;DONE IDIOT: MOVSI E,1 PUSHJ P,PUN1 JRST CLOSEF SUBTTL E COMMANDS -- ET, EO & EU ;ET COMMAND ; 0 = Normal typeout ; 1 = Literal typeout ; 2 = Image typeout (IONEOU) TYOCTL: POP P,CH ;CLR RET. ADDR. FROM PDL TXNE FF,F.ARG ;ARGUMENT? JRST TYOCT1 ;YES. SKIPE A,ETVAL ;[331] Get ET value CHKEO EODEC,FFOK ;[331] If EO > 2 and non-zero, return -1 JRST VALRET ;[331] Return the value TYOCT1: CHKEO EODEC,TYOCT3 ;[331] Jump if old style ET SKIPL B ;[331] Check range CAILE B,2 ;[331] ... ERROR E.ETA ;[331] Illegal value TYOCT2: MOVEM B,ETVAL ;[331] Store value JRST RET ;RETURN TYOCT3: JUMPE B,TYOCT2 ;[331] Old ET can be only 0 or 1 MOVEI B,1 ;[331] Non zero means 1 JRST TYOCT2 ;[331] Go store and return ;EO COMMAND OLDMOD: POP P,CH ;CLR RET. ADDR. FROM PDL TXNE FF,F.ARG ;ARGUMENT? JRST OLD1 ;YES, SET FLAG MOVE A,EOFLAG ;NO, RETURN VALUE OF EOFLAG JRST VALRET OLD1: CAIG B,0 ;N <= 0? MOVEI B,EOVAL ;YES, SET TO STANDARD CAILE B,EOVAL ;N > STANDARD FOR THIS VERSION? ERROR E.EOA MOVEM B,EOFLAG ;SET EOFLAG JRST RET ;EU COMMAND TYCASE: POP P,CH ;CLR RET. ADDR. FROM PDL TXNE FF,F.ARG ;ARGUMENT? JRST TYCAS1 ;YES MOVE A,TYCASF ;NO, RETURN VALUE OF TYPE-OUT CASE FLAG JRST VALRET TYCAS1: MOVEM B,TYCASF ;SET TYPE-OUT CASE FLAG JRST RET SUBTTL E COMMANDS -- ES AUTOTY: POP P,CH ;CLR RET ADDR FROM PDL TXNE FF,F.ARG ;ARG? JRST AUTOT1 ;YES MOVE A,AUTOF ;NO, RETURN VALUE OF FLAG JRST VALRET AUTOT1: MOVEI A,.CHLFD ;USE LF FOR FLAG IF ARG = 1 TO 37 CAIL B,1 CAILE B,37 MOVE A,B ;OTHERWISE USE WHAT HE GAVE MOVEM A,AUTOF ;SET NEW VALUE IN FLAG JRST RET SUBTTL E COMMANDS -- EH (CHANGE ERROR MESSAGE LEVEL) ERRSET: POP P,CH ;YOU GOT HERE BY PUSHJ DUMMY!! TXNE FF,F.ARG ;ARG SEEN? JRST ERRSE1 ;YES, RESET INDICATOR HLLZ B,ERRLEN ;NO, RETURN CURRENT VALUE OF FLAG MOVSI E,-3 ;NUMBER OF POSSIBILITIES TDNE B,JWTABL(E) ;BIT ON? MOVEI A,1(E) AOBJN E,.-2 ;NO, LOOP JRST VALRET JWTABL: XWD JW.WPR_-22,JW.WPR_-22 XWD JW.WFL_-22,_-22 XWD JW.WCN_-22,_-22 ERRSE1: CAILE B,3 ;3 IS HIEST MOVEI B,3 ;FORCE IT DOWN IF GREATER MOVE A,PRMERR ;ASSUME DEFAULT SKIPLE B ;OK ASSUMPTION? HRLZ A,JWTABL-1(B) ;NO MOVEM A,ERRLEN ;2 BECOMES 0 = MEDIUM JRST RET ;3 BECOMES +1 = LONG SUBTTL E COMMANDS -- EV (SET TERMINAL CHARACTERISTICS) VIDEO: IFE CRT,<..ERROR E.CRT> IFN CRT,< POP P,CH ;GET RID OF RETURN ADR TXNE FF,F.ARG ;ARG SEEN? JRST VIDCHG ;YES, GO POKE SETZ E, ;INIT SIXBIT NAME MOVE OU,[POINT 6,E] ;INIT POINTER MOVSI I,770000 ;INIT MASK FOR PARTIAL NAME VID1: PUSHJ P,SKRCH ;GET NEXT CHARACTER ..ERROR E.UTV ;NO MORE CAIN CH,.CHESC ;ALTMODE? JRST VID2 ;YES PUSHJ P,CKSYM ;LEGAL CHARACTER? SKIPA ;YES ..ERROR E.ICV ;NO MOVE CH,B ;PUT CHARACTER BACK IN CH PUSHJ P,PAKSIX ;PACK THE CHARACTER JRST VID1 ;LOOP VID2: MOVEM E,SWITHL ;SAVE IN CASE ITS BAD SETZM SWINDX ;NO MATCH YET MOVSI T,-NUMCRT ;SET UP INDEX POINTER VID3: CAMN E,CRTTAB(T) ;EXACT MATCH? JRST VID5 ;YES MOVE OU,CRTTAB(T) ;GET IT AND OU,I ;AND MASK IT CAME OU,E ;HOW ABOUT NOW? JRST VID4 ;NOPE SKIPE SWINDX ;GOT IT--IS THIS THE FIRST? ..ERROR E.ABT ;NOPE-AMBIGUOUS NAME MOVEM T,SWINDX ;STORE IT VID4: AOBJN T,VID3 ;GO TRY THE NEXT SKIPN T,SWINDX ;DID WE GET ONE? ..ERROR E.UTT ;UNKNOWN VID5: HLRZ A,CRTDSP(T) ;GET 1ST PARAMETER MOVEM A,CRTTYP MOVEI A,BACRUB ;NOW SET UP BLT FOR REST OF PARAMETERS HRL A,CRTDSP(T) ;WITH APPROPRIATE TERMINAL BLT A,CTUSEQ JRST RET ;WE'RE DONE ;HERE IF EV HAD NUMERICAL ARGUMENTS. VIDCHG: PUSHJ P,SKRCH ;GET ANOTHER CHARACTER ..ERROR E.NAV CAIE CH,.CHESC ;MUST BE ALTMODE ..ERROR E.NAV TXZN FF,F.ARG2 ;ONLY ONE ARG? JRST RETEV ;YES, GO RETURN THE VALUE SKIPLE C CAILE C,20 ;MAKE SURE FIRST ARG IS BETWEEN 1 AND 16. ..ERROR E.VOR CAIE C,20 ;EQUAL TO 16? JRST VDC1 ;NO CAMN B,[-1] ;YES, IS ARG -1? HRLZI B,032120 ;YES, CHANGE TO CRLF (SHIFTED 1 RIGHT) VDC1: CAILE C,6 ;IS THE 1ST ARG GREATER THAN 6? LSH B,1 ;YES, SHIFT (TECO CAN'T HANDLE BIG NEG. #S) MOVEM B,CRTTYP-1(C) ;STORE VALUE JRST RET RETEV: SKIPLE B ;CHECK RANGE CAILE B,20 ..ERROR E.VOR MOVE A,CRTTYP-1(B) ;GET VALUE CAILE B,6 ;NEED TO SHIFT AN ASCIZ TO MAKE IT POS? LSH A,-1 ;YES JRST VALRET SUBTTL E COMMANDS -- TERMINAL CHARACTERISTICS TABLES CRTTAB: SIXBIT /TTY/ ;TYPES OF CRT'S SIXBIT /CRT/ SIXBIT /ACT4/ ;[331] SIXBIT /ACT5/ ;[331] SIXBIT /ADD580/ SIXBIT /ADM2/ SIXBIT /ADM3/ SIXBIT /ADM3A/ ;[331] SIXBIT /BEE/ SIXBIT /DPT/ SIXBIT /CDC/ SIXBIT /H1200/ SIXBIT /H1500/ ;[331] SIXBIT /H2000/ SIXBIT /HP2640/ ;[331] SIXBIT /VT05/ SIXBIT /VT50/ ;[324] SIXBIT /VT52/ NUMCRT==.-CRTTAB ;FLAG BITS--STORED IN CRTTYP (PARAMETER 1). .CCRT.==1 ;TERMINAL IS A CRT .CNCR.==2 ;DON'T OUTPUT LONE CR TO TERMINAL .CRUB.==4 ;RUBOUT GETS TRADITIONAL TREATMENT (FOR GENERAL "CRT") .CWAP.==10 ;TERMINAL DOESN'T WRAP AROUND ON BACKSPACE FROM LEFT MARGIN ;ADDRESSES OF TERMINAL BLOCKS ;LEFT HALF CONTAINS VALUE OF CRTTYP (PARAMETER 1) CRTDSP: XWD 0,VTTY ;FOR TTY, ONLY THE 0 MATTERS-REST IS GARBAGE CRTGEN: XWD .CWAP.+.CRUB.+.CCRT.,VCRT ;GENERAL CRT SETTING. XWD .CCRT.+.CWAP.,VACT4 XWD .CCRT.+.CWAP.,VACT5 XWD .CCRT.,VADD5 XWD .CCRT.,VADM2 XWD .CWAP.+.CCRT.,VADM3 XWD .CWAP.+.CCRT.,VADM3A XWD .CCRT.,VBEE XWD .CWAP.+.CCRT.,VDPT XWD .CCRT.,VCDC XWD .CCRT.,VHZL1 XWD .CCRT.,VHZL15 XWD .CCRT.,VHZL2 XWD .CWAP.+.CCRT.,VHP26 ;[331] HP2640 XWD .CWAP.+.CCRT.,VVT05 XWD .CWAP.+.CCRT.,VVT50 ;[331] XWD .CWAP.+.CCRT.,VVT52 ;[331] VT52 same as VT50 VBEE: EXP 10,0,0,4,10 BYTE (7) 10 BYTE (7) 33,103 BYTE (7) 40,10 BYTE (7) 33,101 BYTE (7) 33,101 BYTE (7) 33,101 0 BYTE (7) 10 0 BYTE (7) 15,33,113,15 VACT5: VACT4: EXP 10,0,0,4,10 BYTE (7) 10 BYTE (7) 40 BYTE (7) 40,10 BYTE (7) 32 BYTE (7) 32 BYTE (7) 32 BYTE (7) 32 BYTE (7) 10 BYTE (7) 0 BYTE (7) 15,36 VADM2: EXP 10,0,1,4,10 BYTE (7) 10 BYTE (7) 40 BYTE (7) 40,10 BYTE (7) 13 BYTE (7) 13 BYTE (7) 13 0 BYTE (7) 10 0 BYTE (7) 15,33,124,15 VTTY: ;DUMMY ADDRESS - ALL THIS IS IGNORED VCRT: ;GENERAL CRT SETTING = ADM3 VADM3: EXP 10,0,0,0,0 BYTE (7) 10 BYTE (7) 40 BYTE (7) 40,10 EXP 0,0,0,0 BYTE (7) 10 0 0 VADM3A: EXP 10,0,1,4,10 BYTE (7) 10 BYTE (7) 40 BYTE (7) 40,10 BYTE (7) 13 BYTE (7) 13 BYTE (7) 13 BYTE (7) 13 BYTE (7) 10 EXP 0,0 VDPT: EXP 10,0,0,4,8 BYTE (7) 10,31 BYTE (7) 40 BYTE (7) 36 ;THIS MAY BE A LOCAL MOD AT U. OF T. BYTE (7) 32 BYTE (7) 32 BYTE (7) 32 BYTE (7) 32 BYTE (7) 10,31 BYTE (7) 31 BYTE (7) 15,36 VCDC: EXP 10,0,0,4,8 BYTE (7) 10 BYTE (7) 25 BYTE (7) 40,10 BYTE (7) 32 BYTE (7) 32 BYTE (7) 32 0 BYTE (7) 10,40,10,10 0 0 ;EOL SEEMS TO BE DISABLED ON A CDC (SHOULD BE ^V) VHP26: EXP 10,0,0,4,10 BYTE (7) 10 BYTE (7) 33,103 BYTE (7) 40,10 BYTE (7) 33,101 BYTE (7) 33,101 BYTE (7) 33,101 BYTE (7) 33,101 BYTE (7) 10,40,10,10 0 BYTE (7) 15,33,113,15 VHZL1: EXP 10,0,0,1,1 BYTE (7) 10 0 BYTE (7) 20,10 BYTE (7) 12 0 0 0 BYTE (7) 10 0 0 VHZL15: EXP 10,0,0,4,10 BYTE (7) 10 BYTE (7) 40 BYTE (7) 40,10 BYTE (7) 176,14 0 0 0 BYTE (7) 10 EXP 0 BYTE (7) 15,176,17,15 VHZL2: EXP 10,0,0,0,0 BYTE (7) 10 BYTE (7) 40 BYTE (7) 40,10 0 0 0 0 BYTE (7) 10 0 BYTE (7) 176,23,177,15 ;[331] VVT52: VVT50: EXP 10,0,0,4,10 BYTE (7) 10 BYTE (7) 33,103 BYTE (7) 40,10 BYTE (7) 33,101 BYTE (7) 33,101 BYTE (7) 33,101 BYTE (7) 33,101 BYTE (7) 10 0 BYTE (7) 15,33,113,15 VVT05: EXP 10,0,0,4,8 BYTE (7) 10 BYTE (7) 40 BYTE (7) 40,10 BYTE (7) 32 BYTE (7) 32 BYTE (7) 32 BYTE (7) 36,32 ;[331] BYTE (7) 10 0 BYTE (7) 15,36 VADD5: EXP 10,0,0,4,8 BYTE (7) 25,10 BYTE (7) 40 BYTE (7) 40,25,10 BYTE (7) 32 BYTE (7) 32 BYTE (7) 32 0 BYTE (7) 25,10 BYTE (7) 25,10 0 SUBTTL E COMMANDS -- EK (KILL) AND EN (RENAME) EKILL: MOVEI E,OUTCHN RESDV. E, ;DISCARD FILE CLOSE OUTCHN,CL.RST ;DO THE BEST WE CAN TXZ FF,F.UBAK+F.OOPN ;ZERO EB AND EW FLAGS POPJ P, ;AND RETURN RENAM: TXNE FF,F.UBAK ;EB IN PROGRESS ..ERROR E.EBO PUSHJ P,FILSPC ;GET A FILE SPEC (IF ANY) SKIPE FILDEV ..ERROR E.END TXZN FF,F.IOPN ;ER IN PROGRESS? ..ERROR E.ENO TXNN FF,F.FILE ;DID WE SEE ANY FILSPEC AT ALL JRST RENAM1 ;NO, MUST BE A DELETE PUSH P,FILPPN ;[340] Save directory spec PUSHJ P,ERDFSP ;YES, SO FILL IN ALL MISSING PARTS HRRZ E,INFILE+1 ;INCLUDING DATE STUFF- <000> NEEDS THIS HRRM E,XFILNM+.RBEXT POP P,(P) ;[340] Pop the stack SKIPN 1(P) ;[340] Was an explicit directory given? SETZM XFILNM+.RBPPN ;[340] No, don't move the file MOVE E,INFILE+2 TXNE FF,F.PROT ;WAS A FILE PROTECTION SPECIFIED? TLZ E,777000 ;YES, SO CLEAR OLD PROTECTION IORM E,XFILNM+.RBPRV ;STORE IT RENAM1: RENAME INCHN,XFILNM ;CHANGE NAME OR DELETE JRST RENFLD RELEASE INCHN, POPJ P, ;SUCCESSFUL RENFLD: RELEASE INCHN, EE1+..ERROR E.RNF SUBTTL E COMMANDS -- ER (PREPARE TO READ A FILE) OPNRD: TXZ FF,F.EOFI+F.IOPN ;NOT EOF & CLOSE PREVIOUS INPUT RELEAS INCHN,0 ;YES. RELEASE IT BEFORE OPENING NEW FILE. PUSHJ P,CLREXT ;CLEAR LOOKUP BLOCK PUSHJ P,FILSPC ;GET FILE SPEC SETZM NFORMS ;HAVE NOT SEEN ANY FORM FEEDS YET SETZM OPNRI+.OPMOD ;ASCII MODE PUSHJ P,ERDFSP ;NO SO SET UP DEFAULT FILE SPEC SKIPN FILPPN ;IS PPN 0? MOVE E,FILDEV ;INITIALIZE OPEN UUO ARGUMENTS MOVEM E,OPNR1 PUSHJ P,DEVCHK ;GET DEVICE CHARACTERISTICS MOVEM E,DEVSAV ;SAVE FOR EB JUMPE E,ERRNXD ;NO SUCH DEVICE TXNE E,DV.IN ;MUST BE ABLE TO INPUT TXNN E,DV.M0 ;IN ASCII MODE ..ERROR E.ILD MOVEI E,IBUF MOVEM E,OPNRB OPEN INCHN,OPNRI ;OPEN INPUT FILE ..ERROR E.IDV PUSHJ P,OPNIN HLLZS XFILNM+.RBEXT ;CLEAR EXT RH FOR MON ERR ON DTA SKIPG MONITR ;IF SERIES 3 OR 4 MONITOR, SHORT LOOKUP JRST OPNRD1 ;SHORT MOVE E,DEVSAV ;GET DEVICE CHARACTERISTICS SPR 10-8431 TXNE E,DV.DTA ;IS IT A DECTAPE? SPR 10-8431 JRST OPNRD1 ;YES, SHORT LOOKUP SPR 10-8431 LOOKUP INCHN,XFILNM ;EXTENDED LOOKUP JRST LKUPER ;ERROR JRST OPNRD2 OPNRD1: LOOKUP INCHN,XFILNM+.RBNAM ;SHORT LOOKUP JRST LKUPER ;LOOKUP FAILURE OPNRD2: PUSHJ P,CHKSPC ;[340] Issue warning if found elsewhere MOVEI E,INFILE ;SAVE INPUT SPECS PUSHJ P,SPCSAV TXO FF,F.IOPN ;INPUT FILE NOW OPEN MOVSI E,FS.SUP!FS.NOL ;CK SUPLSN SWITCH AND E,SWITC ;GET SETTING XORM E,SWITC ;[317]CLEAR THEM HERE, SO NO SUPLSN ON OUTPUT MOVEM E,INSWIT ;STORE SETTING FOR INPUT TXZ FF,F.SEQ ;CLR SEQUENCE NUMBER FLAG IN INCHN, ;READ A BUFFER IN JRST .+3 PUSHJ P,ANERR ;SOME ERROR, OR JUST EOF JRST OPNRD3 ;IT WAS EOF-FILE EMPTY MEANS UNSEQUENCED MOVE B,IBUF+.BFPTR ;GET ADR OF BUFR MOVE A,1(B) ;FIRST WORD OF BUFR IOR A,2(B) ;!2ND MOVEI B,RI ;SLOW INPUT ROUTINE TLNN E,FS.NOL ;NO LSN'S TRNN A,1 ;SEQF ;Fall through to next page... OPNRD3: MOVEI B,RIQ ;USE QUICK ONE MOVEM B,INCH ;SET UP INPUT ROUTINE CAIN B,RI ;SLOW? TXO FF,F.SEQ ;THEN MUST BE SEQUENCED FILE TXNE FF,F.EBTP ;[343] EB in progress? POPJ P, ;[343] Yes, return TXZE FF,F.CCL ;[343] ARE WE HERE FROM A .MAKE COMMAND? PUSHJ P,YANK ;[343] Yes, do an EY POPJ P, ;RETURN OPNIN: MOVEI T,IBUF1 ;GET INPUT BUFFERS EXCH T,.JBFF INBUF INCHN,2 MOVEM T,.JBFF POPJ P, SUBTTL E COMMANDS -- FILE SPEC SETUP ERDFSP: TDZA A,A EWDFSP: MOVEI A,12 EIDFSP: MOVE E,SWITC ;[337] Get file switches TLNN E,FS.DEF ;[337] /DEFAULT set? JRST DEFSP1 ;[337] No, continue MOVSI E,ERSPEC(A) ;[337] Yes, we must clear the block HRRI E,ERSPEC+1(A) ;[337] Set up the BLT SETZM ERSPEC(A) ;[337] Zero the block BLT E,ERSPEC+11(A) ;[337] DEFSP1: SKIPN E,XFILNM+.RBNAM ;HE TYPE A NAME? SKIPA E,ERSPEC+1(A) ;[337] NO, GET DEFAULT MOVEM E,ERSPEC+1(A) ;SAVE IT MOVEM E,XFILNM+.RBNAM SKIPN E,XFILNM+.RBEXT ;HE TYPE EXT? SKIPA E,ERSPEC+2(A) ;[337] NO, GET DEFAULT MOVEM E,ERSPEC+2(A) ;SAVE MOVEM E,XFILNM+.RBEXT MOVSI B,ERSPEC+4(A) ;SET UP PPN HRRI B,FILPPN MOVS I,B SKIPE FILPPN JRST DFSP1 TXNE F2,S.DPPN HRLI B,DEFPTH+2 ;HE WANTS [-] PUSHJ P,CHKERZ ;CHECK FOR ERSATZ DEVICE HRLI B,SPCPPN ;IT WAS ERSATZ--GET RIGHT PPN MOVE E,B ;[317]SAVE BLT AC BLT E,FILPPN+5 ;[317] HRRI B,SPCPPN ;PUT IT HERE TOO BLT B,SPCPPN+5 TXNE F2,S.DPPN ;[340] Make [-] default, but not ersatz PPN DFSP1: BLT I,ERSPEC+9(A) ;NOW MAKE IT THE NEW DEFAULT MOVE E,FILPPN MOVEM E,XFILNM+.RBSIZ ;FOR SHORT LOOKUPS AND ENTERS MOVEI E,FILPTH ;[340] Get pointer to PATH block SKIPE FILPPN ;[340] Does PATH block have something MOVEM E,XFILNM+.RBPPN ;[340] Yes, point to it SKIPN E,FILDEV ;HE TYPE A DEVICE? SKIPA E,ERSPEC(A) ;[337] NO, GET DEFAULT MOVEM E,ERSPEC(A) ;SAVE MOVEM E,FILDEV POPJ P, SUBTTL E COMMANDS -- EB (EDIT BACKUP PROCESSOR) EBAKUP: TXNE FF,F.UBAK ;BACKUP IN PROGRESS NOW? ..ERROR E.EBO TXO FF,F.EBTP ;SET EB UUO FLAG PUSHJ P,OPNRD ;READ THE SPECIFIED FILE MOVE E,SWITC ;[343] Get I/O switches TLNE E,FS.REA ;[343] /READONLY? JRST EBAKU3 ;[343] Yes, cancel EB and do an ER MOVE E,DEVSAV ;GET DEVICE CHARACTERISTICS TXNN E,DV.DIR ;DEVICE MUST HAVE DIRECTORY ..ERROR E.EBD TXNE E,DV.DTA ;SKIP IF NOT DECTAPE (E.G. DSK) SPR 10-8431 JRST EBAKU4 ;DO SHORT LOOKUP/ENTER. SPR 10-8431 HLLZS XFILNM+.RBEXT ;CLEAR EXT RH MOVE E,SWITC ;GET FILE SWITCHES TLNN E,FS.INP ;/INPLACE EDIT? JRST EBAKU0 ;NO TXZ FF,F.EBTP ;NO LONGER EB MOVE E,[FILPPN,,SPCPPN] ;[340] Save the real path BLT E,SPCPPN+5 ;[340] so EW goes to the right place JRST EBAKU6 ;DO ER/EW EBAKU0: MOVEI E,INCHN PUSHJ P,CHKDEF ;CHECK TO SEE IF SAME AS DEFAULT JRST EBAKU2 ;NOPE-JUST DO ER-EW MOVE E,FILDEV ;SAVE DEVICE NAME SKIPG MONITR ;SERIES 5 MONITOR? JRST EBAKU5 ;NO MOVE E,XFILNM+.RBSIZ ;COMPUTE # BLKS TO ASK FOR LSH E,-7 AOJ E, MOVEM E,XFILNM+.RBEST ;SAVE MOVE E,XFILNM+.RBDEV ;GET PHYSICAL UNIT NAME IN-FILE IS ON MOVEM E,DCLOC ;DO A DSKCHR ON IT MOVE E,[5,,DCLOC] DSKCHR E, EBAKU4: SKIPA E,FILDEV ;ERROR, USE BEST NAME WE HAVE MOVE E,DCLOC+.DCSNM ;GET NAME FOR FILESTR IN-FILE IS ON MOVEM E,FILDEV ;SO WE CAN PUT NEW FILE ON SAME STR ;Fall through to next page... EBAKU5: MOVEM E,EBDEV MOVE E,XFILNM+.RBNAM ;SAVE FILENAME MOVEM E,BAKNAM ;IN BACKUP STORE HLRZ E,XFILNM+.RBEXT ;AND THE EXTENSION CAIN E,(SIXBIT /BAK/) ;CANNOT USE EB WITH FILE EXT = "BAK" ..ERROR E.EBF HRLZM E,BAKNAM+1 LDB E,[POINT 9,XFILNM+.RBPRV,8] ;SAVE PROTECTION OF INPUT FILE MOVEM E,PROTEC ;SAVE INPUT FILE PROTECTION MOVEM E,EBPROT ;[333] Also in 2 RENAME switch MOVE A,E ;[333] Make full access CHKACC block HRLI A,.ACREN ;[333] and check for enough privs to do it straight MOVE AA,FILPPN ;[333] PPN of file owner MOVE B,USRPPN ;[333] Our PPN MOVEI E,A ;[333] Point to block CHKACC E, ;[333] See SETZ E, ;[333] Assume ok JUMPE E,EBAKU9 ;[333] OK if OK HRROS EBPROT ;[333] Flag that 2 RENAME's needed at close time HRLI A,.ACCPR ;[333] See if we can change protection to reasonable MOVEI E,A ;[333] CHKACC E, ;[333] Try that SETZ E, ;[333] Assume OK now (??) SKIPE E ;[333] Yes, skip to see if we are supposed to write ..ERROR E.EBP ;[333] No, it's too protected HRLI A,.ACWRI ;[333] Yes, can we write to it MOVEI E,A ;[333] CHKACC E, ;[333] SETZ E, ;[333] ????? JUMPE E,EBAKU9 ;[333] OK ..ERROR E.EBP ;[333] So sorry EBAKU9: MOVE E,PROTEC ;[333] Get input file protection back SKIPE A,SPCPRO LDB E,[POINT 9,A,8] MOVEM E,BAKPRO ;THIS IS THE DESIRED PROTECTION FOR THE NEW FILE MOVSI E,100000 ;MEANWHILE, USE <100> FOR .TMP FILE MOVEM E,SPCPRO ;SO FINAL RENAME NEVER FAILS. MOVE E,TMPTEC ;GET "###TEC" CAME E,XFILNM+.RBNAM ;FILNAM=###TEC? JRST EBAKU1 ;NO, OK HLRZ A,XFILNM+.RBEXT ;ALSO EXT="TMP"? CAIN A,(SIXBIT /TMP/) ;EB###TEC.TMP ILLEGAL ..ERROR E.EBF EBAKU1: MOVEM E,XFILNM+.RBNAM MOVEM E,BAKTMP ;SAVE FOR DTA RENAME MOVSI E,(SIXBIT /TMP/) MOVEM E,XFILNM+.RBEXT EBAKU6: PUSHJ P,OPNW4 ;WRITE THE TMP FILE PUSHJ P,OPNW2 TXNE FF,F.EBTP ;UNLESS NOT BACK-UP, TXO FF,F.UBAK ;SET IN PROGRESS EBAKU3: TXZE FF,F.CCL ;EB OR TECO COMMAND? PUSHJ P,YANK ;TECO, DO A Y ALSO POPJ P, EBAKU2: TXZ FF,F.EBTP ;NO LONGER AN EB SETZM SPCPPN ;FAKE DEFAULT PATH HLLZS XFILNM+.RBEXT ;RESTORE FILE SPECS MOVSI E,(SIXBIT /DSK/) MOVEM E,FILDEV ;MAKE SURE DSK AND NOT SOME ERSATZ. MOVEM E,SPCDEV ;HERE TOO JRST EBAKU6 SUBTTL E COMMANDS -- I/O ERROR ROUTINES LKUPER: RELEAS INCHN,0 TXZ FF,F.IOPN ;LET GO OF INPUT DEVICE EE1+..ERROR E.FNF ;TYPE OUTPUT ERROR ENTERR: RELEAS OUTCHN,0 TXZ FF,F.OOPN+F.UBAK ;LET GO OF OUTPUT DEVICE & EB FLAG LDB E,[POINT 6,XFILNM+.RBEXT,35] ;ERROR CODE CAIE E,2 ;ERROR CODE 2? JRST ENTER2 ;NO MOVE E,WRICHR ;GET DEVICE BITS TXNE E,DV.DTA ;IF DTA ITS FULL, OTHERWISE ENTER ERROR ..ERROR E.FUL ENTER2: EE1+..ERROR E.ENT LOOKIN: RELEAS INICHN, ;DON'T WANT CHANNEL ANYMORE TXZN F2,S.INFO ;WE PUSH ANYTHING? POPJ P, ;NO, DON'T WORRY EE1+..ERROR E.FNF SUBTTL E COMMANDS -- EW (EDIT WRITE) OPNWRA: TXOA F2,S.EA ;WE ARE GOING TO APPEND OPNWR: TXZ F2,S.EA PUSHJ P,OPNW1 OPNW2: MOVE E,WRICHR ;GET DEVCHR WORD TXNN E,DV.DTA ;DECTAPE? SKIPG MONITR ;OR OLD MONITOR JRST SHRTLK ;SHORT LOOKUP - ENTER TXNN E,DV.DSK ;A DSK? JRST SHRTLK ;NO, NO NEED FOR EXTENDED LOOKUP - ENTER SETO B, ;SET FOR FANCY DISK ALLOCATION MOVEI E,FILPTH ;[340] Make sure path pointer is set MOVEM E,XFILNM+.RBPPN ;[340] TXNE FF,F.EBTP ;THIS AN EB TEMP FILE ENTER? JRST XENTER ;YES, CARE NOT OF SUPERCEDE PUSHJ P,PPNSET ;SET UP DEFAULT, IF NECESSARY AOS FILPTH+1 ;NO SCANNING LOOKUP OUTCHN,XFILNM ;FILE THERE? JRST XENTER ;NO, JUST ENTER IT MOVE B,FILPPN ;SAVE PPN PUSHJ P,PPNSET ;RESET PPN TXNE F2,S.EA ;APPENDING? JRST XENTRE ;YES, DON'T SCREW UP PROT/DATE CLOSE OUTCHN, ;NO, CLOSE FOR SUPERCEDE XENTER: SETZM XFILNM+.RBPRV ;CREATION DATE NOW HLLZS XFILNM+.RBEXT ;... MOVE E,SPCPRO ;NOW SET UP RIGHT PROT. TRNE E,1 ;IF <000>, MAKE IT <100> TLO E,100000 HLLZM E,XFILNM+.RBPRV XENTRE: SETZM XFILNM+.RBALC ;CLEAR ALLOCATION ENTER OUTCHN,XFILNM ;ENTER THE FILE JRST ENTERR ;??? JUMPL B,OPNW5 ;[320] -1 MEANS LOOKUP FAILED, SO SKIP ALL THIS CAMN B,FILPPN ;FILE IN SAME AREA? PUSHJ P,SUPERC ;YES, THEN SUPERCEDING TXNE F2,S.EA ;TO APPEND? USETI OUTCHN,-1 ;YES, TELL GOD OPNW5: MOVEI T,OBUF1 ;WHERE OUTPUT BUFFERS MUST BE EXCH T,.JBFF ;TELL MONITOR TO PUT THEM THERE OUTBUF OUTCHN,2 ;TWO OF THEM MOVEM T,.JBFF ;AND RESTORE JOBFF MOVEI E,OUTFIL ;SAVE FILESPEC PUSHJ P,SPCSAV MOVSI E,FS.GEN+FS.SUP ;GET OUTPUT FS.GEN & FS.SUP SWITCHES AND E,SWITC MOVE T,INSWIT ;[317]GET INPUT SWITCHES MOVEI B,PPAQ ;ASSUME QUICK ROUTINE TLNE E,FS.GEN ;[317]MUST GENERATE LSN'S? MOVEI B,PPA ;= USE SLOW ONE TXNE FF,F.SEQ ;[317]SEQUENCED FILE? TLNE T,FS.SUP ;[317]YES, BUT IS INPUT SUPPRESSING THEM? SKIPA ;[317]BUFFER WILL NOT HAVE SEQUENCE NUMBERS MOVEI B,PPA ;[317]USE SLOW ROUTINE MOVEM B,OUTCH ;SAVE IT TXO FF,F.OOPN ;OUTPUT FILE NOW OPEN TLNE E,FS.GEN ;ARE BOTH SET? TLNN E,FS.SUP JRST .+2 ;NO, OK ..ERROR E.COS MOVEM E,OUTSWT ;STORE OUTPUT SWITCH MOVE E,[<"00000">B34+1] ;INIT LSN GENERATION CTR MOVEM E,LSNCTR POPJ P, DEVICL: MOVE E,OPNWI+.OPDEV ;DEVICE NAME DEVCHR E, ;WHAT IS IT CAIN E,0 ERRNXD: ..ERROR E.NXD TXNE E,DV.OUT ;MUST BE CAPABLE OF OUTPUT TXNN E,DV.M0 ;IN ASCII MODE ..ERROR E.ILD POPJ P, OPNW1: TXZE FF,F.UBAK TXZA FF,F.OOPN SKIPA CLOSE OUTCHN,CL.RST PUSHJ P,FILSPC PUSHJ P,EWDFSP ;SET UP DEFAULTS MOVE E,SWITC ;[343] Get I/O switches TLNE E,FS.APP ;[343] /APPEND? TXO F2,S.EA ;[343] Yes, set append flag SKIPE E,FILDEV ;DO WE HAVE A DEVICE? JRST OPNW11 ;YES MOVE E,ERSPEC ;NO, GET ER'S MOVE T,[XWD 3,E] ;CHECK IF ITS ERSATZ PATH. T, TRNE E+1,40 ;WELL? MOVSI E,'DSK' ;IT IS ERSATZ...SO MAKE IT DSK: OPNW11: MOVEM E,FILDEV ;STORE DEVICE MOVEM E,SPCDEV ;HERE TOO SKIPN E,XFILNM+.RBNAM ;HAVE A NAME? MOVE E,ERSPEC+1 ;USE ER'S NAME IF NOT MOVEM E,XFILNM+.RBNAM ;SAVE IT SKIPN E,XFILNM+.RBEXT ;GET EXT? MOVE E,ERSPEC+2 ;NO, USE ER'S HLLZM E,XFILNM+.RBEXT MOVSI B,(SIXBIT /SFD/) ;CHECK FOR AN .SFD FILE CAMN B,XFILNM+.RBEXT JRST OPNW4 ;IS AN .SFD, DONT GET DEFAULT PROT. SKIPE E,SPCPRO ;WAS A PROTECTION SPECIFIED? JRST OPNW1A ;YES, GO MAKE IT THE DEFAULT TXNN F2,S.EA ;IF WE ARE DOING AN EA, SKIPN E,EWSPEC+3 ;OR IF NO PREVIOUS DEFAULT JRST OPNW4 ;THEN DONT FIDDLE WITH ANYTHING MOVEM E,SPCPRO ;MAKE DEFAULT PROT THE CURRENT PROT OPNW1A: MOVEM E,EWSPEC+3 ;AND THE NEW DEFAULT TXO FF,F.PROT ;AND SAY WE'VE GOT ONE ; JRST OPNW4 ;FALL THROUGH OPNW4: TXZE FF,F.OOPN ;CALL HERE FROM EB RENAME OUTCHN,OUTFIL JFCL ;CANT HAPPEN RELEAS OUTCHN,0 SETZM OPNWI+.OPMOD MOVE E,FILDEV MOVEM E,OPNWD PUSHJ P,DEVCHK ;GET DEVICE CHARACTERISTICS MOVEM E,WRICHR MOVSI E,OBF MOVEM E,OPNWB PUSHJ P,DEVICL ;LEGAL DEVICE? OPEN OUTCHN,OPNWI ..ERROR E.ODV MOVEI B,"A" MOVEI E,OUTCHN DEVTYP E, ;TYPE OF DEVICE JRST OILDER TXNE F2,S.EA ;EDIT APPEND (IE DSK ONLY)? TRNN E,77 ;.TYDSK? SKIPA JRST OILDER MOVEI T,OBUF1 EXCH T,.JBFF OUTBUF OUTCHN,2 MOVEM T,.JBFF POPJ P, OILDER: RELEAS OUTCHN, ..ERROR E.ILD SUBTTL E COMMANDS -- EZ & EF ;GET I-O DEVICE CHARACTERISTICS IN AC E ;IF TTY, IT MUST BE AVAILABLE & NOT CONTROLLING A JOB DEVCHK: DEVCHR E, ;GET CHARACTERISTICS TXNN E,DV.TTY ;TTY? POPJ P, ;NO TXNE E,DV.AVL ;YES, AVAILABLE? TXNE E,DV.TTA ;CONTROLLING A JOB (INCLUDING USER)? ..ERROR E.TTY POPJ P, ;NO, IT'S OK ;EZ SELECTS THE OUTPUT DEVICE, ISSUES A REWIND COMMAND TO IT, ; ISSUES A COMMAND TO ZERO ITS DIRECTORY, AND OPENS THE FILE ; SPECIFIED (IF ANY). ZERDIR: PUSHJ P,OPNW1 ;DETERMINE OUTPUT DEVICE UTPCLR OUTCHN, ;CLEAR DIRECTORY OF OUTPUT DEVICE MTAPE OUTCHN,1 ;REWIND OUTPUT DEVICE JRST OPNW2 ;ENTER FILE ;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT ; SELECTING A NEW OUTPUT FILE. CLOSEF: TXNN FF,F.OOPN POPJ P, CLOSE OUTCHN,CL.IN STATZ OUTCHN,IO.ERR JRST OUTERR TXNE FF,F.UBAK ;EB IN PROGRESS? PUSHJ P,BAKCLS ;YES (THIS WILL SKIP RETURN) RENAME OUTCHN,OUTFIL ;IF NOT EB, THEN RENAME FOR PROTECTION JFCL ;CANT HAPPEN RELEAS OUTCHN,0 TXZ FF,F.UBAK!F.OOPN ;CLEAR WRITE AND EB FLAGS POPJ P, SUBTTL E COMMANDS -- EM (MTAPE UUO'S) EMTAPE: TXNN FF,F.IOPN ERROR E.EMD MOVE E,OPNR1 ;SET UP INPUT DEVICE NAME MOVEM E,FILDEV ;IN CASE OF AN ERROR PUSHJ P,CHK2 CAIGE B,1 ERROR E.EMA MTAPE INCHN,0(B) OPEN INCHN,OPNRI ;RE-INIT BUFFERS ERROR E.IEM PJRST OPNIN SUBTTL E COMMANDS -- EB (FINISH UP COMMAND) ;THIS ROUTINE IS CALLED AT EF IF AN EB WAS DONE. IT DOES ;THE WORK OF MAKING THE INPUT FILE HAVE THE EXTENSION .BAK , ;DELETING ANY PREVIOUS FILE.BAK, AND RENAMING THE NEW OUTPUT ;FILE AS THE ORIGINAL FILE.EXT BAKCLS: CLOSE INCHN,0 MOVE E,EBDEV ;ORIGINAL EB DEVICE MOVEM E,FILDEV ;IN CASE OF AN ERROR TXZN FF,F.IOPN ;INPUT OPEN? JRST BKCLS4 ;NO CAMN E,OPNR1 ;ORIGINAL SAME AS CURRENT? JRST BKCLS2 ;YES BKCLS4: MOVEM E,OPNR1 ;NO, RE-OPEN ORIGINAL MOVE E,WRICHR ;GET DEVICE CHARACTERISITECS TXNN E,DV.DSK ;IS IT DISK ? JRST BKCLS6 ;NO - JUST DO NORMAL OPEN MOVX E,UU.PHS ;YES - DO PHYS ONLY OPEN IORM E,OPNRI+.OPMOD ;. . . BKCLS6: MOVEI E, ;SETUP ERROR CODE OPEN INCHN,OPNRI JRST BKCERR ;ERROR ROUTINE BKCLS2: MOVE E,BAKNAM MOVEM E,XFILNM+.RBNAM MOVSI E,(SIXBIT /BAK/) MOVEM E,XFILNM+.RBEXT MOVE E,WRICHR ;[353] Get device characteristics TXNE E,DV.DTA ;[353] DEC-tape? JRST BKCLSD ;[353] Yes MOVEI E,FILPTH ;[353] Set up path pointer MOVEM E,XFILNM+.RBPPN ;[353] PUSHJ P,PPNDEF ;[353] Set default path AOS FILPTH+1 ;[353] No scanning! MOVE B,PROTEC ;GET PROTECTION OF INPUT FILE SKIPN FDAEM ;[333] See what protection we want file to be TRZN B,700 ;[333] No FILDAE, make owner protection 0 TRZ B,300 ;[333] FILDAE, leave 400 on if it is LOOKUP INCHN,XFILNM ;[353] JRST BKCLS0 ;[333] .BAK file not there or protection failure LDB B,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;GET PROTECTION OF BACKUP FILE SETZM XFILNM+.RBNAM MOVEI E, ;ERROR CODE IN CASE WE NEED IT RENAME INCHN,XFILNM ;[353] JRST BKCERR ;ERROR JRST BKCLS1 ;[333] Now go rename original file to .BAK ;[353] Here to do short LOOKUP on DEC-tapes BKCLSD: LOOKUP INCHN,XFILNM+.RBNAM ;[353] Short LOOKUP for DTA JRST BKCLS1 ;[353] None, assume not there SETZM XFILNM+.RBNAM ;[353] Zero the file name RENAME INCHN,XFILNM+.RBNAM ;[353] Delete JRST BKCERR ;[353] Most strange JRST BKCLS1 ;[353] Move on ;Here when LOOKUP on .BAK file fails BKCLS0: HRRZ E,XFILNM+.RBEXT ;[333] Get error code JUMPE E,BKCLS1 ;[333] 0 means not found, so we're OK MOVEI E,;[333] Otherwise, load error code JRST BKCERR ;[333] Can't LOOKUP existing .BAK file BKCLS1: MOVE E,BAKNAM MOVEM E,XFILNM+.RBNAM HLLZ E,BAKNAM+1 MOVEM E,XFILNM+.RBEXT MOVE E,WRICHR ;[353] Get device characteristics TXNE E,DV.DTA ;[353] DEC-tape? JRST BKCLD1 ;[353] Yes MOVEI E,FILPTH ;[353] Set up default path again MOVEM E,XFILNM+.RBPPN ;[353] (May have gotten wiped) PUSHJ P,PPNDEF ;[353] AOS FILPTH+1 ;[353] No scanning MOVEI E, ;ERROR CODE LOOKUP INCHN,XFILNM ;[353] JRST BKCERR ;ERROR SKIPG MONITR ;SERIES 5? JRST BKCLS5 ;NO SKIPL EBPROT ;[333] Need to do 2 RENAMEs due to protection? JRST BKCLS5 ;[333] No, skip this bother MOVE E,PROTEC ;GET PROT OF INPUT FILE ;When we arrive at this point, we know the protection must be ;<2xx>, the only one which requires a double rename but still ;allows us to edit at all. XORI E,300 ;THEN RENAME IT TO 100 RANGE -- DPB E,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;SO WE CAN DO THE REAL RENAME TO .BAK MOVEI E, ;ERROR RENAME INCHN,XFILNM ;[353] JRST BKCERR ;ERROR BKCLS5: MOVSI E,(SIXBIT /BAK/) HLLM E,XFILNM+.RBEXT ;DATE75 DPB B,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;GIVE BAK FILE SAME PROT AS OLD BAK RENAME INCHN,XFILNM ;[353] TRNA ;[333] Try to recover JRST BKCLS8 ;[333] Now go rename the .TMP file ;Here when renaming file to file.BAK with a lower protection fails. ;We will try again, this time keeping the protection the same. LDB E,[POINT 15,XFILNM+.RBEXT,35] ;[333] Get error code CAIE E,ERPRT% ;[333] Protection failure? JRST BKCLS7 ;[333] No, complete loss HLLZ E,BAKNAM+1 ;[333] Retrieve original extension MOVEM E,XFILNM+.RBEXT ;[333] Store MOVEI E,;[333] Setup error code LOOKUP INCHN,XFILNM ;[353][333] Lookup old source again JRST BKCERR ;[333] Most strange MOVSI E,'BAK' ;[333] New extension HLLM E,XFILNM+.RBEXT ;[333] Change only extension RENAME INCHN,XFILNM ;[353][333] Try the rename again TRNA ;[333] It's hopeless JRST BKCLS8 ;[333] Good, now go rename .TMP file BKCLS7: MOVEI E,'IRB' ;[333] Set error code JRST BKCERR ;[333] Go issue message ;Here to rename original file to .BAK on a DEC-tape BKCLD1: MOVEI E, ;[353] Set up error code LOOKUP INCHN,XFILNM+.RBNAM ;[353] Lookup original file JRST BKCERR ;[353] Curious MOVSI E,'BAK' ;[353] New extension HLLM E,XFILNM+.RBEXT ;[353] Store it RENAME INCHN,XFILNM+.RBEXT ;[353] Change the name to .BAK JRST BKCLS7 ;[353] Sigh ;Fall thru... ;Here to rename .TMP file to new source file BKCLS8: RELEAS INCHN, ;[353] Make sure input device finished MOVE E,WRICHR ;[353] GET OUTPUT DEVICE CHARCATERISTICS TXNN E,DV.DTA ;DECTAPE? JRST BKCLS3 ;NO MOVEI E, ;ERROR CODE LOOKUP OUTCHN,OUTFIL ;DECTAPE, <5 SERIES MONITORS NEED EXTRA LOOKUP JRST BKCERR ;ERROR CLOSE OUTCHN,2 ;CLOSE OUTPUT FOR RENAME BKCLS3: MOVE E,BAKNAM ;RENAME ###TEC.TMP TO ORIGINAL NAME MOVEM E,XFILNM+.RBNAM HLLZ E,BAKNAM+1 MOVEM E,XFILNM+.RBEXT MOVE E,BAKPRO ;GET PROTECTION WE WANTED SETZM XFILNM+.RBPRV DPB E,[POINTR (XFILNM+.RBPRV,RB.PRV)] ;PUT IT IN SETZM XFILNM+.RBSIZ MOVEI E, ;ERROR CODE RENAME OUTCHN,XFILNM+.RBNAM JRST BKCERR ;ERROR JRST CPOPJ1 ;DO A SKIP RETURN ;ERROR ROUTINE TO MAKE SURE THE .TMP FILE GETS CLOSED WITH THE CORRECT ;PROTECTION BKCERR: MOVE B,BAKPRO ;GET INTENDED PROTECTION. DPB B,[POINT 9,OUTFIL+2,8] ;DEPOSIT IT RENAME OUTCHN,OUTFIL ;PUT IN THE RIGHT ONE JFCL ;TOO BAD!! WE'VE ALREADY GOT ONE ERROR ON ;OUR HANDS! WE TRIED. CAIE E,'IRN' ;UNLESS ITS THE IRN ERROR, TLO E,400 ;FLAG THE UUO ERROR CODE TYPE OUT TLO E,001000 ;FINISH BUILDING THE ERROR UUO XCT E ;DO IT! SUBTTL E COMMANDS -- EW (SUBROUTINES FOR EW) SHRTLK: LOOKUP OUTCHN,XFILNM+.RBNAM ;FILE THERE? JRST SHRTOK ;NO, ENTER IT PUSHJ P,SUPERC ;SAY SUPERCEDING MAYBE TXNE F2,S.EA ;TO APPEND IS AN ERROR JRST OILDER SHRTOK: CLOSE OUTCHN, ;CLOSE FOR NO UPDATING MOVE A,FILPPN ;GET THE FILE PPN BACK MOVEM A,XFILNM+.RBSIZ ;SAVE IT SHRTEN: ENTER OUTCHN,XFILNM+.RBNAM ;AND ENTER THE FILE JRST ENTERR ;TOUGH COKIES JRST OPNW5 ;FIX BUFFERS, SWITCHES ETC. SUPERC: MOVE E,WRICHR ;GET DEVICE CHARACTERISTICS TXNN FF,F.EBTP ;TEMP FILE ENTER? TXNN E,DV.DIR ;MUST BE DIRECTORY DEVICE POPJ P, ;ELSE DO NOTHING MOVE E,SWITC ;[351] Get I/O switches TLNN E,FS.INP ;[351] /INPLACE? TXNE F2,S.EA ;OR APPENDING? POPJ P, ;YES, RETURN JSP A,CONMES ;TYPE %SUPERSEDING... ASCIZ .%Superseding existing file . POPJ P, SUBTTL E COMMANDS -- MISC. ROUTINES CLREXT: MOVE E,[XFILNM+1,,XFILNM+2] ;CLR EXTENDED LOOKUP ARG BLK SETZM XFILNM+1 BLT E,SPCPRO MOVEI E,16 MOVEM E,XFILNM POPJ P, ;ROUTINE TO CHECK WHETHER THE PATH FILE WAS FOUND ON WAS THE ONE WE ;WANTED TO FIND IT ON. CHKPTH: MOVE T,[SPCPPN(E)] ;WE WANT TO CHECK SPECIFIED PATH SKIPN SPCPPN ;UNLESS ITS 0, IN WHICH CASE... CHKDEF: MOVE T,[DEFPTH+2(E)] ;CHECK AGAINST DEFAULT PATH MOVEM E,FILPTH MOVE E,[11,,FILPTH] PATH. E, JFCL ;USE THE BEST WE HAVE MOVSI E,-6 ;CHECK FOR INTENDED PATH MOVE A,@T CAME A,FILPPN(E) POPJ P, ;NOT EQUAL AOBJN E,.-3 JRST CPOPJ1 ;EQUAL, SKIP RETURN PPNSET: SKIPN SPCPPN ;WAS A PATH SPECIFIED? PUSHJ P,CHKERZ ;NO, CHECK FOR ERSATZ DEVICE JFCL PPNSPC: MOVE E,[SPCPPN,,FILPTH+2] ;SET UP DIRECTORY PATH SKIPN SPCPPN ;DEFAULT IF NOT SPECIFIED PPNDEF: MOVE E,[DEFPTH+2,,FILPTH+2] ;ENTER HERE FOR DEFAULT PATH BLT E,FILPTH+7 SETZM FILPTH+1 ;ZERO THE SCAN SWITCH POPJ P, SPCSAV: MOVE A,E ;ROUTINE TO SAVE A FILESPEC HRLI A,XFILNM+.RBNAM BLT A,2(E) SETZM 3(E) MOVE A,SPCPRO ;PUT CORRECT PROTECTION IN ROT A,11 ;POSITION IT TXNE FF,F.PROT ;IF SPECIFIED DPB A,[POINT 9,2(E),8] POPJ P, ;ROUTINE TO CHECK FOR AN ERSATZ DEVICE CHKERZ: SKIPN SPCDEV ;WAS DEVICE SPECIFIED? JRST CPOPJ1 ;NO, SKIP RETURN MOVE E,[11,,SPCDEV] ;SET UP PATH. PATH. E, JRST CPOPJ1 ;PATH. FAILED, ASSUME NOT ERSATZ MOVE E,SPCDEV+.PTSWT ;GET SCAN BITS TXNN E,PT.IPP ;IS IT AN ERSATZ DEVICE? JRST CPOPJ1 ;NO, SKIP RETURN SETZM SPCPPN+1 ;YES, DO THE MONITORS JOB--WE DONT WANT SFDS POPJ P, ;RETURN ;***[340]*** ;ROUTINE TO ISSUE WARNING MESSAGE IF FILE NOT FOUND ON ;SPECIFIED DIRECTORY. CHKSPC: MOVEI E,INCHN ;Set up input channel for PATH. UUO PUSHJ P,CHKPTH ;See if file found on specified path TXNE FF,F.COLN ;If : specified, no warning. POPJ P, ;Yes, return JSP A,CONMES ;Type a warning ASCIZ /%File found in [/ HLRZ B,FILPPN ;Type PPN PUSHJ P,OCTMS MOVEI CH,"," PUSHJ P,TYOM HRRZ B,FILPPN PUSHJ P,OCTMS MOVE TT1,[-5,,FILSFD] ;Type SFD's CHKSP1: SKIPN TT,(TT1) ;End of list? JRST CHKSP2 ;Yes MOVEI CH,"," ;No, type another comma PUSHJ P,TYOM PUSHJ P,SIXBMS ;And SFD AOBJN TT1,CHKSP1 ;Loop CHKSP2: JSP A,CONMES ;Finish message ASCIZ /] / POPJ P, SUBTTL ^V, ^W, ^X COMMANDS ;^V COMMAND LOWCAS: TXNE FF,F.ARG ;ARG SEEN? JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS TXZ F2,S.UCAS ;CLEAR ^W FLAG TXO F2,S.LCAS ;& SET ^V FLAG JRST RET ;^W COMMAND STDCAS: TXNE FF,F.ARG ;ARG SEEN? JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS TXZ F2,S.LCAS ;CLEAR ^V FLAG TXOA F2,S.UCAS ;& SET ^W FLAG CLRCAS: TXZ F2,S.LCAS+S.UCAS ;0^V OR 0^W CLEARS BOTH FLAGS JRST RET ;^X COMMAND SETMCH: TXNE FF,F.ARG ;ANY ARGUMENT? JRST SETMC1 ;YES TXNE FF,F.PMAT ;NO, FORCED EXACT MATCH FLAG ON? JRST FFOK ;YES, RETURN -1 JRST BEGIN ;NO, RETURN 0 SETMC1: TXZ FF,F.PMAT ;CLR ^X FLAG JUMPE B,RET ;IF ARG = 0, FLAG = 0 TXO FF,F.PMAT ;OTHERWISE, SET FLAG JRST RET SUBTTL ROUTINE TO PARSE FILE DESIGNATOR FILSPC: HRROS EATCH ;IF THIS COMMAND FAILS, U MUST EAT TIL ALT PUSHJ P,CLREXT ;CLEAR EXTENDED ARG BLOCK SETZM SWITC MOVNI A,5 ;INITIALIZE SFD COUNTER MOVEM A,PTHCNT MOVEI A,1 ;INITIALIZE STATE TO 1 PUSHJ P,ENDPUT ;INIT PACKING WORDS TXZ FF,F.FILE!F.PROT ;BUT WE HAVEN'T SEEN ANY PART OF FILESPEC YET FILSP1: PUSH P,A ;SAVE OUR STATE! PUSHJ P,FILCHR ;GET A CHAR POP P,A ;RESTORE THE DAMN THING ASH A,1 ;A HAS CURRENT STATE CAIG B,6 ;B HAS CHAR TYPE JRST FILSP2 SUBI B,6 ;MUNG FOR OFFSET AOS A FILSP2: IMULI B,6 MOVE T,STPROC-2(A) ;GET PROCEDURE ROT T,(B) ANDI T,77 ;T NOW HAS PROC. NUM. PUSHJ P,@FILPRO-1(T) ;DO IT MOVE A,STNEXT-2(A) ;GET NEXT STATE ROT A,(B) ANDI A,77 CAIE A,^D15 ;IF STATE=15, WE'RE DONE JRST FILSP1 POPJ P, FILCHR: PUSHJ P,SKRCH ;GET A CHAR. ERROR E.UFS CAIL CH,.CHLFD ;< LF OR CAILE CH,.CHCRT ;> CR JRST TOUP ;OK SO FAR JRST FILCHR ;IGNORE LF,FF,CR,VT TOUP: CAIL CH,"A"+" " ;CONVERT LOWER CASE CAILE CH,"Z"+" " SKIPA TXC CH," " MOVEI T,FILDSP ;NOW WE CLASSIFY THE CHARACTER FILCH1: MOVE B,(T) JUMPE B,FILCH2 CAIE CH,(B) AOJA T,FILCH1 HLRZS B POPJ P, FILCH2: PUSHJ P,CKSYM ;IS IT A-Z, 0-9, %, $? SKIPA B,[1] ;YES MOVEI B,^D12 ;NO, MUST BE OTHER CAIL CH,"0" ;BUT MIGHT BE OCTAL CAILE CH,"7" ;... POPJ P, ;NOPE AOJA B,CPOPJ ;YES, B=2 PAKSIX: SUBI CH," " ;CONVERT TO SIXBIT TLNE OU,770K ;IS THERE STILL ROOM? IDPB CH,OU ;YES, PACK IT TLNE E,7700 ;SHIFT MASK? ASH I,-6 ;YES POPJ P, PAKOCT: LSH E,3 ;STANDARD NUMBER PACKING IORI E,-"0"(CH) POPJ P, PUTDEV: JUMPE E,ENDPUT ;DONT STORE NULL DEVICE SKIPE FILDEV ;ALREADY GOT ONE? ..ERROR E.DDV ;YEP MOVEM E,FILDEV ;STORE IT MOVEM E,SPCDEV ;HERE TOO JRST ENDPUT PUTFIL: JUMPE E,ENDPU1 ;DON'T SAVE NULL FILE NAMES SKIPE XFILNM+.RBNAM ;DOUBLE FILE NAME? ..ERROR E.DFN MOVEM E,XFILNM+.RBNAM ;SAVE IT JRST ENDPUT ;GO RESET PACKING PUTEXT: IORI E,1 ;SAID . SO REMEMBER NOT TO DEFAULT SKIPE XFILNM+.RBEXT ;DOUBLE EXT ILLEGAL ..ERROR E.DEX MOVEM E,XFILNM+.RBEXT ;STORE IT JRST ENDPUT PUTPRO: SKIPE XFILNM+.RBPRV ;DOUBLE PROTECTION LOSES ..ERROR E.DPR CAILE E,777 ;IS IT A LEGAL PROTECTION ..ERROR E.PRO ;NOPE DPB E,[POINT 9,SPCPRO,8] ;SAVE IT HERE SKIPE E ;IF <000>, JRST .+3 MOVEI E,100 ;THEN MAKE IT 100, SO RENAME WORKS AOS SPCPRO ;AND FLAG SPCPRO DPB E,[POINT 9,XFILNM+.RBPRV,8] ;PUT IT AWAY TXO FF,F.PROT ;A PROTECTION WAS SPECIFIED JRST ENDPUT PUTPRJ: SKIPN FILPPN ;DO WE ALREADY HAVE A DIRECTORY? TXNE F2,S.DPPN ;NO, BUT MAYBE HE SPECIFIED DEFAULT ..ERROR E.DDR ;2 DIRECTORY SPECS LOSE CAIN E,0 ;IS PROJ 0? HLRZ E,USRPPN ;YES, GET LOGGED-IN PROJ HRLZM E,FILPPN ;STORE IT JRST ENDPUT PUTPRG: CAIN E,0 ;IS PROG 0? HRRZ E,USRPPN ;YES, GET LOGGED-IN PROG HRRM E,FILPPN ;STORE IT MOVE E,FILPPN MOVEM E,XFILNM+.RBSIZ MOVEM E,SPCPPN ;SAVE IT HERE TOO JRST ENDPUT PUTPTH: JUMPE E,ENDPUT ;DONT STORE NULL SFD'S AOSLE T,PTHCNT ;COUNT TOTAL SFD'S ..ERROR E.TMS ;TOO MANY MOVEM E,FILSFD+4(T) ;STORE IT MOVEM E,SPCPPN+5(T) ;SAVE HERE TOO ENDPUT: TXO FF,F.FILE ;WE'VE SEEN AT LEAST ONE PART OF FILESPEC ENDPU1: SETZ E, ;ZERO PACKING WORD MOVE OU,[POINT 6,E] ;INIT SIXBIT BYTE POINTER MOVSI I,770K ;INIT SWITCH MASK POPJ P, PUTSWI: MOVEM E,SWITHL ;SAVE IN CASE BAD SETZM SWINDX ;NO SWITCH SEEN YET MOVSI T,-SWS ;NUMBER OF SWITCHES IN THE WORLD SWLOOP: CAMN E,SWITAB(T) ;THIS IS IT? JRST SETSWH ;YES, SET IT MOVE OU,SWITAB(T) ;YES, GET SWITCH FROM TABLE AND OU,I ;APPLY MASK TO SWITCH CAME OU,E ;SAME? JRST SWHLP ;NO, LOOP SKIPE SWINDX ;ALREADY HAVE MATCH? ..ERROR E.ABS MOVEM T,SWINDX ;ELSE SAVE INDEX AND GO ON SWHLP: AOBJN T,SWLOOP ;LOOP FOR ALL (MAYBE) SKIPN T,SWINDX ;HAVE SEEN A MATCH? ..ERROR E.UIS SETSWH: MOVSI OU,400K ;LITE SIGN BIT MOVNS T LSH OU,(T) ;SHIFT INTO POSITION IORM OU,SWITC ;AND SAVE IT JRST ENDPUT DEFDIR: SKIPN FILPPN ;DOUBLE DIRECTORY LOSES TXOE F2,S.DPPN ;SET THE DEFAULT DIRECTORY BIT ..ERROR E.DDR ;EVEN DOUBLE DEFAULT LOSES-WE ARE MEAN JRST ENDPUT FILERR: MOVE A,STNEXT-2(A) ;IN THE CASE OF AN ERROR, "NEXT STATE" ROT A,(B) ;IS REALLY THE ERROR NUMBER ANDI A,77 JRST FILERT-1(A) ;GO TO IT FILERT: ..ERROR E.IFN ;ERROR DISPATCH TABLE ..ERROR E.DEX ..ERROR E.BFS ..ERROR E.DIR ..ERROR E.IOS SUBTTL TABLES FOR FILSPEC PARSER ;CHARACTER TYPE CLASSIFICATION TABLE FILDSP: ^D3,,.CHESC ^D4,," " ^D4,,.CHTAB ^D5,,"," ^D7,,"." ^D8,,"/" ^D9,,":" ^D10,,"[" ^D11,,"]" ^D6,,"-" ^D10,,"<" ^D11,,">" 0,,0 ;PROCEDURE DISPATCH TABLE FILPRO: EXP PAKSIX EXP PAKOCT EXP PUTDEV EXP PUTFIL EXP PUTEXT EXP PUTPRJ EXP PUTPRG EXP PUTPTH EXP PUTSWI EXP CPOPJ EXP FILERR EXP DEFDIR EXP PUTPRO RADIX 10 ;NOTE!!!! ;PROCEDURE TABLE STPROC: BYTE (6)1,1,4,4,11,11,4,4,3,4,11,11 ;STATE 1 BYTE (6)1,1,5,5,11,11,11,5,11,5,11,11 ;STATE 2 BYTE (6)11,2,11,6,6,12,11,11,11,11,13,11 ;STATE 3 BYTE (6)11,2,7,7,7,11,7,7,11,11,7,11 ;STATE 4 BYTE (6)1,1,8,8,8,11,8,8,11,11,8,11 ;STATE 5 BYTE (6)1,1,9,9,11,11,9,9,11,9,11,11 ;STATE 6 BYTE (6)1,1,10,10,11,11,10,10,11,11,10,11 ;STATE 7 BYTE (6)1,1,10,10,10,11,10,10,11,11,10,11 ;STATE 8 BYTE (6)11,11,11,10,10,11,11,11,11,11,11,11 ;STATE 9 ;"NEXT STATE" TABLE STNEXT: BYTE (6)1,1,15,1,1,1,2,6,1,3,1,1 ;STATE 1 BYTE (6)2,2,15,1,1,1,2,6,3,3,1,1 ;STATE 2 BYTE (6)1,3,3,9,4,7,3,3,3,3,1,1 ;STATE 3 BYTE (6)4,4,15,8,5,4,2,6,4,4,1,4 ;STATE 4 BYTE (6)5,5,15,8,5,4,2,6,4,4,1,4 ;STATE 5 BYTE (6)6,6,15,1,1,1,2,6,3,3,1,1 ;STATE 6 BYTE (6)1,1,15,7,4,4,2,6,3,4,1,1 ;STATE 7 BYTE (6)1,1,15,13,5,4,2,6,3,4,1,4 ;STATE 8 BYTE (6)4,4,4,14,4,4,4,4,4,4,4,4 ;STATE 9 RADIX 8 ;FILE SELCTION COMMAND SWITCH TABLE DEFINE SWTCHS,< SW APPEND ;;APPEND TO THE LOG FILE (NOT SUPERSEDE) SW DEFAUL ;;[337] CLEAR STICKY DEFAULTS BEFORE APPLYING FILESPEC SW GENLSN ;;GENERATE LINE SEQUENCE NUMBER ON OUTPUT SW INPLACE ;;.TECO DOES ER/EW TO SAME FILESPEC SW NOIN ;;NO INPUT FROM TTY IN THE LOG FILE SW NOLSN ;;INTELLIGENT PERSON NOT WANTING LSN'S SW NOOUT ;;NO TTY TYPEOUT IN THE LOG FILE SW READON ;;[337] READ ONLY WHEN .TECO SW SUPLSN ;;SUPPRESS LINE SEQUENCE NUMBERS ON INPUT > DEFINE SW,(SWT),< EXP SIXBIT /SWT/ FS.'SWT==<.BIT.==.BIT._-1>> .BIT.==1B17 SWITAB: SWTCHS ;GENERATE SWITCH TABLE SWS==.-SWITAB SUBTTL Y RENDER THE BUFFER EMPTY. READ INTO THE BUFFER ; UNTIL (A) A FORM FEED CHARACTER IS READ, OR ; (B) THE BUFFER IS WITHIN ONE THIRD OR ;128 CHARACTERS OF CAPACITY AND A LINE FEED IS READ, OR ; (C) AN END OF FILE IS READ, OR ; (D) THE BUFFER IS COMPLETELY FULL. ;THE FORM FEED (IF PRESENT) DOES NOT ENTER THE BUFFER. YANKER: CHKEO EODEC,YANK ;[335] Y is OK if EO level is 2 or less SKIPN EQM ;Y ILLEGAL FROM TTY ERROR E.UEY YANK: YANK1: MOVE OU,BEG MOVEM OU,PT ;PT:=BEG MOVSI C,377777 ;[346] Set up "infinite" line count MOVEM C,LFCNT ;[346] YANK2: TXZ FF,F.FORM ;RESET THE YANK,APPEND FORM FEED FLAG TXNN FF,F.IOPN ;ERROR IF INPUT NOT SPECIFIED ERROR E.NFI ;MAINTAIN AT LEAST A MINIMUM SIZE BUFFER OF 3000 ;CHARACTERS AT ALL TIMES, WHEN TECO ASKS FOR INPUT FROM ;ANYTHING BUT THE CONSOLE. MOVE C,PT ;GET . MOVEM C,Z ;TELL NROOM IT'S AN EXPAND SUBM OU,C ;BUT EXPAND WITH REAL Z IN MIND ADDI C,^D3000 ;NEED 3000 ABOVE Z PUSHJ P,NROOM YANK6: ADD OU,RREL ;RELOCATE IN CASE GARBAGE COLLECTION DONE MOVE TT,MEMSIZ ;TOP OF BUFFER MOVE CH,TT SUB TT,OU IDIVI TT,3 SUBM CH,TT MOVEM TT,M23 ;M23 HAS 2/3 PT SUBI CH,200 MOVEM CH,M23PL ;M23PL HAS 200 BELOW TOP MOVE TT,OU ;CHAR ADR IDIVI TT,5 ;TO WORD ADR HLL TT,BTAB-1(TT1) ;MAKE BYTE POINTER YANK4: CAMGE OU,M23 ;2/3 FULL YET? JRST YANK3 ;NO, KEEP GOING CAMG OU,M23PL ;YES, GETTING NEAR TOP? CAIN CH,.CHLFD ;NO. LINE FEED? JRST YANK51 ;YES. THAT'S ALL. ;NO. GET MORE. YANK3: PUSHJ P,@INCH ;READ A CHARACTER JRST YANK51 ;NONE LEFT, CLEAR BUFFER AND RETURN. IDPB CH,TT ;PUT CHARACTER IN MEMORY CAIN CH,.CHFFD ;[346] FORM FEED? JRST YANK5 ;[346] Yes CAIE CH,.CHLFD ;[346] Line feed? AOJA OU,YANK4 ;NO. UPDATE DATA BUFFER PTR AND CHECK FOR OVERFLOW. SOSLE LFCNT ;[346] Yes, decrement line count AOJA OU,YANK4 ;[346] Still positive...Keep going AOJA OU,YANK51 ;[346] Time to stop YANK5: TXO FF,F.FORM ;[346] YANK AND/OR APPEND ENDS ON A FORM FEED YANK51: MOVEM OU,Z ;YES. SET END OF DATA BUFFER AND RETURN SKIPE XCTING ;IF OFF STOP POPJ P, JRST GO ;RESTART ;A APPEND TO THE END OF THE BUFFER FROM THE SELECTED INPUT ; TERMINATING THE READ IN THE SAME MANNER AS Y. THE POINTER ; IS NOT MOVED BY A. ;:nA SAME AS A EXCEPT THAT INPUT STOPS AFTER THE NTH LINE FEED, ; UNLESS ONE OF THE REGULAR CONDITIONS TERMINATES IT FIRST. ; IF n IS MISSING, 0, OR NEGATIVE, IT IS TAKEN AS 1. APPEND: MOVE OU,Z ;STORE DATA AT END OF BUFFER. PUSHJ P,CHK2 ;[346] GET ARG TXZN FF,F.COLN ;[346] WAS COLON SET? MOVSI B,377777 ;[346] NO, REGULAR APPEND, SO SET LARGE COUNT MOVEM B,LFCNT ;[346] STORE COUNT PUSHJ P,YANK2 JRST RET SUBTTL ^Y ! ^P - QUICK PAGE SCAN COMMANDS QYANK: TXO F2,S.YANK ;NOTE QUICK YANK QPAGE: TXNN FF,F.ARG ;NO ARG MEANS RETURN # OF FF'S SEEN JRST [MOVE A,NFORMS ;# FF'S SEEN JRST VALRET] ;SAY IT UNTO THE USER SKIPLE B ;ZERO IS ILLEGAL ARG CAMGE B,NFORMS ;BACKWARD OR NEGATIVE ARG? ..ERROR E.IPA CAMN B,NFORMS ;REQUEST IS FOR THIS PAGE? JRST RET ;YES, GO AWAY FROM HERE MY BROTHER TXNE FF,F.EOFI ;EOF? QERR: ..ERROR E.PTL PUSH P,B ;SAVE PAGE WE WANT FOR LATER AND TXO FF,F.NSRH ;NO FREE FORM FEEDS TXNN F2,S.YANK ;NO OUTPUT? PUSHJ P,PUNCHR ;PUNCH ANY BUFFER THERE NOW MOVE B,BEG ;WHERE TEXT BUFFER STARTS MOVEM B,Z ;NOTHING IN IT NOW MOVEM B,PT ;PT ALSO = BEG POP P,B ;GET THE ARGUMENT BACK SOJ B, ;MINUS 1 SO THAT WHEN NFORMS = B ;WE WANT THE NEXT PAGE TXNN FF,F.IOPN ;SOMETHING TO READ? ..ERROR E.NFI TXNN F2,S.YANK ;^Y REQUIRES NO OUTPUT FILE TXNE FF,F.OOPN ;FILE MUST BE OPEN FOR OUTPUT HERE CAIA ERROR E.NFO TXNE FF,F.SEQ ;SEQUENCED FILE= USE STUPID ROUTINE JRST STUPID QLOOP: CAMG B,NFORMS ;FOUND IT YET? JRST APPEND ;YES, YANK AND RETURN PUSHJ P,@INCH ;READ A CHARACTER AOJA B,QERR ;END OF FILE = BAD PAGE ARG TXNN F2,S.YANK ;NO OUTPUT ON ^Y PUSHJ P,@OUTCH ;SEND IT TO OUTPUT FILE SKIPN XCTING ;HE WANT ME TO STOP? PUSHJ P,CKEOL ;YES, BUT STOP ON EOL JRST QLOOP ;NOT EOL OR NOT TO STOP JRST APPEND ;AND YANK A PAGE STUPID: MOVEM B,SAVEAC ;SAVE B STUP1: TXNE FF,F.EOFI ;[327] ANYTHING LEFT? AOJA B,QERR ;[327] NO, RESET B AND GO TYPE ERROR PUSHJ P,YANK1 ;[327] GET A BUFFER-FULL TXNN F2,S.YANK ;[327] IF ^Y, WE DON'T NEED TO OUTPUT PUSHJ P,PUNCHR ;[327] OUTPUT CURRENT BUFFER MOVE B,SAVEAC ;[327] RESTORE B CAMLE B,NFORMS ;[327] ARE WE DONE? JRST STUP1 ;[327] NO, LOOP BACK PUSHJ P,YANK1 ;[327] YES, SO DO ONE MORE Y JRST RET ;[327] AND RETURN SUBTTL READ A CHARACTER FROM INPUT FILE RI: SOSGE IBUF+.BFCNT ;MORE IN THE BUFFER? JRST RI3 ;NO, CAUSE THERE TO BE MORE RI0: ILDB CH,IBUF+.BFPTR ;GET ONE JUMPE CH,RI ;EAT NULLS CAIN CH,.CHFFD ;FF? AOS NFORMS ;NOTE IT IN CASE NEW ^P COMMAND USED TXZN F2,S.SSEQ ;LAST THIS WAS A SUPPRESSED SEQUENCE #? JRST RI1 ;NO.. CAIE CH,.CHCRT ;CR (FOR SOS) OR CAIN CH,.CHTAB ; FOLLOWING IT? JRST RI ;= EAT IT UP RI1: LDB T,[POINT 1,@IBUF+.BFPTR,35] ;GET BIT 35 OUT OF CURRENT WORD JUMPE T,CPOPJ1 ;LEAVE, A LSN MOVE T,INSWIT ;SUPPRESS SEQ # FLAF ON? TLNN T,FS.SUP ;? JRST CPOPJ1 RI2: MOVEI T,4 ;THINGS TO EAT IBP IBUF+.BFPTR ;INCREMENT BYTE POINTER SOS IBUF+.BFCNT ;DECREMENT COUNT SOJG T,.-2 ;A BUNCH OF TIMES TXO F2,S.SSEQ ;JUST ATE A SEQUENCE NUMBER JRST RI ;NEXT CHARACTER PLS RI3: IN INCHN, ;GET A BUFFER JRST RI ;AND CHAR TOO ANNERR: TXO FF,F.EOFI ;ELSE ASSUME EOF ANERR: STATO INCHN,IO.ERR ;ERROR? POPJ P, ;SINGLE RETURN INERR: GETSTS INCHN,B ;SAVE ERROR FLAGS RELEAS INCHN,0 TXZ FF,F.IOPN EE2ERR: EE2+ERROR E.INP RIQ: SOSGE IBUF+.BFCNT ;MORE THERE? JRST [IN INCHN, ;GET SOME JRST RIQ ;YANK CHAR JRST ANNERR] ;CHECK FOR ERRORS OR EOF ILDB CH,IBUF+.BFPTR ;GET CHARACTER CAIN CH,.CHFFD ;? AOS NFORMS ;YES, COUNT IT JUMPN CH,CPOPJ1 ;AND RETURN JRST RIQ ;ELSE LOOP SUBTTL INSERT COMMAND ;^ITEXT$ INSERTS AT THE CURRENT POINTER LOCATION THE ^I (TAB) ; AND THE TEXT FOLLOWING THE ^I UP TO BUT NOT INCLUDING THE ; ALT MODE. THE POINTER IS PUT TO THE RIGHT OF THE INSERTED ; MATERIAL. TAB: TXZ FF,F.ARG ;NO ARGUMENT WANTED PUSHJ P,TAB2 ;INSERT TAB IFN VC, ;ADJUST VVAL ;ITEXT$ INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING ; THE I UP TO BUT NOT INCLUDING THE FIRST ALT. MODE. THE ; POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL. INSERT: TXNE FF,F.ARG ;IS THERE AN ARGUMENT? JRST INS1A ;YES. NI COMMAND. MOVEI CH,.CHESC ;NORMAL TERMINATOR TXZN FF,F.SLSL ;DID @ PRECEED I? JRST INSERA ;NO, TERMINATOR = ALTMODE PUSHJ P,SKRCH ;YES. CH:=USER SELECTED TERMINATOR. ERROR E.UIN INSERA: MOVEI B,(CH) ;B=INSERTION TERMINATOR. SETZM CTGLEV ;ZERO THE ^G NEST COUNTER MOVEI T,INSER0 ;AND SET ^G ROUTINE RETURN POINT MOVEM T,CTGRET PUSH P,CPTR ;SAVE CURRENT POSITION IN CMD STRING PUSH P,COMCNT MOVEI C,0 ;COUNT # CHARACTERS TO INSERT IN C AND ;MOVE CPTR TO END OF STRING. INSER0: PUSHJ P,SKRCH ;GET NEXT CHARACTER JRST INS0A ;NO MORE CHARS AT THIS LEVEL SKIPN CTGLEV ;IF WE ARE IN A ^G NEST, IGNORE TERMINATOR CAIE CH,(B) ;IS IT THE TERMINATOR? TRNA ;NO, SKIP JRST INSER2 ;YES, END OF 1ST PASS TXO FF,F.NNUL ;FLAG NON-NULL STRING (FOR F-SEARCH) CHKEO EO21,INSER1 ;IF EO=1, CTRL-CHARS ARE JUST TEXT MOVEI T,IN1TAB ;CK FOR ^V, ^W, ^R, ^T, ^^ TXNE F2,S.NCCT ;^T FLAG ON? MOVEI T,IN2TAB ;YES, USE RESTRICTED TABLE PUSHJ P,DISP1 TXNN F2,S.NCCT ;IF ^T ON, ALL OTHER CTL-CHARS LEGAL TEXT PUSHJ P,CKNCC ;CHECK FOR OTHER CTRL-CHARS (THEY ARE ILLEGAL) INSER1: AOJA C,INSER0 ;COUNT TEXT CHARACTERS INSER2: MOVEM C,VVAL ;SAVE LENGTH OF STRING IFN VC,< TXZE FF,F.TABS ;TAB INSERTED? AOS VVAL> ;YES, COUNT IT TXZ F2,S.NCCT ;REFRESH ^T FLAG TXNE FF,F.SRCH ;DOING FS OR FN? JRST SERCHJ ;YES POP P,COMCNT ;RESET TO BEGINNING OF INSERT TEXT POP P,CPTR PUSHJ P,NROOM ;YES. MOVE FROM PT THROUGH Z UP C POSITIONS. ;MOVE INSERTION INTO DATA BUFFER INS1B: MOVE OU,PT SETZM CTGLEV ;ZERO ^G NEST COUNTER MOVEI T,INS1C ;AND SET RETURN POINT MOVEM T,CTGRET INS1C: PUSHJ P,GCH ;CH:=CHARACTER FROM COMMAND STRING. SKIPGE COMCNT ;END OF COMMAND AT THIS LEVEL? JRST INS0A ;YES INS1F: CAIN CH,(B) ;IS IT THE TERMINATOR? SKIPE CTGLEV ;YES, BUT IGNORE IT IF IN ^G NEST TRNA ;NO, SKIP POPJ P, ;BUT WE'RE NOT, SO LEAVE CHKEO EO21,INS1D ;IF EO=1, THERE ARE NO CTL-CHAR. COMMANDS MOVEI T,INSTAB ;CK FOR CONTROL CHARACTERS TXNE F2,S.NCCT ;^T FLAG ON? MOVEI T,INTTAB ;YES, ONLY ^T AND ^R ARE SPECIAL PUSHJ P,DISP1 INS1E: PUSHJ P,CASE ;CONVERT UC TO LC IF FLAGS WARRANT INS1D: PUSHJ P,PUT ;NO. STORE CHARACTER IN DATA BUFFER TO RIGHT OF PT. AOS OU,PT ;PT:=PT+1 JRST INS1C ;LOOP ;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (COUNT PASS) IN1TAB: XWD CTRGI,7 ;^G XWD INSER0,.CHCNV ;^V XWD INSER0,.CHCNW ;^W XWD INSER0,.CHCCF ;^^ IN2TAB: XWD INSER4,.CHCNT ;^T XWD INSER3,.CHCNR ;^R XWD 0,0 ;END OF LIST ;GET CHARACTER AFTER ^R INSER3: PUSHJ P,SKRCH ;DON'T COUNT ^R & DON'T DO CHECKS ON CHAR AFTER IT ERROR E.UIN JRST INSER1 ;CHANGE NO-CONTROL-COMMANDS FLAG INSER4: TXC F2,S.NCCT JRST INSER0 ;DON'T COUNT ^T ;^GI CAUSES THE CONTENTS OF Q REG I TO BE INSERTED INTO THE TEXT STRING ;AT THIS POINT CTRGI: PUSHJ P,SKRCH ;GET THE NAME OF THE Q-REG ERROR E.ICG ;NOT THERE PUSH PF,CPTR ;SAVE POINTER PUSH PF,COMCNT ;AND COUNT PUSH P,C ;AND LENGTH OF STRING SO FAR AOS CTGLEV ;BUMP ^G NEST COUNTER PUSHJ P,QREGV2 ;ACCESS THE Q REGISTER PUSHJ P,QTEXEI PUSHJ P,GTQCNT ;LENTH OF Q REG STRING IN C MOVEI A,(I) IDIVI A,5 ;FIX THE POINTER HLL A,BTAB-1(A+1) MOVEM A,CPTR ;AND STORE IT MOVEM C,COMCNT ;THE NEW COUNT POP P,C ;RESTORE INSERT STRING LENGTH JRST @CTGRET ;RETURN INS0A: SKIPN CTGLEV ;ARE WE IN A Q-REGISTER? ERROR E.UIN ;NO, UNTERMINATED INSERT COMMAND POP PF,COMCNT ;RESTORE COUNT POP PF,CPTR ;AND POINTER SOS CTGLEV ;DECREMENT NEST COUNT JRST @CTGRET ;RETURN ;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (INSERT PASS) INSTAB: XWD CTRGI,7 ;^G XWD INSLOW,.CHCNV ;^V XWD INSSTD,.CHCNW ;^W XWD INSSPC,.CHCCF ;^^ INTTAB: XWD INSMAC,.CHCNT ;^T XWD INSIGR,.CHCNR ;^R XWD 0,0 ;END OF LIST ;^V CAUSES THE NEXT CHARACTER TO BE CONVERTED TO LOWER CASE (IF UPPER CASE) ;^V^V SETS LOWER CASE MODE UNTIL THE END OF THE TEXT STRING (OR FURTHER NOTICE) INSLOW: PUSHJ P,C.V ;SET ^V FLAGS JRST INS1C ;CONTINUE TO NEXT CHAR. ;^W CAUSES NEXT CHAR. TO BE TAKEN AS IS (STANDARD MODE) ;^W^W SETS STANDARD MODE UNTIL END OF TEXT STRING (OR FURTHER NOTICE) INSSTD: PUSHJ P,C.W ;SET ^W FLAGS JRST INS1C ;CONTINUE TO NEXT CHAR. ;^R CAUSES NEXT CHAR. TO BE TAKEN AS TEXT ;EVEN IF IT IS A CONTROL CHAR. OR THE TEXT TERMINATOR INSIGR: PUSHJ P,GCH ;GET NEXT CHAR. JRST INS1E ;TREAT AS TEXT ;^^ -- IF NEXT CHAR IS @,[,\,],^, OR _, CONVERT IT TO LC RANGE INSSPC: PUSHJ P,GCH ;GET NEXT CHAR PUSHJ P,CVTSPC ;CONVERT IF WARRANTED JRST INS1F ;CHANGE NO-CONTROL-COMMANDS MODE INSMAC: TXC F2,S.NCCT ;COMPLEMENT ^T FLAG JRST INS1C ;GO ON TO NEXT CHAR SUBTTL ALPHA CASE CONVERTED ;SET ^V FLAGS C.V: TXON F2,S.CTLV ;SET ^V FLAG -- WAS IT ON BEFORE? POPJ P, ;NO TXZ F2,S.CTLV+S.CTWW ;YES, SET ^V^V FLAG & CLR OTHERS TXO F2,S.CTVV POPJ P, ;SET ^W FLAGS C.W: TXON F2,S.CTLW ;SET ^W FLAG -- WAS IT ON BEFORE? POPJ P, ;NO TXZ F2,S.CTLW+S.CTVV ;YES, SET ^W^W FLAG & CLR OTHERS TXO F2,S.CTWW POPJ P, ;CONVERT ALPHABETIC CH TO UPPER OR LOWER CASE ACCORDING TO CASE CONTROL FLAGS CASE: CAIL CH,"A" ;IS CHAR IN UPPER CASE RANGE? CAILE CH,"Z" CAIL CH,"A"+40 ;IS IT IN LOWER CASE RANGE? CAILE CH,"Z"+40 JRST CASE3 ;NO CASE2: TXNE F2,S.LCAS ;PREVAILING LOWER CASE? TRO CH,40 ;YES, CONVERT TO LOWER TXNE F2,S.UCAS ;PREVAILING UPPER CASE? TRZ CH,40 ;YES, CONVERT TO UPPER TXNE F2,S.CTVV ;DOUBLE ^V ON? TRO CH,40 ;YES, CONVERT TO LC TXNE F2,S.CTWW ;DOUBLE ^W ON? TRZ CH,40 ;YES, CONVERT TO UC TXZE F2,S.CTLV ;SINGLE ^V ON? TRO CH,40 ;YES, CONVERT TO LC TXZE F2,S.CTLW ;SINGLE ^W ON? TRZ CH,40 ;YES, CONVERT TO UC CASE3: TXZ F2,S.CTLV+S.CTLW ;CLR IN CASE NO CONVERSION POPJ P, ;CONVERT @, [, \, ], ^, AND _ TO THE EQUIVALENT LC CHARACTER CVTSPC: CAIL CH,"[" CAILE CH,"_" CAIN CH,"@" TRO CH,40 ;CONVERT TO LOWER CASE RANGE POPJ P, SUBTTL CHECK FOR NON-CONTROL CHARACTERS ;IF CH<10, OR 15 SUBTTL PUT A CHARACTER IN THE OUTPUT FILE PPA: PPA05: SOSGE OBF+.BFCNT ;YES. IS OUTPUT BUFFER FULL? JRST OUTBFR MOVE A,OUTSWT ;GET OUTPUT SWITCHES TXNN FF,F.SEQ ;SEQUENCED FILE? TLNE A,FS.GEN ;NO, OUTPUT FS.GEN ON? JRST PPA02 ;YES, GENERATE LSN TXZ FF,F.SQIN PPA01: IDPB CH,OBF+.BFPTR ;CH TO OUTPUT BUFFER. POPJ P, ;RETURN OUTBFR: OUT OUTCHN, ;DUMP BUFFER JRST PPA05 ;AND CONTINUE OUTERR: GETSTS OUTCHN,B ;SAVE ERROR FLAGS RELEAS OUTCHN,0 ;CLOSE FILE AND RELEASE OUTPUT DEVICE. TXZ FF,F.OOPN+F.UBAK ;CLEAR OUTPUT FILE OPEN INDICATOR. EE2+ERROR E.OUT PPAQ: SOSGE OBF+.BFCNT ;MORE ROOM? JRST [OUT OUTCHN, ;DUMP BUFFER JRST PPAQ ;LOOP JRST OUTERR] ;ELSE ERROR IDPB CH,OBF+.BFPTR ;SAVE CHARACTER POPJ P, ;LEAVE PPA02: TXNN FF,F.SQIN ;WAS LAST CHAR AN EOL OR BEG OF BUFR? JRST PPA03 ;NO MOVE AA,OUTSWT ;GET OUTPUT SWITCHES TLNE AA,FS.SUP ;IF WE ARE SUPRESSING SEQUENCE #'S, JRST PPA06 ;DON'T WORRY ABOUT PADDING WITH NULLS MOVE A,OBF+.BFCNT ;ROOM FOR SEQ# IN OUTPUT BUFR? CAIG A,^D12 ;[345] Page marks need 12 positions JRST PPA05 ;NO, OUTPUT & COME BACK PUSHJ P,NULPAD ;[345] Go pad with nulls if necessary PPA06: TXZ FF,F.SQIN TXNE FF,F.SEQ ;GENERATE NEW LSN OR OUTPUT EXISTING LSN? JRST PPA04 ;OUTPUT EXISTING LSN CAIN CH,.CHFFD ;[345] Form feed? JRST PPA14 ;[345] Yes, go handle it MOVE A,LSNCTR ;GET LAST CREATED LSN WITH BIT 35 ON ADD A,[BYTE (7)106,106,106,107] ;& ADD ASCII 10 TO IT MOVE T,A AND T,[BYTE (7)60,60,60,60] LSH T,-3 MOVE TT,A AND TT,[BYTE (7)160,160,160,160] IOR T,TT SUB A,T ADD A,[BYTE (7)60,60,60,60] MOVEM A,LSNCTR ;STORE NEW LSN PPA06A: AOS OBF+.BFPTR ;& OUTPUT THE 5 DIGITS + BIT 35 MOVEM A,@OBF+.BFPTR MOVEI A,.CHTAB ;FOLLOWED BY TAB IDPB A,OBF+.BFPTR MOVNI A,6 ;ADJUST BUFR CTR ADDM A,OBF+.BFCNT PPA03: PUSHJ P,CKEOL ;IS THIS CHAR AN EOL? JRST PPA01 ;NO TXO FF,F.SQIN CAIE CH,.CHFFD ;[345] Form feed? JRST PPA01 ;[345] No, just output TLNE AA,FS.SUP ;[345] Suppressing LSN's? JRST PPA01 ;[345] Yes MOVEI A,.CHCRT ;[345] No, insert a CRLF IDPB A,OBF+.BFPTR ;[345] before a page mark MOVEI A,.CHLFD ;[345] So it will be recognized IDPB A,OBF+.BFPTR ;[345] SOS OBF+.BFCNT ;[345] Update the counter SOS OBF+.BFCNT ;[345] PUSHJ P,NULPAD ;[345] Go pad with nulls if necessary JRST PPA14 ;[345] Mark the page ;Routine to pad buffer with nulls till next word boundary ; NULPAD: LDB A,[POINT 6,OBF+.BFPTR,5] ;GET CURRENT BYTE POSITION CAIG A,1 ;AT END OF WORD? POPJ P, ;Yes, return IBP OBF+.BFPTR ;NO, PAD OUT WORD WITH NULLS SOS OBF+.BFCNT JRST NULPAD ;TRY AGAIN ;OUTPUT EXISTING LSN WITH LEADING ZEROS PPA04: MOVEI A,4 ;INIT 5 DIGIT CTR MOVEM A,LSNCTR MOVE A,[<"00000">B34] ;INIT LSN ACCUMULATOR CAIL CH,"0" ;IS CURRENT CHAR A DIGIT? CAILE CH,"9" JRST PPA08 ;NO, FILL IN 5 SPACES JRST PPA12 PPA10: SOSGE LSNCTR ;DONE 5 DIGITS YET? JRST PPA09 ;YES PPA12: LSH A,7 ;PUT DIGIT INTO ACCUMULATOR DPB CH,[POINT 7,A,34] CAML I,B JRST PPA09 ILDB CH,OU ;GET THE NEXT FUCKING CHARACTER ADDI I,1 ;INCREMENT TEXT PTR CAIL CH,"0" ;IS IT A DIGIT? CAILE CH,"9" JRST PPA09 ;NO JRST PPA10 ;YES, STORE IT PPA08: MOVE A,[<" ">B34] ;GET 5 SPACES PPA08X: CAIE CH," " ;SPACE? JRST PPA08B ;NO, INSERT 5 SPACES SOSGE LSNCTR ;HAVE WE SEEN 5 SPACES? JRST PPA08C ;IF SO, CHECK FOR TAB OR CR ILDB CH,OU ;GET NEXT CHARACTER AOJA I,PPA08X ;TRY AGAIN ; HERE IF WE'VE SEEN 5 SPACES MAY BE TECO BLANK SEQUENCE NUMBER, ; SOS PAGE MARK, OR SPACES THE USER HAS INSERTED. PPA08C: ILDB CH,OU ;GET THE CHAR AOS I CAIE CH,.CHCRT ;TEST FOR CR (FOR SOS) OR CAIN CH,.CHTAB ;TAB TO BE OUTPUT WITH SPACES JRST PPA09 ;OUTPUT 5 SPACES + CHAR IN CH ; HERE IF NOT 5 SPACES FOLLOWED BY TAB OR CR. THIS IMPLIES ; THAT ANY SPACES SEEN WERE USERS'S TEXT. PPA08B: SUBI I,4 ;BACK UP TO FIRST CHARACTER ADD I,LSNCTR ;AND OUTPUT IT WITH BLANK LSN MOVE OU,I ;FIX BYTE POINTER IDIVI OU,5 HLL OU,BTAB-1(OU+1) ILDB CH,OU ;GET PROPER CHARACTER MOVE AA,OUTSWT ;GET SWITCHES TLNE AA,FS.SUP ;SUPPRESS SEQ# JRST PPA01 ;YES TRO A,1 ;NO SET BIT 35 JRST PPA06A ;OUTPUT SEQ# WITH A TAB PPA09: MOVE AA,OUTSWT ;GET SWITCHES TLNE AA,FS.SUP ;SUPPRESS SEQ#'S? JRST PPA13 ;YES TRO A,1 ;SET BIT 35 AOS OBF+.BFPTR ;& OUTPUT SEQ # MOVEM A,@OBF+.BFPTR MOVNI A,5 ADDM A,OBF+.BFCNT ;& ADJUST BUFR CTR JRST PPA03 ;CONTINUE PPA13: CAIE CH,.CHCRT ;ELEMINATE CR (FOR SOS) CAIN CH,.CHTAB ;IS TERMINATOR A TAB? AOSA OBF+.BFCNT ;YES, ADJUST BYTE COUNT JRST PPA01 ;NO, OUTPUT IT POPJ P, ;AND OMIT IT ; ; Here to insert an SOS type page mark. ; PPA14: MOVE A,[BYTE (7) 40,40,40,40,40] ;[345] Five spaces TRO A,1 ;[345] Set the bit AOS OBF+.BFPTR ;[345] Increment pointer MOVEM A,@OBF+.BFPTR ;[345] and output MOVE A,[BYTE (7) .CHCRT,.CHFFD,0,0,0] ;[345] CR,FF AOS OBF+.BFPTR ;[345] Increment MOVEM A,@OBF+.BFPTR ;[345] and deposit MOVNI A,^D9 ;[345] Adjust buffer counter ADDM A,OBF+.BFCNT ;[345] (We already counted one at PPA:) TRO FF,F.SQIN ;[345] Set the EOL flag MOVE A,[<"00000">B34+1] ;[345] Reset the LSN's MOVEM A,LSNCTR ;[345] POPJ P, ;[345] Return SUBTTL PW OUTPUT THE ENTIRE BUFFER, FOLLOWED BY A FORM FEED CHARACTER. ; TO THE SELECTED OUTPUT DEVICE. BUFFER IS UNCHANGED AND POINTER ; IS UNMOVED. ;P IS IDENTICAL TO PWY. ;NP IS IDENTICAL TO PP...P (P PERFORMED N TIMES). ;I,JP OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER. NO FORM ; FEED IS PUT AT THE END. BUFFER UNCHANGED;POINTER UNMOVED. PUNCHA: MOVEI D,CPPA ;SELECT PPA FOR OUTPUT INDIRECTLY IN CASE I,JP. TXNE FF,F.ARG2 ;I,JP? JRST TYPE0 ;YES. GET STRING ARGUMENTS AND OUTPUT. MOVE E,B ;NO. E:=N MOVE B,CPTR ILDB T,B ;T:=COMMAND CHARACTER FOLLOWING P. TRZ T,40 ;FILTER L.C. JUMPL E,CPOPJ ;IF N<0, IGNORE P. CHKEO EO21,PUN1 ;OLD STYLE P ALWAYS GIVES FORM FEED CAIE T,"W" ;PW ALWAYS GIVES FORM FEED TXO FF,F.NSRH ;OTHERWISE, FORM GOES OUT ONLY IF FORM CAME IN PUN1: PUSHJ P,PUNCHR ;PUNCH OUT BUFFER SKIPE COMCNT ;IF NO COMMANDS LEFT CAIE T,"W" ;OR COMMAND IS NOT W JRST PUN3 ;READ NEXT PAGE CAIG E,1 ;ARG DOWN TO 1 YET? PUSHJ P,RCH ;YES, THROW AWAY THE W PUN4: SKIPN XCTING JRST GO MOVE C,Z CAMN C,BEG ;EMPTY BUFFER? TXNN FF,F.EOFI ;NO. QUIT ON EOF SOJG E,PUN1 ;YES. E:=E-1. DONE? CPOPJ: POPJ P, ;YES PUN2: MOVE OU,BEG ;IF NOTHING READ IN, CLEAR THE BUFFER MOVEM OU,PT TXZ FF,F.FORM ;AND THE FORM FEED FLAG JRST YANK51 ;SET Z=BEG & POPJ PUNCHR: MOVE C,BEG ;OUTPUT DATA BUFFER. MOVE B,Z MOVE D,OUTCH CAME B,C ;IS PAGE BUFFER EMPTY? JRST PUNCH1 ;NO TXNE FF,F.FORM ;YES, IS THERE A FORM-FEED ON THIS BLANK PAGE? JRST TYPE5 ;YES, OUTPUT IT POPJ P, PUNCH1: TXNN FF,F.OOPN ;CAN WRITE? ERROR E.NFO JRST TYPE1 PUN3: TXNE FF,F.IOPN ;ANY INPUT FILE? TXNE FF,F.EOFI ;DONT TRY TO READ IF NO DATA LEFT JRST PUN2 PUSHJ P,YANK1 ;RENEW BUFFER JRST PUN4 ;CONTINUE SUBTTL NJ, NC, & NL COMMANDS ;NJ MOVE THE POINTER TO THE RIGHT OF THE NTH CHARACTER IN THE ; BUFFER. (I.E., GIVE "." THE VALUE N.) ;J SAME AS 0J. JMP: ADD B,BEG ;PT:=N+BEG JRST JMP1 ;NR SAME AS .-NJ. REVERS: PUSHJ P,CHK2 ;MAKE SURE THERE IS AN ARGUMENT MOVNS B ;B:=-C(B) SKIPA ;NC SAME AS .+NJ. NOTE THAT N MAY BE NEGATIVE. CHARAC: PUSHJ P,CHK2 ;MAKE SURE THERE IS AN ARGUMENT ADD B,PT ;B:=PT+C(B) ;IF B LIES BETWEEN BEG AND Z, STORE IT IN PT. JMP1: PUSHJ P,CHK ;IS C(B) WITHIN DATA BUFFER? MOVEM B,PT ;YES. PT:=C(B) JRST RET ;NL IF N>0: MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS ; PASSED OVER N LINE FEEDS. ; IF N<0: MOVE POINTER TO THE LEFT;STOP WHEN IT HAS PASSED ; OVER N+1 EOL'S AND THEN MOVE IT TO THE RIGHT OF ; THE LAST EOL PASSED OVER. ;L SAME AS 1L. LINE: TXNE FF,F.ARG2 ;ERROR IF THERE ARE 2 ARGS ERROR E.TAL PUSHJ P,GETARG ;NO. C:=FIRST STRING ARGUMENT ADDRESS, ;B:=SECOND STRING ARGUMENT ADDRESS. XOR B,C XORM B,PT JRST RET SUBTTL ROUTINE TO RETURN CURRENT ARGUMENT IN B ;ASSUMES A VALUE OF 1 WITH SIGN OF LAST OPERATOR IF THERE IS NO CURRENT ARGUMENT ;CALL PUSHJ P,CHK2 ; RETURN WITH B:=CURRENT ARG.,+1 OR -1 CHK2: TXOE FF,F.ARG ;IS THERE AN ARGUMENT? POPJ P, ;YES. IT'S ALREADY IN B. CHK22: MOVEI B,1 ;B=1*SIGN OF LAST OP TXZE FF,F.NEG ;WAS IT A MINUS SIGN? MOVNS B ;YUP POPJ P, ;RETURN ;NK PERFORM NL BUT DELETE EVERYTHING THE POINTER MOVES OVER. ;M,NK DELETE THE (M+1)TH THROUGH THE NTH CHARACTER FROM THE BUFFER. ; THE POINTER IS THEN PUT WHERE THE DELETION TOOK PLACE. ;K SAME AS 1K KILL: PUSHJ P,GETARG ;C:=FIRST STRING ARG. ADDRESS ;B:=SECOND STRING ARG. ADDRESS PUSHJ P,CHK1 ;C:=MAX(C(C),BEG), B:=MIN(C(B),Z) MOVEM C,PT ;PT:=C(C) SUB B,C ;B:=NO. OF CHARACTERS TO KILL. JUMPE B,RET ;IF NONE, RETURN. OTHERWISE, FALL INTO DELETE SUBTTL ND DELETE N CHARACTERS FROM THE BUFFER ; IF N IS POSITIVE, DELETE ; THEM JUST TO THE RIGHT OF THE POINTER;IF N IS NEGATIVE, DELETE ; THEM JUST TO ITS LEFT. ;D SAME AS 1D DELETE: PUSHJ P,CHK2 ;MAKE SURE B CONTAINS AN ARGUMENT DEL1: MOVM C,B MOVNS C ;C:=-ABS(B) ADD B,PT ;B:=PT+B PUSHJ P,CHK ;STILL IN DATA BUFFER? CAMGE B,PT ;YES. IS N NEGATIVE? MOVEM B,PT ;YES. MOVE PT BACK FOR DELETION. PUSHJ P,NROOM ;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS TXZE F2,S.DELS ;FROM A SEARCH AND DESTROY MISSION? JRST FND2 ;YES, MAYBE COLON MODIFIER PRESENT JRST RET ;ROUTINE TO CHECK DATA BUFFER POINTER ;CALL MOVE B,POINTER ; PUSHJ P,CHK ; RETURN IF B LIES BETWEEN BEG AND Z CHK: MOVE TT,[MOVE B,SYL] MOVEM TT,DLIM CAMG B,Z CAMGE B,BEG ..ERROR E.POP POPJ P, ;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER ;BOUNDS AND CHECK ORDER RELATION. ;CALL MOVE C,FIRST STRING ARGUMENT ADDRESS ; MOVE B,SECOND STRING ARGUMENT ADDRESS ; PUSHJ P,CHK1 ; RETURN ;IF C>B, DOES NOT RETURN. ;C:=MIN(MAX(C,BEG),Z) ;B:=MIN(MAX(B,BEG),Z) CHK1: CAMLE C,B ;C>B? ERROR E.SAL CAMGE C,BEG ;C:=MAX(C(C),BEG) MOVE C,BEG CAMLE C,Z ;C:=MIN(C(C),Z) MOVE C,Z CAMGE B,BEG ;B:=MAX(C(B),BEG) MOVE B,BEG CAMLE B,Z ;B:=MIN(C(B),Z) MOVE B,Z POPJ P, ;RETURN SUBTTL Searches -- Commands ;F Search FCMD: PUSHJ P,SKRCH ;GET CHAR AFTER F ERROR E.MEF TXO FF,F.SRCH ;SET F-SEARCH FLAG TRZ CH,40 ;UPPER OR lower CASE CAIN CH,"S" ;FS? JRST SERCH ;YES CAIN CH,"N" ;FN? JRST SERCHP ;YES TXZ FF,F.SRCH ;MUST NOT BE ON CAIE CH,"D" ;SEARCH AND DESTROY ERROR E.IFC TXO F2,S.DELS ;TO DELETE JRST SERCH ;S SEARCH ONLY ;_ SEARCH LARR: TXOA FF,F.LARW ;F.LARW:=1 FOR LEFT ARROW SEARCH ;N SEARCH SERCHP: TXO FF,F.NSRH ;F.NSRH:=1 FOR N SEARCH ;S SEARCH SERCH: MOVE E,PT ;OLD POINT MOVEM E,SAVEAC ;SAVE IN CASE THE SEARCH FAILS MOVEM E,UPPERB ;[342] PT is upper bound on backward searches SETZ E, ;ASSUME FIRST OCCURRENCE IN CASE BOUNDED TXZE FF,F.ARG2 ;TWO ARGS = BOUNDED SEARCH JRST BOUNDS ;BOUNDED SEARCH SETZM LOWERB ;SAVE AS DEFAULT LOWER BOUND PUSHJ P,CHK2 ;GET 1ST ARG SKIPE B ;ZERO? JRST SERC33 ;NO TXNE FF,F.ARG ;THERE MUST BE NO ARG ERROR E.ISA SERC33: SKIPGE E,B ;GET ARG WHERE IT WANTS IT TXOA F2,S.MINS ;[342] MINUS SEARCH SETZM UPPERB ;[342] No upperbound on forward searches JRST SERCHA SUBTTL Searches -- pattern source setup ;Here if bounded search, set up bounds BOUNDS: PUSHJ P,GETAG6 ;GET THE STRING POINTERS TXZ FF,F.NSRH!F.LARW!F.ARG ;FN + N GO TO FS AND S CAMLE C,Z ;TOO BIG MOVE C,Z CAMGE C,BEG ;TOO SMALL MOVE C,BEG MOVEM C,PT ;PLACE TO START SEARCHIN' CAML B,C ;MINUS IMPLIED? JRST SAVESH ;NO, SAVE BOUNDS EXCH C,B ;YES, EXCHANGE ARGS TXO F2,S.MINS ;SAY MINUS SEARCH SAVESH: MOVEM C,LOWERB MOVEM B,UPPERB ;Adjust upper and lower bounds SERCHA: MOVE A,BEG ;GOOD LOWER BOUND MOVE B,Z ;GOOD UPPER BOUND CAMLE A,LOWERB MOVEM A,LOWERB CAMGE B,LOWERB MOVEM B,LOWERB SKIPE UPPERB ;FIX ZERO UPPER BOUND CAMGE B,UPPERB MOVEM B,UPPERB CAMLE A,UPPERB MOVEM A,UPPERB MOVMS E ;FOR CORRECT MINUS SERCH MOVEI CH,.CHESC ;USE ALT-MODE DELIMITER IF NO @ SEEN TXZN FF,F.SLSL ;@ SEEN? JRST SERCHB ;NO, TERMINATOR = ALTMODE PUSHJ P,SKRCH ;YES. CH:=USER SPECIFIED DELIMITER. ERROR E.USR ;Determine whether we can use the previous pattern SERCHB: MOVEM CH,B ;B:=Pattern source string delimiter MOVEM CH,ARGTRM ;Save delimiter for FS insertion SETZM SCNEST ;Search nest level is zero PUSHJ P,SKRCH ;Look ahead 1 character ERROR E.USR CAIE CH,(B) ;Is it the delimiter? JRST SERCHT ;No, an argument is given SKIPL SRHCTR ;Yes, use previous pattern string ; unless there was none or last had error ERROR E.SNA SKIPN SCTLGA ; but not if remembered pattern source used ^Gi JRST SCH.E ;OK, use previous matrices ;Move a new pattern source to storage SERCHT: TXZ F2,S.XMAT ;[344] Clear exact match flag STORE A,SMATRX,SMATRX+SCLRLN-1,0 ;Clear previous matrices SETZM SRHCTR ;Clear source pattern length counter SETZM SCTLGA ;Assume pattern source doesn't use ^Gi MOVE AA,[POINT 7,SRHARG] ;Point to start of storage area JRST SERCHD ;1st character already in SERCHC: PUSHJ P,SKRCH ;Get next character of pattern source ERROR E.USR SERCHD: CHKEO EO21,SERCHE ;If EO=1, ^R is just text CAIE CH,.CHCNR ;^R? SERCHE: CAIN CH,.CHCNQ ;^Q? JRST SERCHG ;Yes, next character is text CAIN CH,(B) ;The delimiter? JRST SERCH0 ;Yes CAIN CH,.CHCNT ;^T? JRST SERCHU ;Yes TXNE F2,S.NCCT ;^T flag on? JRST SERCHF ;Yes, ^V and ^W are just text CAIE CH,.CHCNV ;^V? CAIN CH,.CHCNW ;^W? TXO F2,S.XMAT ;Yes, set exact match flag SERCHF: AOS A,SRHCTR ;Bump string counter CAILE A,^D80 ;Still fit in store? ERROR E.STC IDPB CH,AA ;Yes, store character JRST SERCHC ; and go back for more SERCHG: AOS A,SRHCTR ;Count the ^R (^Q) CAILE A,^D80 ;Will it fit? ERROR E.STC IDPB CH,AA ;Yes, store it PUSHJ P,SKRCH ;Get next character ERROR E.USR JRST SERCHF ; and store it as text SERCHU: TXC F2,S.NCCT ;^T, complement control command switch JRST SERCHF SUBTTL Searches -- set up search matrix SERCH0: TXZ F2,S.NCCT ;Refresh ^T flag MOVE B,SRHCTR ;Set source pattern length counter MOVE AA,[POINT 7,SRHARG] ; and pointer MOVEI D,0 ;Start at beginning of pattern ;Set up a 131 by 36 bit table based on the pattern source. ;The table is implemented as a four word by 36 table, with the first ; 32 bits of the words used for the four portions of the ASCII character ; set (i.e. 0-37, 40-77, 100-137, 140-177) and three of the bits left over ; in the last word used for the "bogus" characters BEGPAG, ENDPAG, and ; SPCTAB. This is a little harder to set up for single letters in the ; pattern source, but is much easier for ranges and makes the fast search ; algorithm setup much faster. The table is then rotated into the old ; TECO 36 by 131 bit table for the actual search matrix. SCH.1: ILDB CH,AA ;CH:=Next pattern source character SOJL B,SCH.8 ;End of string? MOVEI T,S2TABL ;Check for control character in string TXNE F2,S.NCCT ;^T flag on? MOVEI T,S3TABL ;Yes, use restricted table PUSHJ P,DISP1 ;Go search table, don't return if found CHKEO EO21,SCH.4 ;Not control, if EO=1, force exact mode TXNN F2,S.NCCT ;If ^T flag on, all control characters are legal PUSHJ P,CKNCC ;Off, all other control characters are illegal ; (Don't return if any) SCH.2: TXNE F2,S.EMAT ;Forced either match on? JRST SCH.3 ;Yes, match either TXNN F2,S.XMAT ;No, want an exact match? TXNE FF,F.PMAT ;No, want global exact match? JRST SCH.4 ;Asked for exact match SCH.3: CAIL CH,"a" ;Match either, is it lower case? CAILE CH,"z" JRST .+2 ;No SUBI CH,"a"-"A" ;Yes, make it upper case CAIL CH,"A" ;Is it upper case? CAILE CH,"Z" JRST SCH.5 ;No MOVSI TT1,400000 ;Yes, convert character to bit of 131 MOVNI TT,-"@"(CH) ; want - (-100) for LSH LSH TT1,0(TT) ;Position bit to letter range IORM TT1,BITMAT+2(D) ;Set match on upper case IORM TT1,BITMAT+3(D) ; and lower case characters JRST SCH.6 SCH.4: PUSHJ P,CASE ;Exact mode, adjust pattern character case SCH.5: MOVSI T,400000 ;Convert character to bit of 131 MOVE TT,CH ;Copy of character IDIVI TT,^D32 ;Using 32 bits per word, figure word and bit ADDI TT,0(D) ; Word plus current pattern position MOVNS TT1 ;Negative of remainder for bit shift LSH T,0(TT1) ;Position bit within 32 bit range for each word IORM T,BITMAT(TT) ; and include it in appropriate word SCH.6: SKIPE SCNEST ;Nested? (^N, ^E[], ^Gi) POPJ P, ;Yes, return to caller ADDI D,4 ;End of a pattern position, on to next JUMPE B,SCH.8 ;Done if no more characters in pattern source CAILE D,^D36*4 ; and error if more than 36 positions in pattern ERROR E.STL JRST SCH.1 ;More pattern source, get some ;Finished building the 131 by 36 bit search table SCH.8: SKIPE SCNEST ;In a nest (^E[ with no ] or ^Gi) POPJ P, ;Yes, let caller carry on LSH D,-2 ;Really finished, convert index to pattern length MOVEM D,PATLEN ; and save it MOVNS SRHCTR ;Flag source pattern length as being legal JRST ROTATE ;Skip 131 by 36 build subroutines to ROTATE ;Control character dispatch table for second scan of pattern source S2TABL: XWD CNTLE,.CHCNE ;^E XWD CNTLG,.CHBEL ;^G XWD CNTLX,.CHCNX ;^X XWD CNTLN,.CHCNN ;^N XWD CNTLS,.CHCNS ;^S XWD CNTLV,.CHCNV ;^V XWD CNTLW,.CHCNW ;^W XWD CNTLBS,.CHCBS ;^\ XWD CNTLCF,.CHCCF ;^^ ;Shorter table used for ^T on mode starts here S3TABL: XWD CNTLT,.CHCNT ;^T XWD CNTLQ,.CHCNQ ;^Q XWD CNTLR,.CHCNR ;^R XWD CNTLLB,.CHESC ;ESCape XWD 0,0 ;End of list ;Control S matches any separator character (i.e., any character not ; a letter, number, period, dollar, or percent) CNTLS: MOVX T, ;All control characters but null (?) IORM T,BITMAT(D) ; on MOVX T, ;All non-symbol special characters IORM T,BITMAT+1(D) ; on MOVX T, ;Upper case range specials IORM T,BITMAT+2(D) ; on MOVX T, ;Lower case range specials + ends of page IORM T,BITMAT+3(D) ; on JRST SCH.6 ;To next character ;Control X matches any single character CNTLX: MOVX T, ;All control characters except null (?) IORM T,BITMAT(D) ; on TLO T,400000 ;Plus space @ grave IORM T,BITMAT+1(D) ; all specials and numbers IORM T,BITMAT+2(D) ; all upper case IORM T,BITMAT+3(D) ; all lower case JRST SCH.6 ;To next character ;Control R is the same as Control Q (Provided EO > 1) ; except it doesn't cause rubout problems CNTLR: CHKEO EO21,SCH.5 ;If EO=1, ^R is just text ;Control Q causes the next character to be taken as text, even if it is ; a control character or the delimiter CNTLQ: ILDB CH,AA ;Get the next character SOJA B,SCH.2 ; and process it as ordinary text ;Control V causes the next character to be made lower case ;Two Control V's set lower case mode until further notice CNTLV: CHKEO EO21,SCH.5 ;If EO=1, ^V is just text PUSHJ P,C.V ;Set ^V flags JRST SCH.1 ; and on to next character ;Control W causes the next character to be taken without case conversion ;Two Control W's set standard case mode until further notice CNTLW: CHKEO EO21,SCH.5 ;If EO=1, ^W is just text PUSHJ P,C.W ;Set ^W flags JRST SCH.1 ; and on to next character ;Control \ inverts case match mode, starting at accept either CNTLBS: CHKEO EO21,SCH.5 ;If EO=1, ^\ is just text TXC F2,S.EMAT ;Complement accept either flag JRST SCH.1 ; and on to next character ;When searching for ALTmode under EO=1, both ESCape and ALTmode match CNTLLB: CHKEO EO21,.+2 ;EO=1? JRST SCH.5 ;No, accept ESCape only MOVEI T,000040 ;Yes, mark ALTmode as an acceptable character IORM T,BITMAT+3(D) JRST SCH.5 ; and ESCape ;Control circumflex causes immediately following @[\]^_ to be converted to ; the appropriate character in the lower case range CNTLCF: CHKEO EO21,SCH.5 ;If EO=1, ^^ is just text JUMPE B,SCH.1 ;[344] If no next character, ignore ILDB CH,AA ;Get the next character PUSHJ P,CVTSPC ;Convert it to lower case if appropriate SOJA B,SCH.2 ; and go process it ;Control T inverts the control character interpretation switch ; The initial setting is that all control character commands are active ; With the switch on, only ^Q, ^R, and ^T commands exist, but all other ; control characters are legal CNTLT: CHKEO EO21,SCH.5 ;If EO=1, ^T is just text TXC F2,S.NCCT ;Complement current setting JRST SCH.1 ; and on to next character ;Control N - invert the sense of the following "character", i.e. accept ; anything but the specified character CNTLN: MOVSI T,-4 ;Set AOBJN count for the 4 words of this position HRR T,D ; of the pattern PUSH P,BITMAT(T) ;Save the current status of the pattern (in case ; of ^E[A,^N^EW] for example) SETZM BITMAT(T) ;Start over again AOBJN T,.-2 ;Loop through this position AOS SCNEST ;Go up a level in complexity PUSHJ P,SCH.1 ;Build the table for the character SOS SCNEST ;Now less complex MOVEI T,4 ;Now go back through the 4 words MOVEI TT,BITMAT+3(D) ;[341] starting at the high end 'cause of stack CTLN.1: SETCM TT1,0(TT) ; complementing the resulting setting TRZ TT1,17 ; (remembering only using 32 bits per word) POP P,0(TT) ;Get back the original bits IORM TT1,0(TT) ;Include the new bits wanted SUBI TT,1 ;Back up to previous word (need a ASOBJN) SOJG T,CTLN.1 ; and loop through all 4 words JRST SCH.6 ;Done this "character" position ;Control Gi causes the text in Q register i to be substituted into ; the search string at this point CNTLG: CHKEO EO21,SCH.5 ;If EO=1, ^G is just text ILDB CH,AA ;Get name of Q register SOJL B,CNTLGR ;If none there, error PUSH PF,AA ;Save source pointer (using Q stack) PUSH PF,B ; and count AOS SCNEST ;Bump search nest level PUSH P,CPTR ;Set up CPTR in case of error (PAIN!) MOVEM AA,CPTR ; so that error will get the right Q name PUSHJ P,QREGV2 ;Figure out which Q register PUSHJ P,QTEXEI ;Set up to read from it PUSHJ P,GTQCNT ;Set how long it is POP P,CPTR ;Restore CPTR MOVE TT,I ;Set up new byte pointer from bogus PT IDIVI TT,5 HLLZ AA,BTAB-1(TT1) ;Get byte pointer value HRR AA,TT ; and quotient is address MOVE B,C ;Copy the string length from GTQCNT CTLG.1: PUSHJ P,SCH.1 ;Go process the string as pattern source JUMPLE B,CTLG.2 ;Done yet? ADDI D,4 ;No, on to next character position CAILE D,^D36*4 ;Full? (see SCH.6) ERROR E.STL JRST CTLG.1 ;No, get next CTLG.2: POP PF,B ;Restore to scan after the ^Gi POP PF,AA SOS SCNEST ;Nesting is back down one JRST SCH.6 ; and go do next character CNTLGR: ERROR E.ICG ;Control E commands all go through here CNTLE: CHKEO EO21,SCH.5 ;If EO=1, ^E is just text ILDB CH,AA ;Get character after the ^E SOJL B,CNTLER ;If none, an error MOVEI T,S4TABL ;Set to search for ^E command characters PUSHJ P,DISPAT ; and look for legal commands (no return if good) CNTLER: ERROR E.ICE ;Dispatch table for ^E commands S4TABL: XWD CNTLEA,"A" ;^EA accept any alpha XWD CNTLEV,"V" ;^EV accept any lower case alpha XWD CNTLEW,"W" ;^EW accept any upper case alpha XWD CNTLED,"D" ;^ED accept any digit XWD CNTLEL,"L" ;^EL accept any end of line character XWD CNTLES,"S" ;^ES accept a string of spaces and/or TABs XWD CNTLEN,74 ;^E accept the ACSII character represented by XWD CNTLEB,133 ;^E[A,B,C] accept A or B or C or ... XWD 0,0 ;End of list ;Control EA - accept any alphabetic character CNTLEA: MOVX T, ;All letters IORM T,BITMAT+2(D) ; upper case on ;Control EV - accept any lower case alphabetic character CNTLEV: MOVX T, ;All letters IORM T,BITMAT+3(D) ; lower case on JRST SCH.6 ; and on to next character ;Control EW - accept any upper case alphabetic character CNTLEW: MOVX T, ;All letters IORM T,BITMAT+2(D) ; upper case on JRST SCH.6 ; and on to next character ;Control ED - accept any digit CNTLED: MOVX T, ;All digits IORM T,BITMAT+1(D) ; on JRST SCH.6 ; and on to next character ;Control EL - accept any end of line character (including buffer end) CNTLEL: MOVX T, ;LF, VT, and FF IORM T,BITMAT(D) ; on MOVX T, ; end of page IORM T,BITMAT+3(D) ; on JRST SCH.6 ; and on to next character ;Control ES - accept any string of spaces and/or TABs CNTLES: MOVX T, ;A TAB IORM T,BITMAT(D) ; on MOVX T, ;A space IORM T,BITMAT+1(D) ; on MOVX T, ;The special space/tab bit IORM T,BITMAT+3(D) ; on JRST SCH.6 ; and on to next character ;Control E[a,b,c,...] - accept any of "characters" a or b or c CNTLEB: AOS SCNEST ;Up one nest level (down?) CTEB.1: PUSHJ P,SCH.1 ;Process the next "character" ILDB CH,AA ;Get the next pattern source (if already off end ; of string, will catch that anyway at .+1) SOJL B,CNTLER ;Error if off end of string CAIN CH,"," ;Another "character" to come? JRST CTEB.1 ;Yes, go include it too CAIE CH,"]" ;No, correct ending to ^E command? ERROR E.ICE SOS SCNEST ;Yes, one fewer level of nesting now JRST SCH.6 ; and have finished a "character" position ;Control E - accept the ASCII character whose octal representation is nnn CNTLEN: MOVEI A,0 ;Clear number accumulator CTEN.1: ILDB CH,AA ;Get an oit SOJL B,CNTLER ;Error if run out CAIN CH,">" ;The other end of the number? JRST CTEN.2 ;Yes, done CAIL CH,"0" ;Is it an oit? CAILE CH,"7" ERROR E.ICE LSH A,3 ;Yes, scale up the previous value ADDI A,-60(CH) ; and add in the new oit JRST CTEN.1 ; then go try for more CTEN.2: CAILE A,177 ;Make sure it's legitimate ERROR E.ICE MOVE CH,A ;Copy the result as the character JRST SCH.5 ; and go set the appropriate bit ;Now we need to build up TECO's standard search table, a 36 bit by 131. word ; table with each pattern position being a slice of the 131 words, with all of ; the acceptable characters for each position marked by a bit on in the word ; reached by using the character directly as an index into the table (the extra ; 3 words are for "beginning of page", "end of page", and "this position matches ; strings of spaces and/or TABs"). At the same time we will set up the two ; simple tables for the fast search algorithm (DELTA0 and DELTA1), since it is ; much quicker to do this now if we use the fast one. ;Since DELTA0 and DELTA1 are the same at all points except for entries which ; are not needed in DELTA1, we will build them as one. ;The conversion is done by rotating the 131. bit by 36 word table 90 degrees. ;Since that table was built first (instead of the normal TECO table as in ; standard TECO), the loop is only needed for as many times as there were ; pattern characters (doing it in the other order requires a loop through all ; 131 characters with no possibility for less). ;AC usage: (Other than poor, I want P1-P4) ;D AOBJN pointer with "virtual" index into 131 by 36 table (word index/4) ;I actual word index into 131 by 36 table ;A bit mask specifying pattern position we're currently doing ;AA AOBJN pointer into the 131 bits of an entry of the 131 by 36 table ;TT+TT1 current words worth of the 131 bits and the JFFO result SLARGE==10777777 ;A special large number for DELTA0 used for ; the characters defining the rightmost pattern ; position ROTATE: MOVN D,PATLEN ;Get the number of pattern positions used HRLZS D ; as an AOBJN pointer MOVEI I,0 ;Clear the actual index MOVE A,PATLEN ;Initialize DELTA0 and DELTA1 to the number MOVEM A,DELTA0 ; of positions in the pattern MOVE AA,[XWD DELTA0,DELTA0+1] BLT AA,DELTA0+SPCTAB SUBI A,1 ;Pattern length - 1 is the distance we are from MOVEM A,ROTLEN ; the end of the pattern at the moment MOVSI A,400000 ;Start mask at first pattern position ROTA.1: MOVSI AA,-BITMLN ;Set AOBJN pointer into the 131 bits ROTA.2: SKIPE TT,BITMAT(I) ;Get 32 of those, seeing if any are on ROTA.3: JFFO TT,[ ; and if any are, see which the first one is MOVSI CH,400000 ;Got one, make a mask to turn it off MOVN T,TT1 LSH CH,0(T) ANDCM TT,CH ; and do so ADDI TT1,0(AA) ;Add 0, 32, 64, or 96 to the bit number IORM A,SMATRX(TT1) ; and turn on the position bit for the character SKIPN CH,ROTLEN ;Get the current distance from the right end of the pattern MOVX CH,SLARGE ;At the right, change to the special number MOVEM CH,DELTA0(TT1) ;Set that in fast loop table JRST ROTA.3 ;On to next bit ] ADDI I,1 ;Finished a word of the 131 bit string ADDI AA,^D31 ;Next word is 32 farther into the 36 by 131 table AOBJN AA,ROTA.2 ;Loop until all 131 bits done LSH A,-1 ;On to the next pattern mask position SOS ROTLEN ; and distance from the end AOBJN D,ROTA.1 ; and loop through all used pattern position ;Now determine which search method we will use. If ^ES appeared we have to use ; the old slow method. Initially if we need to match BEGPAG or ENDPAG, we will ; use the old method. Also we will arbitrarily select 3 as the shortest string ; which will benefit from using the new search. As an aid, turn off the BEGPAG ; and ENDPAG bits which don't appear at the appropriate end of the pattern, ; since they obviously won't match except there. FIGSCH: SETZB A,SCHTYP ;Assume an old style search MOVN D,PATLEN ;Generate a bit mask for the last pattern MOVSI AA,400000 ; position used in this search ANDM AA,SMATRX+BEGPAG; (with a side effect of clearing extra begin page bits) LSH AA,1(D) MOVE D,PATLEN ;Now see how long the pattern is CAILE D,2 ;If it is fewer than 3 positions long, SKIPE SMATRX+SPCTAB ; or if there were any ^ES positions, JRST SCH.E ; just go use the old search ANDM AA,SMATRX+ENDPAG;We know pattern is longer than 1, so clear extra end page bits SKIPN SMATRX+BEGPAG ;If either end of buffer will match, SKIPE SMATRX+ENDPAG ; ... JRST SCH.E ; go use old search SETOM SCHTYP ;We win with the new one, remember that in case ; this was an nSFOO$ type ;We are going to use the new search, set up the more costly DELTA2 table. ;This table is based on the arrangement of characters in the pattern. ;It uses the existence (or non-existance) of matching substrings in the ; pattern to be able to shift the pattern farther than would be indicated by ; DELTA1, e.g. if the pattern is ACACACACACAABC and the part of the searched ; string being examined is CABC, DELTA1 will only shift the pattern right 3 ; positions, while "looking" at the pattern will tell a human observer that ; the pattern can be shifted its whole length without missing any possible ; matches. ;A few bits in B for use during the DELTA2 setup NEDSET==1B35 ;This position of DELTA2 still needs setting up WNTOFF==1B34 ;We shifted off the end of the pattern this pass FSTIME==1B33 ;This is the first pass - use a special value instead of ; having to initialize the index matrix (INDMAT) ;AC usage (see comment at ROTATE) ;A the highest entry currently being used in INDMAT ;AA a number used to indicate how far the pattern can be shifted when we ; find a mismatch between sub-pattern strings ;B used for the above flag bits ;C index into INDMAT for updates to it as matches occur in sub-patterns ;CH index into INDMAT for loop ;I index into pattern (*4 since 4 words per pattern position) ;J temporary index into pattern (also *4) ;We want to look for sub-strings in the pattern matching rightmost sub-strings ; of the pattern. If none are found, then as in the above example when more than ; one pattern position has been matched we know we can shift farther than to ; the next occurance of single pattern characters. If some matches are found ; then we can try them next immediately. ;The examination is implemented by using an array of pointers (indices into ; the pattern) (INDMAT), stored in decreasing order and overwritten each pass ; by the pointers for the next pass. When I points to the beginning of the ; rightmost n characters of the pattern, then each pointer in INDMAT points ; to the beginning of a sub-string which matches those n characters. When ; INDMAT has been emptied, all of these sub-strings have been matched and the ; rest of DELTA2 can be set to shift the pattern its entire length. The ; initial setting of INDMAT (implemented by FSTIME) is such that every pattern ; position is examined on the first pass. MOVEI A,-1(D) ;Start the top of INDMAT at pattern length - 1 MOVEI AA,-1(D) ;Start the non-match shift at pattern length ; (adjusted because a 0-index is subtracted from it) MOVX B,NEDSET!FSTIME ;The first setting is needs setting, first pass, ; and haven't gone off the end MOVEI I,-1(D) ;Start at right end of pattern (0-indexed) LSH I,2 ; adjusted for being 4 word bit strings MOVEI D,0(I) ;Set initial INDMAT value to shift all less 1 ; remembering the first SUBI 4 SET2.2: MOVEI C,0 ;Start used INDMAT entry index off at none MOVN CH,A ;Make an AOBJN pointer for loop through INDMAT HRLZS CH SET2.3: TXNN B,FSTIME ;Get the appropriate INDMAT entry SKIPA D,INDMAT(CH) ;Not the first time, use the real array SUBI D,4 ;The first pass, use our fake value MOVE TT,BITMAT(I) ;Figure out if any of the characters matched AND TT,BITMAT(D) ; by the position we are looking at at highest MOVE TT1,BITMAT+1(I) ; level (I) also match at the position indicated AND TT1,BITMAT+1(D) ; by the substring table (INDMAT - D) OR TT,TT1 MOVE TT1,BITMAT+2(I) ;(AND the strings together, if result is zero AND TT1,BITMAT+2(D) ; then no characters match) OR TT,TT1 MOVE TT1,BITMAT+3(I) AND TT1,BITMAT+3(D) OR TT,TT1 JUMPE TT,SET2.5 ;If zero, no matches here JUMPE D,SET2.4 ;Did we just match with the leftmost position? MOVEI T,-4(D) ;No, update the index matrix to check the position MOVEM T,INDMAT(C) ; in front of this for finding substrings AOSA C ;Remember we used another element of INDMAT SET2.4: TXO B,WNTOFF ;We matched at the left end, that goes off the end SET2.5: TXNN B,NEDSET ;Do we still need to set up this position? JRST SET2.6 ;No, skip all the logical stuff MOVE TT,BITMAT(D) ;Yes, then we need to figure out if the substring ANDCM TT,BITMAT(I) ; indicated position (D) character set is a MOVE TT1,BITMAT+1(D) ; subset of the high level (I) character set ANDCM TT1,BITMAT+1(I) ; (Done by D .AND. .NOT. I .NE. 0) OR TT,TT1 MOVE TT1,BITMAT+2(D) ANDCM TT1,BITMAT+2(I) OR TT,TT1 MOVE TT1,BITMAT+3(D) ANDCM TT1,BITMAT+3(I) OR TT,TT1 JUMPE TT,SET2.6 ;Skip out if it's not TXZ B,NEDSET ;It is, don't do this again MOVNI T,4(D) ;We now know that we can shift at least as much ASH T,-2 ; as the distance from here to the right end ADD T,PATLEN ; since no substrings matched from here to there MOVE TT1,I ;Figure out where to put it with LSH TT1,-2 ; a word table MOVEM T,DELTA2(TT1) ;Put it there SET2.6: AOBJN CH,SET2.3 ;Loop through current index matrix TXZ B,FSTIME ;Finished the first pass MOVE A,C ;Remember the highest index matrix element used TXOE B,NEDSET ;Do we still need to set this position? JRST [ ;Yes, then we can shift it based on how MOVE T,AA ; far the highest level loop is from MOVE TT,I ; the right end of the pattern LSH TT,-2 SUB T,TT ADD T,PATLEN MOVEM T,DELTA2(TT) JRST .+1 ] TXZE B,WNTOFF ;Did this pass go off the end of the pattern JRST [ ;Yes, need to adjust the amount we MOVEI AA,-4(I) ; can shift when NEDSET is used LSH AA,-2 ; immediately above JRST .+1 ] SUBI I,4 ;Now look a position to the left of last loop SKIPE A ; unless there is no need to cause no matches JUMPGE I,SET2.2 ; or because we looked at all of them JUMPL I,SET2.E ;Did we look at all of them? ADD AA,PATLEN ;No, need to fill in the rest with the largest LSH I,-2 ; possible number based on how far we are from SUB AA,I ; the right end of the pattern and how far the ; setup got MOVEM AA,DELTA2(I) ADDI AA,1 ;Each position to the left can shift one farther SOJGE I,.-2 SET2.E: ;Now, if F search, scan insert argument SCH.E: TXNN FF,F.SRCH ;F? search? JRST WCHSCH ;No, go start search TXZ F2,S.NCCT ;Refresh ^T flag MOVE CH,ARGTRM ;Get delimiter back TXZ FF,F.NNUL ;Reset non-null string flag JRST INSERA ;Go scan insert argument SERCHJ: POP P,COMBAK ;Save pointers for the insertion (COMCNT) POP P,CPTBAK ; (CPTR) ; and fall into search ;Here to call the appropriate search WCHSCH: TXNN F2,S.MINS ;If this time is minus search, force old search SKIPN SCHTYP ;Which one are we using? JRST SLOSCH ;The old one ; JRST FSTSCH ;The new one, fall into it SUBTTL Searches -- New fast search routine ;This is an implementation of the algorithm of Boyer and Moore, published ; in the Communications of the ACM, October 1977, Vol. 20 Number 10, page 762. ; This article serves as the primary documentation for this routine (and the ; DELTA? table setup routines). ;This is the actual search, which uses the numbers in DELTA0, DELTA1, and ; DELTA2 for determining where in the searched string to look. The actual ; character comparisons are done in the tried and true TECO way, with TECO's ; original bit map (there can't be a better way). ;AC usage (ditto) ;A During the slow loop, counts down through the pattern ;AA Contains the bit mask for the last pattern position ;B The base register into the byte pointer table, including (C) ;C A negative index into the byte pointer table ;D The length of the string to be searched ;T During the slow loop, shifts the bit mask through the pattern ;TT The word address of the first byte of the portion of the searched ; string currently being examined ;TT1 The value of C at the start of the current FAST and SLOW loop execution ;The bytes in the searched string are obtained through a window by a table of ; constant byte pointers indexed into by B, C, and TT. FSTSCH: MOVN T,PATLEN ;Generate the bit mask for the rightmost MOVSI AA,400000 ; pattern position LSH AA,1(T) MOVE I,PT ;Start searching at . MOVE D,UPPERB ;Figure out how many characters are to be searched SUB D,I ; i.e. the length of the searched string ADDI D,1 ;*Note that all this code must use full word ; arithmetic when referring to I, since its ; maximum value is 128K * 5 characters* TXNE FF,F.ARG ;Is this an nSFOO$$? JUMPLE E,FND ;Yes, done if we've found that many MOVX B,<0(C)> ;Start the byte pointer base at 0(C) FSTS.1: MOVE TT,I ;Convert I into a word and byte address IDIVI TT,5 MOVE T,D ;Figure the current byte pointer window length CAILE T,SCHBPL ; the length of string left MOVEI T,SCHBPL ; or the window size, whichever is less ;Fall through to next page... MOVN C,T ;Copy that as negative index into table ADD T,TT1 ;Add the byte in word offset ADDI T,SCHBPT-1 ; plus the address of the start of the table HRR B,T ; equals the base address to be negatively ; indexed from ADD C,PATLEN ;This search starts at the right end of the pattern JUMPG C,NOFND3 ;If that is to the right of the last character ; of the string, then we didn't find it MOVE TT1,C ;Save C at the start of the loop, so we can ; tell how many characters we've skipped ;FAST: ;The fast loop in the ACM article FSTS.3: LDB CH,@B ;Get a character from the searched string ADD C,DELTA0(CH) ;Shift down based on its existance in the pattern JUMPLE C,FSTS.3 ; and loop unless it is in the rightmost position ; i.e. if we just had a match (see LARGE) TLON C,-1 ;Did it match (SLARGE makes the left half 7) JRST FSTS.5 ;No, we used up our window (left half is zero) MOVE T,AA ;Start at right end of pattern bit mask MOVE A,PATLEN ; for that many characters ;SLOW: ;SLOW loop in ACM article FSTS.4: SOJLE A,FSTS.6 ;If we run out of pattern characters, it matched LSH T,1 ;Set bit mask to previous pattern position LDB CH,@B ;Get the next searched string character TDNE T,SMATRX(CH) ;Does it match? SOJA C,FSTS.4 ;Yes, back up byte pointer index one and loop MOVE T,DELTA0(CH) ;No, figure which table shift us the most TLNN T,-1 ;If we just got SLARGE, use DELTA2 always CAMGE T,DELTA2-1(A) MOVE T,DELTA2-1(A) ADD C,T ;Update our current position by that much JUMPL C,FSTS.3 ; and go back to FAST unless we exceeded window ;Search failed in this window, see what to do FSTS.5: JUMPLE D,NOFND3 ;Not found if there is no searched string left SUB C,TT1 ;See how many characters we skipped ADDI I,0(C) ;Update current position by that much SUBI D,0(C) ; and amount left by that much JRST FSTS.1 ; and try again ;Here when string found, decide where the right end of the pattern is FSTS.6: SUB C,TT1 ;How much we moved ADD I,C ;Adjust pointer by that much ADD I,PATLEN ; but we scanned back by that much too MOVEM I,PT ;Update . to that point ADD I,PATLEN ;Now get to right end of pattern JRST FND ;We did it ;Build the fixed byte pointer table. The following code is done again ; under an XLIST SCHBPL==^D200 ;Length of window of byte pointers $A==0 ;Start the base address at zero ;SCHBPT:REPEAT SCHBPL/5+1,< ;Build 5 for each word of bytes, plus extra for ; ; the fact that the first byte may be one of 5 ; $M==177B6 ;A mask for the current character of the word ; REPEAT 5,< ;For each word of bytes ; POINTR $A(TT),$M ;Build 5 pointers ; $M==$M_-7 ;Moving mask each time ; > ; $A==$A+1 ;To next word ; > XLIST SCHBPT: IF1,< BLOCK SCHBPL+5 > IF2,< REPEAT SCHBPL/5+1,< $M==177B6 REPEAT 5,< POINTR $A(TT),$M $M==$M_-7 > $A==$A+1 > > LIST SUBTTL Searches -- Old slow but sure routine SLOSCH: SERCH1: MOVN T,PATLEN ;Figure old end of search comparator MOVSI AA,400000 LSH AA,0(T) ;Which is bit one past end of pattern MOVE I,PT ;START SEARCHING AT PT S1: TXNE FF,F.ARG ;IS THERE AN ARGUMENT? JUMPLE E,FND ;YES. SEEN STRING N TIMES? MOVE TT,I ;NO, FORM BYTE PTR WHICH WILL BE SUBI TT,1 ;INCREMENTED BEFORE USE IDIVI TT,5 HLL TT,BTAB(TT1) CAMG I,BEG ;AT BEG OF BUFR? SKIPL SMATRX+BEGPAG ;& 1ST SERCH CHAR = BEG OF BUFR CHAR? JRST S3 ;NO MOVSI D,200000 ;YES, START SEARCH AT 2ND SEARCH CHAR MOVE TT1,TT ;SET DYNAMIC PTR = STATIC PTR SETOM BCOUNT ;FLAG 1ST IS BEGPAG JRST S4B ;ENTER SEARCH LOOP S3: MOVSI D,400000 ;START SEEKING MATCH FOR 1ST CHAR MOVE TT1,TT ;SET DYNAMIC PTR=STATIC PTR JRST S4A S4: TDNE D,SMATRX+SPCTAB ;IS SPACE/TAB STRING BIT SET? JRST SPTB ;YES S4E: CAML I,UPPERB ;DON'T ALLOW I OUTSIDE BOUNDS JRST S4D ;... ADDI I,1 ;LOOK AT NEXT LOC, XCEPT 1ST TIME THRU S4C: LSH D,-1 ;ADVANCE TO NEXT CHAR POSITION S4B: CAMN D,AA ;END OF SEARCH TABLE? JRST FND ;YES. S4A: ILDB CH,TT1 ;NO, GET NEXT CHAR TDNE D,SMATRX(CH) ;IS IT A MATCH? JRST S4 ;YES, GO TO NEXT TABLE ENTRY. S4D: AOSN BCOUNT ;IF WE FAILED WITH BEGPAG JRST S3 ;THEN TRY AGAIN WITH 1ST CHAR TXNE F2,S.MINS ;BACKWARDS SEARCH JRST SR4A CAML I,UPPERB ;TOO FAR? JRST NOFND AOS I,PT IBP TT ;MOVE STATIC BYTE PTR JRST S3 ;KEEP LOOKING SR4A: SOS I,PT ;DECREMENT PT CAMGE I,LOWERB ;DONE JRST NOFND ADD TT,[7B5] ;PREVIOUS BYTE (MAYBE) JUMPGE TT,S3 ;DEFINITELY HRLI TT,(POINT 7,,34);FIX SOJA TT,S3 ;DECREMENT AND GO ;Skip over a string of spaces and/or TABs while searching SPTB: CAIE CH," " ;But was the character we matched a space CAIN CH,.CHTAB ; or a TAB? JRST SPTB.1 ;Yes, then accept more JRST S4E ;No, look at next pattern position SPTB.1: ADDI I,1 ;Advance to next buffer location CAML I,UPPERB ;End of buffer? JRST S4C ;Yes, no more then MOVEM TT1,ERR1 ;Save current byte pointer (using ERR1 as temp) ILDB CH,TT1 ;Look at next character CAIE CH," " ;Is it a space? CAIN CH,.CHTAB ; or a TAB? JRST SPTB.1 ;Yes, keep on trucking MOVE TT1,ERR1 ;No, end of string, restore pointer to last space/tab JRST S4C ; and continue search SUBTTL Searches -- pattern found FND: SETOM SFINDF ;NO. SFINDF:=-1 MOVE A,I SUB A,PT ;COMPUTE LENGTH OF SEARCH ARG MOVE B,I ;SAVE CURRENT POINTER TXNN F2,S.MINS JRST NOTMIN ;[342] Test removed since upper-bound was set to PT at the start. ;[342] CAMLE I,SAVEAC ;LEGAL FIND? ;[342] SOSA I,PT SOSA I,PT JRST WCHSCH ;No, continue search NOTMIN: MOVEM I,PT ;ELSE GO FORWARD SOJG E,WCHSCH ;Try again if haven't found it n times MOVEM B,PT TXNE F2,S.DELS ;SEARCH AND DESTROY JRST [MOVE B,SAVEAC ;GET OLD PT SUB B,PT ;MINUS POINT AFTER SEARCH JRST DEL1] ;DELETE !(B)! TXNN FF,F.SRCH ;F-SEARCH? JRST FND3 ;NO MOVE C,VVAL ;YES, GET INSERT SIZE SUB C,A ;[321]INSERT MINUS DELETE MOVNS A ;SET PT TO BEGINNING OF STRING FOUND ADDM A,PT PUSHJ P,NROOM ;STRETCH OR SCRUNCH THE HOLE MOVE B,ARGTRM ;GET TERMINATOR TO LOOK FOR MOVE A,COMBAK ;RESET COMCNT & CPTR TO BEGINNING MOVEM A,COMCNT ;OF INSERT ARGUMENT MOVE A,CPTBAK MOVEM A,CPTR PUSHJ P,INS1B ;INSERT THE 2ND ARG PUSHJ P,ZEROTT ;DO AUTO-TYPE IF REQUIRED MOVE CH,ARGTRM TXZN FF,F.NNUL ;WAS THERE A NON-NULL INSERT? CAIE CH,.CHESC ;ALTMODE TERMINATOR? JRST FND2 ;NO TXO F2,S.NRAD ;FLAG SO 2ND ALTMODE STAYS AROUND JRST ALTM1 ;YES, FS$$ TERMINATES EXECUTION FND3: IFN VC, ;SAVE LENGTH OF STRING PUSHJ P,ZEROTT ;AUTOTYPE FND2: TXZE FF,F.COLN ;COLON MODIFIER? JRST FFOK ;YES, RETURN VALUE CHKEO EODEC,FND4 ;[344] IF old TECO, must check for < ... > JRST RET ;[344] Don't return a value FND4: SKIPL (P) ;IN AN ITERATION? JRST RET ;NO, RETURN NO VALUE FFOK: MOVNI A,1 ;YES. RETURN VALUE OF -1 JRST VALRET SUBTTL Searches -- Autotype after succesful searches ;IF AUTOF IS NON-ZERO ;INCLUDE POINTER MARKER = ASCII CHAR IN AUTOF IF AUTOF > 0 ZEROTT: TXNE FF,F.COLN ;NO AUTOTYPE ON COLON SEARCHES POPJ P, SKIPL -1(P) ;IN AN ITERATION? SKIPN AUTOF ;AUTOTYPE WANTED? POPJ P, TXO FF,F.ARG ;DO 0T SETZ B, PUSHJ P,TYPE HRRZ CH,AUTOF SKIPL AUTOF ;PTR MARKER WANTED? PUSHJ P,TYOM ;YES MOVEI B,1 ;DO 1T PUSHJ P,TYPE TXZ FF,F.ARG POPJ P, SUBTTL Searches -- Pattern not found in this buffer NOFND: TDNN D,SMATRX+ENDPAG ;[344] ENDPAG GOOD FOR A MATCH HERE? JRST NOFND3 ;NO CAMN I,Z ;[344] Yes, but only if we're at Z JRST FND ;ENDPAG MATCHES! NOFND3: MOVE I,BEG ;SEARCH FAILED MOVEM I,PT ;PT=BEG SETZM SFINDF ;SFINDF=0 TXNN F2,S.MINS ;See if this needs to look at a new buffer TXNN FF,F.NSRH!F.LARW; Minus searches never do, but N and _ do JRST RESTPT ;No new buffer, the search lost MOVEM E,SRHCNT ;YES. SAVE SEARCH COUNT MOVEI B,1 ;PUNCH 1 PAGE ONLY TXNE FF,F.NSRH ;N SEARCH? PUSHJ P,PUNCHA ;YES. PUNCH THIS BUFFER AND REFILL IT. TXNN FF,F.IOPN ;ANY INPUT FILE? JRST BEGIN1 ;NO TXNE FF,F.EOFI ;MORE DATA? TXNE FF,F.FORM JRST NOFND4 ;YES MOVE E,BEG ;EOF & NO FORM SEEN CAMN E,Z ;CHECK BUFFER CONTENTS JRST BEGIN1 ;NO MORE DATA NOFND4: TXNE FF,F.LARW ;LEFT ARROW SEARCH? PUSHJ P,YANK1 ;YES. FILL BUFFER. MOVE E,SRHCNT ;RESTORE SEARCH COUNT. MOVE A,BEG MOVEM A,LOWERB MOVE A,Z MOVEM A,UPPERB JRST WCHSCH ;Go do search with this buffer full RESTPT: CHKEO EODEC,BEGIN1 ;[335] Leave pointer at top for EO of 2 or less MOVE A,SAVEAC ;GET OLD PT MOVEM A,PT ;RESTORE IT BEGIN1: TXZ FF,F.NSRH+F.LARW ;[344] Clear N and _ flags. TXNN FF,F.SRCH ;F-SEARCH? JRST NOFND5 ;[344] No MOVE CH,ARGTRM ;GET INSERT TERMINATOR TXZN FF,F.NNUL ;WAS IT A NULL INSERT? CAIE CH,.CHESC ;YES, WAS IT AN ALTMODE TERMINATOR? JRST NOFND5 ;[344] No TXO F2,S.NRAD ;[344] Flag so second altmode gets put in *i NOFND5: TXZE FF,F.COLN ;[344] Colon modified? JRST NOFND6 ;[344] Yes, return a 0 NOFND2: SKIPL (P) ;[344] IN AN ITERATION? ERROR E.SRH ;[344] No, give error message CHKEO EODEC,NOFND6 ;[344] If old TECO, return 0 TXNN F2,S.NRAD ;[344] Null insert? JRST RET ;[344] No, new TECO returns nothing JRST ALTM1 ;[344] Yes, end the command NOFND6: TXNE F2,S.NRAD ;[344] Was it a null insert? JRST ALTM1 ;[344] Yes, that terminates execution JRST BEGIN ;[344] No, return a 0 SRHMOD: EXP SRCHSW ;DEFAULT SEARCH MODE SUBTTL <> ITERATION BRACKETS. COMMAND INTERPRETATION IS SENT ; BACK TO THE < WHEN THE > IS ENCOUNTERED. LSSTH: PUSH P,ITERCT ;SAVE ITERATION COUNT PUSH P,COMAX ;KEEP MAX FOR GARBAGE COLLECTION PUSH P,CPTR ;SAVE COMMAND STATE PUSH P,COMCNT SETOM ITERCT ;ITERCT:=-1 PUSH P,ITERCT ;-1 FLAGS ITERATION ON PDL TXZN FF,F.ARG ;IS THERE AN ARGUMENT? JRST RET ;NO JUMPLE B,INCMA1 ;IF ARG NOT > 0, SKIP OVER <> MOVEM B,ITERCT ;YES. ITERCT:=ARGUMENT JRST RET GRTH: SKIPN XCTING ;CONTINUE? JRST GO SKIPGE A,(P) ;IS THERE A LEFT ANGLE BRACKET? JRST GRTH2 ;YES. OTHERWISE ITS A MISSING < OR SOJE A,GRTH9 ;SOMETHING LIKE <...(...> ERROR E.MLA GRTH2: SOSN ITERCT ;ITERCT:=ITERCT-1. DONE? JRST INCMA2 ;YES MOVE A,-2(P) ;NO. RESTORE COMMAND STATE TO START OF ITERATION. MOVEM A,CPTR MOVE A,-1(P) MOVEM A,COMCNT TXNE FF,F.TRAC ;TRACING? PUSHJ P,CRR ;YES. OUTPUT CRLF JRST RET GRTH9: ERROR E.MRP ;; IF NOT IN AN ITERATION, GIVES ERROR. IF IN AN ITERATION AND ; IF THE MOST RECENT SEARCH FAILED, SEND COMMAND TO FIRST UNMATCHED ; > TO THE RIGHT. OTHERWISE, NO EFFECT. SEMICL: SKIPL (P) ;ERROR IF NOT IN <...> ERROR E.SNI TXNN FF,F.ARG ;YES. IF NO ARG, MOVE B,SFINDF ;USE LAST SEARCH SWITCH (0 OR -1). JUMPL B,CD ;IF ARG <0, JUST RET + EXECUTE LOOP INCMA1: MOVEI TT,">" ;SKAN FOR > MOVEI TT1,"<" ;IGNORE <...> STRINGS PUSHJ P,SKAN ERROR E.MRA INCMA2: SUB P,[XWD 3,3] ;POP OUT A LEVEL POP P,COMAX ;RESTORE MAX. COUNT POP P,ITERCT JRST RET ;!TAG! TAG DEFINITION. THE TAG IS A NAME FOR THE LOCATION IT ; APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING. EXCLAM: PUSHJ P,SKRCH ;LOOK FOR NEXT ! ERROR E.UTG CAIE CH,"!" JRST EXCLAM JRST RET SUBTTL OTAG$ GO TO THE TAG NAMED TAG. ; THE TAG MUST APPEAR IN THE ; CURRENT MACRO OR COMMAND STRING. OG: MOVE A,CPTR MOVE AA,A IDIVI AA,17 CAMN A,SYMS(B) JRST OGFND SKIPN SYMS(B) JRST OGNF CAMN A,SYMS+1(B) ES1: AOJA B,OGFND SKIPN SYMS+1(B) ES2: AOJA B,OGNF CAMN A,SYMS+2(B) AOJA B,ES1 SKIPN SYMS+2(B) ADDI B,2 OGNF: PUSH P,CPTR PUSH P,B MOVEI D,STAB OG1: PUSHJ P,SKRCH ;GET NEXT COMMAND CHAR ERROR E.MEO CAIL D,STAB+STABLN-1 ;DON'T RAVAGE YOURSELF ERROR E.TTL MOVEM CH,(D) ;STAB ... _ TAG CAIE CH,.CHESC AOJA D,OG1 MOVEI A,"!" ;TAG TERMINATOR MOVEM A,(D) SETZM 1(D) MOVE B,COMCNT ;MAKE PTR TO START OF THIS COMMAND LEVEL SUB B,COMAX IDIVI B,5 ADD B,CPTR JUMPE E,OG7 ;NO REMAINDER SOS B MOVMS E JRST .(E) IBP B IBP B IBP B IBP B OG7: MOVEM B,CPTR MOVE B,COMAX ;GET # OF CMD CHARS AT THIS LEVEL MOVEM B,COMCNT OG2: MOVEI TT,"!" ;SKAN FOR ! MOVEI TT1,-1 ;NO SECONDARY CHAR. PUSHJ P,SKAN ERROR E.TAG TXO F2,S.NTRC ;DON'T TYPE EVERY TAG WHILE TRACING MOVEI E,STAB ;INIT SEARCH STRING TO 1ST CHAR AFTER ! OG5: SKIPN (E) ;OVER STRING? JRST OG3 ;YES PUSHJ P,SKRCH ;NO. GET A CHAR ERROR E.TAG CAMN CH,(E) ;MATCH ? AOJA E,OG5 ;YES. MOVE ON. CAIN CH,"!" ;NO, ARE WE AT END OF A TAG? JRST OG2 ;YES, LOOK FOR ANOTHER MOVEI E,"!" ;NO, SKIP TO NEXT ! OG6: PUSHJ P,SKRCH ;GET NEXT CHAR OF TAG ERROR E.UTG CAIE CH,(E) ;!? JRST OG6 ;NO, KEEP GOING JRST OG2 ;YES, LOOK FOR ANOTHER TAG OG3: TXZ F2,S.NTRC ;RE-ENABLE TRACING POP P,A ;GET INDEX TO SYMBOL TABLE POP P,SYMS(A) ;SAVE POSITION OF THIS O COMMAND MOVE B,COMCNT ;SAVE COMCNT FOR THIS TAG MOVEM B,CNTS(A) MOVE B,CPTR ;SAVE TAG POSITION IN COMMAND STRING MOVEM B,VALS(A) JRST RET OGFND: MOVE A,VALS(B) MOVEM A,CPTR MOVE A,CNTS(B) MOVEM A,COMCNT JRST RET SUBTTL " ' PROCESSING ;N"G HAS NO EFFECT IF N IS GREATER THAT 0. OTHERWISE, ; SEND COMMAND INTERPRETATION TO NEXT MATCHING '. ; THE " AND ' MATCH SIMILAR TO ( AND ). ;N"L SEND COMMAND TO MATCHING ' UNLESS N<0. ;N"N SEND COMMAND TO MATCHING ' UNLESS N NOT = 0. ;N"E SEND COMMAND TO MATCHING ' UNLESS N=0. ;N"F SEND COMMAND TO MATCHING ' UNLESS N=0. ;N"U SEND COMMAND TO MATCHING ' UNLESS N=0. ;N"T SEND COMMAND TO MATCHING ' UNLESS N<0. ;N"S SEND COMMAND TO MATCHING ' UNLESS N<0. ;N"C SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII ; CHARACTER IS A LETTER, NUMBER, PERIOD (.), DOLLAR SIGN ($), ; OR PER CENT (%). ;N"A SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII ; CHARACTER IS ALPHABETIC. ;N"D SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII ; CHARACTER IS A DIGIT. ;N"V SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII ; CHARACTER IS LOWER CASE ALPHABETIC. ;N"W SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII ; CHARACTER IS UPPER CASE ALPHABETIC. DQUOTE: TXNN FF,F.ARG ;ERROR IF NO ARG BEFORE " ERROR E.NAQ PUSHJ P,SKRCH ;GET CHAR AFTER " ERROR E.MEQ MOVEI T,DQTABL ;INDEX DISPATCH TABLE PUSHJ P,DISPAT ;DISPATCH FOR CHAR. AFTER " ERROR E.IQC ;" COMMAND DISPATCH TABLE DQTABL: XWD DQ.G,"G" XWD DQ.L,"L" XWD DQ.N,"N" XWD DQ.E,"E" XWD DQ.C,"C" XWD DQ.L,"T" XWD DQ.E,"F" XWD DQ.L,"S" XWD DQ.E,"U" XWD DQ.A,"A" XWD DQ.D,"D" XWD DQ.V,"V" XWD DQ.W,"W" XWD 0,0 ;END OF LIST SUBTTL EXECUTE INDIVIDUAL " COMMANDS DQ.V: TRZN B,40 ;EXECUTE "V JRST NOGO ;IF BIT 30 NOT ON IT CAN'T BE L.C. DQ.A: TRZ B,40 ;EXECUTE "A -- TREAT UC & LC ALIKE DQ.W: CAIL B,"A" ;EXECUTE "W CAILE B,"Z" JRST NOGO ;IT IS NOT A LETTER JRST RET ;IT IS A LETTER DQ.D: CAIL B,"0" ;EXECUTE "D CAILE B,"9" JRST NOGO ;IT IS NOT A DIGIT JRST RET ;IT IS A DIGIT DQ.C: PUSHJ P,CKSYM1 ;EXECUTE "C JRST RET ;IT IS A SYMBOL CHAR JRST NOGO ;IT'S NOT A SYMBOL CHAR DQ.G: MOVNS B ;EXECUTE "G DQ.L: JUMPL B,RET ;EXECUTE "L JRST NOGO ;TEST FAILED DQ.N: JUMPN B,RET ;EXECUTE "N JRST NOGO ;TEST FAILED DQ.E: JUMPE B,RET ;EXECUTE "E, "F, "U NOGO: MOVEI TT,"'" ;SKAN FOR ' MOVEI TT1,"""" ;IGNORE "...' STRINGS PUSHJ P,SKAN ERROR E.MAP JRST RET SUBTTL ROUTINE TO TEST CHARACTER FOR $,%,.,0-9,A-Z ;CALL PUSHJ P,CKSYM ; RETURN IF $,%,.,0-9,A-Z ; RETURN ON ALL OTHER CHARACTERS CKSYM: MOVEI B,(CH) ;ENTER AT CKSYM1 IF CHAR ALREADY IN B CKSYM1: CAIE B,"$" ;$ OR %? CAIN B,"%" POPJ P, ;YES CAIN B,"." ;NO. POINT? POPJ P, ;YES. CAIGE B,"0" ;NO. DIGIT OR LETTER? JRST CPOPJ1 ;NO CAIG B,"9" ;MAYBE. DIGIT? POPJ P, ;YES. CKSYM2: TRZ B,40 ;LC TO UC CAIL B,"A" ;LETTER? CAILE B,"Z" JRST CPOPJ1 ;NO. POPJ P, ;YES SUBTTL ERROR MESSAGE PRINTOUT ERRP: MOVE P,PDLSAV ;RESTORE PDL HRRZ B,.JBUUO ;GET ERROR CODE LDB D,[POINT 4,.JBUUO,12] ;GET SPECIAL CODE CAIE B,'COR' ;CORE IS ALWAYS FATAL TRNN D,10 ;COLONABLE ERROR? TXZ FF,F.COLN ;NO,TURN OFF FLAG TXZE FF,F.COLN JRST ABEGIN ERRPDL: SETZM XCTING ;NO LONGER XCTING MOVE B,.JBREL ;.JBREL NOW MOVEM B,RELSAV SETZM CCLSW ;NO PECULIAR THINGS FOR ME TXO FF,F.EMSG ;ERROR PROCEDURE IN PROGRESS HRLZ B,.JBUUO ;GET ERROR CODE CLRBFI ;CLEAR TTY PUSHJ P,TTOPEN MOVEI CH,"?" ;TYPE ? PUSHJ P,TYOM MOVSI TT,'TEC' HLR TT,B MOVX A,JW.WPR ;HOW MUCH WE PRINT TDNE A,ERRLEN ;WELL PUSHJ P,SIXBMS TRZ D,10 ;SPECIAL FLAG JUMPE D,ERRP04 ;NO SPECIAL ERROR EXTENSION CAIN D,3 ;FLAG=EE3? JRST ERRP05 ;YES MOVEI CH,"-" ;NO, TYPE EXTENSION (MONITOR ERROR CODE) PUSHJ P,TYOM LDB B,[POINT 6,XFILNM+.RBEXT,35] ;GET UUO ERROR FLAG SOJLE D,ERRP03 ;1 IMPLIES IT IS A UUO ERROR HRRZI B,IO.ERR ;GET I-O ERROR FLAGS AND B,ARGSTO ERRP03: PUSHJ P,OCTMS ;TYPE ERROR CODE IN OCTAL ERRP04: MOVE B,ERRLEN ;HOW MUCH MESSAGE WANTED? TXNE B,JW.WFL JRST ERRP02 PUSHJ P,CRR ;HE WANTS ONLY ?XXX, SO END LINE JRST ERRP5 ;BETTER SEE IF HE WANTS MORE ERRP02: MOVEI CH," " ;1ST LINE OF MESSAGE AUTOMATIC PUSHJ P,TYOM ;TYPE TAB ERRP0: SKIPN TT,ERRDEV ;[337] Get device TECO was run from MOVSI TT,'DSK' ;[337] If 0, we're probably debugging: use DSK DEVCHR TT, ;[337] Legal device? JUMPE TT,ERRPSY ;[337] Nope, go use SYS: TXNN TT,DV.DIR ;[337] Had better be a directory device JRST ERRPSY ;[337] Strange... SKIPN TT,ERRDEV ;[337] Retrieve name again MOVSI TT,'DSK' ;[337] MOVEM TT,ERRBLK+1 ;[337] Store in OPEN block MOVEI TT,IO.SYN ;[337] Set status MOVEM TT,ERRBLK ;[337] MOVEI TT,ERRHDR ;[337] Set input buffer header MOVEM TT,ERRBLK+.OPBUF;[337] OPEN ERRCHN,ERRBLK ;[337] Open TECO.ERR device JRST ERRPSY ;[337] Failed JRST ERRP00 ;[337] Success ERRPSY: MOVE TT,ERRDEV ;[337] Get device CAMN TT,[SIXBIT/SYS/] ;[337] Equal to SYS:? JRST NOERRS ;[337] Yes, give up MOVSI TT,'SYS' ;[337] No, try SYS: MOVEM TT,ERRDEV ;[337] Remember for next time JRST ERRP0 ;[337] Try again ;Here when OPEN succeeds ERRP00: MOVE TT,Z ;[337] GET ACTUAL FIRST FREE LOC IDIVI TT,5 ADDI TT,2 MOVEI T,*2(TT) ;ROOM FOR 2 DISK BUFFERS? MOVE B,.JBREL ;NO COMMENT CAML T,.JBFF PUSHJ P,GRABJR ;NO, GET 1K CORE EXCH TT,.JBFF ;GET INPUT BUFFER INBUF ERRCHN,2 MOVEM TT,.JBFF MOVSI A,(SIXBIT /ERR/) MOVEM A,TECERR+1 ;SET UP FILE EXTENSION SETZM TECERR+2 MOVE TT,ERRPPN ;[337] Get PPN used in RUN MOVEM TT,TECERR+3 ;[337] Store HRL A,JOBN ;GET JOBNUMBER HRRI A,.GTPRG ;& JOBNAME TABLE ADDRESS GETTAB A, ;GET JOBNAME JRST ERRP01 ;CAN'T MOVEM A,TECERR ;SET FILE NAME LOOKUP ERRCHN,TECERR ;LOOKUP JOBNAME.ERR JRST ERRP01 ;NOT THERE, SO USE TECO.ERR JRST ERRP1 ;FOUND ERRP01: MOVE A,[SIXBIT /TECO/] MOVEM A,TECERR MOVEM TT,TECERR+3 ;[337] Store PPN again LOOKUP ERRCHN,TECERR ;FIND TECO.ERR JRST ERRPSY ;[337] Lookup failed ERRP1: HRRZ D,.JBUUO ;GET ERROR CODE AGAIN ERRP2: PUSHJ P,ERRWRD ;GET A WORD FROM FILE IN A CAIN D,(A) ;IS THIS THE CODE WE WANT? JRST ERRP3 ;YES JUMPN A,ERRP2 ;NO, KEEP LOOKING IF NOT END OF INDEX ;FALL INTO ?TECEEE IF END OF INDEX NOERRS: TXO FF,F.XPLN+F.EM ;CANT DO / JSP A,CONMES ;PRINT BAD NEWS ASCIZ / ?TECEEE Unable to Read Error Message File / JRST ERRP5 ERRP3: HLRZS A ;GET DISK ADR OF MESSAGE IDIVI A,BUFSIZ ;GET DISK BLOCK AND WORD ADDR USETI ERRCHN,1(A) ;TELL MONITOR WHAT BLOCK I WANT IN ERRCHN,0 ;GET THAT BLOCK CAIA ;BETTER WORK JRST NOERRS ;DIDN'T ADDM AA,ERRHDR+.BFPTR ;FIX ADDR IMULI AA,5 ;CHANGE TO CHARS SUB AA,ERRHDR+.BFCNT ;GET CORRECT COUNT MOVNM AA,ERRHDR+.BFCNT ;FIX IT PUSHJ P,ERRPRN ;YES, PRINT EVERYTHING UP TO THE LF TXO FF,F.EM ;NOTE THAT THE 1ST LINE HAS BEEN TYPED ERRP5: MOVE A,COMAX SUB A,COMCNT MOVEM A,ERR1 ;ERR1:=COMAX-COMCNT MOVE A,CPTR MOVEM A,ERR2 ;ERR2:=CPTR MOVE A,ERRLEN ;DOES HE WANT THE WHOLE THING AUTOMATICALLY? TXNE FF,F.XPLN ;MAYBE PREVENT LOOPING IF NO ERROR MES FILE JRST ERRP6 TXNE A,JW.WCN JRST XPLAIN ERRP6: TXZN FF,F.CCL ;GET HERE FROM A "TECO" COMMAND? JRST ERRP6A ;NO LDB CH,[POINT 6,XFILNM+.RBEXT,35] ;CHECK FOR ?FNF-00 JUMPN CH,ERRP6A ;IT'S NOT HRRZ CH,.JBUUO ;MAYBE CAIN CH,(SIXBIT /FNF/) MONRT. ;EXIT, BUT ALLOW CONT "/" FOR ERROR ERRP6A: MOVEI CH,"*" ;TYPE * FOR NEXT COMMAND PUSHJ P,TYOM TXO FF,F.DDTM PUSHJ P,TYI ;GET A CHARACTER NOW CAIN CH,"?" ;QUESTION MARK? JRST ERRTYP ;YES, TYPE BAD COMMAND TXNE FF,F.XPLN ;EXPLANATION TYPED YET? JRST ERRP7 ;YES, CAN'T DO THAT AGAIN CAIE CH,"/" ;NO, IS IT A SLASH? JRST ERRP7 ;NO TXNN FF,F.EM ;YES, 1ST LINE DONE YET? JRST ERRP0 ;NO JRST XPLAIN ;OK, TYPE MORE EXPLANATION OF ERROR ERRP7: RELEAS ERRCHN, TXNN FF,F.XPLN!F.EM ;MED OR LONG MSG TYPED ? JRST GOE ;NO, SKIPE CORE CONTRACTION MOVE B,RELSAV ;GO BACK TO CORE WE HAD BEFORE CORE B, JFCL ;REDUCTION WON'T FAIL JRST GOE ;GET REST OF COMMAND ERRPRN: PUSHJ P,ERRCHR ;GET A CHAR FROM ERR. FILE ERRPR2: CAIE CH,.CHCNN ;^N? JRST ERRPR3 ;NO, SKIP PUSHJ P,ERRCHR ;GET 1ST DIGIT AFTER ^N MOVEI T,-60(CH) IMULI T,^D10 ;PUT IT IN TEN'S PLACE PUSHJ P,ERRCHR ;GET 2ND DIGIT ADDI T,-60(CH) ROT T,-1 ;DIVIDE TOTAL BY 2 & SAVE BIT 35 HLRZ CH,ETABL(T) ;GET LEFT SIDE ADDR IN CASE EVEN TLNE T,400000 ;EVEN OR ODD? HRRZ CH,ETABL(T) ;ODD, GET ADDR FROM RIGHT SIDE JRST (CH) ;TYPE SPECIAL INFORMATION ERRPR3: PUSHJ P,TYOM ;PRINT NORMAL CHARS. CAIE CH,.CHLFD ;LF? JRST ERRPRN ;NO POPJ P, ;GET A CHARACTER FROM SYS:TECO.ERR ERRCHR: SOSGE ERRHDR+.BFCNT ;ANY CHARS. IN BUFFER? JRST ERRCH2 ;NO ILDB CH,ERRHDR+.BFPTR ;YES, GET NEXT POPJ P, ;DO NOT IGNORE NULLS ERRCH2: IN ERRCHN,0 ;GET NEXT BUFFER JRST ERRCHR ;OK, NOW GET A CHAR. ERRCH3: POP P,A ;UNABLE TO READ TECO.ERR JRST NOERRS ;GET 1K CORE FOR ERROR MESSAGE FILE READ-IN GRABJR: ADDI B,^D1024 ;ADD 1K CORE B, JRST ERRCH3 ;CAN'T GET IT POPJ P, ;CAN'T PRINT ERROR FILE BECAUSE OF NO CORE ERRP05: TXO FF,F.XPLN+F.EM RELEAS INICHN, JSP A,CONMES ASCIZ / Storage Capacity Exceeded / PUSHJ P,ECORE1 ;[354] GARBAGE COLLECT AND SMALLIFY MOVE B,.JBREL ;.JBREL NOW MOVEM B,RELSAV ;SO AS TO NOT CAUSE HUGIFICATION JRST ERRP6A ;DON'T GET I-O TO UNASSIGNED CHANNEL SUBTTL ROUTINE TO TYPE C(TT) IN SIXBIT ;CALL MOVE TT,[SIXBIT /MESSAGE/] ; PUSHJ P,SIXBMS ; RETURN SIXBMS: SKIPN CH,TT ;ALL SPACES? JRST SIXBM2 ;YES MOVNI B,6 MOVE E,[POINT 6,TT] ILDB CH,E JUMPE CH,CPOPJ SIXBM2: ADDI CH," " PUSHJ P,TYOM AOJL B,.-4 POPJ P, SUBTTL ERROR PROCESSING ROUTINES ERRTYP: SKIPN AA,ERR2 ;VALUE OF CPTR WHEN LAST ERROR OCCURRED. JRST [MOVEI CH,"*" ;THIS HAD TO BE IT PUSHJ P,TYOM ;TYPE IT SKIPE CH,EATCH ;GET Q REG NAME IF GOT THAT FAR PUSHJ P,TYOM ;TYPE IT JRST LASTQ] ;AND TYPE FINAL QUESTION MARK MOVEI B,12 SUBI AA,2 ;BACK POINTER UP 10 CHARACTERS. ILDB CH,AA ;GET CHARACTER CAMG B,ERR1 ;WAS IT IN THE COMMAND BUFFER? PUSHJ P,TYOM ;YES. TYPE IT. CAME AA,ERR2 ;HAVE WE REACHED THE BAD COMMAND? SOJA B,.-4 ;NO. DO IT AGAIN. LASTQ: JSP A,CONMES ;PRINT A ? TO MARK END ASCIZ /? / JRST ERRP6A XPLA2: PUSHJ P,ERRPR2 ;PRINT UP TO LF XPLAIN: PUSHJ P,ERRCHR ;IS NEXT CHAR A "?" OR ^A,^B, ... ^H? CAILE CH,10 ;TEXT ENDS WITH A NULL OR CONTROL-A OR B JRST XPLA2 ;NO, KEEP GOING XPLA1: TXO FF,F.XPLN ;SET FLAG THAT XPLANATION IS TYPED JRST ERRP6 ;YES, STOP HERE ;ROUTINE TO READ A WORD FROM THE FILE OPEN IN ASCII MODE ERRWRD: SOSGE ERRHDR+.BFCNT ;ANY LEFT? JRST ERRWR2 ;NO, GET SOME MOVNI A,4 ;SUBTRACT 5 FROM COUNT ADDM A,ERRHDR+.BFCNT ;(1 SUBTRACTED BY SOS ABOVE) AOS A,ERRHDR+.BFPTR ;INCR ADR MOVE A,(A) ;GET THE WORD POPJ P, ERRWR2: IN ERRCHN,0 ;GET NEXT BUFFER JRST ERRWRD ;READ JRST ERRCH3 ;ERROR SUBTTL DISPATCH TABLE FOR SPECIAL INFORMATION TYPEOUT ;BASED ON CHARACTER AFTER CONTROL-N ETABL: XWD ECOMCH,EOUTFL ;00 01 XWD EFILEN,EERNUM ;02 03 XWD EDEVNM,EPROJN ;04 05 XWD EARG1,EPROTC ;06 07 XWD EEBFN,EINFIL ;08 09 XWD EEBFIL,EIOFLG ;10 11 XWD ESTAB,ESKIP ;12 13 XWD EISKIP,0 ;14 15 XWD EEOVAL,EESRCH ;16 17 XWD EECTRL,EESWIT ;18 19 XWD EECRTS,0 ;20 21 SUBTTL SPECIAL INFORMATION TYPEOUT ROUTINES EECTRL: SKIPA CH,ARGSTO ;GET BAD CHAR FROM TEXT STRING ECOMCH: LDB CH,CPTR ;GET LAST COMMAND STRING CHAR. PUSHJ P,TYOS JRST ERRPRN EOUTFL: MOVEI TT1,OUTFIL ;AIM AT OUTPUT FILENAME EOUTF2: MOVE TT,(TT1) PUSHJ P,SIXBMS ;PRINT FILENAME HLLZ TT,1(TT1) JUMPE TT,ERRPRN ;SKIP REST IF NO EXTENSION MOVEI CH,"." PUSHJ P,TYOM EOUTF3: PUSHJ P,SIXBMS ;PRINT EXTENSION JRST ERRPRN EFILEN: MOVEI TT1,XFILNM+.RBNAM ;GET FILENAME REF'D BY UUO JRST EOUTF2 EERNUM: LDB B,[POINT 6,XFILNM+.RBEXT,35] ;GET 2-DIGIT ERROR CODE EERNU1: PUSHJ P,OCTMS ;TYPE IT JRST ERRPRN EDEVNM: SKIPN TT,FILDEV ;[337] GET DEVICE NAME JRST ERRPRN ;[337] No device to be typed. PUSHJ P,SIXBMS ;[337] Type it MOVEI CH,":" ;[337] Get colon PUSHJ P,TYOM ;[337] Type it JRST ERRPRN ;[337] Continue EPROJN: SKIPN FILPPN ;[337] Is there a PPN? JRST ERRPRN ;[337] No, skip this. MOVEI CH,"[" ;[337] Get a bracket PUSHJ P,TYOM ;[337] Type it HLRZ B,FILPPN ;TYPE PROJECT NUMBER PUSHJ P,OCTMS MOVEI CH,"," ;TYPE COMMA PUSHJ P,TYOM HRRZ B,FILPPN ;TYPE PROGRAMMER NUMBER PUSHJ P,OCTMS MOVE TT1,[XWD -5,FILSFD] ;TYPE SFD'S ERSFDS: SKIPN TT,(TT1) ;GET ONE JRST EPROJ2 ;[337] IF ZERO, WE'RE DONE MOVEI CH,"," PUSHJ P,TYOM ERSFD1: PUSHJ P,SIXBMS AOBJN TT1,ERSFDS ;LOOP BACK EPROJ2: MOVEI CH,"]" ;[337] Close the brackets PUSHJ P,TYOM ;[337] JRST ERRPRN EECRTS: IFN CRT,< MOVE CH,"[" ;[337] Make it look good PUSHJ P,TYOM ;[337] MOVE TT1,[IOWD NUMCRT,CRTTAB+1] ;TYPE OUT VALID CRT TYPES MOVE TT,(TT1) JRST ERSFD1 > IFE CRT, EESWIT: MOVE TT,SWITHL ;GET I/O SWITCH NAME JRST EOUTF3 EARG1: MOVE B,ARGSTO ;GET ARG BACK EARG1A: PUSHJ P,DECMS ;PRINT IT JRST ERRPRN EPROTC: LDB B,[POINT 9,XFILNM+.RBPRV,8] ;GET FILE PROTECTION MOVEI CH,"0" ;[337] Possible leading 0 CAIGE B,100 ;[337] 3 digit protection? PUSHJ P,TYOM ;[337] No, type a leading 0 MOVEI CH,"0" ;[337] Once again... CAIGE B,10 ;[337] 2 digit protection? PUSHJ P,TYOM ;[337] No, type another leading 0 JRST EERNU1 EEBFN: MOVE TT,BAKNAM ;EB FILENAME JRST EOUTF3 ;PRINT IT WITHOUT EXTENSION EINFIL: MOVEI TT1,INFILE ;AIM AT INPUT FILENAME JRST EOUTF2 EEBFIL: MOVEI TT1,BAKNAM ;AIM AT EB ORIGINAL FILENAME JRST EOUTF2 EIOFLG: HRRZI B,IO.ERR ;RETRIEVE I/O ERROR FLAGS AND B,ARGSTO JRST EERNU1 ESTAB: MOVEI TT,STAB ;INDEX STAB WHERE TAG RESIDES ESTAB1: MOVE CH,(TT) JUMPE CH,ERRPRN ;THAT'S ALL PUSHJ P,TYOS AOJA TT,ESTAB1 EISKIP: LDB TT,[POINT 4,ARGSTO,21] ;GET I/O ERROR FLAGS SKIPA ESKIP: LDB TT,[POINT 6,XFILNM+.RBEXT,35] ESKIP2: PUSHJ P,ERRCHR ;LOOK FOR ^A CAIN CH,2 ;^B ENCOUNTERED? JRST ERRPRN ;YES, PRINT DEFAULT MESSAGE CAIE CH,1 JRST ESKIP2 ;NOT ^A PUSHJ P,ERRCHR ;GET 1ST DIGIT AFTER ^A MOVEI T,-60(CH) LSH T,3 ;MULT BY 8 PUSHJ P,ERRCHR ;GET NEXT DIGIT ADDI T,-60(CH) CAME TT,T ;THIS THE NUMBER WE WANT? JRST ESKIP2 ;NO JRST ERRPRN ;YES, NOW START PRINTING EEOVAL: MOVEI B,EOVAL ;GET MAXIMUM EOFLAG FOR THIS VERSION JRST EARG1A EESRCH: MOVE TT,[POINT 7,SRHARG] ;GET PTR TO SEARCH STRING MOVM B,SRHCTR ;& STRING CTR EESRH2: ILDB CH,TT ;GET STRING CHAR PUSHJ P,TYOS ;TYPE IT SOJE B,ERRPRN ;WATCH STRING CTR JRST EESRH2 ;NOT FINISHED YET SUBTTL UUO HANDLER UUOH: MOVEM B,ARGSTO ;SAVE POSSIBLE ARG LDB B,[POINT 9,.JBUUO,8] ;GET UUO TYPE CAIL B,20 ;CHKEO? JRST CEO ;YES CAIN B,1 ;ERROR UUO? JRST ERRP ;YES UUOERR: HRRZ B,(P) ;ADDRESS OF ILLEGAL UUO SUBI B,1 MOVE D,@B ;GET COMPLETE UUO INSTRUCTION MOVEM D,FILPPN ;STORE IT SETZM FILPPN+1 ;WE DON'T WANT ANY SFD'S TYPED! ERROR E.UUO ;CHKEO EO#,ADDR ;IF EOFLAG > EO#, RETURN AT CALL+1 (FEATURE IS LEFT ON) ;OTHERWISE GO TO ADDR (FEATURE IS TURNED OFF) CEO: PUSH P,A ;SAVE AC LDB B,[POINT 8,.JBUUO,12] ;GET EO TEST VALUE MOVE A,EOFLAG ;GET LAST SETTING OF EOFLAG CAIG A,(B) ;EOFLAG > TEST VALUE? JRST CEO1 ;NO CEO2: POP P,A ;RESTORE AC A MOVE B,ARGSTO ;RESTORE AC B POPJ P, ;RETURN CEO1: HRRZ A,.JBUUO ;GET DISPATCH ADDR HRRM A,-1(P) ;PUT ON PDL AS RET. ADDR. JRST CEO2 SUBTTL COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND QUESTN: TXCN FF,F.TRAC ;COMPLEMENT TRACE FLAG JRST RET PUSHJ P,CRR ;TYPE CR/LF AFTER TRACE MODE EXIT JRST RET COMMEN: PUSHJ P,SKRCH ;GET A COMMENT CHAR ERROR E.UCA CAIN CH,1 ;^A JRST [TXNN FF,F.TRAC OUTPUT TTY, ;FORCE OUTPUT TO TTY JRST RET] ;AND LEAVE TXNN FF,F.TRAC ;OMIT DOUBLE TYPE-OUT WHEN TRACING PUSHJ P,TYOM ;TYPE IT JRST COMMEN ;ILLEGAL CHARACTER OR COMMAND ERRA: MOVE B,CH ;DONT USE TEXT BUFFER, SO THAT ^ WORKS ERROR E.ILL SUBTTL ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS. ;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER. ;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES, ;TO ARGUMENTS. ;CALL PUSHJ P,GETARG ; RETURN WITH FIRST ARGUMENT ADDRESS IN C, SECOND IN B. ;IF THE EO VALUE HAS BEEN SET TO 1, THE ONLY EOL CHAR IS LINE FEED. ;IF EO > 1, THE EOL CHARS ARE LF, VT, AND FF (& END OF BUFFER IF ;LAST CHAR IN BUFR IS NOT AN EOL) GETARG: TXNE FF,F.ARG2 ;IS THERE A SECOND ARGUMENT? JRST GETAG6 ;YES ;N SIGN INDICATES DIRECTION RELATIVE TO PT. GETNAG: PUSHJ P,CHK2 ;NO, GET 1ST ARG (+ OR - 1 IF NONE THERE) MOVE I,PT ;IN:=PT GETAG4: JUMPLE B,GETAG2 ;WAS LAST ARGUMENT FUNCTION -? CAMN I,Z ;NO. ARGUMENT IS LOCATION OF NTH EOL FORWARD FROM PT. ;IS PT AT END OF BUFFER? JRST GETAG1 ;YES. PUSHJ P,GETINC ;NO. CH:=NEXT DATA BUFFER CHARACTER, IN:=IN+1 PUSHJ P,CKEOL ;IS IT AN EOL? JRST GETAG4 ;NO. TRY AGAIN. SOJG B,GETAG4 ;YES. NTH EOL? GETAG1: MOVE B,I ;YES. RETURN FIRST ARGUMENT IN C MOVE C,PT ;SECOND IN B. POPJ P, ;M,N GETAG6: ADD B,BEG ;C:=M+BEG ADD C,BEG ;B:=N+BEG POPJ P, GETAG2: SOS I ;SET I FOR CHAR BEFORE PT CAMGE I,BEG ;PASSED BEGINNING OF BUFFER? JRST GETAG3 ;YES. IN:=BEG PUSHJ P,GETINC ;NO. CH:=NEXT DATA BUFFER CHARACTER. IN:=IN+1 PUSHJ P,CKEOL ;IS IT AN EOL? SOJA I,GETAG2 ;NO. BACK UP ONE POSITION AND TRY AGAIN. AOJLE B,.-1 ;YES. NTH EOL? GETAG3: CAMGE I,BEG ;YES. PASSED BEGINNING OF BUFFER? MOVE I,BEG ;YES. RESET TO BEGINNING. MOVE C,I ;NO. RETURN FIRST ARGUMENT IN C. MOVE B,PT ;SECOND IN B POPJ P, SUBTTL ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER ;AND INCREMENT THE POINTER. ;CALL MOVE I,POINTER (AS A CHARACTER ADDRESS) ; PUSHJ P,GETINC ; RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN IN. GETINC: PUSHJ P,GET AOJA I,CPOPJ GET: MOVE TT,I IDIVI TT,5 HLL TT,BTAB(TT1) LDB CH,TT POPJ P, PUT: MOVE TT,OU IDIVI TT,5 HLL TT,BTAB(TT1) DPB CH,TT POPJ P, ;CHARACTER TRANSLATION BYTE POINTER TABLE ;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT OF A CHARACTER ADDRESS POINTER XWD 440700,0 BTAB: XWD 350700,0 XWD 260700,0 XWD 170700,0 XWD 100700,0 XWD 10700,0 ;CHECK IF CH = EOL CHARACTER ;CALL: PUSHJ P,CKEOL ; RETURN IF CH NOT = EOL ; RETURN IF CH IS EOL CHAR CKEOL: CAIN CH,.CHLFD ;LINE FEED? JRST CPOPJ1 ;YES, IT IS AN EOL! CHKEO EO21,CPOPJ ;IF EO=1, LF IS ONLY POSSIBLE EOL CAIE CH,.CHVTB ;VERTICAL TAB? CAIN CH,.CHFFD ;FORM FEED? AOS (P) ;YES, SKIP RETURN POPJ P, ;NO SUBTTL ROUTINES TO MOVE CHARACTERS AROUND NROOMC: IFN VC, ;SAVE LENGTH OF STRING NROOM: SETZM CRREL ;[317]ZERO THE RELOCATION WORDS SETZM RREL ;[317] JUMPE C,CPOPJ ;IF 0, THERE'S NOTHING TO DO MOVEM 17,AC2+15 ;SAVE 17 MOVEI 17,NROOM9 ;ANTICIPATE GARBAGE COLLECTION MOVEM 17,GCRET ;THIS THE EXIT DISPATCH MOVE 17,PT CAMN 17,Z ;PT=Z? I.E., DATA BUFFER EXPANSION? JRST NROOM1 ;YES. NROOM0: MOVE 17,[XWD 2,AC2] ;NO. SAVE ACS 2 THROUGH 16. BLT 17,AC2+14 JUMPL C,NROOM6 ;DELETION? SETOM GCFLG ;NO. ;MOVE STRING STORAGE UP C CHARACTERS STARTING AT PT. NROOM9: MOVE F2,AC2+F2-2 ;IN CASE CORE ERROR MOVE 17,Z ADD 17,C CAML 17,MEMSIZ ;WILL REQUEST OVERFLOW MEMORY? JRST GC ;YES. GARBAGE COLLECT. ;MOVE FROM PT THROUGH Z UP C POSITIONS MOVE 14,C ;NO. IDIVI 14,5 ;AC14:=Q(REQ/5), AC15:=REM(REQ/5) IMULI 15,7 ;AC15:=(REM(REQ/5))*7 MOVN 13,15 ;AC13:=-(REM(REQ/5))*7 MOVEI 15,-43(15) ;AC15:=(REM(REQ/5))*7-43 MOVE 11,PT IDIVI 11,5 ;AC11:=Q(PT/5), AC12:=REM(PT/5) MOVNI 16,-5(12) IMULI 16,7 ;AC16:=-(REM(PT/5)-5)*7 DPB 16,[XWD 300600,NROOM2] ;SET SIZE FIELD OF LAST PARTIAL WORD POINTER. ADDI 14,1(11) ;AC14:=Q(REQ/5)+Q(PT/5)+1 MOVE 16,Z IDIVI 16,5 ;AC16:=Q(Z/5) MOVEI B,1(16) SUB B,11 ;B:=Q(Z/5)+1-Q(PT/5)=NO. OF WORDS TO MOVE. ;PUT MOVE ROUTINE IN FAST ACS HRLI 11,200000+B+A*40 ;AC11:=MOVE A,[Q(PT/5)](B) HRLOI 12,241000+A*40 ;AC12:=ROT A,-1 HRLI 13,245000+A*40 ;AC13:=ROTC A,-(REM(REQ/5))*7 HRLI 14,202000+B+AA*40 ;AC14:=MOVEM AA,[Q(PT/5)+1](B) HRLI 15,245000+A*40 ;AC15:=ROTC A,(REM(REQ/5))*7-43 MOVE 17,[JRST,NROOM7] ;AC16:=SOJGE B,11 MOVE 16,.+1 ;AC17:=JRST NROOM7 SOJGE B,11 ;B:=B-1. DONE? NROOM7: ROTC A,43(13) ;YES. STORE LAST PARTIAL WORD. DPB A,NROOM2 ADDM C,Z ;Z:=Z+REQ NROOM5: MOVE 17,[XWD 2,AC2] ;RESTORE ACS AND RETURN. MOVSS 17 BLT 17,17 POPJ P, ;A CALL FOR A BUFFER EXPANSION, WHERE PT=Z. IF ;THERE IS NOT ENOUGH ROOM, PERFORM THE GARBAGE COLLECTION ROUTINE ;IF THERE IS STILL NO ROOM, GET THE NECESSARY CORE FROM THE ;MONITOR TO SATISFY THIS REQUEST NROOM1: ADD 17,C ;TOTAL SPACE REQUIREMENT CAMGE 17,MEMSIZ ;[320] IS THERE ENOUGH? JRST .+4 ;YES, THEREFORE, UPDATE Z AND EXIT MOVEI 17,GCRETA ;EXIT DISPATCH FOR THE MOVEM 17,GCRET ;GARBAGE COLLECTION ROUTINE JRST NROOM0 ;GO DO THE GARBAGE COLLECTION ADDM C,Z ;UPDATE Z, SIZE IS OK MOVE 17,AC2+15 ;RESTORE AC#17 POPJ P, ;EXIT OUT ;NOT ENOUGH ROOM FOR THE EXPANSION, GARBAGE COLLECTION HAS BEEN ;PERFORMED, IF NEED BE, GRAB A K FROM THE MONITOR (OR MORE) GCRETA: MOVE 17,Z ;GET TOTAL SO FAR ADD 17,C ;ADD IN THE REQUEST MOVE F2,AC2+F2-2 CAML 17,MEMSIZ ;STILL IN NEED OF CORE? PUSHJ P,GRABAK ;YES, GET THE REQUIRED CORE FROM THE MONITOR ADDM C,Z ;UPDATE Z AND EXIT JRST NROOM5 ;RESTORE ALL AC'S AND RETURN TO SEQUENCE ;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS NROOM6:IFN BISSW,< ;KL10 BIS SUPPORT SKIPN BIS ;KL10? JRST NBIS6 ;NO MOVE 15,PT ;CHARACTER ADDRESS OF TEXT POINTER IDIVI 15,5 ;WORD ADDR HLL 15,BTAB-1(16) ;BYTE POINTER TO DESTINATION MOVE 11,Z ;LAST BYTE ADDR IN TEXT BUFFER ADDM C,Z ;UPDATE Z MOVMS 12,C ;NUMBER OF CHARACTERS TO MOVE DOWN ADD 12,PT ;SOURCE BYTE SUB 11,12 ;# BYTES TO MOVE MOVE 14,11 ;# BYTES TO MOVE TO DESTINATION IDIVI 12,5 ;SOURCE WORD ADDR HLL 12,BTAB-1(13) ;SOURCE BYTE POINTER SETZM 13 ;NOT USED BY US EXTEND 11,[MOVSLJ ;MOVE STRING LEFT JUSTIFIED EXP 0] ;NO FILL E$$EMF: ERROR (EMF) ;EXTENDED MOVE FAILED JRST NROOM3 ;RESTORE ACS NBIS6:> ;END IFN BISSW MOVE 14,PT ;INITIALIZE PARTIAL WORD POINTER. IDIVI 14,5 ;AC14:=Q(PT/5), AC15:=REM(PT/5) MOVEM 14,B ;B:=Q(PT/5) HRRZM 14,NROOM4 IMULI 15,7 DPB 15,[XWD 300600,NROOM4] ;SIZE:=(REM(PT/5))*7 MOVNI 15,-44(15) DPB 15,[XWD 360600,NROOM4] ;POSITION:=44-(REM(PT/5))*7 MOVE 11,Z IDIVI 11,5 ;AC11:=Q(Z/5)+1, AC12:=REM(Z/5) ADDI 11,1 MOVE 13,C IDIVI 13,5 ADDI 13,-1(11) ;AC13:=Q(Z/5)-Q(REQ/5) MOVNM 14,12 ;AC12:=(REM(REQ/5))*7 IMULI 12,7 MOVNI 15,-43(12) ;AC15:=43-(REM(REQ/5))*7 SUBI B,1(13) ;B:=Q(PT/5)+Q(REQ/5)-Q(Z/5)-1:=# WORDS TO MOVE NROOM8: HRLI 11,200000+B+AA*40 ;AC11:=MOVE AA,[Q(Z/5)+1](B) HRLI 12,245000+A*40 ;AC12:=ROTC A,(REM(REQ/5))*7 HRLI 13,202000+B+A*40 ;AC13:=MOVEM A,[Q(Z/5)-Q(REQ/5)](B) MOVE 14,[ADDM A,@13] ;AC14:=ADDM A,@13 HRLI 15,245000+A*40 ;AC15:=ROTC A,43-(REM(REQ/5))*7 MOVE 17,[JRST NROOM3] ;AC16:=AOJLE B,11 ADDM C,Z ;AC17:=JRST NROOM3 LDB C,NROOM4 MOVE A,@11 ;Z:=C(Z)-REQ ROT A,-1 ;A:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED. MOVE 16,.+1 AOJLE B,11 ;B:=B+1. DONE? NROOM3: DPB C,NROOM4 ;YES. DEPOSIT PARTIAL WORD. JRST NROOM5 SUBTTL GARBAGE COLLECTOR GC: AOSE GCFLG ;FIRST ATTEMPT? JRST PRENR9 ;TRY TO EXPAND MEMORY SETOM GCPTR ;YES. GCPTR:=-1 SETZM SYMS ;CLEAR SYMS,VALS AND CNTS TABLES MOVE T,[XWD SYMS,SYMS+1] BLT T,SYMEND-1 MOVEI T,CPTR ;COMMAND BUFFER PUSHJ P,GCMA MOVEI T,(P) PUSHJ P,GCMA ;NO. GARBAGE COLLECT ALL BYTE POINTERS ON IT. CAILE T,PDL+1 SOJA T,.-2 HRRZ T,AC2+PF-2 ;GARBAGE COLLECT Q-REG PUSHDOWN LIST. CAIL T,PFL PUSHJ P,GCM CAILE T,PFL SOJA T,.-2 MOVE T,[XWD -45,QTAB] ;GARBAGE COLLECT Q-REGISTERS. PUSHJ P,GCM AOBJN T,.-1 MOVE I,BEG ;MAKE SURE STUFF BEFORE BEG SUB I,QRBUF ;IS COLLECTED MOVEI T,0 ;MARK THIS AS LAST COLLECTION PUSHJ P,GCM3 ;STORE IT ON TH GC LIST MOVE I,QRBUF GCS1A: MOVSI TT,200000 ;TT>MAX. NO. CHARACTERS IN WORLD MOVE OU,GCPTR ;GO BACKWARDS THROUGH GCTAB GCS1: HRRZ A,GCTAB(OU) ;RELOCATE ADD A,QRBUF CAMGE A,I JRST GCS2 CAMGE A,TT ;SET TT TO HIGHEST CHARACTER POSITION MOVE TT,A GCS2: SOJGE OU,GCS1 CAMN TT,[1B1] ;ANYTHING IN GCTAB ? [EDIT #116] JRST GCS4A ;NO, DON'T SAVE INFINITY[EDIT #116] MOVE F2,TT ;HIGHEST CHARACTER. IDIVI I,5 ;C(QRBUF)/5 IDIVI F2,5 ;HIGH CHAR/5 AOS I ;C(QRBUF)/5+1 MOVS OU,F2 MOVE T,F2 SUB T,I ;HIGH CHAR/5-C(QRBUF)/5+1 JUMPLE T,GCS4A ;ANYTHING TO GET? HRR OU,I ;XWD HIGH CH/5,C(QRBUF)/5+1=NREG MOVE B,Z ;GET TOP OF BUFR FOR BLT HRRZ F2,(P) ;SEE WHO CALLED NROOM CAIN F2,YANK6 ;WAS IT APPEND? MOVE B,AC2+OU-2 ;YES, MUST USE THE REAL Z FOR THE BLT IDIVI B,5 SUB B,T ;Z/5-NREG BLT OU,(B) ;MOVE STUFF DOWN MOVNS OU,T IMULI OU,5 ;OUT:=-5*NREG ADDM OU,BEG ;BEG:=C(BEG)-5*NREG ADDM OU,PT ;PT:=C(PT)-5*NREG ADDM OU,Z ;Z:=C(Z)-5*NREG ADDM OU,RREL ;RREL:=C(RREL)-5*NREG MOVE CH,GCPTR ;UPDATE INSERTER GCS3: HRRZI TT1,GCTAB(CH) HRRZ A,(TT1) ADD A,QRBUF CAMGE A,TT JRST GCS4 ADDM OU,(TT1) HLRZ A,(TT1) JUMPE A,GCS4 ;NO PTR TO BEG CAIN A,CPTR ;IN COMMAND BUFFER? ADDM T,CRREL ;YES. UPDATE COMMAND POINTER RELOCATION SKIPL (A) ;Q-REG? ADDM T,(A) ;NO SKIPGE (A) ;Q-REG? ADDM OU,(A) ;YES. RELOCATE BASE POINTER. GCS4: SOJGE CH,GCS3 ;DONE? ADD TT,OU ;YES. IN:=C(TT)-5*NREG GCS4A: CAML TT,BEG ;LAST COLLECTION? JRST @GCRET ;YES, RETURN MOVE I,TT PUSH P,C PUSHJ P,GTQCNT ADD I,C POP P,C JRST GCS1A GCM: MOVE I,(T) TLZE I,400000 ;DOES Q-REG CONTAIN TEXT? TLZE I,377777 POPJ P, ;NO ADD I,QRBUF ;YES. ENTER POINTER IN GCTAB GCM2: CAML I,BEG ;REGION BEFORE TEXT BUFFER? POPJ P, ;NO. FORGET IT. SUB I,QRBUF ;YES. IN:=# CHARACTERS TO RETREIVE. ;IN Q-REG BUFFER AREA? JUMPL I,CPOPJ ;NO. FORGET IT. GCM3: AOS TT,GCPTR ;YES. TO BE GRABBED. CAIL TT,GCTBL ;AM I WINNING? ERROR E.GCE HRL I,T ;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS MOVEM I,GCTAB(TT) ;SAVE DATA POPJ P, ;DONE THIS POINTER ;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP ;OF STRING - NO. OF CHARACTERS. GCMA: HLRZ TT,(T) ;LEFT HALF OF PTR TRC TT,700 ;DOES T POINT TO A TEXT BYTE POINTER? TRNE TT,7700 POPJ P, ;NO MOVE I,-1(T) ;MAYBE. GET WORD BEFORE POINTER. (MAX) SUB I,1(T) ;MAX-CT LSH TT,-14 ;BYTE POSITION IDIVI TT,7 ;NO. OF CHARACTERS MOVEI TT1,4-3+1 ;2 SUB TT1,TT ;2-NO. OF CHARACTERS HRRZ TT,(T) ;POINTER WORD ADDRESS (UNRELOCATED) IMULI TT,5 ;5*ADDRESS ADD TT,TT1 SUBM TT,I ;5*ADDRESS-NO. CHARS+2+CT-MAX JRST GCM2 SUBTTL AUTOMATIC MEMORY EXPANSION ;MEMORY WILL BE EXPANDED UNDER ONE OF THESE CONDITIONS. ; 1.AN INTERNAL BUFFER EXPANSION CANNOT BE PERFORMED, ; TO DO SO WOULD OVERFLOW THE PRESENT MEMORY ; CAPACITY. THE INTERNAL OPERATIONS WHICH DESCOVER ; THE NEED FOR EXPANSION ARE: ; A.COMMAND BUFFER EXPANDING ; B.THE Q-REG GET (GI) ; C.THE Q-REG LOAD (NXI) ; D.ANY OF THE INSERTS ; E.COMMAND ACCEPTANCE ROUTINE ; 2.THE DATA BUFFER WILL BE MAINTAINED AT A MINIMUM ; NUMBER OF 5000 CHARACTERS BEFORE NEW DATA IS LOADED ; FROM AN INPUT DEVICE OTHER THAN THE CONSOLE. Q-REG ; USAGE SHORTENS THE NUMBER OF AVAILABLE CHARACTERS ; DIRECTLY, AND NORMAL TECO COMMANDS ARE GREATLY IMPARED ; OTHERWISE. ;SAVE THE ACCUMULATORS GRABAK: TXOA FF,F.TALK ;TALKATIVE GRAB GRABKQ: TXZ FF,F.TALK ;GRAB A K QUIETLY MOVEM CH,SAV16 ;TO SAVE THE ACCUMULATORS MOVEI CH,SAVE ;WHILE WE SCOOT ALL OVER THE BLT CH,SAV16-1 ;THE PLACE ;COUNT THE NUMBER OF BLOCKS NEEDED TO FILL THE REQUEST MOVEI F2,^D1024 ;1 BLOCK OF CORE MOVEI B,1 ;WE WILL NEED AT LEAST ONE BLOCK ADDM F2,.JBFF ;UP THE FIRST FREE COUNT PUSHJ P,CRE23 ;COMPUTE A NEW MEMSIZ AND 2/3 VALUE CAML 17,MEMSIZ ;WILL THIS BE ENOUGH CORE? AOJA B,.-3 ;NO, COMPUTE ANOTHER BLOCK ;NUMBER OF BLOCKS HAVE BEEN FOUND ;OBTAIN THE NEEDED CORE FROM THE MONITOR MOVE B,.JBFF ;TO HELP OUT THE MONITOR CAMG B,.JBREL ;NEED TO ASK? JRST EXITZ ;NO CORE B, ;MAKE THE CALL TO THE MONITOR JRST NOTANY ;NO CORE (OR NOT ENOUGH) AVAILABLE TXNN FF,F.INIT ;IF PROCESSING INI FILE NO RANDON [NK... TXNN FF,F.TALK ;MESSAGE DESIRABLE? JRST EXITZ ;NO CORES: MOVEI CH,"[" PUSHJ P,TYOM MOVE B,.JBREL ;SIZE OF CORE NOW ADDI B,1 ASH B,-12 PUSHJ P,DECMS ;PRINT JSP A,CONMES ASCIZ /K Core] / TXNE FF,F.INIT ;INIT FILES NEED NO AC RESTORE! POPJ P, ;SO DON'T ;RESTORE THE AC'S AND EXIT FROM THIS COR GET ROUTINE EXITZ: MOVSI CH,SAVE ;FROM TO BLT CH,CH ;ALL AC'S AS THEY WERE POPJ P, ;AND EXIT ;NO CORE AVAILABLE (OR NOT ENOUGH) NOTANY: HLRZ A,.JBSA ;GET LAST FIGURE OF CORE BOUND MOVEM A,.JBFF ;AND STORE IT PUSHJ P,CRE23 ;COMPUTE THE MEMSIZE VALUES AGAIN MOVSI CH,SAVE ;RESTORE THE ACCUMULATORS BLT CH,CH ;& INFORM THE OUTSIDE WORLD THAT THEY LOSE EE3+ERROR E.COR ;THIS IS AN AUXILARY SPOT FOR ENTRANCE FROM GC2 ;GET THE REQUIRED CORE TO SAVE THE JOB IF POSSIBLE PRENR9: PUSHJ P,GRABAK ;GET THE REQUIRED CORE JRST NROOM9 ;GO TRY THE INSERT AGAIN SUBTTL COMMAND DISPATCH TABLE DEFINE DSP (C1,A1,C2,A2)< XWD <B20+A1>,<B20+A2>> ;CODES INDICATE TYPE OF DISPATCH JR==0 ;FOR SIMPLE JRST DISPATCH HR==1 ;FOR DISPATCH TO A COMMAND PERFORMED BY A SUBROUTINE MV==2 ;FOR JRST DISPATCH AFTER PROCESSING PRECEDING NUMERIC ARGUMENTS DTB: DSP(JR,ERRA,JR,COMMEN) ;^@ ^A DSP(JR,ERRA,JR,STOP) ;^B ^C DSP(JR,ERRA,JR,FFEED) ;^D ^E DSP(MV,LAT,MV,BELDMP) ;^F ^G DSP(JR,GTIME,HR,TAB) ;^H TAB DSP(JR,CD5,JR,ERRA) ;LF VT DSP(HR,TYO,JR,CD5) ;FF CR DSP(JR,EOF,JR,OCTIN) ;^N ^O DSP(MV,QPAGE,JR,ERRA) ;^P ^Q DSP(JR,ERRA,JR,ERRA) ;^R ^S DSP(MV,SPTYI,HR,IUSET) ;^T ^U DSP(MV,LOWCAS,MV,STDCAS) ;^V ^W DSP(MV,SETMCH,MV,QYANK) ;^X ^Y DSP(JR,DECDMP,JR,ALTMOD) ;^Z ^[ DSP(JR,ERRA,JR,ERRA) ;^BKSLH ^] DSP(JR,CNTRUP,JR,ERRA) ;^^ ^LFTARR DSP(MV,PLUS,JR,EXCLAM) ;SPACE ! DSP(MV,DQUOTE,MV,COR) ;" # DSP(JR,ERRA,JR,PCNT) ;$ % DSP(MV,CAND,JR,CD) ;& ' DSP(JR,OPENP,MV,CLOSEP) ;( ) DSP(MV,TIMES,MV,PLUS) ;* + DSP(MV,COMMA,MV,MINUS) ;, - DSP(JR,PNT,MV,SLASH) ;. / DSP(JR,CDNUM,JR,CDNUM) ;0 1 DSP(JR,CDNUM,JR,CDNUM) ;2 3 DSP(JR,CDNUM,JR,CDNUM) ;4 5 DSP(JR,CDNUM,JR,CDNUM) ;6 7 DSP(JR,CDNUM,JR,CDNUM) ;8 9 DSP(MV,COLON,MV,SEMICL) ;: ; DSP(MV,LSSTH,HR,PRNT) ;< = DSP(JR,GRTH,JR,QUESTN) ;> ? DSP(MV,ATSIGN,MV,ACMD) ;@ A DSP(JR,BEGIN,MV,CHARAC) ;B C DSP(MV,DELETE,HR,ECMD) ;D E DSP(MV,FCMD,JR,QGET) ;F G DSP(JR,HOLE,HR,INSERT) ;H I DSP(MV,JMP,MV,KILL) ;J K DSP(MV,LINE,JR,MAC) ;L M DSP(MV,SERCHP,JR,OG) ;N O DSP(HR,PUNCHA,JR,QREG) ;P Q DSP(MV,REVERS,MV,SERCH) ;R S DSP(HR,TYPE,MV,USE) ;T U DSP(HR,VCMD,JR,MJRST) ;V W DSP(MV,X,HR,YANKER) ;X Y DSP(JR,END1,MV,OPENB) ;Z [ DSP(MV,BAKSL,MV,CLOSEB) ;BKSLH ] DSP(JR,UAR,MV,LARR) ;^ LFTARR SUBTTL LOW SEGMENT RELOC 0 ;TO THE LOW SEGMENT LOCORE==. ;START OF THE LOW SEGMENT IFN BISSW,< BIS: BLOCK 1 ;FLAG TO INDICATE KL-10 > INI: BLOCK 1 ;FLAG FOR TO DO INI FILE TEMPP: BLOCK 1 ;PLACE TO SAVE P ON REENTER TEMPDL: BLOCK 1 ;TEMP PDL IFN CCL,< CCLB: BLOCK 3 ;THE HEADER FOR CCL FILE IO TYIPT: BLOCK 1 > ;END IFN CCL TTYBFS: BLOCK 46 ;100 MODE TTY BFRS TIB: BLOCK 3 ;BUFFER HEADER TOB: BLOCK 3 ;DITTO JOBN: BLOCK 1 ;JOB # USRPPN: BLOCK 1 ;USER PROJ-PROG # MONITR: BLOCK 1 ;MONITOR LEVEL: 0=3,1=4,2=5 IBUF: BLOCK 3 OBF: BLOCK 3 IBUF1: BLOCK 2* OBUF1: BLOCK 2* EATCH: BLOCK 1 ;FOR LAST INPUT CHARACTER IN CASE ERROR OCCURS DLIM: BLOCK 1 NUM: BLOCK 1 SYL: BLOCK 1 SARG: BLOCK 1 PDLSAV: BLOCK 1 VVAL: BLOCK 1 ;LENGTH OF LAST TEXT STRING PROCESSED XFILNM: BLOCK 17 FILDEV: BLOCK 1 ;DEVICE SPECIFIED FILPTH: BLOCK 2 ;DIRECTORY BLOCK FILPPN: BLOCK 1 FILSFD: BLOCK 5 ;UP TO 5 SFD'S SWITC: BLOCK 1 ;SWITCH BIT STORE (EACH BIT IS 1 SWITCH) SPCDEV: BLOCK 2 ;FOR SAVING DEVICE LAST SPECIFIED ;(1 EXTRA WD FOR PATH. UUO) SPCPPN: BLOCK 7 ;FOR SAVING PATH LAST SPECIFIED SPCPRO: BLOCK 1 ;FOR SAVING PROTECTION BAKNAM: BLOCK 2 ;FOR THE BACKUP NAME PTHCNT: BLOCK 1 ;TO COUNT SFD'S ;***** DO NOT SEPARATE ERSPEC: BLOCK 12 ;FOR DEFAULT ER FILE SPEC EWSPEC: BLOCK 12 ;FOR DEFAULT EW FILE SPEC ;(SAME AS XFILNM ABOVE EXCEPT ;EWSPEC=DEVICE, EWSPEC+(4 - 9) = PATH EISPEC: BLOCK 12 ;FOR DEFAULT INI FILE SPEC ;***** DO NOT SEPARATE RUNIT: BLOCK 17 ;FOR RUN ON SOMETHING WHEN YOU EXIT PRMERR: BLOCK 1 ;FOR PERMANENT ERROR BITS LOGOPN: BLOCK 3 ;FOR LOG FILE OPEN BLOCK AND FLAG FOR APPEND OLOG: BLOCK 3 ;BUFFER HEADER FOR LOG FILE EEFL: BLOCK 4 ;BLOCK FOR STORING EE FILSPEC LOGFL: BLOCK 4 ;FOR LOG FILE FILESPEC IINI: BLOCK 3 ;BUFR HEADER FOR INI FILES LOGSPC: BLOCK BUFSIZ+3 ;RESERVE 200 WORDS IN CASE A LOG FILE IS DESIRED OSAV: BLOCK 3 ;OUTPUT BUFFER HEADER FOR SAVE CHANNEL STARTL: BLOCK 13 ;FOR GET SEG STUFF EOFLAG: BLOCK 1 ;EDIT OLD FLAG TYCASF: BLOCK 1 ;TYPE-OUT CASE FLAG: 0 = TYPE ' BEFORE LC ;+ = TYPE ' BEFORE UC;- = DON'T TYPE FLAGS AUTOF: BLOCK 1 ;NON-ZERO IMPLIES AUTOTYPE AFTER SEARCHES ;POSITIVE IMPLIES TYPE AUTOF AS A PTR MARKER IFN CRT,< TTYWID: BLOCK 1 ;CURRENT LINE WIDTH CRTTYP: BLOCK 1 ;TYPE OF CRT IN USE BACRUB: BLOCK 1 ;AUXILLARY DELETE CHAR, RIGHT JUSTIFIED VTWID: BLOCK 1 ;WIDTH OF VERTICAL TAB FFWID: BLOCK 1 ;WIDTH OF FORM FEED VTMUL: BLOCK 1 ;MULTIPLIER FOR DELVT FFMUL: BLOCK 1 ;MULTIPLIER FOR DELFF BACCHR: BLOCK 1 ;BACKSPACE CHARACTER SEQUENCE FORCHR: BLOCK 1 ;NONDESTRUCTIVE FORWARD CURSOR, OR BLANK BACSEQ: BLOCK 1 ;BACKUP AND DELETE SEQUENCE DELLF: BLOCK 1 ;EOL RUBOUT STRINGS (LF, VT, FF) DELVT: BLOCK 1 DELFF: BLOCK 1 DELCR: BLOCK 1 ;CARRIAGE RETURN RUBOUT STRING CANRUB: BLOCK 1 ;STRING TO CANCEL RUBOUT CANBAK: BLOCK 1 ;STRING TO CANCEL BACKSPACE CTUSEQ: BLOCK 1 ;STRING TO PROCESS CONTROL-U > ;END IFN CRT OUTCH: BLOCK 1 ;ADR OF OUTPUT ROUTINE INCH: BLOCK 1 ;ADR OF INPUT ROUTINE OPNRI: BLOCK 1 ;INPUT FILE OPEN ARGUMENTS, OPNRD+4(1) OPNR1: BLOCK 1 ;INPUT DEVICE. INIT+27(0),OPNRD+6 OPNRB: BLOCK 1 ;INITIALIZE TO XWD 0,INBUF. OPNRD+10 BAKTMP: BLOCK 1 ;FOR DECTAPE TEMP NAME PROTEC: BLOCK 1 ;EB INPUT FILE PROTECTION DEVSAV: BLOCK 1 ;DEVICE CHARACTERISTICS EBDEV: BLOCK 1 ;EB DEVICE NAME TMPTEC: BLOCK 1 ;SAVE FOR ###TEC. FILE NAME BAKPRO: BLOCK 1 ;DESIRED PROTECTION FOR THE NEW FILE OPNWI: BLOCK 1 ;OUTPUT FILE OPEN ARGUMENTS. OPNW1+4(1) OPNWD: BLOCK 1 ;OUTPUT DEVICE. OPNW1+6 OPNWB: BLOCK 1 ;OUTBUT BUFFER HEADER ADDRESS. OPNW1+10(OUTBUF) WRICHR: BLOCK 1 ;CHARACTERISTICS OF WRITE DEVICE OUTFIL: BLOCK 4 ;STORE FOR OUTPUT FILENAME INFILE: BLOCK 4 ;STORE FOR INPUT FILENAME SWINDX: BLOCK 1 ;FOR SWITCH INDEX SCAN SWITHL: BLOCK 1 ;SWITCH CHAR HOLD INSWIT: BLOCK 1 ;INPUT SWITCHES OUTSWT: BLOCK 1 ;OUTPUT SWITCHES LSNCTR: BLOCK 1 ;LSN GENERATION CTR CTGRET: BLOCK 1 ;RETURN ADDRESS FOR ^G ROUTINE ARGTRM: BLOCK 1 ;FS, FN 2ND ARG TERMINATOR COMBAK: BLOCK 1 ;STORE FOR COMCNT DURING FS, FN CPTBAK: BLOCK 1 ;DITTO CPTR SRHCNT: BLOCK 1 ;SEARCH COUNT STORE ;Search table stuff ; *** Do not separate vvv SMATRX: BLOCK SMATLN ;The old TECO search bit table BITMAT: BLOCK BITMLN*^D36 ;The new rotated search bit table DELTA2: BLOCK ^D36 ;The table which knows what the pattern looks like SCLRLN==.-SMATRX ; *** Do not separate ^^^ DELTA0: BLOCK SMATLN ;The tables which know where characters are DELTA1: BLOCK SMATLN ; in the pattern INDMAT: BLOCK ^D36 ;A table of indicies into the pattern PATLEN: BLOCK 1 ;Number of positions in pattern ROTLEN: BLOCK 1 ;Current distance from the right end of the pattern SCNEST: BLOCK 1 ;Nest level counter during searches, 0 if none SCHTYP: BLOCK 1 ;0 if old TECO search, -1 if new search SCTLGA: BLOCK 1 ;0 if pattern source has no ^Gi, -1 if it does CTGLEV: BLOCK 1 ;SEARCH FOR TEXT IN Q-REG NEST COUNTER ITERCT: BLOCK 1 SFINDF: BLOCK 1 ERRDEV: BLOCK 1 ;[337] Device for TECO.ERR ERRPPN: BLOCK 1 ;[337] PPN for TECO.ERR ERRBLK: BLOCK 3 ;[337] OPEN block for TECO.ERR TECERR: BLOCK 4 ;LOOKUP SPECS FOR TECO.ERR ERRHDR: BLOCK 3 ;RING HEADER FOR TECO.ERR RELSAV: BLOCK 1 ;STORE FOR .JBREL ARGSTO: BLOCK 1 ;STORE FOR ARGUMENT (IF ANY) ERR1: BLOCK 1 ERR2: BLOCK 1 COMLEN: BLOCK 1 ;LENGTH OF BASIC COMMAND STRING LISTF5: BLOCK 1 ;OUTPUT DISPATCH NROOM2: BLOCK 1 ;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE. GCRET: BLOCK 1 ;GC EXIT DISPATCH NROOM4: BLOCK 1 ;PARTIAL WORD POINTER FOR DOWNWARD MOVE BEG: BLOCK 1 PT: BLOCK 1 Z: BLOCK 1 QRBUF: BLOCK 1 ;*** DO NOT SEPARATE *** COMAX: BLOCK 1 ;TOTAL # OF CHARS AT CUR. CMD. LEVEL CPTR: BLOCK 1 ;EXECUTION-TIME CMD STRING PTR COMCNT: BLOCK 1 ;# OF CHARS REMAINING TO BE EXECUTED AT THIS LEVEL ;*** DO NOT SEPARATE *** CBUFH: BLOCK 1 CBUF: BLOCK 1 MEMSIZ: BLOCK 1 IFN CCL,< CCLSW: BLOCK 1 > ;END IFN CCL GCPTR: BLOCK 1 CRREL: BLOCK 1 GCFLG: BLOCK 1 RREL: BLOCK 1 M23: BLOCK 1 M23PL: BLOCK 1 ERRLEN: BLOCK 1 ;TYPE OF ERROR MESSAGES WANTED BY DEFAULT AC2: BLOCK 16 ;SAVE AC2-AC17 IN NROOM ROUTINE STAB: BLOCK STABLN ;SEARCH MATRIX DEFPTH: BLOCK 11 ;DEFAULT PATH DCLOC: BLOCK 5 ;DSKCHR BLOCK NFORMS: BLOCK 1 ;NUMBER OF FORM FEED SEEN XCTING: BLOCK 1 BCOUNT: BLOCK 1 ETVAL: BLOCK 1 ;[331] ET VALUE EBPROT: BLOCK 1 ;[333] BAK PROTECTION & 2 RENAME SWITCH FDAEM: BLOCK 1 ;[333] FILE DAEMON PRESENCE IF NON-ZERO EPISEQ: BLOCK 1 ;[337] Controls EI-EP LOOKUP sequence LFCNT: BLOCK 1 ;[346] Line feed count for :nA command ;********* EXTRAS: BLOCK 17 ;[331] AVAILABLE LOCATIONS SO LOW SEG ; DOESN'T HAVE TO CHANGE ;********* SYMS: BLOCK 22 ;LIS+4(0),OG3+1,GC+3(0) VALS: BLOCK 22 ;LIS+4(0),OG3+3,GC+3(0) CNTS: BLOCK 22 ;LIS+4(0),OG3+2,GC+3(0) SYMEND: BLOCK 0 EQM: BLOCK 1 ;LEVEL OF MACRO NESTING SRHCTR: BLOCK 1 ;# OF CHARS IN SEARCH ARGUMENT (MUST PRECEDE SRHARG) SRHARG: BLOCK ^D16 ;STORE FOR SEARCH ARGUMENT PFL: BLOCK LPF+1 GCTAB: BLOCK GCTBL ;GCS3+4,GCM2+13 QTAB: BLOCK 45 ;Q-REGISTER TABLE ;USEA+1,PCNT+1 PDL: BLOCK LPDL+1 SAVEAC: BLOCK 2 ;THIS MUST BE IMMEDIATELY BEFORE SAVE! LOWERB==SAVEAC+1 UPPERB==SAVEAC+2 SAVE: BLOCK 16 ;AC STORAGE FOR GC SAV16: BLOCK 1 IFE BUGSW,< CMDBFR: BLOCK 0 ;COMMAND BUFFER > ;END IFE BUGSW IFN BUGSW,< CMDBFR: BLOCK 1 >;END IFN BUGSW LOWEND==.-1 RELOC LIT ;SO PATCH SPACE IS AT TOP OF HI-SEG PATCH: END TECO