Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64b-sb
-
10,7/dteco/dteco.mac
There are 4 other files named dteco.mac in the archive. Click here to see a list.
TITLE DTECO %26A(265) TEXT EDITOR AND CORRECTOR
SUBTTL RC CLEMENTS/PMH/CAM/EAR/DML/JNG/BGS/DCE/MHK/CGN/RDH/RCB
SEARCH JOBDAT,MACTEN,UUOSYM ;STANDARD DEFINITIONS
SEARCH SWIL ;SWIL DEFINITIONS
.REQUE REL:SWIL ;SWIL PACKAGE
SALL ;PRETTY LISTINGS
.DIREC FLBLST ;PRETTIER LISTINGS
COMMENT \
TECO -- "Text Editor and COrrector" for TOPS-10
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
1970,1971,1972,1975,1976,1977,1978,1980,1982,1984,1986,1987,1988.
ALL RIGHTS RESERVED.
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
TRANSFERRED.
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
CORPORATION.
DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
\
;TECO VERSION IDENTIFICATION
MAJVER==26 ;MAJOR VERSION LEVEL
MINVER==1 ;MINOR (MAINTENANCE RELEASE) LEVEL
CSTVER==0 ;CUSTOMER VERSION (WHO LAST . . .)
EDTVER==265 ;EDIT LEVEL
%%TECO==:<BYTE (3)CSTVER(9)MAJVER(6)MINVER(18)EDTVER>
IFDEF .MCRV.,< .VERSION <%%TECO> > ;MAKE SURE OF VERSIONS IF USING TIM'S MACRO
IF2,< PURGE CSTVER,MAJVER,MINVER,EDTVER>
LOC .JBVER
EXP %%TECO ;VERSION #
SUBTTL Revision History
;*** CHANGES FROM VERSION 23 TO 23B ***
; EDIT 114- REMOVES CODE WHICH CHANGED BAK FILE PROTECTION TO
; STANDARD. CHANGES SEARCH COMMAND TO ACCEPT LOWER CASE
; FS AND FN. PROVIDES FOR $ IN Q REGISTER BY RETURNING
; TO NEXT LEVEL WHEN $ SEEN RATHER THAN REINITIALIZING.
; AREAS AFFECTED: GO, RCH2, ALTMOD, MAC, BKCLS2,
; FILSP2, FCMD, EQM
; EDIT 115- FIXES PERTAIN TO LINE SEQUENCE NUMBER PROCESSING
; CHANGES INSERTION OF 5 SPACES TO 5 SPACES AND TAB
; CHANGES SEQ# CHECK SO THAT 5 SPACES AND TAB ARE
; ACCEPTED AS LINE SEQ# (THIS ELIMINATES THE INSERTION
; AFTER THE FIRST TIME AND ALLOWS THEM TO BE REMOVED
; USING THE /SUPLSN SWITCH)
; AREAS AFFECTED:PPA06, PPA08,
; EDIT 116- CHANGES GARBAGE COLLECTION ROUTINE TO CHECK FOR
; ANYTHING TO SAVE PRIOR TO ATTEMPTING A BLT.
; AREAS AFFEDTED: GCS12
; EDIT 117- CHANGES SEARCH ROUTINE TO PROVIDE PROPER OPERATION
; OF ^S, TECO'S "WILD DELIMITER", WHEN THE DELIMITER
; IS THE FIRST BUFFER CHARACTER.
; AREAS AFFECTED: S1, S4A, BCOUNT
; EDIT 120- CHANGES OPERATION OF ET COMMAND TO CONFORM TO
; DOCUMENTATION. ET SHOULD SUPPRESS CASE FLAGGING.
; AREAS AFFECTED: TYO
; EDIT 121- PROVIDES WARNING MESSAGE WHEN TECO
; DETECTS SEQUENCED FILE WITH NO LSN SWITCHES.
; ADDS CLEAR OF OUTPUT BUFFER PRIOR TO PACKING
; TO INSURE AGAINST SPURIOUS BIT35 SETTING.
; AREAS AFFECTED: YNKSEQ,PPA05
; EDIT 122- FIXES HP COMMAND TO SET BIT 35 FOR FIRST
; LINE NUMBER IN THE BUFFER.
; AREAS AFFECTED: HOLE
; EDIT 123- REDEFINES OUTPUT BUFFERS AFTER SECOND OPEN FOR
; FILES WHICH ARE SUPERSEDED. THIS FIXES THE "ADDRESS
; CHECK FOR DEVICE DSK" PROBLEM.
; AREAS AFFECTED: OPNW3
; EDIT 124- REMOVES THE %SUPERSEDING EXISTING FILE MESSAGE
; FOR NON-DIRECTORY DEVICES AND LIB: FILES.
; AREAS AFFECTED: OPNW2, OPNW3
; EDIT 125- CORRECTS "ILL MEM REF AT USER PC 403647" BY ADDING
; A CHECK FOR SHORT ERROR MESSAGES USED PRIOR TO
; PERFORMING CORE CONTRACTION.
; AREAS AFFECTED: ERRP7
; EDIT 126- CHANGES RENAME PROCESSING TO CONFORM TO DATE75
; STANDARD.
; AREAS AFFECTED: EBAKU1, OPNW33, BKCLS3, BKCLS5
; EDIT 127- CORRECTS EDIT#114 WHICH FAILED TO KEEP PROTECTION
; OF INPUT FILE AS PROT FOR BAK FILE.
; AREAS AFFECTED: BKCLS2
; EDIT 130- CORRECTS PROBLEM CAUSED BY EDIT 121. PW COMMAND
; DID NOT WORK SINCE REGISTER "T" WAS NOT SAVED
; CAUSING THE COMMAND TO BE INTERPRETED AS A P COMMAND.
; AREAS AFFECTED: PPA05
; EDIT 131- CORRECTS PORTION OF EDIT 124 WHICH CHECKED WRONG STATUS
; BIT. AREAS AFFECTED: OPNW3B
; EDIT 132- ADDS CHECK FOR DATA IN Q REGISTER PRIOR TO ALLOWING
; INCREMENT (% COMMAND) AND GENERATES ERROR MESSAGE IF
; ATTEMPTED WITH TEXT. AREAS AFFECTED: PCNT
; EDIT 133- MAKES EB WORK PROPERLY FOR FILES OUTSIDE OF
; USER'S PPN. SHOULD JUST DO ER/EW UNDER THIS
; CONDITION INSTEAD OF TRYING TO RENAME FILES.
; AREAS AFFECTED: EBAKUP
; EDIT 134- CHANGES CALLI AND TTCALL UUO'S TO STANDARD FORMAT
; EDIT 135- REPLACES EDIT 132 TO PUT ERROR MESSAGE IN STANDARD FORM
; AND PROVIDE FOR CHECK ON Q COMMAND AS WELL AS %
; ALSO PROVIDES PROPER OPERATION WITH NEGATIVE INTEGER.
; AREAS AFFECTED: PCNT, QREG
; EDIT 136- GENERAL CLEAN-UP TO MAKE EDIT 123 MORE EFFICIENT,
; REMOVE ROUTINE NOT NEEDED WITH EDIT 133, AND MAKE
; DEVICE DTA WORK PROPERLY.
; AREAS AFFECTED: OPNRD, EBAKUP, OPNWR, BAKCLS, EBS1
; EDIT 137- ELIMINATES THE CONVERSION OF OLD ALTMODES TO CODE 033
; IN COMMAND STRINGS IF TTY NO ALTMOD IS SET.
; AREAS AFFECTED: ALTIN, TYI
;EDIT 140- ADDS DEBUG SWITCH WHICH SAVES SYMBOLS, MAKES YANK
; MORE EFFICIENT FOR NNN<Y> COMMANDS, AND CLEANS UP
; THE %LINE NUMBER DETECTED MESSAGE
; AREAS AFFECTED: TECO, LIS03, YANK2, YNKSEQ, CMDBAS
; EDIT 141- REMOVE UNNECESSARY PORTION OF EDIT 121 AND
; EDIT 130. WORK ON LINE SEQUENCE NUMBER PROCESSING.
; AREAS AFFECTED:PPA04,PPA05
; EDIT 142- FIXES COMMAND DISPATCH TABLE ENTRIES FOR CR AND
; LF TO PRESERVE NUMERIC ARGUMENTS.
; AREAS AFFECTED: DTB
; EDIT 143- MAKE CODE FOR Q-REG MORE EFFICIENT.
; AREAS AFFECTED: QREG, QTXTST
; EDIT 144- MAKES EH COMMAND USE STACK PROPERLY.
; AREAS AFFECTED: ERRSET
; EDIT 145- FIXES EW TO OTHER PPN'S.
; AREAS AFFECTED: OPNW33
; EDIT 146- MAKES EB WORK PROPERLY FOR ERSATZ DEVICES. RENAMES
; DEVICE TO DSK FOR OUTPUT. AREAS AFFECTED: EBAKU2
; EDIT 147- CHANGES OPEN FOR EB COMMAND TO PHYSICAL ONLY SINCE
; PHYS DEVICE NAME IS IN OPEN BLOCK. THIS IS NECESSARY
; TO ALLOW PROPER OPERATION OF RENAME SEQUENCE.
; AREAS AFFECTED: OPNW4, BKCLS4
; EDIT 150- MODIFY LSN PROCESSING TO HANDLE SOS PAGE MARKS.
; AREAS AFFECTED: PPA08, PPA13, YANK5
; EDIT 151- GENERAL CLEANUP OF COMMENTS, ETC.
; EDIT 152- CORRECTS CCL PROCESSING TO ACCEPT SPACES FROM COMPIL
; TO MAKE TECO FOO. COMMANDS WORK.
; AREAS AFFECTED: CCLTM1, CCLIL
; EDIT 153- ADDS SPECIAL CHECK FOR ERSATZ PPN TO INSURE SUPERSEDING
; MESSAGE WORKS FOR SYS:, NEW:, ETC.
; AREA AFFECTED: FILSP7
; EDIT 154- MAKE EDIT 147 MORE EFFICIENT
; AREAS AFFECTED: OPNW44
; EDIT 155- DELAY CLEARING EB AND OUTPUT OPEN FLAGS ON EX
; COMMAND IN CASE ERROR OCCURS IN PROCESSING.
; AREAS AFFECTED: CLOSEF
; EDIT 156- ADD ERROR CHECK AND MESSAGE FOR TAG TOO LONG.
; AREAS AFFECTED: OG1
; EDIT 157- NOT USED (RESERVED)
; EDIT 160- PREVENTS TECO FROM GOING INTO INFINITE LOOP IF
; ERROR FILE IS NOT FOUND AND USER HAS SET 3EH.
; AREA AFFECTED: ERRP5
; EDIT 161- CHANGES THE WAY <> USE THE STACK TO INSURE PROPER
; GARBAGE COLLECTIOM.
; AREAS AFFECTED: LSSTH, INCMA2
; EDIT 162- FIXES PROBLEM CAUSED BY EDITS 147, 154, AND 160.
; AREAS AFFECTED: ERRP5, OPNW44, BKCLS4
;*** CHANGES FROM VERSION 23B TO 24 ***
; EDIT 163- CORRECT OPERATION OF EB WHEN USER HAS CHANGED PATH
; AREAS AFFECTED: EBAKU2
; EDIT 164- CORRECTS ERROR PRINTOUT PROBLEM WHICH CAN CAUSE RANDOM
; CORE UUO'S TO BE EXECUTED.
; AREAS AFFECTED: ERRP, ERRP0
; EDIT 165- PROVIDES PRINTING OF LOOKUP ERROR CODE DURING EB
; AREAS AFFECTED: LKUPER
; EDIT 166- CORRECTS PROBLEMS WITH ?NCS ERROR
; AREAS AFFECTED: LIS01, ERRTYP
; EDIT 167- CAUSES SPACES IN ARITHMETIC STRINGS TO BE IGNORED
; EXCEPT AS A + OPERATOR
; AREAS AFFECTED: CD93
; EDIT 170- CORRECTS TYPEOUT OF Q-REG NAME ON AN IQN ERROR FROM
; AN * COMMAND
; AREAS AFFECTED: LIS03
; EDIT 171- CORRECTS OPERATION OF EW COMMAND WHEN PPN IS SPECIFIED
; PRIOR TO FILE.EXT
; AREAS AFFECTED: FILSP6
; EDIT 172- CORRECTLY PUTS BOTH ARGUMENTS, IN A TWO ARGUMENT
; COMMAND (M,N T; M,N X; M,N K), WITHIN BUFFER BOUNDS
; AREA AFFECTED: CHK1
;EDIT 173- FIXES TWO ARGUMENT P COMMAND TO SET BIT 35 WHEN
; FIRST ARGUMENT IS BEG OF BUFFER OR BEG OF LINE
; AREAS AFFECTED: CHK1, PUNCHR, PUNCH1(DELETED)
;EDIT 174- CORRECTS UIN ERROR CAUSED BY A NULL REPLACEMENT
; ALTMODE DELIMITED F SEARCH FOLLOWED BY AN *
; COMMAND
; AREAS AFFECTED:NOALT; LIS03; LIS02; FND3-1
;EDIT 175- RE-DO ER,EW,EB,EZ,EM,EF,EX,EG COMMANDS TO UNDERSTAND
; DEFAULT PATHS, SFD'S, ERSATZ DEVICES, LIBRARIES,
; THE /SCAN PATH SETTING, THE FILE DAEMON, ETC. ETC.
; TECO WILL NOW EDIT THE FILE SPECIFIED BY AN EB
; COMMAND IN PLACE, I.E. BOTH THE BAK FILE AND THE EDITED
; SOURCE FILE WILL APPEAR IN THE DIRECTORY THAT THE USER
; SPECIFIED IN THE EB COMMAND. EXCEPTION: IF THE FILE TO
; BE EDITED IS NOT FOUND IN THE AREA SPECIFIED, BUT RATHER
; IN SOME LIBRARY AREA (LIB:, A HIGHER-LEVEL SFD, ON [1,4]
; WHEN NEW: WAS SPECIFIED, ETC.), THEN TECO WILL PRINT THE
; MESSAGE %FILE WAS FOUND IN [P,PN,SFD,SFD...] AND THEN
; TURN THE COMMAND INTO AN ER FROM THE AREA WHERE THE FILE
; WAS ACTUALLY FOUND AND AN EW INTO THE AREA THAT THE USER
; SPECIFIED. AN EB IN PLACE IS OBVIOUSLY NOT REASONABLE FOR
; FILES FOUND IN LIBRARY AREAS, AND THIS ACTION IS THOUGHT TO
; BE MORE REASONABLE THAN A ?FNF-0 ERROR. TECO WILL NOW ALSO
; RESPECT .RBSPL AND .RBNCA (NOT .RBVER - EDITING CHANGES THE
; VERSION) WHEN EDITING A FILE AS A RESULT OF AN EB COMMAND.
; THIS EDIT WAS CAREFUL NOT TO BREAK DECTAPES.
; AREAS: LOTS
;EDIT 176- CORRECTS PROBLEM OF /SUPLSN SWITCH AND NULL CHARACTERS
; IN OUTPUT FILES. CORRECTES PROBLEM OF /GENLSN
; WITH THE M,NP COMMAND AND EX COMMAND. EX PROBLEM CAUSED BY
; EDIT 174.
; AREAS AFFECTED: PPA02; PPA06; PPA13; CHK1
;EDIT 177- PREVENTS RANDOM CORE UUO CAUSED BY EDIT 164.
; AREAS AFFECTED: ERRP0
;EDIT 200- CORRECTS SOME MINOR PROBLEMS WITH EDIT 175. TECO.ERR WAS
; SOMETIMES BEING PRINTED INCORRECTLY. REMOVES ERDONE FLAG.
; AREAS AFFECTED: ERDONE,OPNRD,EBAKUP,WTFIL,BAKCLS,EPATH,CCLIL
;EDIT 201- MAKE FS SEARCH FASTER FOR SAME LENGTH ARGUMENTS.
; AREAS AFFECTED: FND
;EDIT 202- CLEAR THE OCTAL NUMBER FLAG ON ILLEGAL OCTAL DIGITS.
; AREAS AFFECTED: CDNUM
;[LAST EDIT IN VERSION 24]
;EDIT 203- INITIALIZE LINE SEQUENCE NUMBER FOR EB COMMAND
; AREA AFFECTED: EBAKUP
;EDIT 204- SAVE/RESTORE REGISTER USED BY TRACE. THIS CORRECTS
; FNF ERRORS FROM ER OR EB COMMANDS IF TRACE IS ON.
; AREA AFFECTED: RCH
;EDIT 205- IMPLEMENT "?AOR ARGUMENT OUT OF RANGE " FOR U COMMAND
; AREA AFFECTED: USE
;EDIT 206- MOVE "RUBSW==0" UP NEAR THE BEGINNING OF THE PROGRAM SO MACRO
; VERSION 53 DOSEN'T COMPLAIN THAT RUBSW WAS REFERENCED
; BEFORE IT WAS DEFINED.
; AREAS AFFECTED:CNTRLR+3,"MISC PARAMETERS"+25
;EDIT 207- ADD CODE TO CHECK IF THE COMMAND BUFFER NEEDS MEMORY, IN ORDER
; TO STAY WITHIN BOUNDS, UPON INITIALIZATION.
; IF NECESSARY MEMORY IS EXPANDED.
; AREAS AFFECTED:INITG+2
; EDIT 210- ADD CODE TO MAKE WINNING SEARCHES WITHIN ITERATIONS
; RETURN -1.
; AREAS AFFECTED:FND2+1
; EDIT 211- FOR THE X COMMAND USE FULL WORDS TO REPRESENT THE BUFFER
; POINTER SO WHEN GREATER THAN 2**18 WE WON'T LOSE.
; AREA AFFECTED: X+4
; EDIT 212- WHEN DOING A *I COMMAND DON'T GET FOOLED INTO THINKING THAT
; THE COMMAND BUFFER HAS MOVED WHEN A GARBAGE COLLECTION HAS
; OCCURED.
; AREA AFFECTED:X3+6.5
; EDIT 213- WHEN SEARCHING, LEARN THAT WE ARE DONE WHEN WE EXAMINE
; AND DON'T MATCH A CHARACTER OUTSIDE OF THE
; BUFFER. THIS MAKES ^EL WORK BECAUSE THE BIT MASK
; ISN'T MESSED UP BY ADDITIONAL SEARCH ATTEMPTS.
; AREAS AFFECTED: S3, S4A+4.5
; EDIT 214- FIX FILE STUFF IN EDIT [175] THAT DOESN'T SUPPORT NON-SFD
; MONITORS.
; EDIT 215- REMEMBER X-MATCH FOR ADDITIONAL SEARCHES.
; AREAS AFFECTED: CD93+8L, SERCHT
; EDIT 216- DON'T OVERFLOW THE SEARCH STRING STORAGE AREA
; WHEN THE 81ST CHARACTER IS ^R OR ^Q.
; AREA AFFECTED: SERCHG
; EDIT 217- GENERATE SOS PAGE MARKS WHEN USING LINE SEQUENCE
; NUMBERS.
; AREAS AFFECTED: PPA06, PPA14
; EDIT 220- STOP TIMESHARING THE SEQUIN FLAG FOR INPUT AND OUTPUT
; OF SEQUENCED FILES. THIS ELIMINATES THE LOSS OF
; THE FIRST CHARACTER IN A /GENLSN'ED OUTPUT FILE
; IF IT IS A TAB OR A CR.
; AREAS AFFECTED: YANK1, YANK5, YNKSEZ
; EDIT 221- ACCOUNT FOR COMPIL FEATURE WHICH THROWS IN A NULL
; AFTER THE FILE SPEC IN COMMAND LINE.
; AREAS AFFECTED:CCLIL,CCLNUL
; EDIT 222- PREVENT SEARCHES FROM MATCHING A NULL WHEN THE ^^
; COMMAND IS NOT GIVEN A CHARACTER TO OPERATE ON.
; ADD THE MCO ERROR (MISSING CHARACTER OPERAND).
; AREAS AFFECTED:CNTRU, THE ERR FILE
; EDIT 223- PREVENT SPACE/TAB SEARCHING FROM GOING TO FURTHER BUFFER
; POSITIONS WHEN A CHARACTER HAS ALREADY BEEN FOUND.
; AREAS AFFECTED:SPTB, S4D
; EDIT 224- CLEAN UP SOME COMMENTS AND ADD NEW ONES.
; EDIT 225 - FIX THE MAKE AND TECO COMMANDS BROKEN BY EDIT 221.
; AREAS AFFECTED: CCLDUN
;
; EDIT 226 - MAKE TECO SAVE SYMBOLS IN THE HIGH SEGMENT ONLY
; IF DEBUGGING.
; EDIT 227- REWRITE *I LOGIC BECAUSE IT EXHIBITED A VARIETY
; OF OBSCURE BUGS.
; AREAS AFFECTED: LIS01, LIS03, TIMES, ERRTYP
;230 GIVE A WARNING MESSAGE IF OUTPUT IS TO DEVICE NUL:
; AREA AFFECTED: OPNWR0
;231 IMPLEMENT "EC" COMMAND TO PREVENT TECO FROM MAKING
; ALL SEARCHES WITHIN ITERATIONS INTO
; COLON-SEARCHES.
; 0EC MAKES ITERATION-SEARCHES COLON-SEARCHES.
; NEC FOR ANY NON-ZERO N, MAKES ITERATION-SEARCHES
; NON-COLON SEARCHES.
; EC RETURNS CURRENT SETTING.
;
; AREAS AFFECTED: ECTABL, FND2, COLOIT.
; (COLOIT IS A NEW ROUTINE)
;232 DON'T SUPERCEDE OUTPUT FILE WHEN ?FNF ERROR OCCURS AFTER
; "MAKE OUTFIL=INFILE" COMMAND.
; AREA AFFECTED: ERRP6
;VERSION 24 (DISPLAY TECO... JUD LEONARD)
; EDIT 162- SCREEN FEATURES FROM ERIC OSMAN'S TV
; EDIT 163- FIX TTYSET TO TURN OFF FREE CRLF, NOT ON.
; EDIT 164- FIX VT05 FILL SEQUENCE TO USE RUBOUT RATHER THAN NULL
; AS FILLER. DAS87 DISCARDS NULLS.
; AREA AFFECTED: CNFILL+2
;Version 25(233) RDH 19-Sep-79
;
;233 Use 700 series monitor terminal types, don't enquire
; directly of terminal; add "EA" = Edit All command, read in
; entire file (with <FF>s etc.); don't set "." to "B" on a search
; failure - rather preserve "." across the failure; write crash
; recovery file nnnTEB.TMP; add "E@" = Edit At (indirect) to
; read commands from file (such as nnnTEB.TMP); support ANSI
; terminals (VT100); add space (as first char typed) to scroll
; through text, <LF> to do a "1L$$"; add "\\" as octal mode "\".
;
;234 RDH 24-Dec-79
; Implement dump mode I/O for disk (read/write entire file in one
; giant I/O operation). Initial load with SCAN/WILD (only to read
; SWITCH.INI at the moment, but . . .). Add SWITCH.INI switchs:
; /EAMODE:[ON/OFF] Default dump in entire file
; /OKLSN Don't worry about LSN's in EAMODE
; /OKNULL Don't worry about null's in EAMODE
; /INITFILE:file Process "file" as command file on startup
; Add "EP" to write out (using dump mode if possible) file and then
; "EF" it (like "EX" but without THE EXIT). Add ^H (backspace) to
; scroll backwards (a backwards space). Rename crash recovery file
; to be nnnTEC.CMD (so LOGOUT doesn't delete it!). Add <CR> to put
; cursor on current screen (if not already there a la back/space).
;
;235 RDH 5-Feb-80
; Obscure bug in memory management on ?Core cap exceeded errors.
; Revise [205] to allow Q-reg text anywhere in addressable memory
; Q-reg numerical values can range to approx +- 25 billion.
;
;236 RDH 18-Feb-80
; Implement "arrow" keys. Various and sundry minor bugs.
;
;237 RDH 28-Feb-80
; Don't allow 0-length inserts. Make <TAB> command part of normal
; insert command (saves call to NROOM to expand buffer by 1).
;
;240 RDH 4-Mar-80
; More junky little bugs: Q-reg relocation bug; If core expansion
; fails acs get trounced (F2 in particular, which causes all
; further SFD references to fail - this is also regular TECO bug).
; Modernize command editing - ^R to retype, ^W to rubout a word,
; ^V to quote next character, ^A/^B to do lower/upper case (it's
; what TV does, and seems as good as any other idea); TECO'S EO
; value is now 3, setting EO=2 reverts to old editing characters.
;
;241 RDH 26-Apr-80
; Trash left on screen in obscure situations (due to CNTLF being
; called for character that wasn't echoed - either from command
; file or first char typed in command string). Add crash recovery
; file control - /CRFILE:file names the file, /CRPROT:nnn gives
; the protection, /CRDISP:NEVER!TEMPORARY!DELETE!PRESERVE to [not]
; delete the crash file, /CRSAVE:n to update the recovery file
; every "n" characters, modulo line breaks.
;
;242 RDH 20-May-80
; Assorted buggies.
;
;243 MHK 2-Jun-80
; Implement University of Texas search algorithm which includes the
; following features:
; 1) 10 times faster searching (forward direction)
; 2) backwards searches (using old TECO method)
; 3) bounded searches
; 4) FK searches (Find and Kill specified string)
;
;244 DPM 13-Jun-80
; With all the various flavors of TECO floating around, finding the
; correct TECO.ERR file is nearly impossible. Solution: don't depend
; on an error file for messages. Implement $INFO, $WARN, and $FATAL
; macros to generate verbosity controlled messages.
; RDH 15-Jul-80
; "FD<str>$" to find and delete matched string, "FK<str>$" to find
; string, then delete from previous "." inclusively through to new
; "."; "FR<str>$" to delete last string and replace with <str>;
; "FV" to return last string value (size of string); and "F_" as
; similar to "FS" on general principles. Allow user to specify /RUN
; in SWITCH.INI (if he does, he deserves whatever he gets). Change
; "EP" to "EC" for compatibility with "-11/etc." TECO's, and always
; zero the buffer on exit. Add "EK" to kill current output file.
; Make "1+:Sblah$" type expressions work (":" commands imply a
; free "()" sequence, which includes PUSHing SARG). Ill mem ref
; from "FS" search (day one bug) - must call NROOM after setting new
; COMCNT/COMPTR. Don't do TEBJ sequence if nested into a command file
; (<CR>'s from command file cause nnnJ$$ to appear in nnnTEB file,
; which are not re-executed until after the entire command file
; is completed).
;
;245 RDH 24-Sep-80
; Minor bug(s).
;
;246 RDH 24-Feb-81
; Use TERMINAL LENGTH/STOP if available.
;
;247 RDH 21-Apr-82
; Add VK100/VT101/VT102/VT125 terminal types (equivalent to VT100).
;
;250 RDH 22-Jul-82
; Edit 217 will lead to I/O Address Check for certain bizarre
; files (e.g., a TOPS-20 DUMPER tape) - if a break character
; appears within a few characters of end of I/O buffer and input
; file LSNs exist. Note: an unexpected side "aspect" of this edit
; is that the "cleaned-up" code now generates LSNed files that
; are approximately .2% smaller than before (re standard TECO -
; which liked to leave random nulls sprinkled in the output file).
; In particular, while the files will FILCOM, they will not match
; using DIRECT/CHECKSUM!
;
;251 RDH 22-Aug-82
; i,jP commands appended <FF> characters to output stream (this
; was caused by an earlier edit to clean up some code - not a problem
; with standard TECO sources).
;
;252 RDH 28-OCT-82
; Preserve file version (.RBVER) for EB files. This applies even
; to faked ER/EW files, but does not apply to explicit user ER/EW
; sequences (i.e., if the user types "EB" the version is preserved,
; if the user types "ER" and/or "EW" the version is zero).
;DTECO %25(252) Released with 7.02 (as a tool) Spring, 1984
;253 RDH 22-Jun-84
; Add VT103/VT180/VT185/VT220/VT240 as more ANSI klones.
;
;254 RDH
; Version 26
; Change over to SWIL (replace SCAN/WILD); first pass at running in
; extended addressing. (Also note the /SFT switch added, but forgotten
; in the edit history...); add "EP" command to PUSH to a new context;
;
;255 RDH 16-Feb-85
; Don't do moby dump I/O except for disk devices (LPTs for example
; get annoyed); other assorted little buggies of little import.
; Some source cleanup (remove ancient edit numbers).
;
;256 RDH 22-Feb-85
; Make n%<Q> add value "n" to q-register <Q>; Make n^T type out
; ASCII character of value "n". Both are under control of EO=3.
;
;257 LEO 20-SEP-85
; Copyrights.
;
;260 RCB 24-Jul-87
; Teach the terminal-type driver selection to know about 7.04's class
; names and TTY attributes. That way, a site with Ann Arbor terminals
; (for example) which defines them correctly will not have to edit
; DTECO for it to work with them.
;
;261 RCB 24-Jul-87
; Fix ILMs during (for example) "<HT><DEL>" at the prompt. BACKLN
; was doing a "LDB COMPTR" when there were no characters and the
; byte pointer was invalid.
;
;262 RCB 27-Jul-87
; Finish EP (push) command. The string-until-altmode argument is the
; file for a push-and-run. A numeric arguemnt is a start-address-offset
; for a push-and-run. A null filespec causes a push-and-halt.
; Also re-instate EH. 0EH (the default) means to use the bits returned
; by SCAN's .VERBO, but nEH can change that default.
;
;263 RCB 27-Jul-87
; Add a CRLF to fix up the EP command, especially when pushing to a
; program rather than to COMCON.
;
;264 RCB 27-Jul-87
; Fix ILMs in 3EH typeout.
;
;265 RCB 15-Feb-88
; Update copyrights.
;
;[END OF REVISION HISTORY]
;DEFAULT DEFINITIONS FOR ASSEMBLY SWITCHES & PARAMETERS:
ND AUTOFS,0 ;DEFAULT IS NON-AUTOTYPE AFTER SEARCHES
ND TYCASW,0 ;DEFAULT TYPE-OUT MODE CAUSES FLAGGING OF
;CHARACTERS IN THE LOWER CASE RANGE WITH '
ND SRCHSW,0 ;DEFAULT PREVAILING SEARCH MODE IS ACCEPT
;EITHER LC OR UC ALPHABETICS AS A MATCH
ND SRCHMX,^D200 ;MAXIMUM CHARACTERS IN A SEARCH STRING
ND EOVAL,3 ;THE STANDARD SETTING OF THE EO FLAG FOR
;THIS VERSION IS 3 (^R/^W/^U EDITING)
ND BUGSW,1 ;STANDARD IS SAVE SYMBOLS
ND TEBPRT,077 ;DEFAULT CRASH FILE PROTECTION
ND TEBSAV,^D128 ;UPDATE CRASH RECOVERY FILE EVERY TEBSAV CHARS
; (CAN BE OVERRIDDEN VIA /CRSAVE:NNN)
ND HIORGP,600 ;HIGH SEG ORIGIN PAGE
ND CSECTN,1 ;CODE SECTION FOR EXTENDED ADDRESSING
ND DSECTN,3 ;DATA SECTION FOR EXTENDED ADDRESSING
ND LSECTN,6 ;LAST SECTION FOR EXTENDED ADDRESSING
; (LSECTN+1 = FIRST FREE SECTION)
ND PDLEN,^D200 ;LENGTH OF PROGRAM STACK
ND LPF,40 ;32 WORD Q-REGISTER PDL
ND QRGMAX,44 ;NUMBER OF Q-REGISTERS (A-Z; 0-9)
ND CMFMAX,4 ;LEVELS COMMAND FILES MAY NEST.
ND XSPGMX,4 ;MAXIMUM "IDLE" PAGES TO CARRY AROUND
;ANY IN EXCESS WILL BE DEALLOCATED
ND RMWAIW,1000 ;RANDOM MEMORY ALLOCATION INCREMENT (WORDS)
ND COMAIW,200 ;COMMAND BUFFER ALLOCATION INCREMENT (WORDS)
ND TMPBSZ,200 ;SIZE OF TMPCOR BUFFER
ND DSKBFN,3 ;NUMBER OF INPUT BUFFERS
ND DSKBSZ,^D128 ;SIZE OF DISK INPUT BUFFERS
; THIS UTILIZES ONE PAGE OF BUFFER SPACE.
; TECO IS SUFFICIENTLY COMPUTE BOUND THAT
; USING MANY/LARGE BUFFERS DOES NOT RUN
; ANY FASTER.
ND TTIBFN,1 ;NUMBER OF TERMINAL INPUT BUFFERS
ND TTIBSZ,30 ;SIZE OF TERMINAL INPUT BUFFER(S)
ND TTOBFN,2 ;NUMBER OF TERMINAL OUTPUT BUFFERS
ND TTOBSZ,100 ;SIZE OF TERMINAL OUTPUT BUFFERS
ND TTLMAX,^D60 ;MAXIMUM SCREEN LENGTH WE CAN HANDLE
ND TTWMAX,^D132 ;MAXIMUM SCREEN WIDTH WE CAN HANDLE
WINDEX==<<TTWMAX+2>/5>+1;INTERNAL LINE STORAGE ALLOCATION SIZE
WINTOP==TTLMAX*WINDEX ;INTERNAL SCREEN STORAGE ALLOCATION SIZE
ND RUN603,0 ;ALLOW TO RUN UNDER 6.03 MONITORS
ND TTY603,'VT52 ' ;TERMINAL TYPE TO USE FOR 6.03
;ACCUMULATOR ASSIGNMENTS
FF= 0 ;CONTROL FLAGS
T= 1
TT= 2 ;*** TT AND TT1 MUST BE ADJACENT ***
TT1= 3
A= 4 ;*** A, AA AND B MUST BE CONTIGUOUS AND IN THAT ORDER ***
AA= 5 ;TYPE-IN POINTER TO COMMAND BUFFER & SEARCH TABLE INDEX
B= 6 ;*** B AND E MUST BE ADJACENT ***
E= 7
C= 10
D= 11
F2= 12 ;MORE CONTROL FLAGS
I= 13 ;"INPUT" CHARACTER ADDRESS
OU= 14 ;"OUTPUT" CHARACTER ADDRESS (MUST BE I+1)
CH= 15 ;CHARACTER AC
PF= 16 ;Q-REGISTER PDL PTR
P= 17 ;PROGRAM STACK
;DIFFERENT AC DEFINITIONS FOR INTERFACING WITH SCAN/WILD
;THESE WILL HAVE TO BE RECONCILED WITH TECO'S CONVENTIONS SOMEDAY
T1=1 ;TEMP ACS
T2=T1+1
T3=T2+1
T4=T3+1
P1=5 ;PERM ACS
P2=P1+1
P3=P2+1
P4=P3+1
;CONTROL FLAGS
;RIGHT HALF - AC FF
ALTF== 1B35 ;ALT-MODE SEEN
ARG2== 1B34 ;THERE IS A SECOND ARGUMENT
ARG== 1B33 ;THERE IS AN ARGUMENT
SLSL== 1B32 ;@ SEEN
PCHFLG==1B31 ;N SEARCH
COLONF==1B30 ;COLON SEEN
COLONP==1B29 ;FREE "()" DUE TO COLON MODIFIER IN EFFECT
SYLF== 1B28 ;SYLLABLE FLAG
XPLNFL==1B27 ;HAVE TYPED EXTENSION OF ERROR MESSAGE ALREADY
EMFLAG==1B26 ;HAVE TYPED 1ST LINE OF ERROR MESSAGE
FINDR== 1B25 ;LEFT ARROW SEARCH
QMFLG== 1B24 ;PROCESSING ERROR MESSAGE
SEQUIN==1B23 ;OUTPUT: AFTER EOL NEXT 5 CHARS ARE SEQ #
TRACEF==1B22 ;? SEEN
SEQF== 1B21 ;SEQUENCE NUMBER SEEN ON INPUT
BELLF== 1B20 ;^G SEEN
; 1B19 ;FREE
FORM== 1B18 ;A FORM FEED TERMINATED THE LAST YANK OR APPEND COMMAND
;LEFT HALF - AC FF
F.NNUL==1B17 ;NON-NULL INSERT STRING (MIGHT BE ONLY ^V, SAY)
PMATCH==1B16 ;PREVAILING MATCH MODE
TABSRT==1B15 ;TABBED INSERT (<TAB> COMMAND)
TIBKA== 1B14 ;INPUT IN [BREAK ON ALL] CHARACTER MODE
TINEC== 1B13 ;DON'T ECHO INPUT CHARACTERS
TMPFLG==1B12 ;TMPCOR UUO ALLOWED
FINF== 1B11 ;INPUT CLOSED BY EOF
UREAD== 1B10 ;INPUT FILE IS OPEN
UWRITE==1B09 ;OUTPUT FILE IS OPEN
CFOF== 1B08 ;COMMAND FILE OPEN, USE IT RATHER THAN TTY
EZTMP== 1B07 ;THIS COMMAND IS EZ, NOT EW
FEXTF== 1B06 ;FILE EXT EXPECTED (.TYPED).
UBAK== 1B05 ;EB IN EFFECT
; 1B04 ;FREE
TYOF== 1B03 ;NEED TO OUTPUT A BUFFER
TYOCTF==1B02 ;ALLOW CONTROL CHARS TYPED WITHOUT "^"
CCLFLG==1B01 ;TECO COMMAND REQUESTS Y AFTER EB
;CONTROL FLAGS
;RIGHT HALF - AC F2
CTLVA== 1B35 ;^V/A SEEN INSIDE TEXT
CTLVVA==1B34 ;DOUBLE ^V/A SEEN INSIDE TEXT
CTLWB== 1B33 ;^W/^B SEEN INSIDE TEXT
CTLWWB==1B32 ;DOUBLE ^W/^B SEEN INSIDE TEXT
XMATCH==1B31 ;EXACT MATCH SEARCH MODE
EMATCH==1B30 ;TEMPORARILY ACCEPT EITHER UPPER OR LOWER CASE
LINCHR==1B29 ;TTY LINE HAS LC BIT ON
TYMSGF==1B28 ;TYPE MESSAGE WITH NO CASE FLAGGING
OCTALF==1B27 ;OCTAL RADIX
CQUOTE==1B26 ;QUOTE THE NEXT COMMAND CHARACTER
SKIMRF==1B25 ;WATCH FOR ^R WHEN SKIMMING
SKIMQF==1B24 ;WATCH FOR ^Q WHEN SKIMMING
NOTRAC==1B23 ;DISABLE TRACING
TYSPCL==1B22 ;TYPE <CR>, ETC INSTEAD OF PRINTER CONTROLS
SKANFS==1B21 ;SKANNING FS OR FN
TXTCTL==1B20 ;NO CONTROL COMMANDS IN TEXT EXCEPT ^T, ^R
LCASE== 1B19 ;CONVERT UPPER CASE TO LOWER CASE BY DEFAULT
UCASE== 1B18 ;CONVERT LOWER CASE TO UPPER CASE BY DEFAULT
XCASE==UCASE!LCASE!CTLVA!CTLVVA!CTLWB!CTLWWB ;ANY CASE CONTROL
;LEFT HALF - AC F2
GOING== 1B17 ;A COMMAND STRING HAS BEEN SEEN
DOING== 1B16 ;AND IS BEING EXECUTED NOW
CTXN== 1B15 ;^N IN SEARCH ARGUMENT
NOALT== 1B14 ;DON'T CONVERT OLD ALTMODES TO 033
NALTFS==1B13 ;NULL REPLACEMENT ALTMODE DELIMITED F SEARCH
SFDS== 1B12 ;SUB FILE DIRECTORIES ARE IN EFFECT
LSNINF==1B11 ;IGNORE CHAR AFTER SEQ# IF IT'S A TAB OR CR
;REPLACES USE OF SEQUIN
LSNF== 1B10 ;A LSN WAS SEEN SOMETIME IN THE TEXT BUFFER
CBTMF== 1B09 ;CLEAR TO EOS IN GO BEFORE CLIS
S.MINS==1B08 ;MINUS SEARCH
S.REPL==1B07 ;FIND AND REPLACE SEARCH
S.DELE==1B06 ;FD COMMAND
S.KILL==1B05 ;FK COMMAND
S.FRCM==1B04 ;FR COMMAND
;CHARACTER ECHO CONTROL FLAGS
EC$UPA==1B0 ;ECHO AS ^X
EC$SLF==1B1 ;ECHO AS SELF
EC$DLR==1B2 ;ECHO AS "$"
EC$CRL==1B3 ;ECHO WITH <CR><LF> APPENDED
;I/O CHANNELS
INCHN== 2
OUTCHN==3
TTYCHN==4 ;CHANNEL FOR TTY IO
TTYIOS==IO.FCS+.IOASC ;BASIC TTY I/O MODE
CCLCHN==5 ;CHANNEL FOR THE CCL TMP FILE
ERRCHN==6 ;CHANNEL FOR ERROR MESSAGE FILE
TEBCHN==7 ;CRASH RECOVERY FILE I/O CHANNEL
CMFCHN==10 ;COMMAND ("E@") FILE I/O CHANNEL
;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
SMATXN==^D131 ;Number of characters in the search matricies
BITMLN==SMATXN/^D36+1 ;Number of words needed to hold SMATXN bits
STABLN==^D131 ;LENGTH OF SEARCH TABLE
GCTBLN==100 ;GARBAGE COLLECTION TABLE(S) SIZE
EO21==1 ;TECO %22+ FEATURES
EO25==2 ;TECO %25+ NEW HANDLING OF ^R, ^W, ^V, ^G; ^T AND % COMMANDS
FXVRSN==<12,,%%FXVE> ;SCAN/WILD PROTOCOL VERSION
BLKSIZ==200 ;SIZE OF DISK BLOCK IN WORDS
PAGSIZ==1000 ;SIZE OF MEMORY PAGE IN WORDS
PG2WRD==^D9 ;LSH OF PAGE ADDRESS TO WORD ADDRESS
WRD2PG==-^D9 ;LSH OF WORD ADDRESS TO PAGE ADDRESS
;OPERATORS
;TEMP (HA!)
OPDEF IFIW [1B0]
.NODDT IFIW ;KEEP SETZ OPCODE
IFX2EF==^D17-^D05 ;LSH FOR IFIW INDEX TO EFIW INDEX
;CHECK EO FLAG: CHKEO EO#,ADDR
;IF EOFLAG GREATER THAN EO#, RETURN AT CALL+1
;OTHERWISE GO TO ADDR
; OPDEF Local UUOS
;
OPDEF MSG. [1B8] ;Verbosity controlled message processor
OPDEF CHKEO [20B8] ;EO flag checking
; Macro to generate a comment message
;
DEFINE $INFO (PFX,ADR,TXT),<
MSG. 0,[''PFX'',,[ASCIZ |TXT|]
IFB <ADR>,<EXP .+1>
IFNB <ADR>,<EXP ADR>
]
>
; Macro to generate a warning message
;
DEFINE $WARN (PFX,ADR,TXT),<
MSG. 1,[''PFX'',,[ASCIZ |TXT|]
IFB <ADR>,<EXP .+1>
IFNB <ADR>,<EXP ADR>
]
>
; Macro to generate a fatal message
;
DEFINE $FATAL (PFX,ADR,TXT),<
MSG. 2,[''PFX'',,[ASCIZ |TXT|]
IFB <ADR>,<EXP GO>
IFNB <ADR>,<EXP ADR>
]
>
;MACRO TO DEFINE DATA LOCATIONS
DEFINE U(A,B)<
RELOC
A: BLOCK B
RELOC
>
;MACRO to ensure that falling from one place to another works
DEFINE FALL(ADDR),<
ADDR:
>
SUBTTL Program entry and initialization
TWOSEG <HIORGP_PG2WRD>
U LOCORE,0 ;START OF DATA AREA
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1987. ALL RIGHTS RESERVED.
\ ;END COPYRIGHT\
TECO: TDZA B,B ;NORMAL PROGRAM ENTRY
MOVNI B,1 ;THE CCL ENTRY
RESET ;INITIALIZE ALL IO
MOVE P,[IOWD PDLEN,PDLST] ;INITIALIZE STACK
SKIPN CH,SECTN ;WERE WE RUNNING EXTENDED (^C, START)?
JRST TECO01 ;NO
HRRI CH,TECO05 ;YES
XJRST CH ;SO GET BACK TO DESIGNATED PC SECTION
;SELECT A SECTION IF FEASIBLE
TECO01: XMOVEI CH,777 ;GET CURRENT PC SECTION
HLRZ CH,CH ;REDUCE TO JUST SECTION NUMBER
JUMPE CH,TECO02 ;IF IN SECTION 0 (NORMAL) JUST INITIALIZE
CAIN CH,CSECTN ;WERE WE MAGICALLY STARTED IN CODE SECTION?
JRST TECO05 ;YES, ALL SET HERE, NO FINAGALING NEEDED
OUTSTR [ASCIZ\? DTECO knows better than you in which section to run!\]
EXIT ;PISS ON MEDDLING USER
;RUNNING IN SECTION 0, TRY FOR DESIGNATED EXTENDED PC SECTION (CSECTN)
TECO02: MOVE TT1,[PA.GMS!<0,,CSECTN>] ;MAP SECTION 0 INTO SECTION CSECTN
MOVEI TT,1 ;ONLY MAP ONE SECTION
MOVE T,[.PAGSC,,TT] ;PAGE. ARG POINTER TO
PAGE. T, ;TRY FOR EXTENDED PC SECTION
JRST TECO05 ;NOPE, OH WELL, NO BIG DEAL
XJRST [CSECTN,,TECO05];GOT IT
;RESET MEMORY (IN CASE ^C, START)
TECO05: SETZB FF,F2 ;INITIALIZE FLAGS
SETZM LOCORE ;CLEAR DATA IN CASE OF ^C,ST
MOVE A,[XWD LOCORE,LOCORE+1] ;BLT POINTER TO
BLT A,LOWEND-1 ;CLEAR IMPURE STORAGE
MOVEM B,CCLSW ;REMEMBER HOW WE WERE STARTED
;FLAG RUNNING EXTENDED OR SECTION-0 (E.G., 7.02, KS10, ETC.)
XMOVEI A,777 ;CURRENT PC SECTION
HLLZM A,SECTN ;REMEMBER CURRENT PC SECTION
LSH A,WRD2PG ;MAKE "PAGE NUMBER" OFFSET
;*** ;MUST USE SECTION 0 PAGE ADDRESSES!!!
;*** MOVEM A,SECTNP ;REMEMBER PC SECTION PAGE OFFSET
;GET RID OF DANGLING I/O BUFFER PAGES AND THE LIKE
MOVE TT,.JBREL ;HIGHEST LOCATION IN LOW SEGMENT
ADDI TT,PAGSIZ-1 ;ROUND UP AND
LSH TT,WRD2PG ;TRUNCATE TO PAGE ADDRESS
MOVEI T,HIORGP-1 ;FIRST PAGE IN HIGH SEGMENT
SUB T,TT ;MAKE COUNT OF PAGES THAT SHOULDN'T EXIST
JUMPE T,TECO07 ;NO PAGES TO DELETE
ADD TT,A ;RELOCATE TO PAGES IN CURRENT SECTION
PUSHJ P,PGZAP ;MAKE SURE PAGES DON'T EXIST
HALT . ;BLETCH
;GET RID OF DANGLING DATA SECTIONS
TECO07: SKIPN SECTN ;RUNNING EXTENDED
JRST TECO10 ;NO
MOVEI T,<LSECTN-DSECTN+1> ;MAX DATA SECTIONS POSSIBLE
MOVEI TT,DSECTN ;FIRST POSSIBLE DATA SECTION
PUSHJ P,PSZAP ;MAKE SURE THEY DON'T EXIST
HALT . ;EXTENDED BLETCH
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
TECO10: PUSHJ P,TTOPEN ;GO OPEN TTY
PUSHJ P,GETTYP ;FIGURE OUT WHAT KIND OF SCREEN
PUSHJ P,TTYGET ;GET AND REMEMBER INITIAL TTY MODES
MOVEI A,1 ;SET TABS
MOVEM A,OURTAB ;SET NO TAB CONVERSION
MOVEM A,OURFCR ;SET NO FREE CRLF
MOVEM A,OURDEM ;SET DEFERRED ECHO MODE
SETZM OURBLN ;SET NO BLANK SUPPRESSION
SETZM OURPSZ ;SET PAGE 0
SETZM OURSTO ;SET NO STOP
PUSHJ P,TTYSET ;SETUP TECO TERMINAL CHARACTERISTICS
SKIPE SCTYPE ;IF VIDEO SCREENING
PUSHJ P,CLRSCN ;THEN CLEAR SCREEN
MOVSI A,(ASCII */\*)
MOVEM A,PTRCHR ;WHAT POINTER LOOKS LIKE ON SCREEN
SETOM SCH ;SO FIRST CHARACTER IS TTYED
PUSHJ P,UUOINI ;INITIALIZE UUO HANDLER
HALT . ;CAN'T RECOVER FROM THIS
PUSHJ P,PSIINI ;INITIALIZE PSI SERVICE (^C TRAP IN PARTICULAR)
HALT .+1 ;CAN'T INIT PSI????
;*** THIS IS A KROCK, BUT WHAT CAN I SAY?
MOVE A,[BOSWT,,BOSWT+1] ;START OF SWITCHES BLOCK
SETOM BOSWT ;INITIALIZE SWITCHES
BLT A,EOSWT ;TO NO VALUE SEEN FLAG
JSP OU,CALLSW ;CALL SCAN/WILD
ISLEN,,ISBLK ;MOVE T1,[ISLEN,,ISBLK]
IFIW .ISCAN## ;PUSHJ P,.ISCAN##
JSP OU,CALLSW ;CALL SCAN/WILD
OSLEN,,OSBLK ;MOVE T1,[OSLEN,,OSBLK]
IFIW .OSCAN## ;PUSHJ P,.OSCAN##
;*** END OF THE KROCK
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
TECO20: MOVE TT,.JBFF ;FIRST FREE LOSEG LOCATION
MOVEM TT,RMWBAS ;BECOMES BASE FOR RANDOM MEMORY ALLOCATION
MOVEM TT,RMWEND ;SET END ADDRESS FOR RANDOM MEMORY
SKIPE SECTN ;RUNNING EXTENDED?
MOVSI TT,DSECTN ;YES, SELECT FIRST DATA SECTION AS BASE ADDRESS
MOVEM TT,CMDBAS ;SET BASE ADDRESS FOR COMMAND BUFFER
MOVEM TT,CMDEND ;ALSO END ADDRESS FOR COMMAND BUFFER SO FAR
MOVSI T,(POINT 7,0,-1);PROTOTYPE BYTE POINTER
SKIPE SECTN ;PC IN EXTENDED SECTION?
TLOA T,(1B12) ;YES, USE DOUBLE-WORD BYTE POINTER
HRR T,TT ;NO, USE SINGLE-WORD BYTE POINTER
DMOVEM T,CMDPTR ;SET MASTER COMMAND BUFFER BYTE POINTER
IMULI TT,5 ;CONVERT TO TEXT ADDRESS
MOVEM TT,QRBUF ;SET Q-REG/ETC BASE ADDRESS
MOVEM TT,BEG ;SET BEGIN ("B") ADDRESS OF EDITING TEXT
MOVEM TT,PT ;SET CURSOR (".") ADDRESS WITHIN EDITING TEXT
MOVEM TT,Z ;SET END ("Z") ADDRESS FOR EDITING TEXT
SKIPN SECTN ;RUNNING EXTENDED?
SKIPA TT,.JBREL ;NO, LOCAL CURRENT MEMORY LIMIT (WORDS)
HRLOI TT,DSECTN-1 ;YES, GLOBAL CURRENT MEMORY LIMIT (WORDS)
IMULI TT,5 ;CURRENT MEMORY LIMIT (CHARACTERS)
MOVEM TT,MEMSIZ ;SET END ADDRESS FOR Q-REG/TEXT MEMORY
SETOM MESFLG ;ON STARTUP THE SCREEN IS ALL MESSED UP!
; THIS WILL FORCE INITIALIZATION OF SCRN??
; VARIABLES
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
TECO30: MOVE A,[F%FDAE&<-1,,0>!.GTFET] ;GETTAB FTFDAE
GETTAB A, ;NEED TO KNOW IF FILE DAEMON
SETZ A, ;MONITOR FOR EB STUFF
SETZM FDAEM ;ASSUME NOT
TXNE A,F%FDAE&<0,,-1>;FILE DAEMON MONITOR?
SETOM FDAEM ;YES, SIGN BIT OF .RBPRV CHANGED
MOVE C,[%FTSTR] ;FIND OUT IF SFDS ARE USED
GETTAB C, ;...
JRST .+2 ;ASSUME SO
TXNE C,F%SFD &<0,,-1>;SFDS HERE?
TXO F2,SFDS ;YES, SET THE FLAG
MOVE A,.MYJOB## ;GET OUR JOB NUMBER
MOVEI C,3 ;WANT THREE DIGITS' WORTH
TECO40: IDIVI A,12 ;CONVERT JOB NUMBER TO SIXBIT
ADDI AA,20
LSHC AA,-6
SOJG C,TECO40
HRRI B,'TEC' ;FORM NAME ###TEC
MOVEM B,TMPTEC ;SAVE
HRREI A,TYCASW ;GET DEFAULT TYPE-OUT CASE FLAGGING MODE
MOVEM A,TYCASF ;AND MAKE IT CURRENT
HRROI A,.GTLIM ;THE "BATCH" JOB TABLE
GETTAB A, ;READ MONITOR INFORMATION
SETZ A, ;DUH?
TXNE A,JB.LBT ;ARE WE A BATCH JOB?
SKIPGE A,S.EOBA ;YES, GET BATCH EO VALUE
MOVE A,S.EOMO ;NO (OR NO /EOBATCH), GET TIMESHARING EO
CAIG A,EOVAL ;USER GIVE AN EOVAL WITHIN REASON?
CAIGE A,0 ;DID USER SPECIFY EITHER /EOMODE OR /EOBATCH?
MOVEI A,EOVAL ;NO, PICKUP SYSTEM DEFAULT
MOVEM A,EOFLAG ;AND SET OUR EO RUNTIME VALUE
HRREI A,AUTOFS ;INIT AUTOTYPE-AFTER-SEARCHES FLAG
MOVEM A,AUTOF
;FALL THROUGH TO NEXT PAGE
;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.
TECO50: MOVEI A,SYL
MOVEM A,DLIM ;DLIM:=SYL
MOVEI FF,0 ;CLEAR FLAG REGISTER
IFN SRCHSW,<TXO FF,PMATCH> ;MAKE EXACT MODE CURRENT
XMOVEI T,RENTR ;OUR "REENTER" ADDRESS
MOVEM T,.JBREN ;SET IT UP TOO
JRST GO ;START TECO'ING
SUBTTL REENTER COMMAND RECOVERY
RENTR: MOVE P,[IOWD PDLEN,PDLST] ;[RE]INITIALIZE PUSHDOWN STACK
SKIPN CH,SECTN ;RUNNING EXTENDED ADDRESSING?
JRST RENTR1 ;NO
HRRI CH,RENTR1 ;YES
XJRST CH ;[RE]ENTER SELECTED PC SECTION
RENTR1: PUSHJ P,TTOPEN ;GO [RE]OPEN TERMINAL CHANNEL
PUSHJ P,GETTYP ;FIND OUT WHAT TYPE OF TERMINAL WE NOW HAVE
PUSHJ P,TTYGET ;GET AND REMEMBER TTY MODES BECAUSE USER
;MAY HAVE CHANGED THEM WHILE AT MONITOR LEVEL
PUSHJ P,TTYSEC ;RESTORE OUR OWN MODES
;FAKE OUT THE CRASH FILE
MOVEI CH,.CHBEL ;A ^G CHARACTER
PUSHJ P,TEBCHR ;STUFF IN FIRST ^G
PUSHJ P,TEBCHR ;A SECOND ^G IN CASE THE FIRST GETS CAUGHT
; BY A "DANGLING" ^V IN THE CRASH FILE
MOVEI CH,.CHCNU ;A ^U CHARACTER
PUSHJ P,TEBCHR ;ABORT LAST POSSIBLE PARTIAL COMMAND
PUSHJ P,TEBJ ;ISSUE NNNJ$$ COMMAND SO WE KNOW WHERE WE ARE
;OTHER RANDOM CLEANUP
PUSHJ P,TYICNR ;ZAP COMMAND FILE (IF ANY)
SETOM SCH ;SO CHARACTER COMES FROM TTY
SETOM MESFLG ;ASSUME DISPLAY IS AMUCK
SETZM WINFLG ;SO DISPLAY HAPPENS
SETZM VFREEZ ; . . .
;RESUME TECO'ING
XMOVEI T,GO ;ADDRESS FROM WHENCE TO RESUME
MOVEM T,PSICCV+.PSVOP ;SET FOR DEBRK. TO SEE
DEBRK. ;ALLOW FURTHER CONTROL-C'S
JRST GO ;MUST HAVE BEEN ?ILL MEM REF OR SUCH
JRST GO ; WHICH TOOK US TO MONITOR LEVEL
;SCAN/WILD INTERFACE STUFF
;CALLSW -- CALL A SCAN/WILD ROUTINE
;CALL IS:
;
; JSP OU,CALLSW
; <ARG>
; <RTN>
; NON-SKIP RETURN
; SKIP RETURN
;
;WHERE <ARG> IS THE ARGUMENT TO BE PASSED IN SCAN'S T1; AND <RTN> IS
;THE ROUTINE TO BE CALLED.
;
;SKIP OR NON-SKIP RETURN IS PRESERVED.
;
;PRESERVES ALL ACS.
CALLSW: PUSH P,T1 ;SAVE
PUSH P,T2 ; SCAN'S
PUSH P,T3 ; VOLATILE
PUSH P,T4 ; ACS
MOVE T1,(OU) ;FETCH T1 ARGUMENT
PUSHJ P,@1(OU) ;CALL SCAN/WILD ROUTINE
HRRI OU,-1(OU) ;NON-SKIP RETURN
DMOVEM T1,SCNT1 ;SAVE WHAT SCAN RETURNED US
DMOVEM T3,SCNT3 ; . . .
POP P,T4 ; RESTORE
POP P,T3 ; SCAN'S
POP P,T2 ; VOLATILE
POP P,T1 ;ACS
JRST 3(OU) ;RETURN TO CALLER
U SCNT1,1 ;SCAN'S RETURNED T1
U SCNT2,1 ; AND T2
U SCNT3,1 ; AND T3
U SCNT4,1 ; AND T4
;TECO/SCAN CHARACTER I/O
;SCNTYI -- RETURN ONE COMMAND INPUT CHARACTER
SCNTYI: MOVEI P4,.CHLFD ;HMMM
POPJ P, ;GO AWAY AGAIN
;SCNTYO -- TYPE ONE COMMAND TERMINAL CHARACTER
SCNTYO: PUSHJ P,TECCTX ;SWITCH TO TECO ACS
PUSH P,CH ;SAVE A REG
PUSH P,A ; AND ANOTHER REG
PUSH P,AA ; AND YET ANOTHER REG
MOVE CH,SCNACS+T1 ;THE CHARACTER SCAN WANTS TO OUTPUT
PUSHJ P,TYOM ;TYPE A CHARACTER
POP P,AA ; RESTORE A REG
POP P,A ; AND ANOTHER REG
POP P,CH ;AND YET ANOTHER REG
PJRST SCNCTX ;SWITCH BACK TO SCAN
;SCNTYS -- TYPE ONE SPECIAL CHARACTER (E.G., "<ESC>")
SCNTYS: PUSHJ P,TECCTX ;SWITCH TO TECO ACS
PUSH P,CH ;SAVE A REG
PUSH P,A ; AND ANOTHER REG
PUSH P,AA ; AND YET ANOTHER REG
MOVE CH,SCNACS+T1 ;THE CHARACTER SCAN WANTS TO OUTPUT
PUSHJ P,TYOS ;TYPE A SPECIAL CHARACTER
POP P,AA ; RESTORE A REG
POP P,A ; AND ANOTHER REG
POP P,CH ;AND YET ANOTHER REG
PJRST SCNCTX ;SWITCH BACK TO SCAN
;SCNCTX -- SWITCH TO SCAN/WILD CONTEXT
SCNCTX: MOVEM 10,TECACS+10 ;Save AC 10
MOVEI 10,TECACS ;Set up BLT
BLT 10,TECACS+10-1 ;Save TECO's ACs
MOVSI 10,SCNACS ;SCAN'S ACS
BLT 10,10 ;SET THEM UP
POPJ P, ;Return in SCAN's context
;TECCTX -- SWITCH TO TECO CONTEXT
TECCTX: MOVEM 10,SCNACS+10 ;Save AC 10
MOVEI 10,SCNACS ;Set up BLT
BLT 10,SCNACS+10-1 ;Save SCAN's ACs
MOVSI 10,TECACS ;Address of TECO context acs
BLT 10,10 ;Back to TECO mode
POPJ P, ;Return in TECO's context
U TECACS,11 ;TECO's ACs
U SCNACS,11 ;SCAN's ACs
;SWITCH DEFINITIONS
DM CRF,.FXLEN,0,0
DM INI,.FXLEN,0,0
DEFINE SWTCHS,<
SL CRDISP,S.CRDI,$TB,$TBDEL,FS.NFS!FS.VRQ
SP CRFILE,S.CRFI,.SWFIL##,CRF,FS.NFS!FS.VRQ
SP CRPROT,S.CRPR,.SWOCT##,,FS.NFS!FS.VRQ
SP CRSAVE,S.CRSA,.SWDEC##,,FS.NFS!FS.VRQ
SN EAMODE,S.EAMO,FS.NFS
SP EOBATC,S.EOBA,.SWDEC##,,FS.NFS!FS.VRQ
SP EOMODE,S.EOMO,.SWDEC##,,FS.NFS!FS.VRQ
SP INITFI,S.INIT,.SWFIL##,INI,FS.NFS!FS.VRQ
SN OKLSN,S.OKLS,FS.NFS
SN OKNULL,S.OKNU,FS.NFS
SN SFT,S.SFT,FS.NFS
>
KEYS ($TB,<NEVER,TEMPORARY,DELETE,PRESERVE>)
DOSCAN(TECSW)
;DATA BLOCKS
;FOR SCAN
;MONITOR COMMAND TABLE
CCMDT: 'MAKE ' ;CREATE A NEW FILE
'TECO ' ;EDIT AN EXISTING FILE
CCMDL==.-CCMDT
;ISCAN PARAMETER BLOCK
ISBLK: EXP FXVRSN ;SCAN/WILD PROTOCOL VERSION WORD
IOWD CCMDL,CCMDT ;IOWD OF LEGAL MONITOR COMMANDS
CCLSW,,'TEC' ;ADR OF STARTING OFFSET,,CCL NAME
0,,SCNTYO ;CHAR INPUT RTN,,CHAR OUTPUT RTN
Z ;INDIRECT FILE BLOCK POINTER (XWD)
Z ;PROMPT RTN,,MONRET RTN
Z ;FLAGS,,<FUTURE>
Z ;ERROR INTERCEPT RTN
ISLEN==.-ISBLK
;TSCAN PARAMETER BLOCK
;TSBLK: EXP FXVRSN ;SCAN/WILD PROTOCOL VERSION WORD
; IOWD TECSWL,TECSWN ;IOWD POINTER FOR SWITCH NAMES
; XWD TECSWD,TECSWM ;DEFAULT TABLE,,PROCESSOR TABLE
; XWD 0,TECSWP ;<FUTURE>,,STORAGE POINTERS
; SIXBIT /TECO/ ;HELP
; XWD CLRALL,0 ;CLEAR ALL,,CLEAR FILE
; XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
; Z ;MEMORIZE STICKY,,APPLY STICKY
; Z ;CLEAR STICKY,,FLAGS
; Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
;
; TSLEN==.-TSBLK
;OSCAN BLOCK
OSBLK: EXP FXVRSN ;SCAN/WILD PROTOCOL VERSION WORD
IOWD TECSWL,TECSWN ;IOWD POINTER FOR SWITCH NAMES
XWD TECSWD,TECSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,TECSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /TECO/ ;HELP
SIXBIT /TECO/ ;OPTIONS NAME
OSLEN==.-OSBLK
;FOR WILD
;LKBLK: EXP FXVRSN ;SCAN/WILD PROTOCOL VERSION WORD
; WIFIR,,WILAS ;<FIRST,,LAST> SCAN BLOCK POINTER ADR
; INOPN,,INFIL ;<OPEN,,LOOKUP> BLOCK ADDRESS
; .FXLEN,,FILLEN ;SCAN BLOCK LENGTH,,LOOKUP LENGTH
; 0,,WICUR ;FLAGS!CHANNEL,,CUR SCNBLK PTR ADR
; Z ;END OF DIRECTORY RTN
;
; LKLEN==.-LKBLK
;SCBLK: EXP FXVRSN ;SCAN/WILD PROTOCOL VERSION WORD
; WICUR,,[OUSCN] ;<CUR INPUT,,OUTPUT> SCNBLK PTR ADR
; INOPN,,OUOPN ;<INPUT,,OUTPUT> OPEN BLK ADR
; INFIL,,OUFIL ;<INPUT,,OUTPUT> FILE BLK ADR
; [0,,-1],,FILLEN ;DEFAULT EXT ADR,,FILE BLK LEN
; 0,,SCFLG ;<FUTURE>,,SCWILD PROCESSING FLAGS
;
; SCLEN==.-SCBLK
;THIS PAGE CONTAINS THE COMMAND READER FOR THE CCL SYSTEM
CCLDSK: .IOASC ;ASCII I/O
'DSK ' ;TO A DISK DEVICE
0,,CCLB ;INPUT BUFFER RING HEADER
U CCLB,3 ;THE HEADER FOR CCL FILE I/O
CCLIN: HRRZ TT,.JBFF ;GET FIRST FREE
ADDI TT,TMPBSZ ;LAST LOC USED IN TMPCOR
CAMG TT,.JBREL ;ENOUGH ROOM?
JRST CCLIN2 ;YES, JUST READ IN BUFFER
LSH TT,WRD2PG ;NO, MAKE PAGE ADDRESS
ADD TT,SECTNP ;OFFSET TO PC SECTION
PUSHJ P,P1CRE ;ALLOCATE ANOTHER MEMORY PAGE
HALT . ;BAD NEWS
CCLIN2: HRLI T,'EDT' ;SET UP READ BLOCK FOR TMPCOR UUO
HRLOI TT,-TMPBSZ-1 ;SIZE OF TMPCOR READ
ADD TT,.JBFF ;MAKE IOWD POINTER TO TMPCOR BUFFER
MOVE TT1,[.TCRDF,,T] ;TMPCOR UUO ARG POINTER TO
TMPCOR TT1, ;READ AND DELETE FILE EDT
JRST CCLTMP ;NO FILE EDT OR NO TMPCOR UUO
HRRZ AA,.JBFF ;GET START OF BUFFER AREA
HRLI AA,350700 ;PICK UP EDT CHARACTERS, SKIP LINED "S"
TXO FF,TMPFLG ;SET TMPCOR FLAG
JRST CCLTM1 ;FINISH PROCESSING COMMAND
;HERE IF TMPCOR FAILED. READ NNNEDT.TMP FROM DSK:
CCLTMP: HLLZ B,TMPTEC ;GET SIXBIT JOB #
HRRI B,'EDT' ;REST OF NAME
MOVE T,[-XFILEN,,XFILNM-1] ;PDL INTO LOOKUP BLOCK
PUSH T,[XFILEN-1] ;FIRST WORD IS CNT OF ARGS
PUSH T,[0] ;LOOK ON DEFAULT PATH
PUSH T,B ;STORE FILENAME
PUSH T,['TMP '] ;EXTENSION
MOVE T,.JBFF ;USE BUFFER SPACE BRIEFLY
OPEN CCLCHN,CCLDSK ;OPEN DSK CHANNEL
JRST TECO ;IF NO DSK, SAY "*"
INBUF CCLCHN,1 ;DONT ADR CHECK
LOOKUP CCLCHN,XFILNM ;OPEN THE FILE
JRST TECO ;IT WASN'T THERE?
INPUT CCLCHN,0
MOVEM T,.JBFF ;GIVE BACK SPACE
IBP CCLB+1 ;SKIP THE LINED S
MOVE AA,CCLB+1 ;SETUP BYTE POINTER TO INPUT
CCLTM1: MOVE T,TTYPT2 ;OUTPUT CHARS
MOVEI C,2 ;INIT CHAR CTR
MOVEI A,"=" ;FLAG NO EQUALS SIGN SEEN
;FALL INTO LOOP ON NEXT PAGE
;LOOP BACK HERE ON EACH NEW CHARACTER IN THE TMP FILE
CCLIL: ILDB B,AA ;INPUT THE FILE NAME & EXT
CAMN B,A ;FIRST EQUALS SIGN SEEN?
JRST CCLEQL ;YES
CAIE B,.CHCRT ;CR?
CAIN B,"}" ;OLD ALT?
AOJA C,CCLNUL ;THEN PROCESS
JUMPE B,CCLIL ;THROW AWAY NULLS
IDPB B,T ;ELSE STORE CHAR
AOJA C,CCLIL ;AND LOOP FOR ALL CHARS
;HERE ON THE FIRST "=" IN THE COMMAND STRING
CCLEQL: MOVE D,T ;SAVE C & T
MOVE E,C ;INCASE .TE A=B
MOVEI B,.CHESC ;REPLACE FIRST EQUALS SIGN
IDPB B,T ; WITH <ALT>ER
MOVEI B,"E" ; SINCE WE EXPECT
IDPB B,T ; AN INPUT FILE
MOVEI B,"R" ; SPEC TO FOLLOW
IDPB B,T ; THE FIRST ONE
ADDI C,3 ;COUNT THE CHARS STORED
SETO A, ;PREVENT FINDING LATER EQUALS
TXO FF,CCLFLG ;DO A Y IN ANY CASE
JRST CCLIL ;AND LOOP BACK FOR NEXT CHAR
;HERE ON A NUL (END OF COMMAND). SEE IF IT WAS MAKE OR TECO
CCLNUL: MOVEI TT,"W" ;PREPARE FOR EW COMMAND
CAILE B,.CHCRT ;WAS BREAK A CRLF?
JRST CCLDUN ;NO. ALTMODE ASSUMED
TXO FF,CCLFLG ;REQUEST Y AFTER EB
MOVEI TT,"B" ;NOW PREPARE FOR EB
AOJN A,CCLDUN ;CONTINUE UNLESS EB & "=" WAS SEEN
MOVE T,D ;IF .TE A=B, WE NEVER SAW THE "="
AOS C,E ;IN CASE .MA A=B, THEN .TE<CRLF>
; SINCE TYI USES SOSG, THE COUNT MUST BE
; ONE TOO LARGE (YECH).
CCLDUN: MOVEI B,.CHESC ;AN <ESC> TO TERMINATE THE FILE SPEC
IDPB B,T ;TERMINATE THE FILE SPEC
SKIPL S.EAMO ;EAMODE SET?
TXZ FF,CCLFLG ;YES, NO FREE YANKS THEN
TXZN FF,CCLFLG ;WANT TO YANK IN THE FIRST PAGE?
JRST CCLDU1 ;NO
MOVEI B,"E" ;YES, A YANK COMMAND
IDPB B,T ;STUFF IT INTO THE BUFFER
MOVEI B,"Y" ;YANK COMMAND, PART TWO
IDPB B,T ;STUFF IT INTO THE BUFFER TOO
MOVEI B,.CHESC ;ANOTHER <ESC> CHARACTER
IDPB B,T ;TERMINATE THE YANK COMMAND
ADDI C,3 ;COUNT THE "EY$" CHARACTERS
CCLDU1: IDPB B,T ;SECOND ALT TO TERMINATE COMMAND
ADDI C,2 ;COUNT TERMINATING "$$" CHARACTERS
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 ;AND EITHER W OR B
MOVEM C,TIB+.BFCTR ;SET BUFR CTR
TXZE FF,TMPFLG ;TMPCOR UUO IN PROGRESS?
JRST CCLDU2 ;YES, DON'T CLOSE DSK
SETZM XNAM ;NOW FLUSH FILE
RENAME CCLCHN,XFILNM ;BY RENAME TO ZERO
JFCL ;PROTECTED?
CCLDU2: RELEAS CCLCHN,
POPJ P,
;FIGURE OUT WHAT KIND OF TERMINAL THIS IS, AND SET THE SCTYPE CODE
GETTYP: MOVEI A,.TOTRM ;TRMOP. TERMINAL TYPE FUNCTION
MOVE AA,TTYUDX ;GET TERMINAL UDX
MOVE B,[2,,A] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ MONITOR'S TERMINAL TYPE
IFE RUN603,< SETO B,> ;MONITOR DOESN'T KNOW (PRE-7.00)
IFN RUN603,<MOVX B,TTY603> ;IF 6.03, SET ASSEMBLED TERMINAL
;HERE WITH TERMINAL TYPE IN B (SIXBIT NAME), SEE IF WE LIKE IT
PUSHJ P,GETTY0 ;SET TERMINAL FROM TABLE
POPJ P, ;DONE
MOVEI A,.TOTCN ;TRMOP. TERMINAL CLASS NAME FUNCTION
MOVE B,[2,,A] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ MONITOR'S CLASS TYPE
MOVSI B,'TTY' ;MONITOR DOESN'T KNOW (PRE-7.04)
;HERE WITH TERMINAL CLASS IN B (SIXBIT NAME), SEE IF WE LIKE IT
PUSHJ P,GETTY0 ;TRY TO SETUP FROM THIS NAME
POPJ P, ;DONE HERE
;HERE IF NEITHER THE TYPE NOR THE CLASS WAS KNOWN. TRY TO FAKE IT.
MOVEI A,.TOAT2 ;ATTRIBUTE BYTES FUNCTION
MOVE B,[2,,A] ;TRMOP. ARGUMENT POINTER
TRMOP. B, ;TRY TO READ THEM
JRST GETTYX ;GIVE UP IF PRE-7.04
TXNN B,T2.ACL ;ANSLVL:0?
JRST GETTYV ;YES, GO CHECK FOR VT52
MOVEI A,.TOATR ;ATTRIBUTE BITS FUNCTION
MOVE B,[2,,A] ;POINTER FOR TRMOP.
TRMOP. B, ;GET THE BITS
JRST GETTYX ;SNH
TXNE B,TA.DIS ;IS THIS A DISPLAY?
SKIPA B,['VT100 '] ;YES, CALL IT ONE OF THESE
GETTYX: MOVSI B,'TTY' ;NO, CALL IT ONE OF THESE
PJRST GETTY0 ;SET IT UP & RETURN
;HERE TO TRY TO CHECK A NON-ANSI TERMINAL
GETTYV: MOVEI A,.TOATR ;ATTRIBUTE BITS FUNCTION
MOVE B,[2,,A] ;POINTER FOR TRMOP. UUO
TRMOP. B, ;READ THEM
JRST GETTYX ;SNH
TXNE B,TA.DIS ;IF A DISPLAY,
TXNN B,TA.V52 ;WITH VT52EMULATION,
JRST GETTYX ;(NO--CALL IT A TTY)
MOVX B,'VT52 ' ;YES--CALL IT ONE OF THESE
;FALL INTO GETTY0 TO SETUP AN ERSATZ VT52
GETTY0: MOVSI A,-TYPTLN ;LENGTH OF OUR TYPE TABLE
GETTY2: CAME B,TYPTBL(A) ;TERMINAL WE KNOW ABOUT?
AOBJN A,GETTY2 ;NO, CHECK REST OF TABLE
JUMPGE A,CPOPJ1 ;NOT IN TABLE
MOVE B,TYPVTX(A) ;GET INTERNAL TERMINAL TYPE
; (0 IF UNKNOWN)
MOVEM B,SCTYPE ;REMEMBER FOR SCREEN CHECKING
HRLZ A,TYPCTL(B) ;ADDRESS OF CONTROL CODES TABLE
HRRI A,TTYESC ;ADDRESS OF CONTROL CODES TABLE
BLT A,TTYESZ ;COPY WORKING TABLE
MOVEI A,8
MOVEM A,TABSIZ ;TABS EVERY 8 COLUMNS
POPJ P,
;TTY CONTROL STUFF
;INTERNAL TERMINAL TYPES
VXTTY==0 ;NO SCREEN CONTROL (UNKNOWN/HARDCOPY)
VX05==1 ;VT05
VXD50==2 ;VT50-CLASS
VXDEC==3 ;VT52-CLASS
VXANSI==4 ;VT100 (ANSI) CLASS
TYPCTL: VCTTY ;(00) NONE (E.G., HARDCOPY TERMINAL)
VC05 ;(01) VT05 CONTROL
VCD50 ;(02) DEC-STANDARD SANS CURSOR ADDRESSING
VCDEC ;(03) DEC-STANDARD ESCAPE CONTROL
VCANSI ;(04) ANSI-STANDARD ESCAPE CONTROL
;TERMINAL TYPES DEFINITIONS
DEFINE TRMTYP,<
X VT05, VX05 ;GOOD OLE VT05
X VT50, VXD50 ;DINKY VT50
X VT52, VXDEC ;STANDARD VT52
X VT55, VXDEC ;VT52 WITH GRAPHICS
X VT61, VXDEC ;FANCY EDITING TERMINAL
X DAS21, VXDEC ;FUNNY LOOKING VT52
X VT100, VXANSI ;NOT-SO-NEW-ANYMORE NEWEST LATEST GREATEST
X VT101, VXANSI ;EL CHEAPO VT100
X VT102, VXANSI ;FANCY VERSION OF EL CHEAPO VT100
X VT103, VXANSI ;EGADS, THEY'RE PROLIFERATING LIKE RABBITS
X VT125, VXANSI ;VT100 WITH GRAPHICS
X VT180, VXANSI ;ROBIN
X VT185, VXANSI ;ROBIN RED BREAST?
X VT220, VXANSI ;NEWEST LATEST GREATEST WITH SUCKY KEYBOARD
X VT240, VXANSI ;FANCIER VERSION OF NEWEST ETC.
X VK100, VXANSI ;VT100 WITH EVEN MORE GRAPHICS ("GIGI")
X VT200, VXANSI ;CLASS NAME FOR 'NEWEST'
X VT300, VXANSI ;CLASS NAME FOR EVEN NEWER TYPE SERIES
X TTY, VXTTY ;GENERIC DUMB HARDCOPY
> ;END TRMTYP MACRO
;THE TTY TYPES TABLE
DEFINE X(NAM,DSP),<SIXBIT\NAM\>
TYPTBL: TRMTYP ;DEFINE TERMINAL NAMES TABLE
TYPTLN==.-TYPTBL ;LENGTH OF TYPE TABLE
;THE TTY TYPE DISPATCH TABLE
DEFINE X(NAM,DSP),<EXP DSP>
TYPVTX: TRMTYP ;DEFINE TYPE DISPATCH TABLE
VXTTY ;(--) UNKNOWN TERMINAL (NO CONTROL)
;OUR WORKING TABLE OF TTY CONTROL
U THOME,1 ;(00) HOME
U TEREOL,1 ;(01) ERASE TO END OF LINE
U TEREOS,1 ;(02) ERASE TO END OF SCREEN
U TCUP,1 ;(03) CURSOR UP
U TDOWN,1 ;(04) CURSOR DOWN
U TRIGHT,1 ;(05) CURSOR RIGHT
U TLEFT,1 ;(06) CURSOR LEFT
U TDCAD,1 ;(07) DIRECT CURSOR ADDRESS PROCESSOR
U TKESC,1 ;(10) START OF ESCAPE SEQUENCE
U TKCUP,1 ;(11) CURSOR UP "KEY"
U TKDWN,1 ;(12) CURSOR DOWN "KEY"
U TKRGT,1 ;(13) CURSOR RIGHT "KEY"
U TKLFT,1 ;(14) CURSOR LEFT "KEY"
U TCOCH,1 ;(15) CONTINUATION CHARACTER
TTYESC==THOME ;START OF CONTROL TABLE
TTYESZ==TCOCH ;END OF CONTROL TABLE
;PROTOTYPE CONTROL TABLE FOR HARDCOPY TERMINALS
VCTTY: BLOCK 1 ;(00) HOME
BLOCK 1 ;(01) ERASE TO END OF LINE
BLOCK 1 ;(02) ERASE TO END OF SCREEN
BLOCK 1 ;(03) CURSOR UP
BLOCK 1 ;(04) CURSOR DOWN
BLOCK 1 ;(05) CURSOR RIGHT
BLOCK 1 ;(06) CURSOR LEFT
BLOCK 1 ;(07) DIRECT CURSOR ADDRESS PROCESSOR
BLOCK 1 ;(10) START OF ESCAPE SEQUENCE
BLOCK 1 ;(11) CURSOR UP "KEY"
BLOCK 1 ;(12) CURSOR DOWN "KEY"
BLOCK 1 ;(13) CURSOR RIGHT "KEY"
BLOCK 1 ;(14) CURSOR LEFT "KEY"
EXP "!" ;(15) LINE CONTINUATION CHARACTER
;PROTOTYPE CONTROL TABLE FOR VT05'S
VC05: BYTE(7) 035,177,177,177,177 ;(00) HOME
BYTE(7) 036,177,177,177,177 ;(01) ERASE TO END OF LINE
BYTE(7) 037,177,177,177,177 ;(02) ERASE TO END OF SCREEN
BYTE(7) 032,177,177,177,177 ;(03) CURSOR UP
BYTE(7) 012,000,000,000,000 ;(04) CURSOR DOWN
BYTE(7) 030,000,000,000,000 ;(05) CURSOR RIGHT
BYTE(7) 010,000,000,000,000 ;(06) CURSOR LEFT
IFIW VT05LN ;(07) DIRECT CURSOR ADDRESS PROCESSOR
EXP 0 ;(10) START OF ESCAPE SEQUENCE
EXP 032 ;(11) CURSOR UP "KEY"
EXP 013 ;(12) CURSOR DOWN "KEY"
EXP 030 ;(13) CURSOR RIGHT "KEY"
EXP 010 ;(14) CURSOR LEFT "KEY"
EXP "!" ;(15) CONTINUATION CHARACTER
;PROTOTYPE CONTROL TABLE FOR DEC-STANDARD TERMINALS SANS CURSOR CONTROL (VT50'S)
VCD50: BYTE(7) 033,"H",000,000,000 ;(00) HOME
BYTE(7) 033,"K",000,000,000 ;(01) ERASE TO EOL
BYTE(7) 033,"J",000,000,000 ;(02) ERASE TO EOS
BYTE(7) 033,"A",000,000,000 ;(03) CURSOR UP
BYTE(7) 033,"B",000,000,000 ;(04) CURSOR DOWN
BYTE(7) 033,"C",000,000,000 ;(05) CURSOR RIGHT
BYTE(7) 033,"D",000,000,000 ;(06) CURSOR LEFT
IFIW VT50LN ;(07) DCA PROCESSOR
EXP .CHESC ;(10) START OF ESCAPE SEQUENCE
EXP "A" ;(11) CURSOR UP "KEY"
EXP "B" ;(12) CURSOR DOWN "KEY"
EXP "C" ;(13) CURSOR RIGHT "KEY"
EXP "D" ;(14) CURSOR LEFT "KEY"
EXP "!" ;(15) CONTINUATION CHARACTER
;PROTOTYPE CONTROL TABLE FOR DEC-STANDARD TERMINALS (VT52'S)
VCDEC: BYTE(7) 033,"H",000,000,000 ;(00) HOME
BYTE(7) 033,"K",000,000,000 ;(01) ERASE TO EOL
BYTE(7) 033,"J",000,000,000 ;(02) ERASE TO EOS
BYTE(7) 033,"A",000,000,000 ;(03) CURSOR UP
BYTE(7) 033,"B",000,000,000 ;(04) CURSOR DOWN
BYTE(7) 033,"C",000,000,000 ;(05) CURSOR RIGHT
BYTE(7) 033,"D",000,000,000 ;(06) CURSOR LEFT
IFIW VT52LN ;(07) DCA PROCESSOR
EXP .CHESC ;(10) START OF ESCAPE SEQUENCE
EXP "A" ;(11) CURSOR UP "KEY"
EXP "B" ;(12) CURSOR DOWN "KEY"
EXP "C" ;(13) CURSOR RIGHT "KEY"
EXP "D" ;(14) CURSOR LEFT "KEY"
EXP "|" ;(15) CONTINUATION CHARACTER
;PROTOTYPE CONTROL TABLE FOR ANSI-STANDARD TERMINALS (VT100)
VCANSI: BYTE(7) 033,"[","H",000,000 ;(00) HOME
BYTE(7) 033,"[","0","K",000 ;(01) ERASE TO EOL
BYTE(7) 033,"[","0","J",000 ;(02) ERASE TO EOS
BYTE(7) 033,"[","1","A",000 ;(03) CURSOR UP
BYTE(7) 033,"[","1","B",000 ;(04) CURSOR DOWN
BYTE(7) 033,"[","1","C",000 ;(05) CURSOR RIGHT
BYTE(7) 033,"[","1","D",000 ;(06) CURSOR LEFT
IFIW VTANLN ;(07) DCA PROCESSOR
EXP .CHESC ;(10) START OF ESCAPE SEQUENCE
EXP "A" ;(11) CURSOR UP "KEY"
EXP "B" ;(12) CURSOR DOWN "KEY"
EXP "C" ;(13) CURSOR RIGHT "KEY"
EXP "D" ;(14) CURSOR LEFT "KEY"
EXP "|" ;(15) CONTINUATION CHARACTER
;PSI SERVICE INITIALIZATION
;SETUP PSI SYSTEM
PSIINI: XMOVEI T,PSIVEC ;BASE PSI VECTOR
SKIPE SECTN ;RUNNING EXTENDED?
TXO T,PS.IEA ;YES, WANT "EXTENDED" FORMAT THEN
PIINI. T, ;INITIALIZE PSI SYSTEM
POPJ P, ;BLETCH
;BY DEFAULT, ALWAYS GET ^C TRAPPING, SO INCLUDE IT AS PART OF THE
;"GENERIC" PSI SETUP CODE
XMOVEI T,CCINT ;CONTROL-C TRAP ROUTINE
MOVEM T,PSICCV+.PSVNP ;SET TRAP PC
MOVX T,PS.VTO!PS.VDS ;CONTROL-FLAGS: IGNORE FURTHER ^C'S
MOVEM T,PSICCV+.PSVFL ;SET FLAGS WORD
MOVE T,[PS.FON!PS.FAC+[.PCSTP ;ENABLE ARG BLOCK FOR ^C TRAP
XWD PSICCV-PSIVEC,0 ;VECTOR OFFSET
EXP 0]] ;JUNK WORD
PISYS. T, ;ENABLE CONTROL-C TRAPPING
POPJ P, ;JUNK
JRST CPOPJ1 ;PSI (AND ^C TRAP) SETUP
;CONTROL-C TRAP SERVICE ROUTINE
CCINT: PUSH P,A ;SAVE ACCUMULATORS A, AA, AND B
PUSH P,AA ; . . .
PUSH P,B ; . . .
PUSH P,T ;SAVE
PUSH P,TT ; EVEN
PUSH P,TT1 ; MORE
PUSH P,CH ; ACS
PUSHJ P,TEBURB ;FORCE COMMAND BACKUP UPDATE NOW
PUSHJ P,CLREOS ;CLEAR OUT JUNK AT BOTTOM OF SCREEN
PUSHJ P,TTYRST ;RESTORE ORIGINAL USER TTY MODES
PUSHJ P,ZAPTT ;CLEAR OUT THE TTY
EXIT 1, ;LET MONITOR HAVE USER
;BACK HERE WHEN USER TYPES CONTINUE
CCONT: PUSHJ P,TTOPEN ;RE-OPEN DEVICE TTY:
PUSHJ P,GETTYP ;CHECK ON TERMINAL TYPE JUST IN CASE . . .
PUSHJ P,TTYGET ;GET TTY MODES (USER MAY HAVE CHANGED THEM)
PUSHJ P,TTYSEC ;SETUP OUR TTY MODES
TXNN F2,DOING ;EXECUTING A COMMAND?
SKIPE COMCNT ;NO, ANY COMMAND CHARACTERS IN YET?
JRST CCONT5 ;YES TO ONE OF THE ABOVE, JUST RESUME
;HERE WHEN USER ^C'ED FROM COMMAND INPUT WAIT, NO CHARACTERS IN YET
PUSHJ P,CLRSCN ;FORCIBLY CLEAR THE WHOLE SCREEN
XMOVEI CH,GO ;ADDRESS FROM WHENCE TO RESUME
MOVEM CH,PSICCV+.PSVOP;SET FOR DEBRK. TO SEE
JRST CCONT8 ;AND GO RESTART
;HERE WHEN USER ^C'ED FROM SOMETHING HAPPENING, JUST RESUME
CCONT5: SETOM MESFLG ;NOTE THAT SCREEN IS [PROBABLY] TRASHED
SETZM WINFLG ;WE WANT IT UPDATED NOW!
SETZM VFREEZ ; . . .
CCONT8: POP P,CH ;RESTORE
POP P,TT1 ; SOME
POP P,TT ; MORE
POP P,T ; ACS
POP P,B ;RESTORE A, AA, AND B
POP P,AA ; . . .
POP P,A ; . . .
DEBRK. ;BACK TO THE OLD GRIND....
HALT GO ;DUH?
HALT GO ;DOUBLE DUH?
SUBTTL TERMINAL HANDLING AND I/O ROUTINES
;TTOPEN - OPEN AND INITIALIZE THE TERMINAL I/O CHANNEL
TTOPEN: OPEN TTYCHN,TTYBLK ;OPEN DEVICE TTY:
JRST TTOPF1 ;OPEN FAILURE? OFF TO A BAD START!
SETOM TTSTS ;INITIALLY JUNK STATUS
MOVEI T,TTYCHN ;TTY I/O CHANNEL
DEVTYP T, ;GET DEVICE TYPE INFORMATION
JRST TTOPF2 ;CAN'T FAIL
LDB TT,[POINTR T,TY.DEV] ;GET DEVICE CODE
CAIE TT,.TYTTY ;IS TTY: A TRUE TERMINAL?
JRST TTOPF3 ;NO, BARF ON USER
MOVEI T,TTYCHN ;TTY I/O CHANNEL AGAIN
IONDX. T, ;GET OFFICIAL TTY UDX
JRST TTOPF4 ;CAN'T FAIL
MOVEM T,TTYUDX ;SAVE FOR ASSORTED AND SUNDRY TRMOP.S
;NOW SET UP INPUT BUFFER RING STRUCTURE
MOVE A,[TTIBFN,,TTIBSZ+3] ;TERMINAL INPUT BUFARG
MOVEI AA,TTIBF1 ;FIRST INPUT BUFFER
MOVEI B,TIB ;TERMINAL INPUT BUFFER RING
PUSHJ P,SETBF ;INITIALIZE INPUT BUFFER RING
HALT . ;CAN'T HAPPEN
;NOW SET UP OUTPUT BUFFER RING STRUCTURE
MOVE A,[TTOBFN,,TTOBSZ+3] ;TERMINAL OUTPUT BUFARG
MOVEI AA,TTOBF1 ;FIRST OUTPUT BUFFER
MOVEI B,TOB ;OUTPUT RING HEADER
PUSHJ P,SETBF ;INITIALIZE OUTPUT BUFFER RING
HALT . ;CAN'T HAPPEN
POPJ P, ;TERMINAL CHANNEL ALL SET
;TTOPEN ERRORS
TTOPF1: OUTSTR [ASCIZ\? Can't OPEN device TTY:\]
JRST TTOPFX ;COMMON ERROR EXIT
TTOPF2: OUTSTR [ASCIZ\? DEVTYP failure for TTY channel\]
JRST TTOPFX ;COMMON ERROR EXIT
TTOPF3: OUTSTR [ASCIZ\? Device TTY: is not a real terminal\]
JRST TTOPFX ;COMMON ERROR EXIT
TTOPF4: OUTSTR [ASCIZ\? IONDX. failure for TTY channel\]
JRST TTOPFX ;COMMON ERROR EXIT
TTOPFX: OUTSTR [ASCIZ\
\] ;BLANK LINE BEFORE THE "."
EXIT 1, ;RETURN TO MONITOR LEVEL
JRST TTOPEN ;USER .CONTINUED, SO TRY AGAIN
;ROUTINE TO GET AND REMEMBER VARIOUS TTY SETTINGS, SO IF WE CHANGE THEM,
;WE CAN RESTORE THEM CORRECTLY WHEN TECO EXITS TO THE MONITOR FOR ANY
;REASON
TTYGET: MOVE TT,TTYUDX ;GET OUR TTY UDX FOR SUBSEQUENT TRMOP.'S
MOVEI T,.TOLCT ;LOWER CASE CONVERSION
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ LC SETTING
SETZ B, ;ASSUME LOWER CASE TTY
SKIPN B ;LOWER CASE CAPABILITY?
TXOA F2,LINCHR ;YES, SET FLAG
TXZ F2,LINCHR ;NO, CLEAR IT
MOVEI T,.TOALT ;READY TO CHECK FOR ALTMODE CONVERSION
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ ALTMODE CONVERSION SETTING
MOVEI B,0 ;ASSUME NOT
SKIPE B ;COPY ALTMODE CONVERSION SWITCH TO F2
TXOA F2,NOALT
TXZ F2,NOALT
MOVEI T,.TOTAB ;PREPARE TO READ TAB-SPACES SWITCH
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ TAB-SPACES SWITCH
SETZ B, ;ASSUME NOT
MOVEM B,TTYTAB ;REMEMBER TAB SWITCH SETTING
MOVEI T,.TONFC ;PREPARE TO READ FREE CRLF SWITCH
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ CRLF SWITCH
SETZ B, ;ASSUME FREE CRLF
MOVEM B,TTYFCR ;SAVE CURRENT FREE CRLF SETTING
MOVEI T,.TOBLK ;PREPARE TO READ TTY BLANK
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ CRLF SWITCH
SETZ B, ;ASSUME TTY NO BLANK SUPPRESS
MOVEM B,TTYBLN ;SAVE CURRENT TTY BLANK
MOVEI T,.TODEM ;PREPARE TO READ DEFERRED ECHO MODE
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ DEFERRED ECHO SETTING
SETZ B, ;ASSUME IMMEDIATE ECHO
MOVEM B,TTYDEM ;SAVE CURRENT DEFERRED ECHO MODE
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVEI T,.TOWID ;PREPARE TO READ TTY WIDTH
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ TTY WIDTH
MOVEI B,^D80 ;ASSUME VT52-CLASS WIDTH
CAILE B,TTWMAX ;CAN WE HANDLE IT?
MOVEI B,TTWMAX ;NO, USE MOST WE SUPPORT
SUBI B,1 ;(WE START AT 0)
MOVEM B,SWIDTH ;SET SCREEN WIDTH
MOVEI T,.TOSTO ;PREPARE TO READ TERMINAL STOP
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ TERMINAL [NO] STOP
JRST TTYGE5 ;FALL BACK TO TERMINAL PAGE
MOVEM B,TTYSTO ;REMEMBER USER'S TERMINAL [NO] STOP SETTING
MOVEI T,.TOLNB ;PREPARE TO READ TERMINAL LENGTH
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ TERMINAL "FORMS" LENGTH
JRST TTYGE5 ;ASSUME NOT YET IMPLEMENTED
JUMPN B,TTYGE7 ;USE LENGTH IF ANY IS SET
MOVEI T,.TOSSZ ;PREPARE TO READ STOP SIZE
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ STOP SIZE
JRST TTYGE5 ;ASSUME NOT YET IMPLEMENTED
JUMPN B,TTYGE7 ;USE STOP SIZE IF ANY IS SET
TTYGE5: MOVEI T,.TOPSZ ;PREPARE TO READ PAGE SIZE
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;READ PAGE SIZE
SETZ B, ;ASSUME PAGE 0
MOVEM B,TTYPSZ ;SAVE CURRENT USER'S PAGE SIZE
TTYGE6: JUMPN B,TTYGE7 ;USE KNOWN PAGE SIZE
MOVE B,SCTYPE ;GET TTY TYPE
MOVE B,[DEC 63,20,12,24,24](B) ;HYPOTHESIZE A LENGTH
TTYGE7: CAILE B,TTLMAX ;CAN WE HANDLE IT?
MOVEI B,TTLMAX ;NO, THE MOST WE CAN HANDLE
MOVEM B,SSIZE ;SAVE SCREEN "SIZE"
MOVE T,B ;NEED TWO CONTIGUOUS REGISTERS
IMULI T,^D100 ;TO CALCULATE PERCENTAGE OF SCREEN
IDIVI T,^D120 ;TO USE FOR TEXT (20 OUT OF 24 LINES)
MOVEM T,DLENTH ;SET LENGTH OF TEXT AREA
MOVEM T,SLENTH ; . . .
IDIVI T,3 ;PREFERRED OFFSET FOR CURSOR
MOVEM T,CLENTH ;SET FOR OTHERS
POPJ P, ;WE HAVE READ ALL PERTINENT TTY INFO
;ROUTINE TO SET VARIOUS TTY MODES FROM OURTAB, OURFCR ETC.
;
;ENTER AT TTYSEC TO CLEAR THE TERMINAL INPUT STREAM COMMAND WHICH
;STARTED US UP (E.G., REENTER COMMAND) AND WHICH WOULD OTHERWISE PREVENT
;THE DISPLA ROUTINE FROM UPDATING THE SCREEN (IT WOULD THINK IT HAD
;TYPEAHEAD (THE MONITOR COMMAND) AND TERMINATE).
TTYSEC: MOVEI T,.TOSIP ;SKIP-IF-INPUT FUNCTION
MOVE TT,TTYUDX ;FOR OUR COMMAND TERMINAL
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;NUDGE TERMINAL AND CLEAR COUNTERS
JFCL ;DON'T CARE, AS LONG AS DISPLA DOES OUTPUT
TTYSET: TDZA A,A ;SETUP FROM OUR MODES
TTYRST: MOVEI A,1 ;RESET OLD TERMINAL MODES
SKIPN SCTYPE ;ONLY MUCK WITH USER TTY IF VIDEO SCREENING
POPJ P, ;HARDCOPY, LEAVE IT ALONE
MOVE TT,TTYUDX ;SET TTY UDX FOR TRMOP.S BELOW
MOVEI T,.TOTAB+.TOSET ;PREPARE TO SET TAB CONVERSION
MOVE TT1,OURTAB(A) ;GET TAB SETTING
MOVE B,[3,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;SET UP TTY TAB-SPACES SWITCH
JFCL ;IGNORE FAILURE
MOVEI T,.TONFC+.TOSET ;PREPARE TO SET FREE CRLF SETTING
MOVE TT1,OURFCR(A) ;GET STATE TO SET
MOVE B,[3,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;SET UP FREE CRLF SWITCH
JFCL ;ERROR IS OK
MOVEI T,.TOBLK+.TOSET ;PREPARE TO SET TTY NO BLANK SUPPRESSION
MOVE TT1,OURBLN(A) ;GET STATE TO SET
MOVE B,[3,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;SET TTY NO BLANK SUPPRESSION
JFCL ;ERROR IS OK
MOVEI T,.TODEM+.TOSET ;PREPARE TO SET DEFERRED ECHO MODE
MOVE TT1,OURDEM(A) ;GET STATE TO SET
MOVE B,[3,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;SET UP DEFERRED ECHO MODE
JFCL ;ERROR IS OK
MOVEI T,.TOSTO+.TOSET ;PREPARE TO SET STOP
MOVE TT1,OURSTO(A) ;GET STATE TO SET
MOVE B,[3,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;SET TERMINAL [NO] STOP
JRST TTYSE5 ;FAILED, USE TERMINAL PAGE INSTEAD
JRST TTYSE7 ;DO NOT USE PAGE TRMOP.!
TTYSE5: MOVEI T,.TOPSZ+.TOSET ;PREPARE TO SET PAGE SIZE 0
MOVE TT1,OURPSZ(A) ;GET STATE TO SET
MOVE B,[3,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;SET UP PAGE SIZE 0
JFCL ;ERROR IS OK
TTYSE7: POPJ P, ;USER'S TERMINAL HAS BEEN [RE]SET
;*** DO NOT SEPARATE OURFCR FROM TTYFCR, NOR OURTAB FROM TTYTAB ***
U OURFCR,1 ;WHAT TECO'S CRLF BIT IS
U TTYFCR,1 ;HOLDS CRLF BIT AS EXISTING THE LAST
;TIME WE WENT FROM MONITOR TO TECO
U OURTAB,1 ;WHAT TECO'S TAB-SPACE BIT IS
U TTYTAB,1 ;SAME FOR TAB-SPACES BIT
U OURBLN,1 ;WHAT TECO'S BLANK SUPRESSION IS
U TTYBLN,1 ;AND USER'S SELECTION
U OURDEM,1 ;WHAT TECO'S DEFERRED ECHO MODE IS
U TTYDEM,1 ;AND USER'S SELECTION
U OURPSZ,1 ;TECO'S PAGE SIZE
U TTYPSZ,1 ;ORIGINAL PAGE SIZE
U OURSTO,1 ;TECO'S [NO] STOP
U TTYSTO,1 ;ORIGINAL [NO] STOP
;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.
;CALL PUSHJ PDP,TYI
; RETURN
TYI: TXZE FF,TYOF ;NEED A TYO?
PUSHJ P,TYOOUT ;YES. DO SO.
TYI0: SKIPL CH,SCH ;IF SAVED CHARACTER IN SCH
JRST TYIB4 ;USE IT INSTEAD OF INPUTTING ONE FROM TTY
TXNE FF,CFOF ;READING FROM COMMAND FILE?
JRST TYICF ;YES, DIFFERENT BUFFER(S)
SOSG TIB+.BFCTR ;CHARS IN NORMAL MODE?
PUSHJ P,TYIIN ;NONE LEFT, GET ANOTHER BUFFERFUL
ILDB CH,TIB+.BFPTR ;YES. GET ONE
JUMPE CH,TYI0 ;FLUSH NULLS
TYI3: PUSHJ P,TEBCHR ;SAVE COMMAND CHARACTER IN CRASH RECOVERY FILE
TYI4: TXZ FF,TIBKA ;CLEAR CHARACTER MODE
TXZN FF,TINEC ;NO ECHO?
SKIPE CMFECH ;OR SUPPRESSING COMMAND FILE ECHO?
PJRST ALTLIN ;YES, DON'T DO ANY SPECIAL CHARACTER STUFF
; 1) ECHO <BEL> AS ^G
; 2) COUNT SCREEN SCROLLING
CAIE CH,.CHBEL ;NO, USER TYPE A <BEL>?
JRST TYI4NG ;NO, NO ECHO WORRIES THEN
MOVE CH,CHTBL(CH) ;YES, GET <BEL> ECHO CONTROL
TXZ CH,EC$SLF ;THE MONITOR ALREADY ECHOED THIS WAY
PJRST TYIEC0 ;SO JUST ECHO IT FOR HIM AS ^G
TYI4NG: CAIL CH," " ;CONTROL CHARACTER?
JRST ALTLIN ;NO (BUT WATCH FOR OLDE ALTMODES)
CAIL CH,.CHLFD ;VERTICAL MOTION CHARACTER?
CAILE CH,.CHFFD ; . . .
SKIPA CH,CHTBL(CH) ;NO, GET ECHO CONTROL BITS
JRST CNTLF ;YES, COUNT ANY EFFECTS ON SCREEN
TXNE CH,EC$CRL ;THIS CHARACTER ECHO WITH <CR><LF>?
JRST TYI5C ;YES, ACCOUNT FOR POSSIBLE SCROLLING
ANDI CH,177 ;NO, REDUCE TO JUST ASCII CHARACTER
POPJ P, ;AND GIVE IT TO CALLER
TYI5C: PUSH P,CH ;SAVE THE BITS/CHARACTER
MOVEI CH,.CHLFD ;PRETEND A LINE FEED
PUSHJ P,CNTLF ;NOTE SCREEN MAY HAVE SCROLLED
POP P,CH ;RESTORE THE BITS/CHARACTER
ANDI CH,177 ;AND REDUCE TO JUST CHARACTER
POPJ P, ;AND GIVE IT TO CALLER
TYIINZ: CLOSE TTYCHN, ;CLEAR EOF (^Z)
TYIIN: MOVEI CH,TTYIOS ;BASIC TTY STATUS
TXNE FF,TIBKA ;WANT SINGLE CHARACTER?
IORI CH,IO.BKA ;YEAH
TXNE FF,TINEC ;WANT TO SUPPRESS ECHO?
IORI CH,IO.SUP ;YEAH
CAME CH,TTSTS ;SAME IOS AS LAST PASS THROUGH HERE?
SETSTS TTYCHN,(CH) ;NO, CHANGE TO NEW TERMINAL MODE
MOVEM CH,TTSTS ;SAVE NEW LAST STATUS
IFN RUN603,<
TXNE CH,IO.BKA ;WANT CHARACTER MODE HERE?
JRST [INCHRW CH ;YES, PICK UP SINGLE CHARACTER
JRST CPOPJ1] ;AND SKIP TYI0'S "ILDB"
> ;END IFN RUN603
IN TTYCHN, ;ASK FOR INPUT
POPJ P, ;GOT IT, RETURN TO READ IT
STATZ TTYCHN,IO.EOF ;END OF FILE?
JRST TYIINZ ;GO CLEAR EOF
OUTSTR [ASCIZ\? I/O error reading from command terminal\]
EXIT ;AND THAT IS THE END OF THAT
TYIB4: SETOM SCH ;SO CHARACTER IS INPUT NEXT TIME
POPJ P,
;CONVERT 175 & 176 TO ALTMODE (033) UNLESS TTY NOALT IS ON
ALTLIN: CAIL CH,175 ;OLD ALTMODE?
CAILE CH,176
POPJ P, ;NO
TXNN F2,NOALT ;TEST TTY NOALT BIT
ALTX: MOVEI CH,.CHESC ; CONVERT TO 033
POPJ P,
;CONVERT 175 & 176 TO ALTMODE (033) IF EO = 1
ALTEO: CAIE CH,175 ;OLD ALTMODE?
CAIN CH,176
CHKEO EO21,ALTX ;RUNNING OLD MACRO? IF SO, CONVERT
POPJ P, ;NO, 175=RIGHT BRACE, 176=TILDE
;HERE TO READ CHARACTER FROM COMMAND FILE RATHER THAN TTY:
TYICF: SOSL CMFIBH+.BFCTR ;ANY CHARACTERS LEFT?
JRST TYICF3 ;YES, KEEP READING THEM
PUSHJ P,TYICN ;NO, READ ANOTHER BUFFER
SKIPA CH,COMCNT ;EOF, GET COMMAND CHARACTER COUNT
JRST TYICF ;GOT MORE CHARACTERS, COUNT EM DOWN
SKIPE EQM ;IF REQUEST FROM A MACRO, OK
JRST TYI ; (MUST BE FROM CMCCT)
JUMPE CH,GO ;NO, IF NO OUTSTANDING COMMANDS, RESTART
; AND REFRESH SCREEN AS NEEDED
$WARN (EOC,,<End of command file with unterminated commands pending>)
JRST TYI ;AND GET REGULAR TTY COMMANDS
TYICF3: ILDB CH,CMFIBH+.BFPTR;YES, READ NEXT COMMAND FILE CHARACTER
AOS CMFCTR ;BUMP CHARACTER COUNTER
JUMPE CH,TYICF ;DISCARD NULLS
SKIPN CMFECH ;USER REQUEST ECHOING OF THE COMMAND FILE?
CAIN CH,.CHDEL ;YES, BUT DON'T ECHO RUBOUTS
JRST TYI4 ;RETURN COMMAND CHARACTER (BUT DON'T WRITE
; IT IN CRASH RECOVERY FILE!)
TXNE FF,TINEC ;SUPPRESSING INPUT ECHO?
JRST TYI4 ;YES, IF IT NEEDS ECHOING, IT WILL BE ECHOED LATER
PUSH P,A ;SAVE SOME ACS
PUSH P,AA ; THAT TYOM KRUMPS UPON
CAIN CH,.CHLFD ;A <LF>???
SOS CURLIN ;YES, CNTLF GETS CALLED BY TYI AND TYO . . .
PUSHJ P,TYOM ;"ECHO" THE COMMAND FILE CHARACTER
POP P,AA ;RESTORE POSSIBLE TROUNCED ACS
POP P,A ; . . .
JRST TYI4 ;PROCESS COMMAND CHARACTER NORMALLY
;READ ANOTHER BUFFER, POPPING UP TO PREVIOUS FILE ON EOF
TYICN: IN CMFCHN, ;READ NEXT BUFFER
JRST CPOPJ1 ;RETURN WITH CHARACTERS
STATO CMFCHN,IO.EOF ;END OF FILE?
JRST TYICE2 ;NO, I/O ERROR, GO COMPLAIN
TXZ FF,CFOF ;NO MORE COMMAND FILE (PROBABLY)
RELEAS CMFCHN, ;LET GO OF USED-UP FILE
SOSG CMFLVL ;DECREMENT NESTING COUNT
JRST TYICNZ ;ALL FILES USED UP, BACK TO TTY:
;HERE ON EOF FROM COMMAND FILE NESTED WITHIN ANOTHER COMMAND FILE,
;"POP" BACK TO PREVIOUS COMMAND FILE AND CONTINUE PROCESSING
PUSH P,A ;NEED A COUPLA ACS HERE
PUSH P,AA ; . . .
MOVE A,CMFPDP ;COMMAND FILE STACK POINTER
SUBI A,CMFLEN ;"POP" THE POINTER
MOVEM A,CMFPDP ;SAVE NEW POINTER FOR NEXT TIME
HRLZ A,A ;LEFT HALF OF BLT POINTER
HRRI A,CMFBLK ;POINT TO "ACTIVE" COMMAND FILE AREA
BLT A,CMFBLK+CMFLEN-1 ;"POP" PREVIOUS COMMAND FILE SPECS
MOVE A,[CMFBLK,,COMBLK] ;BLT POINTER TO
BLT A,COMBLK+COMBLN-1 ;SET UP SPEC IN FILE SPEC AREA
PUSHJ P,FILALT ;GO SETUP OPEN AND LOOKUP BLOCKS
PUSHJ P,CMFOPN ;OPEN AND SET UP FOR I/O
MOVE A,CMFCTR ;CHAR POSITION IN FILE WE WERE LAST AT
IDIVI A,<BLKSIZ*5> ;A:=BLOCK NUMBER IN FILE
USETI CMFCHN,1(A) ;SET TO READ THAT PARTICULAR BLOCK
IN CMFCHN, ;AND BRING IT IN
CAIA ;GOOD
JRST TYICE2 ;CAN'T GET EOF SO MUST BE ERROR
MOVN AA,AA ;DON'T HAVE SUB AC FROM MEM
ADDM AA,CMFIBH+.BFCTR;SO DO ADD NEGATIVE INSTEAD
IBP CMFIBH+.BFPTR ;BUMP BYTE POINTER PAST ALREADY READ CHARS
AOJL AA,.-1 ;LOOP FOR ALL OF THEM
; (CAN'T DO ADJBP SINCE IT DOESN'T DO THE
; RIGHT THING IN THIS CASE)
TXO FF,CFOF ;COMMAND FILE OPEN AGAIN
POP P,AA ;RESTORE ACS USED UP
POP P,A ; . . .
JRST CPOPJ1 ;BACK TO TYICF TO READ A CHARACTER
;COMMAND FILE I/O ERROR ROUTINE(S)
TYICE2: GETSTS CMFCHN,B ;I/O STATUS IN B FOR ERRP
PUSHJ P,TYICNR ;ABORT AND CLEAR COMMAND FILE
$FATAL (INP,,<Input error 11 on file 09>)
;CLEAR COMMAND FILE PROCESSING
TYICNR: RELEAS CMFCHN, ;TOSS OUT FILE
TYICNZ: SETZM CMFLVL ;NO COMMAND FILES NESTED
SETZM CMFECH ;NO LONGER SUPPRESSING TYI ECHO
SETZM CMFTYO ;NOR GENERAL PROGRAM OUTPUT
SETZM CMFPDP ;NO MORE SPECS ON THE STACK
TXZ FF,CFOF ;COMMAND FILE PROCESSING IS DEAD
;RDH SETOM MESFLG ;SCREEN NEEDS REFRESHING
POPJ P, ;ET C'EST CA.
;TYIEC -- "ECHO" A COMMAND CHARACTER
;CALL IS:
;
; MOVX CH,<CHAR>
; PUSHJ P,TYIEC
; RETURN
;
;WHERE <CHAR> IS THE 7-BIT ASCII COMMAND CHARACTER TO BE ECHOED JUST AS
;WOULD THE MONITOR.
;
;PRESERVES ALL ACS.
TYIEC: CAIN CH,.CHDEL ;A <DEL>
IORI CH,1000 ;YES
CAIGE CH," " ;NORMAL PRINTING ASCII?
SKIPA CH,CHTBL(CH) ;NO, CONTROL, FETCH ECHO BITS
TXO CH,EC$SLF ;YES, JUST ECHO AS SELF
TRZE CH,1000 ;WAS IT A <DEL>?
ANDI CH,177 ;YES, RUBOUTS DON'T ECHO AT ALL
;NOW ECHO THE CHARACTER TO THE TERMINAL AS WOULD THE MONITOR
TYIEC0: PUSH P,CH ;SAVE THEM
TXNN CH,EC$UPA ;ECHO IN ^X FORM?
JRST TYIEC2 ;NO
MOVEI CH,"^" ;YES, FIRST THE UP-ARROW
PUSHJ P,TYOM ;OUTPUT IT
HRRZ CH,0(P) ;THE CHARACTER AGAIN
TRO CH,100 ;ASCIIIZE IT
PUSHJ P,TYOM ;AND OUTPUT IT TOO
MOVE CH,0(P) ;CHARACTER AND FLAGS AGAIN
TYIEC2: TXNN CH,EC$SLF ;ECHO LITERALLY
JRST TYIEC3 ;NO
ANDI CH,177 ;YES
PUSHJ P,TYOM ;OUTPUT CHARACTER
MOVE CH,0(P) ;RESTORE FLAGS AND CHARACTER
TYIEC3: TXNN CH,EC$DLR ;ECHO AS "$" (I.E., ALTMODE)
JRST TYIEC4 ;NO
MOVEI CH,"$" ;YES
PUSHJ P,TYOM ;SO OUTPUT THE DOLLAR SIGN
MOVE CH,0(P) ;RESTORE FLAGS AND CHARACTER
TYIEC4: TXNN CH,EC$CRL ;CHARACTER GET <CR><LF> APPENDED?
JRST TYIEC5 ;NO
MOVEI CH,.CHCRT ;YES, FIRST THE <CR>
PUSHJ P,TYOM ;OUTPUT IT
MOVEI CH,.CHLFD ;THEN THE <LF>
PUSHJ P,TYOM ;OUTPUT IT TOO
TYIEC5: POP P,CH ;RESTORE STACK AND CHARACTER
ANDI CH,177 ;AND NOTHING BUT THE CHARACTER
POPJ P, ;RETURN
;THE CHARACTER TABLE
CHTBL: EC$UPA+.CHNUL ;000 NUL
EC$UPA+.CHCNA ;001 ^A
EC$UPA+.CHCNB ;002 ^B
EC$UPA+.CHCNC ;003 ^C
EC$UPA+.CHCND ;004 ^D
EC$UPA+.CHCNE ;005 ^E
EC$UPA+.CHCNF ;006 ^F
EC$UPA+EC$SLF+.CHBEL ;007 ^G (BELL)
EC$UPA+.CHCNH ;010 ^H (BACKSPACE)
EC$SLF+.CHTAB ;011 ^I (TAB)
EC$SLF+.CHLFD ;012 ^J (LINE FEED)
EC$SLF+.CHVTB ;013 ^K (VERTICAL TAB)
EC$SLF+.CHFFD ;014 ^L (FORM FEED)
EC$SLF+.CHCRT ;015 ^M (CARRIAGE RETURN)
EC$UPA+.CHCNN ;016 ^N
EC$UPA!EC$CRL+.CHCNO ;017 ^O
EC$UPA+.CHCNP ;020 ^P
.CHCNQ ;021 ^Q (XON)
EC$UPA+.CHCNR ;022 ^R
.CHCNS ;023 ^S (XOFF)
.CHCNT ;024 ^T
EC$UPA+.CHCNU ;025 ^U
EC$UPA+.CHCNV ;026 ^V
EC$UPA+.CHCNW ;027 ^W
EC$UPA+.CHCNX ;030 ^X
EC$UPA+.CHCNY ;031 ^Y
EC$UPA!EC$CRL+.CHCNZ ;032 ^Z (EOF)
EC$DLR+.CHESC ;033 ^[ (ESCAPE)
EC$UPA+.CHCBS ;034 ^\
EC$UPA+.CHCRB ;035 ^]
EC$UPA+.CHCCF ;036 ^^
EC$UPA+.CHCUN ;037 ^_
;HERE WHEN A LINE FEED PASSES THE SCREEN, TO NOTE WHEN SCROLLING OCCURS
CNTLF: CAIL CH,.CHLFD ;VERTICAL CHARACTER MOTION?
CAILE CH,.CHFFD ; . . .
POPJ P, ;NO
PUSH P,CH ;YES, SAVE IT
CAIN CH,.CHLFD ;<LF>?
MOVEI CH,1 ;YES
CAIN CH,.CHVTB ;<VT>?
MOVEI CH,4 ;YES
CAIN CH,.CHFFD ;<FF>?
MOVEI CH,10 ;YES
PUSH P,CH ;SAVE COUNT OF LINES THIS CHARACTER IS WORTH
CNTLF2: AOS CH,CURLIN ;COUNT CURSOR MOVEMENT DOWNWARDS
SUB CH,SSIZE ;FORCED SCREEN TO SCROLL YET?
JUMPL CH,CNTLF8 ;NO
SETOM SCRLED ;NOTE THE SCREEN HAS ACTUALLY SCROLLED
MOVE CH,[WINDOW+WINDEX,,WINDOW] ;YES, SCREEN SCROLLED A LINE
BLT CH,WINDOW+WINTOP-WINDEX-1 ;SO SCROLL OUR COPY TOO
SETOM WINDOW+WINTOP-WINDEX ;LAST LINE NOW BLANK
MOVE CH,[WINDOW+WINTOP-WINDEX,,WINDOW+WINTOP-WINDEX+1]
BLT CH,WINDOW+WINTOP-1 ;SO BLANK OUR COPY TOO
PUSH P,A ;NEED
PUSH P,AA ; TO
PUSH P,B ; SAVE
PUSH P,C ; LOTS
PUSH P,D ; OF
PUSH P,E ; ACS
PUSH P,T ; .
PUSH P,TT ; .
PUSH P,TT1 ; .
PUSH P,I ; .
PUSH P,OU ; .
DMOVE A,SCRNA ;SCREEN BASE
MOVEI D,1 ;WANT TO MOVE DOWN A LINE
PUSHJ P,DISMV ;CALL THE MAGIC ROUTINE
DMOVEM A,SCRNA ;SET FOR NEXT CALL TO WINFIL
POP P,OU ; .
POP P,I ; .
POP P,TT1 ; .
POP P,TT ; .
POP P,T ; .
POP P,E ; NEED
POP P,D ; TO
POP P,C ; RESTORE
POP P,B ; LOTS
POP P,AA ; OF
POP P,A ;ACS
SOS CURLIN ;BACKUP CURSOR TO LAST LINE AGAIN
CNTLF8: SOSLE (P) ;NEED TO ACCOUNT FOR MORE LINES?
JRST CNTLF2 ;YES, GO BACK AND DO IT AGAIN
POP P,CH ;NO, JUNK COUNT WORD
POP P,CH ;RESTORE CALLER'S CHARACTER
POPJ P, ;AND RETURN TO WHOMEVER
U SCH,1 ;HOLDS SAVED CHARACTER TO BE "INPUT" NEXT
; INSTEAD OF TYPED IN ONE
U SCRLED,1 ;.LT. 0 IF SCREEN SCROLLED DUE TO TYPEIN
U COLUMN,1 ;PRINTING COLUMN
U CURLIN,1 ;DISPLAY CURSOR IS CURRENTLY ON THIS LINE #
;ROUTINE TO TYPE A CHARACTER.
;CALL AS FOLLOWS:
;FOR TYPING TEXT: FOR TYPING MESSAGES:
; MOVE CH,CHARACTER MOVE CH,CHARACTER
; PUSHJ P,TYO PUSHJ P,TYOM
; RETURN RETURN
;UNLESS TYOCTF IS TRUE, CONTROL CHARACTERS ARE TYPED WITH "^"
;FOLLOWED BY THE CORRESPONDING PRINTING CHARACTER.
;
;USES ACS A AND AA
TYOS: TXOA F2,TYSPCL ;TYPE <CR>, ETC INSTEAD OF PRINTER CONTROLS
TYOM: TXZ F2,TYSPCL ;CLR SPECIAL TYPEOUT FLAG
TXOA F2,TYMSGF ;SET NO-CASE-FLAGGING FLAG
TYO: TXZ F2,TYMSGF+TYSPCL;CLR NO-CASE-FLAGGING FLAG & SPECIAL FLAG
PUSHJ P,ALTEO ;CHECK FOR FUNNY ALTMODES
TXNE F2,TYSPCL ;ARE WE TYPING <ALT>, <CR> ETC. ??
JRST TYOSP ;YES, LOOK FOR SPECIAL CASES
TYO2: CAIN CH,.CHTAB ;IS IT A TAB ??
JRST TYOTAB ;YES
CAIN CH,.CHLFD ;LINEFEED??
JRST TYOLF ;YES
CAIN CH,.CHCRT ;CARRIAGE RETURN ??
JRST TYOCR ;YES
CAIN CH,.CHESC ;ESCAPE??
JRST TYOESC ;YES
CAIE CH,.CHFFD ;<FF>?
CAIN CH,.CHBEL ;A <BEL>?
JRST TYOBEL ;YES, JUST OUTPUT IT
CAIN CH,.CHCNH ;<BS>?
JRST TYOBS ;YES
CAIG CH,37 ;SKIP IF NON-CONTROL
JRST TYOCT ;HANDLE NON-FORMATTING CONTROLS
PUSHJ P,SFLAGC ;SKIP IF CHARACTER WRONG CASE
CAIA ;IT'S THE CORRECT CASE
JRST TYOFLG ;FLAG WRONG CASE CHARACTERS
TYOCH: AOS COLUMN ;YES, SO REMEMBER TO INCREMENT IT FOR CHARACTER
JRST TYOA ;FINALLY....GO TYPE THE BLASTED CHARACTER !!!
TYOBEL: TXNN F2,TYMSGF ;MESSAGE OR TEXT?
TYOCT: TXNE FF,TYOCTF ;WANT TO OUTPUT CONTROL LITERALLY?
JRST TYOA ;TYPE CONTROL CHARACTER LITERALLY
PUSH P,CH ;SAVE CONTROL-CHARACTER TO BE TYPED
MOVEI CH,"^" ;GET UPARROW
PUSHJ P,TYO ;TYPE IT
MOVE CH,(P) ;GET CONTROL CHARACTER, BUT LEAVE IT ON THE STACK
ADDI CH,100 ;MAKE IT CORRESPONDING NON-CONTROL
JRST TYOFL5 ;TYPE X OF ^X
TYOFLG: PUSH P,CH ;SAVE CHARACTER
MOVEI CH,CFLAG ;GET WRONG CASE SYMBOL
PUSHJ P,TYO ;TYPE WRONG CASE FLAG
MOVE CH,(P) ;GET CHARACTER ORIGINALLY TO BE PRINTED
TYOFL5: PUSH P,TYCASF ;SAVE CURRENT CASE SWITCH
SETOM TYCASF ;SET CASE TO 0 SO NO FLAGGING
PUSHJ P,TYO ;OF X PART OF ^X
POP P,TYCASF ;RESTORE CASE SWITCH
POP P,CH ;AND ORIGINAL CONTROL CHARACTER
POPJ P, ;AND RETURN
TYOBS: SKIPN SCTYPE ;ON VIDEO SCREEN?
JRST TYOCT ;NO, RANDOM CONTROL CHARACTER
SOSGE COLUMN ;BACKSPACE MOVES CURSOR BACKWARDS
SETZM COLUMN ;***KROCK
JRST TYOA ;OUTPUT THE CHARACTER WITHOUT FURTHER ADO
TYOTAB: MOVE CH,COLUMN ;GET CURRENT COLUMN COUNT
;RDH CAML CH,SWIDTH ;ARE WE AT RIGHT MARGIN?
;RDH PUSHJ P,CRR ;YES, SO GO TO NEXT LINE
;RDH MOVE CH,COLUMN ;GET CURRENT COLUMN COUNT
ADDI CH,8 ;ADD 8 TO IT FOR TAB COUNT
TRZ CH,7 ;BUT JUST GO TO NEXT MULTIPLE OF 8
SUB CH,COLUMN ;CH:=COUNT OF POSITIONS TO NEXT TAB STOP
ADDM CH,COLUMN ;UPDATE COLUMN POSITION COUNTER NOW
PUSH P,CH ;SAVE COUNT
MOVEI CH," " ;GET TAB SIMULATOR CHARACTER (SPACE)
PUSHJ P,TYOA ;OUTPUT A SPACE (ERASING SCREEN SLOT)
SOSLE (P) ;COUNT IT DOWN
JRST .-2 ;FILL ENTIRE TAB SLOT
POP P,CH ;RESTORE STACK
MOVEI CH,.CHTAB ;RETURN WHAT WE WERE CALLED WITH
POPJ P, ;RETURN TO CALLER
TYOCR: SETZM COLUMN ;SET COLUMN TO 0 BECAUSE CR GOES TO LEFT MARGIN
MOVEI CH,.CHCRT ;REMEMBER WE STARTED WITH CR
JRST TYOA ;TYPE CARRIAGE RETURN
TYOESC: MOVEI CH,"$" ;ALTMODE PRINTS AS DOLLAR SIGN
PUSHJ P,TYO ;TYPE DOLLAR SIGN
MOVEI CH,.CHESC ;RESTORE CH AS ESCAPE
POPJ P,
;HERE TO TYPE OUT CHARACTERS IN THE FORM <ESC>, ETC.
TYOSP: PUSH P,A ;SAVE A
PUSH P,CH ;AND CH TOO
MOVEI A,TSPTBL ;SPECIAL CHARACTER-NAMES TABLE
TYOSP2: LDB CH,[POINT 7,(A),35] ;LOOK AT TABLE ENTRY
JUMPE CH,TYOSP9 ;NOT A SPECIAL CHARACTER
CAME CH,(P) ;SPECIAL CASE CHARACTER?
AOJA A,TYOSP2 ;NOT THIS ONE, LOOK AT REST OF THE TABLE
MOVEI CH,"<" ;YES, START OF SPECIAL TYPEOUT
PUSHJ P,TYOCH ;OUTPUT CHARACTER
TLOA A,(POINT 7,) ;MAKE BYTE POINTER TO SPECIAL TYPEOUT
TYOSP5: PUSHJ P,TYOCH ;OUTPUT ANOTHER CHARACTER
ILDB CH,A ;FETCH NEXT FUNNY CHARACTER
JUMPN CH,TYOSP5 ;AND TYPE IT OUT
MOVEI CH,">" ;END OF SPECIAL CASE NAME
PUSHJ P,TYOCH ;TYPE IT OUT
POP P,CH ;RESTORE REAL CHARACTER
POP P,A ;AND SCRATCH AC USED
POPJ P, ;RETURN TO TYOS CALLER
TYOSP9: POP P,CH ;RESTORE CHARACTER
POP P,A ;AND SCRATCH AC TROUNCED
JRST TYO2 ;TYPE OUT NORMALLY
;THE SPECIAL NAME TABLE FOR CHARACTERS
TSPTBL: <ASCII "BEL"> + .CHBEL ;^G = <BEL>
<ASCII "TAB"> + .CHTAB ;^I = <TAB>
<ASCII "LF"> + .CHLFD ;^J = <LF>
<ASCII "VT"> + .CHVTB ;^K = <VT>
<ASCII "FF"> + .CHFFD ;^L = <FF>
<ASCII "CR"> + .CHCRT ;^M = <CR>
<ASCII "ESC"> + .CHESC ;^[ = <ESC>
EXP 0 ;END OF TABLE
TYOLF: PUSHJ P,CNTLF ;GO NOTE LINE WENT OUT
;AND OUTPUT IT
TYOA: SOSG TOB+.BFCTR ;OUTPUT SPACE AVAILABLE?
PUSHJ P,TYOOUT ;NO, DO OUTPUT
IDPB CH,TOB+.BFPTR ;STUFF CHARACTER IN OUTPUT BUFFER
TXO FF,TYOF ;MARK OUTPUT PENDING IN BUFFER
AOS TYOTCT ;COUNT TOTAL ACTIVITY
POPJ P, ;RETURN
TYOOUT: TXZ FF,TYOF ;NOTE NO NEED FOR OUTPUT ANYMORE
OUT TTYCHN, ;GIVE CURRENT BUFFER TO MONITOR
POPJ P, ;RETURN WITH NEW BUFFER
POPJ P, ;IGNORE ERROR FOR NOW
;TTY OPEN BLOCK
TTYBLK: TTYIOS ;INITIAL I/O STATUS
'TTY ' ;AIM FOR TTY DEVICE
TOB,,TIB ;RING HEADERS FOR I/O
TTYPT: POINT 7,TTIBF1+3 ;CCL COMMAND BUFFER POINTER
TTYPT2: POINT 7,TTIBF1+3,13 ;TO INSERT FILE NAME AFTER EW OR EB
U TYIPT,1 ;
U TIB,3 ;BUFFER HEADER
U TTIBF1,<TTIBFN*<TTIBSZ+3>> ;TERMINAL INPUT BUFFER RING
U TOB,3 ;DITTO
U TTOBF1,<TTOBFN*<TTOBSZ+3>> ;TERMINAL OUTPUT BUFFER RING
U TTSTS,1 ;CURRENT TERMINAL I/O MODE
U TTYUDX,1 ;UDX OF TTY ON TTY CHANNEL
U TYOTCT,1 ;COUNT OF TERMINAL OUTPUT SINCE START OF CMD
U IBUF,3 ;INPUT TEXT FILE BUFFER RING HEADER
U OBUF,3 ;OUTPUT TEXT FILE BUFFER RING HEADER
U BICNT,1 ;.EQ. 0 THEN INPUT BUFFER RING NOT SETUP
;.GT. 0 THEN COUNT OF BUFFERED INPUTS (+1)
U BOCNT,1 ;.EQ. 0 THEN OUTPUT BUFFER RING NOT SETUP
;.GT. 0 THEN COUNT OF BUFFERED OUTPUTS (+1)
U IOFIR,1 ;FIRST PAGE IN USE FOR I/O
U IOLIST,4 ;DUMP-MODE I/O COMMAND LIST
;INBMES -- TYPE OUT A MESSAGE, INSURING A FRESH LINE
;CALL IS:
;
; PUSHJ P,INBMES
; ASCIZ\TEXT\
; RETURN
;
;USES CH
INBMES: SKIPE COLUMN ;IN COLUMN 0 (LEFT MARGIN)
PUSHJ P,CRR ;NO, ISSUE A CRLF
INLMES: PUSH P,A ;PRESERVE AC "A"
HRRZ A,-1(P) ;GET LOCAL ADDRESS OF ASCIZ STRING
TLOA A,(POINT 7,) ;MAKE INTO A BYTE POINTER AND SKIP INTO LOOP
INLME2: PUSHJ P,TYOM ;OUTPUT THIS CHARACTER
ILDB CH,A ;GET THE NEXT CHARACTER
JUMPN CH,INLME2 ;AND OUTPUT IT
HRRI A,1(A) ;ADVANCE PAST JUNK
HRRM A,-1(P) ;AND SET RETURN ADDRESS
POP P,A ;RESTORE AC "A"
PJRST CRR ;CAP OFF THE MESSAGE WITH A <CR><LF>
;ROUTINE TO OUTPUT DECIMAL (OCTAL IF OCTALF 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 GREATER THAN 0?
MOVEI CH,"-" ;NO. OUTPUT -
PUSHJ P,@LISTF5
MOVMS B ;B:=ABSOLUTE VALUE OF B
DPT1: MOVEI A,12 ;RADIX 10
TXNE F2,OCTALF ;OCTAL RADIX?
MOVEI A,10 ;YES, CHANGE TO RADIX 8
DPT3: IDIVI B,(A) ;E:=DIGIT
PUSH P,E ;PUT DIGIT ON TOP OF PUSH DOWN LIST
CAIE B,0 ;DONE?
PUSHJ P,DPT3 ;NO. PUSH THIS DIGIT AND PRINT RETURN ADDRESS.
POP P,CH ;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: MOVEI CH,.CHCRT ;A <CR>
PUSHJ P,TYOM ;OUTPUT IT
MOVEI CH,.CHLFD ;AND A <LF>
PJRST TYOM ;OUTPUT IT AND RETURN
SUBTTL CRASH RECOVERY FILE ROUTINES
;THE TEB??? ROUTINES (AND ASSOCIATED VARIABLES) WRITE THE CRASH RECOVERY
;FILE WHICH CONTAINS VERBATIM EVERY CHARACTER TYPED IN BY THE USER (YES,
;EVEN RUBOUTS!). CCL CHARACTERS ARE INCLUDED, BUT ALL OTHER COMMAND FILE
;CHARACTERS (E@ FILES) ARE EXCLUDED.
;
;THE CRASH RECOVERY FILE IS CONTROLLED BY THE /CRDISP SWITCH, WHICH
;TAKES "NEVER", "TEMPORARY", "DELETE", OR "PRESERVE" AS ARGUMENTS.
;"NEVER" TURNS OFF CRASH RECOVERY. "TEMPORARY" WRITES THE RECOVERY FILE
;AS NNNTEB.TMP AND DELETES IT ON EXIT. "DELETE" WRITES THE RECOVERY FILE
;AS NNNTEB.TEB (SO LOGOUT WON'T GET IT) AND DELETES IT ON EXIT. "PRESERVE"
;WRITES THE RECOVERY FILE AS NNNTEB.TEB AND DOESN'T DELETE IT.
;
;FURTHER, THE USER CAN SPECIFY THE CRASH RECOVERY FILE EXPLICITLY
;VIA /CRFILE:FILESPEC.
;
;THE CRASH RECOVERY FILE IS AUTOMATICALLY UPDATED EVERY TEBSAV CHARACTERS
;(ACTUALLY THE FIRST BREAK CHARACTER AFTER TEBSAV CHARACTERS) AND IN ANY
;CASE EVERY BLOCK'S WORTH (640 DECIMAL).
;CRASH RECOVERY IMPURE DATA
U TEBINF,1 ;.NE. 0 THEN TEBINI HAS BEEN CALLED
U TEBING,1 ;.NE. 0 THEN CRASH FILE BEING WRITTEN
U TEBCNT,1 ;COUNT OF CHARACTERS TILL NEXT CHECKPOINT
U TEBOBH,3 ;OUTPUT BUFFER RING HEADER BLOCK
U TEBOBF,BLKSIZ+3 ;OUTPUT BUFFER RING (1 BUFFER ONLY)
;TEBINI -- INITIALIZE CRASH RECOVERY FILE FOR WRITTING
TEBINI: SETOM TEBINF ;TEBINI HAS BEEN CALLED
SETZM TEBING ;BUT WE'RE NOT WRITING THE FILE (YET)
MOVE TT,S.CRDI ;/CRDISP SETTING
CAIN TT,$TBNEV ;/CRDISP:NEVER?
POPJ P, ;YES, THEN NO CRASH RECOVERY FILE
;SUPPLY DEFAULT CRASH FILE IF USER DIDN'T GIVE ONE
MOVSI A,'DSK' ;DEFAULT CRASH FILE DEVICE
SKIPN S.CRFI+.FXDEV ;/CRFILE GIVE A DEVICE?
MOVEM A,S.CRFI+.FXDEV ;NO, USE OUR DEFAULT
SKIPGE TT,S.CRDI ;/CRDISP SETTING
MOVEI TT,$TBTEM ;NONE, DEFAULT IS /CRDISP:TEMPORARY
MOVE A,TMPTEC ;SIXBIT/NNNTEC/
SUBI A,1 ;SIXBIT/NNNTEB/ (IN CASE .TMP EXTENSION)
SETO AA, ; -1 = NO WILDCARDS
SKIPN S.CRFI+.FXNAM ;/CRFILE GIVE A FILENAME?
DMOVEM A,S.CRFI+.FXNAM ;NO, USE NNNTEB AS A DEFAULT
MOVSI A,'TEB' ;TEB EXTENSION
CAIN TT,$TBTEM ;/CRDISP:TEMPORARY?
MOVSI A,'TMP' ;YES, LET LOGOUT DELETE IT FOR US
SKIPN S.CRFI+.FXEXT ;/CRFILE GIVE AN EXTENSION?
HLLOM A,S.CRFI+.FXEXT ;NO, USE DEFAULT (,,-1 = NO WILDCARDS)
MOVX B,FX.DIR ;THE DIRECTORY-TYPED FLAG
TDNE B,S.CRFI+.FXMOM ;/CRFILE GIVE A DIRECTORY?
JRST TEBIN1 ;YES
IORM B,S.CRFI+.FXMOM ;NO, WE ARE SUPPLYING ONE THEN
IORM B,S.CRFI+.FXMOD ;AND IT IS TO BE [,]
SETZM S.CRFI+.FXDIR ; . . .
SETOM S.CRFI+.FXDIM ; -1 = NO WILDCARDS
TEBIN1: MOVEI A,TEBPRT ;DEFAULT CRASH FILE PROTECTION
SKIPE FDAEM ;IS THIS A FILE-DAEMON SYSTEM?
TRO A,400 ;YES
SKIPL S.CRPR ;USER SPECIFY /CRSPRO?
MOVE A,S.CRPR ;YES, USE HIS EXPLICIT PROTECTION THEN
DPB A,[POINTR S.CRFI+.FXMOD,FX.PRO] ;SUPPLY PROTECTION
MOVEI A,FX.PRO ;THE PROTECTION MASK
DPB A,[POINTR S.CRFI+.FXMOM,FX.PRO] ;SET MASK TOO
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;NOW SETUP THE OPEN AND LOOKUP BLOCKS FROM THE SCAN BLOCK
SETZM XFIBLK ;INITIALIZE FIRST WORD OF FILE BLOCK
MOVE A,[XFIBLK,,XFIBLK+1] ;BLT POINTER TO
BLT A,XFIBLK+XFILEN-1 ;INITIALIZE ENTIRE FILE BLOCK
MOVEI A,XFILEN ;LENGTH OF ENTER BLOCK
MOVEM A,XCNT ;SET IN ENTER BLOCK
JSP OU,CALLSW ;THIS IS A TOTALLY DISGUSTING KROCK!
.FXLEN,,S.CRFI ;T1/SCAN BLOCK
IFIW TEBIX ;ADDRESS OF ROUTINE TO GO TO .STOPB
JRST TEBIF5 ;WILDCARDS?
MOVX A,UU.RRC ;ASCII, AUTO UPDATE OF RIB
IFN RUN603,<SETZ A,> ;6.03 WILL GIVE ?ILL DATA MODE . . .
IORM A,OPNSTS ;SET INITIAL I/O STATUS
MOVSI A,TEBOBH ;ADDRESS OF OUTPUT BUFFER RING HEADER
MOVEM A,OPNBUF ;SET IN OPEN BLOCK
OPEN TEBCHN,OPNBLK ;INITIALIZE I/O CHANNEL
JRST TEBIF1 ;CAN'T OPEN DSK:?????????
;WE HAVE OUTPUT DEVICE, VERIFY IT'S USEFULLNESS
MOVEI A,OPNBLK ;I/O CHANNEL
DEVSIZ A, ;SEE HOW BIG BUFFERS SHOULD BE
MOVEI A,BLKSIZ+3 ;ASSUME OK
ANDI A,-1 ;JUST BUFFER SIZE (INC OVERHEAD)
SUBI A,2 ;JUST BUFFER SIZE
CAIE A,BLKSIZ+1 ;RIGHT SIZE?
JRST TEBIF3 ;NO, FORGET IT
HRLI A,TEBOBF+.BFHDR ;ADDRESS OF BUFFER IN RING
MOVSM A,TEBOBF+.BFHDR ;SETUP BUFFER RING
HRRI A,(BF.VBR) ;VIRGIN BUFFER RING BIT
MOVSM A,TEBOBH+.BFADR ;LINK RING TO HEADER BLOCK
SETZM TEBOBH+.BFCTR ;FORCE INITIAL OUT
;NOW CREATE OUTPUT FILE
ENTER TEBCHN,XFIBLK ;CREATE THE RECOVERY FILE
JRST TEBIF4 ;CREATE ERROR
;ALL SET FOR CRASH RECOVERY FILE WRITING
SETOM TEBING ;WE ARE NOW LOGGING ALL INPUT
POPJ P, ;RETURN ALL SET
;JUNK KROCK ROUTINE FOR CALLING .STOPB
TEBIX: MOVEI T2,OPNBLK ;ADDRESS OF OPEN BLOCK
MOVE T3,[XFILEN,,XFIBLK] ;LENGTH,,ADDRESS OF ENTER BLOCK
MOVEI T4,PTHBLK ;AND A PATH BLOCK WE CAN USE
PJRST .STOPB## ;NOW LET SCAN DO ITS THING
;INITIALIZATION FAILURES
;THESE ROUTINES ARE JUNK, BUT UNTIL TECO HAS A BETTER ERROR-HANDLING
;FACILITY THEY WILL JUST HAVE TO DO . . .
TEBIF1: $WARN (COC,TEBIFX,<Cannot OPEN crash recovery file>)
TEBIF3: $WARN (CRB,TEBIFX,<Crash recovery file blocksize not 200>)
TEBIF4: $WARN (CEC,TEBIFX,<Cannot ENTER crash recovery file>)
TEBIF5: $WARN (WIC,TEBIFX,<Wildcards illegal in /CRFILE switch>)
TEBIFX: $WARN (RWC,,<Running without crash recovery>)
SETZM TEBING ;MAKE PREDICTION COME TRUE
SETOM WINFLG ;DON'T MUNGE ON THE SCREEN
PJRST CRR ;ISSUE <CR><LF>
;TEBCHR -- ADD COMMAND CHARACTER TO CRASH RECOVERY FILE.
;CALL IS:
;
; MOVX CH,<CHAR>
; PUSHJ P,TEBCHR
; RETURN
;
;WHERE <CHAR> IS THE 7-BIT ASCII COMMAND CHARACTER AS TYPED BY THE USER.
;
;ON AN I/O ERROR A WARNING MESSAGE IS ISSUED, BUT ANY REAL ERRORS ARE
;JUST IGNORED.
;
;PRESERVES ALL ACS.
TEBCHR: SKIPN TEBING ;DOING COMMAND BACKUP?
POPJ P, ;NO, THEN DON'T DO IT
SOSG TEBOBH+.BFCTR ;ANY ROOM IN OUTPUT BUFFER?
PUSHJ P,TEBOUT ;NO, OUTPUT CURRENT BUFFER
IDPB CH,TEBOBH+.BFPTR;PUT CHARACTER IN BUFFER
SOSLE TEBCNT ;TIME TO FORCE A CHECKPOINT YET?
POPJ P, ;NO
CAIL CH,.CHLFD ;YES, A BREAK CHARACTER ENCOUNTERED?
CAILE CH,.CHFFD ; (I.E., A <LF>, <VT>, OR <FF>)
CAIN CH,.CHESC ;OR AN <ESC>?
CAIA ;YES
POPJ P, ;NO, THEN STILL MORE TO COME
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;TIME TO CHECKPOINT THE OUTPUT FILE
TEBURB: SKIPN TEBING ;DOING COMMAND CRASH RECOVERY?
POPJ P, ;NO, THEN DON'T DO IT
PUSH P,A ;NEED A COUPLA ACS
PUSH P,AA ; . . .
MOVE AA,[TEBCHN,,.FOURB] ;FILOP. FUNCTION WORD
MOVE A,[1,,AA] ;FILOP. ARG POINTER TO
PUSH P,TEBOBH+.BFPTR ;MONITOR BUG - LEAVES POINTER MUNGED
PUSH P,TEBOBH+.BFCTR ;MONITOR BUG - THE COUNTER TOO
FILOP. A, ;CHECKPOINT THE CRASH RECOVERY FILE
OUTSTR [ASCIZ\% Error checkpointing crash recovery file, proceeding
\] ;COMPLAIN TO USER
POP P,A ;SAVED BYTE COUNTER
SKIPE TEBOBH+.BFCTR ;DID WE JUST CROSS A BLOCK BOUNDRY?
MOVEM A,TEBOBH+.BFCTR ;NO, STILL HAVE OLD BLOCK, SUPPRESS NULLS
POP P,TEBOBH+.BFPTR ;END OF MONITOR BUG
SKIPGE A,S.CRSA ;/CRSAVE:NNN GIVEN?
MOVEI A,TEBSAV ;NO, COUNT OF CHARACTERS TILL NEXT CHECKPOINT
CAIG A,0 ;IF 0 (E.G., /CRSAVE:0)
MOVEI A,-1 ;THEN WAIT FOR A BLOCK BOUNDRY
MOVEM A,TEBCNT ;RESET CHARACTER COUNTER
POP P,AA ;RESTORE THE CRUNCHED ACS
POP P,A ; . . .
POPJ P, ;AND RETURN IN ANY CASE
;OUTPUT CURRENT BUFFER, GET NEW ONE
TEBOUT: OUT TEBCHN, ;GIVE BUFFER TO MONITOR
CAIA ;ALL WELL AND GOOD
OUTSTR [ASCIZ\% Error writing crash recovery file, proceeding
\] ;COMPLAIN TO USER
MOVEM A,TEBCNT ;NEED AN AC
SKIPGE A,S.CRSA ;GET USER-SPECIFIED SAVE COUNT
MOVEI A,TEBSAV ;COUNT OF CHARACTERS TO NEXT CHECKPOINT
CAIG A,0 ;IF 0 (E.G., /CRSAVE:0)
MOVEI A,-1 ;THEN WAIT FOR A BLOCK BOUNDRY
EXCH A,TEBCNT ;RESET SINCE OUT IS AN IMPLICIT CHECKPOINT
POPJ P, ;AND RETURN IN ANY CASE
;TEBFIN -- TIME TO EXIT, TOSS OUT CRASH RECOVERY FILE NOW.
TEBFIN: SKIPGE A,S.CRDI ;GET /CRDISP SETTING
MOVEI A,$TBDEL ;NONE, ASSUME /CRDISP:DELETE
JUMPE A,TEBFI6 ;IF NO FILE DON'T BOTHER
CAIN A,$TBPRE ;/CRDISP:PRESERVE?
JRST TEBFI3 ;YES
SETZB A,AA ;NULL FILENAM = DELETE
SKIPE TEBING ;I/O CHANNEL OPEN?
RENAME TEBCHN,A ;YES, DELETE CRASH RECOVERY FILE
JFCL ;HO HUM
TEBFI3: CLOSE TEBCHN, ;LET GO OF FILE IN ANY CASE
RELEAS TEBCHN ;AND DEVICE/CHANNEL AS WELL
TEBFI6: SETZM TEBING ;FILE NO LONGER OPEN
POPJ P, ;AND THAT'S THAT.
;TEBJ -- WRITE OUT A <NNN>J COMMAND TO THE BACKUP COMMAND FILE TO
;ENSURE THAT, IN THE EVENT OF A CRASH RECOVERY STINT ON A DIFFERENT
;TERMINAL TYPE, THE CURSOR (".") WILL BE IN THE RIGHT PLACE.
TEBJ: PUSH P,A ;SAVE A
PUSH P,B ;SAVE B
PUSH P,B+1 ;AND "IDIVI B,"
PUSH P,CH ;SAVE CHARACTER
XMOVEI A,TEBCHR ;CHARACTER OUTPUT ROUTINE
MOVE B,I ;THE CURRENT CURSOR POSITION
SUB B,BEG ;MAKE INTO RELATIVE TEXT POSITION
PUSHJ P,DPT ;"TYPE" THE CURSOR POSITION
MOVEI CH,"J" ;A "J" COMMAND
PUSHJ P,TEBCHR ;PUT IT IN BACKUP FILE
MOVEI CH,.CHESC ;AND TERMINATING <ESC>
PUSHJ P,TEBCHR ;PUT IT IN BACKUP FILE
PUSHJ P,TEBCHR ;TERMINATE REGULAR COMMAND
POP P,CH ;RESTORE CH
POP P,B+1 ;RESTORE "IDIVI B,"
POP P,B ;RESTORE B
POP P,A ;RESTORE A
POPJ P, ;RETURN
SUBTTL COMMAND CHARACTER ROUTINES
;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,
;PEEK AT NEXT COMMAND CHAR AT CURRENT LEVEL
;CALL: PUSHJ P,PKRCH
; ERROR RETURN IF NO MORE CHARS AT THIS LEVEL
; NORMAL RETURN WITH CHAR IN CH
PKRCH: SKIPG COMCNT ;ANY CHARS LEFT?
POPJ P, ;NO, TAKE ERROR RETURN
PUSH P,COMPTR ;SAVE CURRENT COMMAND POINTER
PUSH P,COMPTX ; (DOUBLE-WORD POINTER ADDRESS)
PUSH P,COMCNT ;SAVE CURRENT COMMAND COUNTER
PUSHJ P,GCH ;YES, GET NEXT CHAR SANS TRACING
POP P,COMCNT ;RESTORE COMMAND COUNTER
POP P,COMPTX ; (DOUBLE-WORD POINTER ADDRESS)
POP P,COMPTR ;RESTORE COMMAND POINTER
JRST CPOPJ1 ;TAKE SUCCESSFUL RETURN WITH CHAR IN CH
;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,COMPTR ;GET CHAR.
JRST ALTEO ;CONVERT OLD ALTMODES AND RETURN
;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,COMPTR ;NO. GET COMMAND CHARACTER IN CH
PUSHJ P,ALTEO ;CONVERT OLD ALTMODES IF EO = 1
TXNE FF,TRACEF ;IN TRACE MODE?
TXNE F2,NOTRAC ;TRACE ENABLED?
POPJ P, ;NO, RETURN
PUSH P,A ;YES, SAVE A FOR CALLING ROUTINE
PUSHJ P,TYO ;TYPE THE COMMAND
POP P,A ;RESTORE THE STATE
POPJ P, ;AND RETURN
RCH2: POP P,CH ;SAVE RETURN FOR POPJ IN CH
POP P,COMCNT ;GET RID OF FLAG
SKIPE EQM ;DON'T ALLOW NEG MACRO COUNT
SOS EQM ;DECREMENT THE MACRO LEVEL
SOSG COMCNT ;IF ANG BRAK ON PDL, ITS A INCOMPLETE MACRO
$FATAL (IAB,,<Incomplete <...> or (...) in macro>)
POP P,COMCNT ;GET COUNT FROM NEXT MACRO LEVEL
POP P,COMPTX ;RESTORE DOUBLE-WORD POINTER ADDRESS (IF ANY)
POP P,COMPTR ;CURRENT POINTER TOO
POP P,COMMAX ;NUMBER OF COMMAND CHARACTERS
PUSH P,CH ;PUT RETURN BACK ON PDL.
JRST RCH ;TRY AGAIN.
;SCAN COMMAND STRING FOR CHARACTER IN TT
;IGNORING PAIRS STARTING WITH CHAR. IN TT1 AND ENDING WITH (TT)
;ASSUMED THAT COMPTR IS SET
;NON-SKIP RETURN IF (TT) CAN'T BE FOUND
;SKIP RETURN IF FOUND
;COMPTR LEFT SET FOR NEXT CHAR. IN COMMAND STRING
SKAN: TXO F2,NOTRAC ;INHIBIT TRACE ACTION WHILE SKANNING
MOVEI C,0 ;CTR FOR <> AND "...' PAIRS
SKAN0: TXZ F2,SKIMQF+SKIMRF+SKANFS ;CLR SKIM FLAGS
PUSHJ P,SKIMCH ;GET COMMAND CHAR.
CAIN CH,(TT1) ;SECONDARY CHARACTER?
AOJA C,SKAN1 ;YES, COUNT IT
CAIN CH,(TT) ;PRIMARY CHAR?
JRST SKAN99 ;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,SKIMCH ;GET CHAR AFTER "^"
CAIN CH,"A"
JRST SKAN7 ;^A COMMAND
CAIN CH,"^"
JRST SKAN11 ;^^ COMMAND
JRST SKAN0 ;ORDINARY CONTROL-COMMAND, FORGET IT
;EB; EP; ER; EW; EZ; E@.
SKAN3: PUSHJ P,SKIMCH
MOVEI T,SK3TAB ;WHICH E COMMAND?
JRST SKAN00
;@I; @N; @S; @_; @FN; @FS; @F_
SKAN4: PUSHJ P,SKIMCH ;WHAT FOLLOWS @?
MOVEI T,SK4TAB
PUSHJ P,DISPAT
JRST SKAN4 ;MUST BE 1 OF THESE 4
;O; EB; EP; ER; EW; E@ - EAT NORMAL STRING DELIMITED BY <ESC>
SKAN9: PUSHJ P,SKIM ;IGNORE TO $
JRST SKAN0
;HERE TO EAT ^AMESSAGE^A
SKAN7: MOVEI T,.CHCNA ;IGNORE TO ^A
JRST SKAN5
;HERE TO EAT !TAG!
SKAN8: MOVEI T,"!" ;IGNORE TO !
SKAN5: PUSHJ P,SKIM1 ;IGNORE TO CHAR IN T
JRST SKAN0
;EAT TEXT STRING DELIMITED BY @/TEXT/ CLASS CONSTRUCTION
SKAN6: PUSHJ P,SKIMCH ;GET SEARCH DELIMITER
SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE
;EAT TEXT DELIMITED BY NORMAL <ESC> CONSTRUCTION
SKAN12: MOVEI T,.CHESC ;DELIMITER IS ALTMODE
PUSHJ P,SKIMRQ ;SKIP TO DELIMITER & WATCH OUT FOR ^Q,^R
JRST SKAN0
;@I - GET EXPLICIT TERMINATOR AND EAT STRING
SKAN13: PUSHJ P,SKIMCH ;GET INSERT DELIMITER
SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE
;I; <TAB> - EAT STRING UP TO NORMAL <ESC> DELIMITER
SKAN14: MOVEI T,.CHESC ;DELIMITER IS ALTMODE
PUSHJ P,SKIM.R ;SKIP TO DELIMITER & WATCH OUT FOR ^R
JRST SKAN0
;Q-REGISTER COMMAND, EAT Q-REGISTER NAME
SKAN11: PUSHJ P,SKIMCH ;IGNORE NEXT CHAR.
JRST SKAN0
;@FN; @FS; @F_ - EAT TWO TEXT STRINGS WITH EXPLICIT DELIMITERS
SKAN16: MOVEI T,SK5TAB ;TABLE FOR @F
JRST SKAN17
;FN; FS; F_ - EAT TWO TEXT STRINGS WITH NORMAL <ESC> DELIMITER
SKAN15: MOVEI T,SK1TAB ;TABLE FOR F COMMANDS
SKAN17: TXO F2,SKANFS ;SIGNAL FS OR FN IN PROGRESS
PUSHJ P,SKIMCH ;GET CHAR AFTER F
JRST SKAN00
;D/FD; K/FK; R/FR
SKAN20: TXZN F2,SKANFS ;CLEAR F-COMMAND (2 STRING ARGS) FLAG
JRST SKAN0 ;OOPS - WASN'T AN F COMMAND
JRST SKAN12 ;GO EAT SINGLE STRING
;@D/@FD; @K/@FK; @R/@FR
SKAN21: TXZN F2,SKANFS ;CLEAR F-COMMAND (2 STRING ARGS) FLAG
JRST SKAN0 ;OOPS - WASN'T AN F COMMAND
JRST SKAN6 ;GO EAT SINGLE STRING
;HERE ON END OF "PAIRED" STRING, RETURN UNLESS NESTED
SKAN99: SOJGE C,SKAN0 ;IF MATCH JUST ENDS A PAIR, LOOP BACK
TXZ F2,NOTRAC ;ENABLE TRACING
JRST CPOPJ1 ;OTHERWISE, WE HAVE WHAT WE WANT
;SKIM OVER TEXT
;
;SKIM SKIP TO NEXT ALTMODE, GIVING ^R & ^Q NO SPECIAL TREATMENT
;SKIM1 SKIP OVER ARBITRARY CHAR IN T, GIVING ^R & ^Q NO SPECIAL TREATMENT
;SKIM.R SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER ^R
;SKIMRQ SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER EITHER ^R OR ^Q
SKIMRQ: TXO F2,SKIMQF ;CK FOR ^Q AND ^R
SKIM.R: TXOA F2,SKIMRF ;CK FOR ^R
SKIM: MOVEI T,.CHESC ;SKIP TO NEXT ALTMODE
SKIM0: CHKEO EO25,SKIM1 ;IF EO=1,2 THEN USE OLD QUOTING CHARACTERS
SKIM1V: PUSHJ P,SKIMCH ;SKIM ANOTHER COMMAND CHARACTER
CAIN CH,(T) ;DELIMITER CHARACTER WE WANT?
JRST SKIM3 ;YES
TXNE F2,SKIMRF ;NO, ALLOWING QUOTING?
CAIE CH,.CHCNV ;YES, IS THIS THE QUOTE CHARACTER?
JRST SKIM1V ;NO, KEEP LOOKING FOR DELIMITER
PUSHJ P,SKIMCH ;YES, EAT IT AND THE CHARACTER QUOTED
JRST SKIM1V ;KEEP LOOKING FOR DELIMITER
SKIM1: PUSHJ P,SKIMCH ;GET NEXT TEXT CHAR.
CAIN CH,(T) ;CHARACTER WE WANT?
JRST SKIM3 ;YES
CAIN CH,.CHCNQ ;^Q?
TXNN F2,SKIMQF ;YES, CK FLAG ON?
JRST .+2 ;NO
JRST SKIM2 ;YES
CAIN CH,.CHCNR ;^R?
TXNN F2,SKIMRF ;YES, CK FLAG ON?
JRST SKIM1 ;NO, KEEP LOOKING
SKIM2: PUSHJ P,SKIMCH ;GOBBLE UP NEXT CHARACTER
JRST SKIM1 ;CONTINUE SKIMMING
SKIM3: TXZE F2,SKANFS ;SKIMMING OVER FS OR FN?
JRST SKIM0 ;YES, IGNORE 1ST DELIMITER
POPJ P,
;GET A SINGLE CHARACTER FROM COMMAND STRING
;TAKE ERROR RETURN FROM SKAN IF THERE ARE NO MORE
SKIMCH: PUSHJ P,SKRCH ;GET A COMMAND CHAR.
APOPJ: POP P,A ;ERROR RETURN FROM SKAN IF NO MORE CHARS.
POPJ P,
;SKAN ROUTINE DISPATCH TABLES
SKNTAB: XWD SKAN15,"F"
XWD SKAN14,"I"
XWD SKAN14,.CHTAB ;TAB
XWD SKAN9,"O"
XWD SKAN8,"!"
XWD SKAN7,1 ;^A
XWD SKAN11,36 ;^^
XWD SKAN2,"^"
XWD SKAN3,"E"
XWD SKAN11,"U"
XWD SKAN11,"Q"
XWD SKAN11,"X"
XWD SKAN11,"G"
XWD SKAN11,"M"
XWD SKAN11,"%"
XWD SKAN11,"["
XWD SKAN11,"]"
XWD SKAN4,"@"
XWD SKAN11,42 ;"
SK1TAB: XWD SKAN12,"S" ;S OR FS
XWD SKAN12,"N" ;N OR FN
XWD SKAN12,"_" ;_ OR F_
XWD SKAN20,"D" ;D (IGNORED) OR FD
XWD SKAN20,"K" ;K (IGNORED) OR FK
XWD SKAN20,"R" ;R (IGNORED) OR FR
XWD 0,0 ;LIST TERMINATOR
SK3TAB: XWD SKAN9,"B" ;EB
XWD SKAN9,"P" ;EP
XWD SKAN9,"R" ;ER
XWD SKAN9,"W" ;EW
XWD SKAN9,"Z" ;EZ
XWD SKAN9,"@" ;E@
XWD 0,0
SK4TAB: XWD SKAN16,"F" ;@F
XWD SKAN13,"I" ;@I
SK5TAB: XWD SKAN6,"S" ;@S OR @FS
XWD SKAN6,"N" ;@N OR @FN
XWD SKAN6,"_" ;@_ OR @F_
XWD SKAN21,"D" ;@D (IGNORED) OR @FD
XWD SKAN21,"K" ;@K (IGNORED) OR @FK
XWD SKAN21,"R" ;@R (IGNORED) OR @FR
XWD 0,0
SUBTTL START TECO'ING
;HERE FROM ERROR
GOE: TRZA FF,777777-TRACEF-QMFLG-FORM-SEQF
;HERE TO START UP A NEW COMMAND
GO: TRZ FF,777777-TRACEF-FORM-SEQF
PUSHJ P,PCSEC ;VERIFY PC IN PROPER SECTION
;RDH TXZ FF,CCLFLG ;CLEAR "Y" REQUESTED FLAG
TXZ F2,DOING ;NOT IN A COMMAND YET
TXZ F2,NOTRAC
MOVE P,[IOWD PDLEN,PDLST] ;INITIALIZE PUSHDOWN LIST
SETZM PDLST0 ;FLAG PDL TOP - NOTE: PDL FLAGS ARE
;0 = TOP OF PDL
;-1 = LAST ITEM IS AN ITERATION
;+1 = LAST ITEM IS A PARENTHESIS
;GT 1 = LAST ITEM IS A MACRO
PUSH P,CH ;SAVE POSSIBLE ALREADY INPUT CHARACTER
AOSN TOOBIG ;MAYBE TIME TO TRY TO SHRINK DOWN?
PUSHJ P,SHRINK ;YES, SEE IF ANY MEMORY CAN BE RECLAIMED
; MOVE A,BEG ;GET POSITION BUFFER FLOATED AWAY TO
; SUB A,OLDBEG ;CALCULATE DISTANCE IT MOVED
; ADDM A,SCRNA ;MARK NEW START OF SCREEN BASE
; ADDM A,SCRNB ;AND FIRST CHARACTER ON SCREEN
; ADDM A,SCRNZ ;AND END OF SCREEN TOO
; ADDM A,OLDBEG ;MARK FOR NEXT DRIFT
SKIPE SCTYPE ;MAYBE DON'T DISPLAY
SKIPE CMFTYO ;SUPPRESSING OUTPUT DUE TO COMMAND FILE?
JRST GO2 ;DO NOT DISPLAY
SKIPE VFREEZ ;SCREEN FROZEN BY "V" COMMAND?
JRST GO2 ;YES, DO NOT REDISPLAY!
SKIPN WINFLG ;SCREEN HAVE IMPORTANT INFO?
JRST GOSC ;NO, OK TO REDISPLAY
SKIPN SCRLED ;YES, DID IT CAUSE A SCROLL?
JRST GOSB ;NO, THEN WE CAN STILL SAFELY REDISPLAY
SKIPE S.SFT ;USER TIRED OF JUNK MESSAGE?
$INFO (SFT,,<Screen "frozen" due to program typeout, ^L to refresh>)
JRST GO2 ;JUST TYPE "*"
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
GOSB: TXZ F2,CBTMF ;DON'T ERASE TO END OF SCREEN
GOSC: MOVE I,Z ;GET POINTER TO END OF BUFFER
MOVEM I,SCRNVZ ;TELL DISPLAY TO GO ALL THE WAY
; MOVE B,SCRNB ;START OF SCREEN
; MOVE C,SCRNZ ;END OF SCREEN
; CAML B,BEG ;SCREEN START IN IN TEXT BUFFER?
; CAMLE C,Z ;AND END STILL IN TEXT BUFFER?
; SETOM MESFLG ;NO - SOMETHING MESSED UP
SKIPE MESFLG ;RECONFIGURE DISPLAY IF REFRESH NECESSARY
PUSHJ P,WINIT ;RECALCULATE DISPLAY START
PUSHJ P,WINFIL ;FILL UP NEW SCREENFUL
SKIPGE DISPTF ;SEE IF POINTER IS ON SCREEN
JRST GOSC2 ;IT WAS, WE'RE OK
PUSHJ P,WINIT ;WASN'T, SO RECALCULATE SCREEN START
PUSHJ P,WINFIL ;AND REBUILD A SCREEN IMAGE
SKIPL DISPTF ;CURSOR ON SCREEN NOW?
HALT .+1 ;BLETCH
GOSC2: SKIPE MESFLG ;IF WINDOW OUT OF SYNC WITH SCREEN,
PUSHJ P,ZAPSCN ;MAKE THEM BOTH EMPTY
PUSHJ P,DISPLX ;OUTPUT THE SCREEN IMAGE
MOVE CH,SLENTH ;LENGTH OF SCREEN DISPLAY AREA
PUSHJ P,LINECH ;POSITION CURSOR TO COMMAND AREA
TXZE F2,CBTMF ;WANT A CLREOS HERE?
PUSHJ P,CLREOS ;YES
SETZM SCRLED ;CLEAR SCREEN-HAS-SCROLLED FLAG
GO2: POP P,CH ;RESTORE POSSIBLE FIRST COMMAND CHARACTER
SETZM EQM ;CLEAR MACRO LEVEL COUNT
MOVE PF,[XWD -LPF-1,PFL-1]
SKIPN CMFINF ;HAVE WE PROCESSED INIT FILE YET?
PUSHJ P,CMFINI ;NO, PROCESS IT IF REQUESTED
SKIPN TEBINF ;HAVE WE CALLED TEBINI YET?
PUSHJ P,TEBINI ;NO, INITIALIZE CRASH RECOVERY FILE
FALL CLIS
CLIS: SETZM WINFLG ;SO DISPLAY WILL HAPPEN NEXT TIME
SETZM VFREEZ ; . . .
CLIS4: SETZM COMCNT ;AT THIS POINT WE HAVE NO COMMAND CHARACTERS
SETZM COLUMN ;AND ARE AGAINST THE LEFT MARGIN
SKIPN CCLSW ;NEED CCL COMMAND?
JRST LIS0 ;NO
PUSHJ P,CCLIN ;GET THE CCL COMMAND TO TYI BUFFER
JRST LI0 ;AND DON'T PROMPT "*"
LIS0: SKIPN CMFECH ;NOECHOING OF COMMAND FILE INPUT?
TXNE FF,QMFLG ;1ST CHARACTER IN ALREADY?
JRST LIS1A ;YES
MOVEI CH,"*"
PUSHJ P,TYOM ;TYPE *
LIS1: TXO FF,TIBKA!TINEC ;CATCH FIRST CHARACTER TYPED
LIS1A: TXOE FF,QMFLG ;UNLESS ONE ALREADY IN
JRST LIS1C ;WE ALREADY HAVE FIRST CHAR
PUSHJ P,TYI
SKIPN CMFECH ;NOECHOING COMMAND FILE INPUT?
SKIPN SCTYPE ;IF USING A SCREEN,
JRST LIS1C ;NOT, JUST PROCESS COMMAND
PUSH P,CH ;WE ARE, SAVE TYPED CHARACTER A MOMENT
PUSHJ P,CLREOS ;CLEAR OLD COMMAND FROM SCREEN
POP P,CH ;GET USER'S CHARACTER BACK
LIS1C: CAIE CH,.CHDEL ;IS CHARACTER A <DEL>
CAIN CH,.CHCNU ;OR A ^U?
LIS1E: TXZA FF,QMFLG ;FORCE TYI CALL
CAIA ;(SKIP)
JRST LIS1 ;JUST EAT THE CHARACTER SANS ECHO
LIS1F: SKIPE TKESC ;DOES THIS TERMINAL SEND ESCAPE SEQUENCES?
JRST LIS2 ;YES, GO CHECK FOR ESCAPE SEQUENCE
CAMN CH,TKCUP ;CURSOR UP KEY?
JRST LIS4A ;YES
CAMN CH,TKDWN ;CURSOR DOWN KEY?
JRST LIS4B ;YES
CAMN CH,TKRGT ;CURSOR RIGHT KEY?
JRST LIS4C ;YES
CAMN CH,TKLFT ;CURSOR LEFT KEY?
JRST LIS4D ;YES
LIS1N: CAIN CH,.CHCNH ;^H (BACKSPACE) TYPED?
JRST LIS4P ;YES, DISPLAY PREVIOUS SCREEN
CAIN CH," " ;SPACE TYPED?
JRST LIS4S ;YES, DISPLAY MORE OF SCREEN
CAIN CH,.CHCRT ;<CR>?
JRST LIS4V ;YES, PUT CURSOR ON SCREEN
CAIN CH,.CHLFD ;<LF>?
JRST LIS4L ;YES, 1L$$
CAIN CH,.CHFFD ;<FF>?
JRST LIS4R ;YES, REFRESH SCREEN
SKIPN CMFECH ;NO, SUPPRESSING COMMAND FILE ECHO?
PUSHJ P,TYIEC ;NO, ECHO THE CHARACTER
CAIN CH,.CHCNZ ;^Z?
JRST LIS4Z ;YES, RETURN TO MONITOR LEVEL
CAIN CH,"*" ;1ST CHAR AN ASTERISK?
JRST LIS4X ;YES, SAVE AWAY PREVIOUS COMMAND STRING
JRST LI0 ;NO, REGULAR COMMAND - CONTINUE NORMALLY
;HERE TO INTERPRET POSSIBLE USER-INDUCED ESCAPE SEQUENCE (E.G., THE
;VARIOUS "ARROW" KEYS).
LIS2: CAMN CH,TKESC ;START OF AN ESCAPE SEQUENCE?
SKIPN TT,SCTYPE ;ON A VIDEO TERMINAL?
JRST LIS1N ;NO, FORGET THIS STUFF
CAIE TT,VXANSI ;ANSI ESCAPE SEQUENCES?
JRST LIS2E ;NO
TXO FF,TIBKA!TINEC ;YES, QUIETLY
PUSHJ P,TYI ; READ SECOND CHARACTER OF SEQUENCE
CAIE CH,"[" ;REALLY ANSI SEQUENCE?
JRST LIS2U ;NO, QUEER CHARACTERS
LIS2E: TXO FF,TIBKA!TINEC ;QUIETLY
PUSHJ P,TYI ; SNARF NEXT NEXT INPUT CHARACTER
CAMN CH,TKCUP ;CURSOR UP KEY?
JRST LIS4A ;YES
CAMN CH,TKDWN ;CURSOR DOWN KEY?
JRST LIS4B ;YES
CAMN CH,TKRGT ;CURSOR RIGHT KEY?
JRST LIS4C ;YES
CAMN CH,TKLFT ;CURSOR LEFT KEY?
JRST LIS4D ;YES
;UNKNOWN ESCAPE SEQUENCE, JUST TREAT IT AS A REGULAR COMMAND SEQUENCE
;IF ANSI, THEN WE LOSE THE "[", BUT THINGS ARE TOUGH ALL OVER.
LIS2U: MOVEM CH,SCH ;SAVE SECOND CHARACTER
SKIPE CMFECH ;SUPPRESSING COMMAND FILE ECHO?
JRST LIS2X ;YES, DON'T ECHO STUFF THEN
MOVE CH,TKESC ;NO, "ESCAPE" CHARACTER
PUSHJ P,TYIEC ;"ECHO" IT
MOVE CH,SCH ;AND THE OTHER CHARACTER TYPED
PUSHJ P,TYIEC ;"ECHO" IT TOO
LIS2X: MOVE CH,TKESC ;FIRST CHARACTER TYPED
JRST LI0 ;TREAT AS A REGULAR COMMAND
;MOVE CURSOR UP ONE SCREEN LINE
LIS4A: SKIPA D,[-1] ;MOVE "UP" ONE LINE
;MOVE CURSOR DOWN ONE SCREEN LINE
LIS4B: MOVEI D,1 ;MOVE "DOWN" ONE LINE
SKIPN SCTYPE ;ON A VIDEO TERMINAL?
JRST LI0 ;NO, TREAT AS NORMAL CHARACTER THEN
PUSH P,D ;SAVE COUNT
MOVE A,DIPTI ;GET LAST REMEMBERED "." IN DISPLAY IMAGE
CAMN A,PT ;HAS "." CHANGED (E.G., "BJ.=$$" COMMAND)
SKIPL DISPTF ;NO, IS "." ON THE CURRENT SCREEN?
CAIA ;SOMETHING SMELLS, RE-BUILD THE BLOODY SCREEN
JRST LIS4B1 ;NO, PROCEEDING NORMALLY
;HERE WHEN SOMETHING FUNNY IS HAPPENING - FOR SOME REASON THE CURSOR
;(I.E., ".") IS NOT ON THE CURRENT SCREEN IMAGE (E.G., ^H COMMAND) OR
;"." IS NOT CORRECTLY REPRESENTED BY THE CURRENT SCREEN IMAGE WHICH
;DISPLAYS "." (E.G., "BJ.=$$" COMMAND WHICH LEAVES THE SCREEN FROZEN,
;"." DISPLAYED ON FROZEN SCREEN, BUT "." IS REALLY AT 0).
MOVE TT,Z ;GET END OF TEXT BUFFER
MOVEM TT,SCRNVZ ;ENSURE THAT DISPLAY GOES ALL THE WAY
PUSHJ P,WINIT ;INITIALIZE A VIRGIN SCREEN
PUSHJ P,WINFIL ;AND RE-BUILD IT FROM FIRST PRINCIPLES
MOVE D,(P) ;RESTORE D
LIS4B1: CAIN D,1 ;MOVING DOWN?
SETOM PT ;YES, DON'T GET CONFUSED BY THE "/\"
DMOVE A,DIPTA ;BASE/COUNT PAIR FOR SCREEN LINE WITH "."
PUSHJ P,DISMV ;MOVE POINTER AROUND
POP P,D ;RESTORE COUNT (DIRECTION FLAG ALSO)
JUMPGE D,LIS4B3 ;IF MOVING FORWARD ALL SET
CAMN A,DIPTA ;HAS ANYTHING HAPPENED
CAME AA,DIPTAA ; (DITTO)
CAIA ;YES
JRST [MOVEM A,PT ;NO, AT TOP OF TEXT
JRST GO] ;SO CAN'T GO ANY FURTHER
SETZ D, ;CHANGE THE POINTER NOT AT ALL
PUSHJ P,DISMV ;BUT SET I TO START OF SCREEN LINE
LIS4B3: SETZB C,CH ;INITIALIZE COUNTER AND CHARACTER
CAMGE I,Z ;AGAINST BOTTOM OF TEXT?
SKIPN DIPTC ;OR CURSOR AGAINST MARGIN?
JRST LIS4B8 ;YES
LIS4B5: PUSHJ P,DISCHR ;GET A DISPLAY CHARACTER
CAIE CH,.CHCRT ;IF END OF DISPLAY LINE
CAMN C,DIPTC ;OR REACHED OLD CURSOR'S "POSITION"
SOSA I ;YES, TOSS OUT "CURRENT" CHARACTER
AOJA C,LIS4B5 ;NOT YET
LIS4B8: MOVEM I,PT ;MOVE THE CURSOR (".")
;NOW WRITE AN NNNJ COMMAND INTO COMMAND FILE (IN CASE LATER EXECUTED ON
;A DIFFERENT SCREEN SIZE)
TXNN FF,CFOF ;IF TOP-LEVEL COMMAND TERMINAL TYPEIN
PUSHJ P,TEBJ ;THEN WRITE THE NNNJ COMMAND
JRST GO ;NOW UPDATE SCREEN
;CURSOR RIGHT
LIS4C: AOS A,PT ;MOVE RIGHT ONE PLACE
CAMLE A,Z ;STILL IN THE TEXT BUFFER?
SOS PT ;NO, BACK TO WHERE WE WERE
JRST GO ;NEXT COMMAND
;CURSOR LEFT
LIS4D: SOS A,PT ;MOVE LEFT ONE PLACE
CAMGE A,BEG ;STILL IN THE TEXT BUFFER?
AOS PT ;NO, BACK TO WHERE WE WERE
JRST GO ;NEXT COMMAND
;HERE TO FORCE A SCREEN REFRESH
LIS4R: SETZM WINFLG ;CLEAR STICKY SCREEN FLAG
SETZM VFREEZ ; . . .
SETOM MESFLG ;AND ANNOUNCE THE TRASHED SCREEN EFFECT
TXO F2,CBTMF ;ALSO CLEAR OUT BOTTOM OF SCREEN
LIS4RG: TXZ FF,QMFLG ;GOBBLE UP THE CHARACTER
JRST GO ;AND LET GOSC REFRESH THE SCREEN
;HERE TO DO A "1L$$" COMMAND WHEN USER TYPES A <LF>. IN ADDITION,
;IF NOT VIDEO SCREEN MODE DO A "1T$$" AS WELL.
LIS4L: MOVEI B,1 ;EXPLICIT "1" LINE
TXO FF,ARG ;MAKE IT TOTALLY EXPLICIT
PUSHJ P,LINE ;ADVANCE ONE LINE
SKIPE SCTYPE ;VIDEO SCREEN HANDLING?
JRST GO ;YES, DO SCREEN UPDATE
PUSHJ P,CRR ;NO, START UP A NEW LINE
MOVEI B,1 ;WANT ONE LINE ONLY
TXO FF,ARG ;EXPLICITLY ONE LINE
PUSHJ P,TYPE ;TYPE ONE LINE
JRST GO ;GO FOR NEXT COMMAND
;HERE TO "SCROLL" BACKWARDS THROUGH THE TEXT WITHOUT CHANGING "."
LIS4P: SKIPN SCTYPE ;DOING VIDEO SCREEN HANDLING?
JRST LI0 ;NO, TREAT BACKSPACE AS A CHARACTER
PUSHJ P,VUPRV ;VIEW PREVIOUS WINDOW'S WORTH
PUSHJ P,CLREOS ;CLEAR ANY JUNK LEFT LYING AROUND
JRST LIS4RG ;RESTART COMMAND SCANNING
;HERE TO "SCROLL" FOREWARDS THROUGH THE TEXT WITHOUT CHANGING "."
LIS4S: SKIPN SCTYPE ;DOING VIDEO SCREEN HANDLING?
JRST LI0 ;NO, TREAT SPACE AS A SPACE
PUSHJ P,VUNXT ;VIEW NEXT WINDOW'S WORTH
PUSHJ P,CLREOS ;CLEAR ANY JUNK LEFT LYING AROUND
JRST LIS4RG ;RESTART COMMAND SCANNING
;HERE TO PUT CURSOR ON CURRENT SCREEN
LIS4V: PUSHJ P,TYI ;GET THE FOLLOWING <LF>
CAIE CH,.CHLFD ;IT IS A <LF>, ISN'T IT?
HALT .+1 ;BLETCH
SKIPN SCTYPE ;OR NON-SCREEN-MODE TERMINAL?
JRST LIS1E ;YES, EAT THE <CR><LF>
SKIPL DISPTF ;CURSOR ALREADY ON SCREEN?
JRST LIS4V2 ;NO
DMOVE A,DIPTA ;YES, GET CURSOR BASE
SETZ D, ;MOVE 0 LINES
JRST LIS4V4 ;FIND START OF LINE
LIS4V2: DMOVE A,SCRNA ;CURRENT SCREEN BASE
MOVE D,CLENTH ;HOW FAR DOWN WE PREFER THE CURSOR
LIS4V4: PUSHJ P,DISMV ;GET APPROPRIATE TEXT ADDRESS
MOVEM I,PT ;SET NEW "."
;NOW WRITE AN NNNJ COMMAND INTO COMMAND FILE (IN CASE LATER EXECUTED ON
;A DIFFERENT SCREEN SIZE)
TXNN FF,CFOF ;IF TOP-LEVEL COMMAND TERMINAL TYPEIN
PUSHJ P,TEBJ ;THEN WRITE THE NNNJ COMMAND
JRST GO ;NOW UPDATE SCREEN
;RETURN TO MONITOR LEVEL. NO ATTEMPT IS MADE TO PROTECT AGAINST
;PSYCHOPATHIC USERS ISSUING ".FINISH" COMMANDS . . .
LIS4Z: TXZE FF,TYOF ;NEED A TYO?
PUSHJ P,TYOOUT ;YES. DO SO.
PJRST FINISZ ;NOTHING SPECIAL HERE
;SAVE PREVIOUS COMMAND STRING IN NAMED Q-REGISTER
LIS4X: MOVE C,COMLEN ;LENGTH OF STRING
TXNN F2,NALTFS ;FS<STRING>$$ COMMAND LAST THING?
SUBI C,1 ;NO, TOSS OUT SECOND $ OF $$
; NOTE THAT IF COMMAND WAS ABORTED BY ^G^U
; THEN DELLIN LEFT COMLEN COUNTING THE ^G
; CHARACTER SO WE CAN DO THE SUBI HERE.
MOVE B,CMDBAS ;POSITION OF FIRST CHAR. IN BYTES
IMULI B,5
TXNN F2,GOING ;ANY CMD SEEN BEFORE?
TDZA B,B ;NO - FLAG NCS ERROR FOR LATER.
PUSHJ P,XQREG ;YES - SAVE CMD IN Q-REG BUFFER
MOVEM B,COMSAV ;SAVE FOR LATER
HRRZI CH,"*" ;RESTORE CH (GARBAGED BY XQREG)
FALL LI0 ;START UP COMMAND PROCESSING
SUBTTL TECO COMMAND INPUT AND EDITING
LI0:; SETZM COMCNT ;COMCNT:=0
TXZ F2,NALTFS ;CLEAR FLAG
SETZM TAGSYM ;INITIALIZE "O" COMMAND TAG "SYMBOL TABLE"
MOVE T,[XWD TAGSYM,TAGSYM+1] ;BLT POINTER TO
BLT T,SYMEND-1 ;ZERO TAG SYMBOL TABLE
DMOVE A,CMDPTR ;MASTER COMMAND BUFFER STUFFER
DMOVEM A,COMPTR ;RESET DYNAMIC COMMAND POINTER
LI10: TXZ FF,ALTF+BELLF+XPLNFL+EMFLAG
LI11: MOVEI A,1 ;ONE CHARACTER
ADJBP A,COMPTR ;ADVANCE COMMAND BUFFER BYTE POINTER
SKIPN SECTN ;PC IN EXTENDED SECTION?
HRRZ AA,A ;NO, HALF WORD ADDRESS
CAMGE AA,CMDEND ;ROOM IN COMMAND BUFFER?
JRST LI30 ;YES
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;EXPAND COMMAND BUFFER, ALLOCATING CORE IF NEEDED
LI20: MOVE T,Z ;GET THE NUMBER OF CHARACTERS NOW
ADDI T,COMAIW*5 ;PLUS INCREMENTAL TEXT GROWTH SIZE
CAMG T,MEMSIZ ;WILL THIS OVERFLOW?
JRST LI23 ;NO, JUST EXPAND THE COMMAND BUFFER
PUSHJ P,GRABAK ;GET THE NECESSARY CORE
JRST CORERR ;BUMMER! COMMAND GOT TOO BIG
;OK, EXPAND THE COMMAND BUFFER CONFIDENTLY
LI23: MOVEI B,COMAIW ;EXPAND COMMAND BUFFER
ADDB B,CMDEND ;EXTEND COMMAND BUFFER END ADDRESS
MOVE A,QRBUF ;BASE TEXT ADDRESS FOR Q-REGS/ETC.
IDIVI A,5 ;A:=Q-REG/ETC. BASE WORD ADDRESS.
MOVE AA,A ;BASE TEXT ADDRESS (WORDS)
ADDI AA,COMAIW ;OFFSET BY "EXPANSION" SIZE
MOVE B,Z ;EDITING BUFFER END TEXT ADDRESS
IDIVI B,5 ;B:=EDITING BUFFER END WORD ADDRESS.
SUB B,A ;B:=TOTAL Q-REG AND TEXT WORDS
MOVSI T,((B)) ;ASSUME IFIW INDEXING OFF OF AC "B"
SKIPE SECTN ;PC IN EXTENDED SECTION?
LSH T,IFX2EF ;YES, SELECT EFIW INDEXING THEN
IOR A,T ;INDEX "SOURCE" POINTER
IOR AA,T ;INDEX "DESTINATION" POINTER
;LOOP MOVING TEXT AREA DOWN IN MEMORY
LI25: MOVE T,@A ;GET A Q-REG/DATA BUFFER WORD
MOVEM T,@AA ;AND MOVE IT DOWN
SOJGE B,LI25 ;LOOP FOR ENTIRE TEXT AREA
;NOW RELOCATE ALL THE WORLD'S POINTERS (MUCH SIMPLER THAN GC'S WORRIES)
MOVEI B,COMAIW*5 ;HOW FAR TEXT MOVED
ADDM B,QRBUF ;RELOCATE Q-REG BASE ADDRESS
ADDM B,BEG ;RELOCATE EDITING BUFFER "B" ADDRESS
ADDM B,PT ;RELOCATE EDITING BUFFER "." ADDRESS
ADDM B,Z ;RELOCATE EDITING BUFFER "Z" ADDRESS
MOVSI AA,-SCRNRL ;LENGTH OF SCREEN RELOCATION TABLE
ADDM B,@SCRNRP ;RELOCATE SCREEN POINTER
AOBJN AA,.-1 ;RELOCATE THE REST OF 'EM
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE ON EACH COMMAND INPUT CHARACTER
LI30: TXZN FF,QMFLG ;1ST CHAR IN ALREADY?
PUSHJ P,TYI ;GET A NON-NULL CHARACTER IN CH
CAIN CH,.CHDEL ;<DEL>?
JRST CTRDL ;YES, UNCONDITIONALLY RUBOUT ONE CHARACTER
TXZE F2,CQUOTE ;IS QUOTE-THE-NEXT-CHARACTER SET?
JRST LI3QT ;YES, THEN WE HAVE A COMMAND CHARACTER
CAIN CH,.CHBEL ;CONTROL-G?
JRST CTRLG ;YES
CAIN CH,.CHCNR ;CONTROL-R?
JRST CTRLR ;YES
CAIN CH,.CHCNU ;CONTROL-U?
JRST CTRLU ;YES
CAIN CH,.CHCNV ;CONTROL-V?
JRST CTRLV ;YES
CAIN CH,.CHCNW ;CONTROL-W?
JRST CTRLW ;YES
;WE HAVE A COMMAND CHARACTER IN CH. STASH IT AWAY AND READ MORE
AOS COMCNT ;COUNT ANOTHER COMMAND CHARACTER
IDPB CH,COMPTR ;AND STASH IT IN THE COMMAND BUFFER
CAIN CH,.CHESC ;<ESC>?
JRST LI70 ;YES, MAYBE TIME TO EXECUTE THE COMMAND
JRST LI10 ;BACK FOR THE NEXT COMMAND CHARACTER
LI3QN: TXO F2,CQUOTE ;WANT TO QUOTE THE NEXT CHARACTER
LI3QQ: TXZ FF,ALTF!BELLF ;AND DO NOTHING ELSE WITH IT
LI3QT: AOS COMCNT ;COUNT THIS CHARACTER AS A COMMAND CHARACTER
IDPB CH,COMPTR ;AND PUT IT IN THE COMMAND BUFFER
JRST LI11 ;BACK FOR THE NEXT COMMAND CHARACTER
LI70: TXZ FF,BELLF ;$ CLEARS ^G FLAG
TXON FF,ALTF ;SET ALT-MODE FLAG. WAS IT ON?
JRST LI11 ;NO, KEEP ACCEPTING COMMAND INPUT
MOVE A,COMCNT ;COUNT OF COMMAND CHARACTERS
MOVEM A,COMMAX ;SET COMMAND CHARACTER ADDRESS UPPER BOUND
MOVEM A,COMLEN ;SAVE IN CASE OF * COMMAND NEXT
CAIG A,2 ;JUST $$?
PUSHJ P,TEBURB ;YES, FORCE OUT BACKUP FILE CHARACTERS
DMOVE A,CMDPTR ;MASTER COMMAND BUFFER BYTE POINTER
DMOVEM A,COMPTR ;RESET COMMAND BUFFER BYTE POINTER
SETZM CCLSW ;FINISHED WITH CCL READ
SKIPE CMFECH ;SUPPRESSING ECHO DUE TO COMMAND FILE?
JRST LI74 ;YES, THEN NO <CR><LF>
SKIPN SCTYPE ;UNLESS DISPLAYING,
PUSHJ P,CRR ;TYPE CRLF
LI74: TXZE FF,TYOF ;ANY OUTPUT HANGING AROUND?
PUSHJ P,TYOOUT ;YEAH, NOW IS A REASONABLE TIME TO FORCE IT OUT
SETZM TYOTCT ;CLEAR OUTPUT ACTIVITY COUNTER
; (SO "<SBLAH$;0TT>" DOES NICE THINGS)
JRST CD ;DECODE COMMAND
;HERE ON <DEL>
CTRDL: PUSHJ P,RUBCHR ;RUBOUT ONE COMMAND CHARACTER
JRST LIS1E ;EMPTY, WATCH FIRST CHARACTER SPECIAL
JRST LI10 ;RESUME COMMAND TYPEIN
;HERE ON CONTROL-G
CTRLG: TXO FF,BELLF ;SET BELL FLAG
TXZ FF,ALTF ;AND CLEAR ESC SEEN FLAG
JRST LI3QT ;AND STUFF ^G INTO COMMAND BUFFER
;HERE ON CONTROL-R
CTRLR: CHKEO EO21,LI3QQ ;IF EO=1 THEN ^R IS RANDOM CHARACTER
CHKEO EO25,LI3QN ;IF EO=2 THEN ^R IS QUOTING CHARACTER
PUSHJ P,RETYPR ;OTHERWISE ^R RETYPES THE CURRENT LINE
SKIPG COMCNT ;HAVE ANY COMMANDS?
JRST LIS1E ;NO, WATCH FIRST CHARACTER SPECIAL
JRST LI11 ;AND SIMPLY DISAPPEARS
;HERE ON CONTROL-U
CTRLU: PUSHJ P,DELLIN ;DELETE ONE "PHYSICAL" COMMAND LINE
JRST CLIS4 ;EMPTY, RE-PROMPT
JRST LI10 ;RESUME COMMAND TYPEIN
;HERE ON CONTROL-V
CTRLV: CHKEO EO25,LI3QQ ;IF EO=1 OR 2 THEN ^V IS RANDOM CHARACTER
JRST LI3QN ;OTHERWISE ^V IS QUOTING CHARACTER
;HERE ON CONTROL-W
CTRLW: CHKEO EO25,LI3QQ ;IF EO=1 OR 2 THEN ^W IS RANDOM CHARACTER
PUSHJ P,RUBWRD ;OTHERWISE ^W RUBS-OUT A COMMAND WORD
JRST LIS1E ;EMPTY, WATCH FIRST CHARACTER SPECIAL
JRST LI10 ;RESUME COMMAND TYPEIN
;RETYPE THE CURRENT COMMAND LINE
RETYPR: TXNE FF,BELLF ;^G^R (RETYPE ENTIRE COMMAND)?
PUSHJ P,BACKUP ;YES, DELETE THE ^G FROM THE COMMAND BUFFER
MOVE D,COMCNT ;MARK CURRENT POSITION
PUSHJ P,BACKLN ;BACK UP TO BEG OF LINE
JRST RETYP2 ;HIT BEG OF COMMAND STRING
IBP COMPTR ;SKIP THE <CR>
AOS C,COMCNT ; (AND COUNTER TOO)
;AT THIS POINT, COMCNT IS ONE TOO SMALL AND COMPTR POINTS ONE BYTE IN FRONT
;OF THE FIRST TEXT COMMAND CHARACTER TO BE REPRINTED (E.G., ON THE <LF>
;OR IMMEDIATELY IN FRONT OF THE COMMAND BUFFER IF NO FULL LINES YET).
RETYP2: SKIPE CMFECH ;COMMAND FILE NO ECHO?
JRST RETYP4 ;YES, NO OUTPUT HERE THEN
MOVEI CH,.CHCRT ;<CR>
PUSHJ P,TYOM ;BACK TO START OF LINE
MOVEI CH,.CHLFD ;<LF>
SKIPN SCTYPE ;ON VIDEO TERMINAL?
PUSHJ P,TYOM ;NO, THEN NEED NEW LINE AS WELL
CAILE E,0 ;NICE NORMAL <CR><LF> SETUP?
PUSHJ P,RETYUP ;NO, EMBEDDED LINE MOVEMENTS, WORK HARDER
MOVEI CH,"*" ;OUR PROMPT
SKIPG COMCNT ;HAVE WE BACKED UP TO THE START?
PUSHJ P,TYOM ;YES, THEN RE-PROMPT FOR NEATNESS TOO
MOVEM D,COMCNT ;RESET COMCNT TO CORRECTNESS
JRST RETYP5 ;ENTER RETYPE LOOP
;LOOP OUTPUTTING THE COMMAND LINE AS PRESENT IN THE BUFFER
RETYP4: ILDB CH,COMPTR ;GET NEXT [POSSIBLE] COMMAND CHAR
JUMPLE C,RETYP5 ;(BACKLN CAN RETURN US -1)
SKIPN CMFECH ;SUPPRESSING ECHO DUE TO COMMAND FILE?
PUSHJ P,TYIEC ;ECHO (TYPE) COMMAND CHARACTER
RETYP5: CAMGE C,D ;CAUGHT UP YET?
AOJA C,RETYP4 ;NO, DO MORE
RETYP8: SKIPE SCTYPE ;ON VIDEO SCREEN?
PUSHJ P,CLREOS ;YES, ERASE POSSIBLE GARBAGE
SKIPLE CH,COMCNT ;ONLY USE COMPTR IF VALID
LDB CH,COMPTR ;RELOAD CURRENT [LAST] CHARACTER
CAIN CH,.CHESC ;LOOKING AT AN ALTMODE?
TXO FF,ALTF ;YES, BETTER SET FLAG
POPJ P, ;RETURN
RETYUP: SKIPN SCTYPE ;ON VIDEO SCREEN?
POPJ P, ;HARDCOPY - WE CAN DO NOTHING USEFUL HERE
PUSH P,CH ;SAVE CHARACTER
CAML E,SLENTH ;MOVEMENT GREATER THAN SCREEN SIZE?
JRST RETYU8 ;YES, JUST CLEAR SCREEN
PUSHJ P,CUP ;MOVE CURSOR UP ONE LINE
SOJG E,.-1 ;MOVE UP AS MANY LINES AS NEEDED
PUSHJ P,CLREOS ;CLEAR REST OF SCREEN
POP P,CH ;RESTORE CHARACTER
POPJ P, ;AND RETURN
RETYU8: PUSHJ P,CLRSCN ;ERASE AND HOME UP
SETZ E, ;WE DID ALL THE LINES NEEDED
POP P,CH ;RESTORE CHARACTER
POPJ P, ;BACK TO WHOMEVER
;HERE TO RUBOUT ONE COMMAND CHARACTER
RUBCHR: PUSHJ P,RUBOUT ;RUBOUT ONE COMMAND CHARACTER
POPJ P, ;ALL USED UP, WATCH FIRST CHAR SPECIAL
JRST CPOPJ1 ;BACK FOR MORE COMMAND INPUT
;HERE TO RUBOUT ONE COMMAND "WORD"
RUBWRD: SKIPN SCTYPE ;ON VIDEO TERMINAL?
JRST RUBWR1 ;NO, THE "^W" STAYS
PUSHJ P,RUB2P ;YES, ERASE THE "^W" FROM THE SCREEN
TXNN FF,BELLF ;^G^W (RUBOUT "SENTENCE")?
JRST RUBWR1 ;NO
PUSHJ P,RUB2P ;YES, ERASE THE "^G" FROM THE SCREEN
PUSHJ P,BACKUP ; AND FROM THE COMMAND BUFFER TOO!
;NOW EAT ANY AND ALL PRECEDING SPACES (ASSUME <CR><LF> = SPACE)
RUBWR1: LDB CH,COMPTR ;FETCH CURRENT LAST COMMAND CHARACTER
CAIE CH,.CHVTB ;IF A <VT>
CAIN CH,.CHFFD ;OR A <FF>
JRST RUBWR4 ;EAT IT, AND PRECEDING <CR>, IF PRESENT
RUBWR2: CAIE CH,.CHTAB ;IF A <TAB>
CAIN CH," " ;OR A SPACE
JRST RUBWR3 ;JUST ABSORB IT
CAIE CH,.CHLFD ;A <LF>?
JRST RUBWR7 ;RANDOM CHARACTER, EAT IT
PUSHJ P,RUBOUT ;RUBOUT THE <LF>
POPJ P, ;ALL USED UP, WATCH FIRST CHAR SPECIAL
CAIE CH,.CHCRT ;PRECEDED BY A <CR>?
JRST RUBWR5 ;NO, TREAT AS A POSSIBLE WORD BREAK
RUBWR3: PUSHJ P,RUBOUT ;RUBOUT THE CHARACTER
POPJ P, ;ALL USED UP, WATCH FIRST CHAR SPECIAL
JRST RUBWR2 ;LOOK FOR MORE SPACES
RUBWR4: PUSHJ P,RUBOUT ;EAT THE <VT> OR <FF>
POPJ P, ;ALL USED UP, WATCH FIRST CHAR SPECIAL
CAIN CH,.CHCRT ;PRECEDED BY A <CR>?
JRST RUBWR7 ;YES, EAT THE <CR> TOO
RUBWR5: CAIL CH,"0" ;NUMERIC?
CAILE CH,"9" ; . . .
CAIL CH,"A" ;ALPHAMERIC (UPPER CASE)?
CAILE CH,"Z" ; . . .
CAIL CH,"a" ;ALPHAMERIC (LOWER CASE)?
CAILE CH,"z" ; . . .
CAIN CH,"-" ;OR RANDOM HYPHEN?
JRST RUBWR7 ;YES TO ONE OF ABOVE, PART OF WORD, EAT IT
TXNN FF,BELLF ;^G^W (RUBOUT "SENTENCE")?
JRST CPOPJ1 ;NO, ONLY ONE WORD, ALL DONE
CAIE CH," " ;YES, ON A SPACE?
CAIN CH,.CHCRT ;OR A TAB?
JRST RUBWR7 ;YES, THEN NOT A "SENTENCE" BREAK
CAIE CH,.CHLFD ;<LF>?
JRST RUBWR6 ;NO, END OF "SENTENCE"
PUSHJ P,BACKUP ;PEEK AT CHARACTER PRECEDING <LF>
AOS COMCNT ;RESTORE COMMAND CHARACTER COUNT
IBP COMPTR ;AND COMMAND CHARACTER POINTER
CAIN CH,.CHCRT ;<CR><LF> PAIR?
JRST RUBWR4 ;YES, THEN NOT A "SENTENCE" BREAK
LDB CH,COMPTR ;NO, RESTORE CHARACTER
RUBWR6: TXZ FF,BELLF ;CLEAR ^G FLAG
JRST CPOPJ1 ;AND RESUME COMMAND TYPEIN
RUBWR7: PUSHJ P,RUBOUT ;RUBOUT ANOTHER COMMAND CHARACTER
POPJ P, ;ALL USED UP, WATCH FIRST CHAR SPECIAL
JRST RUBWR5 ;SEE IF END OF "WORD" YET
;DELETE ONE "PHYSICAL" (TERMINATED BY <CR><EOL>) COMMAND LINE
DELLIN: TXNN FF,BELLF ;^G^U (DELETE ENTIRE COMMAND)?
JRST DELLI2 ;NO, JUST ^U, EAT THIS PHYSICAL LINE
PUSHJ P,BACKUP ;YES, EAT THE ^G
ADDI C,1 ;(SIGH) SO LIS4X CAN SUBI IT OUT AGAIN
MOVEM C,COMLEN ;IN CASE OF "*" COMMAND IMMEDIATELY FOLLOWING
TXO F2,GOING ;FLAG THAT WE HAVE SOMETHING GOING ON
DELLI2: PUSHJ P,BACKLU ;BACKUP A LINE, GUARANTEEING MOVEMENT
SETOM COMCNT ;NOTE NO COMMANDS LEFT
SKIPE CMFECH ;COMMAND FILE NO ECHO?
JRST DELLI6 ;YES
SKIPE SCTYPE ;NO, USER TYPEIN, ON VIDEO TERMINAL?
JRST DELLI4 ;YES, ERASE THE LINE
PUSHJ P,INLMES ;"ECHO" THE ^U
ASCIZ \^U\
PUSHJ P,CRR ;GO TO A NEW LINE
JRST DELLI6 ;AND FINISH UP
DELLI4: MOVEI CH,.CHCRT ;A <CR>
PUSHJ P,TYOM ;BACK TO MARGIN
CAIE E,0 ;BAD CASE (EMBEDDED "LINES")?
PUSHJ P,RETYUP ;YES, MOVE CURSOR BACK THEN
PUSHJ P,CLREOL ;YES, ERASE ABOUT-TO-BE ERASED LINE FROM SCREEN
DELLI6: SKIPGE COMCNT ;ANYTHING LEFT IN BUFFER?
POPJ P, ;NO
AOS COMCNT ;KEEP CRLF
IBP COMPTR
JRST CPOPJ1 ;CONTINUE TYPE-IN
;RUBOUT ONE COMMAND CHARACTER, CLEARING THE SCREEN AS NEEDED
RUBOUT: SKIPG COMCNT ;ANYTHING TYPED IN?
POPJ P, ;NO, RETURN ALL USED UP
LDB CH,COMPTR ;RELOAD THE CHAR.
SKIPE COMCNT ;AT BEGINNING OF COMMAND STRING?
SKIPE CMFECH ;COMMAND FILE NO ECHO?
JRST RUBOU8 ;YES TO ONE OF ABOVE
;RUBOUT ONE LOGICAL CHARACTER FROM THE SCREEN
SKIPN SCTYPE ;ON VIDEO TERMINAL?
JRST RUBOU6 ;NO
CAIN CH,.CHDEL ;A RUBOUT?
JRST RUBOU8 ;YES (?)
CAIE CH,.CHCRT ;A <CR>?
CAIN CH,.CHTAB ;A <TAB>?
JRST RUBTAB ;YES, HAIRY CASE
CAIN CH,.CHLFD ;<LF>?
JRST RUBLF ;YES
CAIN CH,.CHVTB ;<VT>?
JRST RUBVT ;YES
CAIN CH,.CHFFD ;<FF>?
JRST RUBFF ;YES
CAIGE CH," " ;RANDOM CONTROL CHARACTER?
SKIPA CH,CHTBL(CH) ;YES
HRLI CH,(EC$SLF) ;NO, PRINTING ASCII
TXNE CH,EC$CRL ;ECHO WITH <CR><LF>?
JRST RUBCRL ;YES, ICK
PUSH P,C ;SAVE AN AC
SETZ C, ;INITIAL COUNTER
TXNN CH,EC$SLF ;ECHO LITERALLY?
TXNE CH,EC$DLR ;OR AS "$"?
MOVEI C,1 ;YES, ONE SCREEN POSITION TAKEN UP
TXNE CH,EC$UPA ;ECHO AS ^X?
MOVEI C,2 ;YES, THEN TAKES UP TWO POSITIONS
RUBOU3: PUSHJ P,RUB1P ;WIPE OUT ONE SCREEN CHARACTER
SOJG C,RUBOU3 ;LOOP FOR ALL SCREEN POSITIONS
POP P,C ;RESTORE AC
JRST RUBOU8 ;FINALLY GO DELETE CHARACTER
RUBOU6: PUSHJ P,TYOM ;JUST ECHO THE CHARACTER BEING RUBBED-OUT
RUBOU8: PUSHJ P,BACKUP ;BACK OVER THE CHAR.
RUBOU9: JUMPG C,CPOPJ1 ;RESUME TYPE-IN IF ANYTHING LEFT
SKIPE SCTYPE ;ON SCREEN-MODE TERMINAL?
POPJ P, ;YES, JUST WAIT
PUSHJ P,CRR ;NO, SO GO TO NEW LINE,
MOVEI CH,"*" ;RE-PROMPT,
PJRST TYOM ;AND WAIT FOR NEW COMMAND
RUBCRL: PUSHJ P,CUP ;BACKUP A LINE FIRST, THEN
RUBTAB: PUSHJ P,BACKUP ;RUBOUT THE LAST CHARACTER
JUMPLE C,RETYPR ;IF NONE LEFT, RE-PROMPT
TXZE FF,BELLF ;^G SEEN RECENTLY (E.G., ^G^W)?
JRST RUBTA2 ;YES, DON'T DELETE IT IN RETYPE CODE
PUSHJ P,RETYPR ;OTHERWISE REBUILD THE SCREEN LINE
JRST CPOPJ1 ;AND RETURN FOR MORE INPUT
RUBTA2: PUSHJ P,RETYPR ;REBUILD THE SCREEN LINE
TXO FF,BELLF ;TURN ^G FLAG BACK ON
JRST CPOPJ1 ;RETURN HAPPILY
RUBVT: SKIPA E,[4] ;<VT> IS 4 <LF>S
RUBFF: MOVEI E,^D8 ;<FF> IS 8 <LF>S
PUSHJ P,CUP ;MOVE UP THE SCREEN
SOJG E,.-1 ; FOR REQUISITE NUMBER OF LINES
JRST RUBOU8 ;AND DELETE THE CHARACTER
RUBLF: PUSHJ P,CUP ;MOVE CURSOR UP ONE LINE
JRST RUBOU8 ;DELETE THE <LF>
RUB2P: PUSHJ P,RUB1P ;BLANK FIRST (OF TWO) SCREEN POSITIONS
RUB1P: SKIPE CMFECH ;NO-ECHOING OF COMMAND FILE?
POPJ P, ;YES, THEN NO OUTPUT
MOVEI CH,.CHCNH ;BACKSPACE CHARACTER
PUSHJ P,TYOM ;OUTPUT IT
MOVEI CH," " ;SPACE CHARACTER
PUSHJ P,TYOM ;OUTPUT IT
MOVEI CH,.CHCNH ;ANOTHER BACKSPACE CHARACTER
PJRST TYOM ;OUTPUT IT
;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
;
;RETURNS IN E THE COUNT OF "LOGICAL" LINES PASSED - I.E., THE COUNT OF
;<LF>'S, <VT>'S, OR <FF>'S NOT IMMEDIATELY PRECEDED BY A <CR>. NOTE THAT
;A <VT> IS 4 <LF>S, AND A <FF> IS 8 <LF>S.
;
;BACKLU IS LIKE BACKLN ONLY IT WILL GO BACK A LINE EVEN IF POINTER
;IS ONLY JUST PAST A <CR><LF>. THIS ALLOWS MULTIPLE ^U'S TO EAT MULTIPLE
;LINES.
BACKLU: SETZ E, ;COUNT OF LINES PASSED
LDB CH,COMPTR ;GET CURRENT COMMAND CHARACTER
CAIN CH,.CHLFD ;<LF>
MOVEI E,1 ;YES, ONE LINE
CAIN CH,.CHVTB ;<VT>?
MOVEI E,4 ;YES, FOUR LINES
CAIN CH,.CHFFD ;<FF>?
MOVEI E,^D8 ;YES, EIGHT LINES
JRST BACKL0 ;NOW SEARCH FOR THE PRECEDING LINE
BACKLN: SETZ E, ;COUNT OF LINES PASSED LOOKING FOR <CR>
SKIPLE CH,COMCNT ;DON'T DO LDB IF OUT OF BUFFER SPACE
LDB CH,COMPTR ;COPY OF CURRENT LAST CHARACTER
SKIPA C,COMCNT ;AND COUNT OF CHARACTERS
BACKL0: PUSHJ P,BACKUP ;BACK UP ONE CHAR
BACKL1: JUMPG C,BACKL5 ;KEEP GOING IF MORE TO DO
BACKL2: HLRZ C,E ;GET LAST "LINES" COUNT
ADD E,C ;ADD TO TOTAL SO FAR
ANDI E,-1 ;RETURN "LINES" SKIPPED
MOVE C,COMCNT ;RESTORE C
TXZ FF,BELLF ;CLEAR FLAG
POPJ P, ;SINCE WE JUST HIT THE START OF THE BUFFER
BACKL5: PUSHJ P,CKEOL ;IS THIS AN EOL CHAR?
JRST BACKL8 ;NO, LOOP FOR OTHER FUNNY CHARACTERS
HLRZ C,E ;GET LAST "LINES" COUNT
ADD E,C ;ADD TO TOTAL SO FAR
CAIN CH,.CHLFD ;<LF>?
HRLI E,1 ;YES
CAIN CH,.CHVTB ;<VT>?
HRLI E,4 ;YES, = 4 <LF>S
CAIN CH,.CHFFD ;<FF>?
HRLI E,^D8 ;YES, = 8 <LF>S
PUSHJ P,BACKUP ;YES, BACK UP ONE MORE
JUMPLE C,BACKL2 ;IF AT BEGINING, THEN STOP IN ANY CASE
TXNN FF,BELLF ;DOING ^G BACKUP (E.G., ^G^R OR ^G^U)?
CAIE CH,.CHCRT ;NO, AT OTHER THAN A <CR><EOL>?
JRST BACKL1 ;YES (TO EITHER), DON'T STOP HERE
ANDI E,-1 ;RETURN COUNT OF "EXCESS" LINES SKIPPED
JRST CPOPJ1 ;TAKE SKIP RETURN
BACKL8: CAIGE CH," " ;CONTROL CHARACTER?
MOVE CH,CHTBL(CH) ;YES, GET ECHO CONTROL BITS
TXNE CH,EC$CRL ;THIS CHARACTER ECHO WITH <CR><LF>?
ADDI E,1 ;YES, COUNT IT IN LINES COUNTER
JRST BACKL0 ;AND LOOK AT NEXT (PREVIOUS) CHARACTER
;BACK UP BYTE POINTER IN COMPTR, LOAD APPROPRIATE CHARACTER IN CH,
;AND ADJUST COMCNT
BACKUP: MOVNI T,1 ;NEGATIVE ONE POSITIONS
ADJBP T,COMPTR ;BACK UP COMPTR ONE POSITION
DMOVEM T,COMPTR ;AND LEAVE RESULTS IN COMPTR
SOSLE C,COMCNT ;DECREMENT COMMAND COUNT
LDB CH,COMPTR ;LOAD CHAR IF ANY LEFT
POPJ P,
SUBTTL TECO COMMAND EXECUTION
CD: TXO F2,GOING!DOING ;A COMMAND STRING IS IN
RET: PUSHJ P,PCSEC ;CHECK FOR WRONG PC SECTION
TXZ FF,ARG!ARG2!FINDR!PCHFLG!SEQUIN
TXZ F2,S.MINS!S.REPL!S.DELE!S.KILL!S.FRCM ;CLEAR SEARCH FLAGS
TXZE FF,COLONP ;COLON-MODIFIED COMMAND FORGET TO RETURN VALUE?
$FATAL (NVR,,<Colon-modified command didn't return a value>)
CD1: SETZM SYL ;NO ARGUMENT ELEMENT (OR ATOM) SEEN
CD2: SETZM NUM ;NO ARGUMENT STRING SEEN
MOVE A,BEG ;STARTING CHARACTER ADDRESS
CAML A,Z ;ANY TEXT IN TEXT BUFFER
TXZ F2,LSNF ;NO, THEN NO LSN'S LEFT EITHER
MOVSI A,(MOVE B,) ;STANDARD ARG OPERATOR IS MOVE B,SYL
CD3: HLLM A,DLIM
CD5: PUSHJ P,RCH
CD9: MOVE A,CH ;GET COMMAND CHARACTER
CAIL CH,"0" ;IS IT A DIGIT?
CAILE CH,"9"
TXZ F2,OCTALF ;NO, CLEAR OCTAL RADIX FLAG
CAIE A,"`" ;ACCENT GRAVE IS ILLEGAL
CAILE A,"z" ;ALSO 173-177 ARE ILLEGAL
MOVEI A,0
CAILE A,"_" ;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: TRNN A,300000 ;IS IT A JRST DISPATCH WITH NO ARG PROCESSING?
JRST <HIORGP_PG2WRD>(A) ;YES, DO IT
MOVE B,NUM ;NO, TAKE CARE OF ARGUMENTS
XCT DLIM ;NUM:=NUM (DLIM OPERATOR) SYL
MOVEM B,NUM
SETZM SYL ;CLEAR OLD OPERAND
MOVE C,SARG ;SAVE SECOND ARGUMENT IN C.
TXZ FF,SYLF ;CLR DIGIT STRING BIT
TXZ F2,CTLVA+CTLVVA+CTLWB+CTLWWB+EMATCH+TXTCTL
TRZ A,100000 ;CLR PUSHJ DISPATCH BIT
TRZE A,200000 ;JRST OR PUSHJ DISPATCH?
JRST <HIORGP_PG2WRD>(A)
PUSHJ P,<HIORGP_PG2WRD>(A)
JRST RET
U DLIM,1 ;
U NUM,1 ;
U SYL,1 ;
U SARG,1 ;
;CHECK FOR PC SECTION GOODNESS
PCSEC: PUSH P,TT ;SAVE AN AC
XMOVEI TT,777 ;GET CURRENT PC SECTION
ANDCMI TT,777 ;REDUCE TO JUST SECTION COUNT
CAMN TT,SECTN ;PC STILL IN RIGHT SECTION?
JRST PCSEC8 ;YES, OK
$FATAL (WPS,PCSEC3,<Wrong PC section, returning to proper PC section>)
PCSEC3: MOVE TT,SECTN ;THE CORRECT PC SECTION
HLLM TT,-1(P) ;FORCE POPJ TO RIGHT SECTION TOO
HRRI TT,PCSEC8 ;AND A LOCAL PC
XJRST TT ;RESTORE SECTION GOODNESS
PCSEC8: POP P,TT ;RESTORE TRASHED AC
POPJ P, ;RETURN IN PROPER SECTION
;DIGITS FORM DECIMAL INTEGERS.
CDNUM: TXON FF,SYLF ;DIGIT STRING ALREADY STARTED?
SETZM SYL ;NO, INIT TO ZERO
MOVEI A,12 ;RADIX 10
TXNN F2,OCTALF ;OCTAL FLAG ON?
JRST CDNUM1 ;NO
MOVEI A,10 ;YES, RADIX 8
CAIG CH,"7" ;8 OR 9 IN OCTAL STRING?
JRST CDNUM1 ;NO, PROCEED
TXZ F2,OCTALF ;YES, CLEAR OCTAL FLAG
$FATAL (OCT,,< "00" in octal digit string>)
CDNUM1: IMUL A,SYL ;SCALE PREVIOUS VALUE
ADDI A,-60(CH) ;ADD IN NEW DIGIT
;SOME COMMANDS HAVE A NUMERIC VALUE
VALRET: MOVEM A,SYL
CD7: TXO FF,ARG
JRST CD5
;$ (<ESC>) COMMAND
ALTMOD: PUSHJ P,PKRCH ;PEEK AHEAD ONE CHARACTER
JRST ALTM2 ;NO COMMAND CHARACTERS LEFT AT THIS LEVEL
CAIE CH,.CHESC
JRST CD
ALTM1: TXNE FF,TRACEF ;TRACING?
PUSHJ P,CRR ;YES, TYPE CR/LF BEFORE *
JRST GO
ALTM2: SKIPN EQM ;WITHIN 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.
$FATAL (MEU,,<Macro ending with ^>)
TRZ CH,140 ;CHANGE IT TO CONTROL CHARACTER
JRST CD9 ;DISPATCH
;^O SETS FLAG FOR OCTAL RADIX INPUT
OCTIN: TXO F2,OCTALF
JRST CD5 ;RETURN WITHOUT MESSING UP ARGUMENTS
;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM
COMMA: MOVEM B,SARG ;SAVE CURRENT ARGUMENT IN SARG.
TXZE FF,ARG ;WAS THERE A CURRENT ARGUMENT?
TXOE FF,ARG2 ;YES. WAS THERE ALREADY A SECOND ARGUMENT?
$FATAL (ARG,,<Improper arguments>)
JRST CD1 ;YES. CLEAR CURRENT ARGUMENT.
;@ COMMAND MODIFIER
ATSIGN: TXO FF,SLSL ;SET @ SEEN FLAG
JRST RET ;AND CONTINUE WITH COMMAND SCAN
; NOTE THAT "@" MUST PRECEDE ANY ":" MODIFIER
;COLON COMMAND MODIFIER
;GENERATE A FREE "()" SEQUENCE. THIS IS SO COMMANDS SUCH AS THE EXPRESSION
;"1+:.,.+9SFOO$" DOES NOT LOSE THE LEADING "1+" ATOM. THIS IS SORT OF A
;KROCK. THE PROBLEM ARISES FROM THE NECESSITY TO NEST EXPRESSIONS WITHIN
;THE VALUE-RETURNING COMMAND (IN THIS CASE, ".+9"). FURTHER, THE SECOND
;ARG MUST ALSO BE PRESERVED (E.G., "100,150+:1,.+(2*2)SBLAH$T").
COLON: PUSH P,SARG ;PRESERVE SECOND ARG
PUSH P,NUM ;PRESERVE CURRENT EXPRESSION VALUE
PUSH P,DLIM ;PRESERVE CURRENT OPERATOR
PUSH P,FF ;PRESERVE CURRENT ARG AND ARG2 VALUE
PUSH P,[1] ;SET PAREN FLAG ON PDL
TXZ FF,ARG!ARG2 ;START WITH A FRESH SLATE
TXO FF,COLONF!COLONP;SET : SEEN FLAG
JRST CD1 ;CONTINUE WITH COLON-MODIFIED COMMAND
;( USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN FOR +,-,*,/,& AND #.
OPENP: PUSH P,SARG ;PRESERVE SECOND ARG
PUSH P,NUM ;PUSH CURRENT ARGUMENT.
PUSH P,DLIM ;CURRENT OPERATOR
PUSH P,FF ;SAVE ARG AND ARG2
PUSH P,[1] ;SET PAREN FLAG ON PDL
JRST CD1
;HERE TO STORE THE VALUE FROM A COLON-MODIFIED COMMAND
CLOSEC: TXZN FF,COLONP ;CLOSE THE "()" GENERATED BY THE COLON-
; MODIFIED COMMAND (E.G., "1+:.,.+9SBLAH$=")
JRST VALRET ;OOPS, WASN'T REALLY COLON-MODIFIED
MOVE T,-1(P) ;GET OLD FLAGS (ARG AND ARG2)
TXNN T,ARG2 ;WAS ARG2 SET?
TXZA FF,ARG2 ;NO, ENSURE IT IS NOW CLEAR
TXO FF,ARG2 ;YES, ENSURE IT IS NOW SET
TXNN T,COLONF ;IN A COLON-MODIFIED NESTED EXPRESSION?
TXZA FF,COLONF ;NO
TXO FF,COLONF ;YES (E.G., "100,200+:B,Z+:.,.+10SY$SX$T$$")
TXNN T,COLONP ;IN A FREE "()" DUE TO COLON-MODIFIER?
TXZA FF,COLONP ;NO
TXO FF,COLONP ;YES
;) END OF PARENTHESIS OPERATOR PRECEDENCE CONTROL
CLOSEP: POP P,T ;LAST THING ON PDL A LEFT PAREN?
JUMPL T,CLOSE1 ;SOMETHING LIKE "(...<...)" (MATCH ANGLE>)
SOJN T,CLOSE2 ;MISSING (
MOVEM B,SYL ;YES. SAVE CURRENT ARGUMENT.
POP P,T ;TOSS OFF OLD FLAGS
POP P,DLIM ;RESTORE OPERATOR
POP P,NUM ;RESTORE ARGUMENT.
POP P,SARG ;RESTORE SECOND ARGUMENT
JRST CD7
CLOSE1: $FATAL (PAR,,<Confused use of parenthesis>)
CLOSE2: $FATAL (MLP,,<Missing left parenthesis>)
;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
JRST CD3
;MULTIPLY TAKES TWO ARGUMENTS
TIMES: MOVE B,COMMAX ;CALCULATE WHICH CHARACTER
SUB B,COMCNT ;* WAS.
CAIN B,1 ;WAS * THE FIRST CHAR?
JRST STARQ ;YES, LOAD Q-REGISTER
MOVSI A,(IMUL B,) ;DLIM = IMUL B,SYL
JRST CD3
STARQ: SKIPE B,COMSAV ;IS THERE A SAVED COMMAND BUFFER?
JRST STARQ2 ;YES, PUT IT IN A Q REGISTER
PUSHJ P,GCH ;NO - EAT Q-REG NAME
$FATAL (NCS,,<No command string seen prior to *00>)
STARQ2: TLNN B,300000 ;THIS REALLY IS A Q-REGISTER STYLE POINTER?
TLNN B,400000 ;ISN'T IT?
HALT .+1 ;NO - I WONDER WHAT HAPPENED TO IT?
PUSHJ P,QREGVI ;REG NAME WITH IQL CHECK
MOVEM B,QTAB-"0"(CH) ;AND SAVE PTR IN THE Q-REG.
SETZM COMSAV ;NO LONGER NEED THIS POINTER
JRST CD ;NEXT COMMAND
;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS
SLASH: MOVSI A,(IDIV B,) ;DLIM = IDIV B,SYL
JRST CD3
;RETURNS THE VALUE OF THE FORM FEED FLAG
FFEED: TXNE FF,FORM ;IS IT SET?
JRST FFOK ;YES, RETURN A -1
;NO, DO BEGIN ROUTINE
;RETURNS THE NUMERIC VALUE 0.
BEGIN: MOVEI A,0
JRST VALRET
;^N RETURNS VALUE OF EOF FLAG
EOF: TXNN FF,FINF ;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.
TXO FF,SEQUIN ;INITIALIZE AS NEW LINE
TXNE FF,ARG2 ;FLAG ANY ARGS BEFORE H
$FATAL (ARG,,<Improper arguments>)
TXOA FF,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
LSVCMD: MOVE A,VVAL ;LENGTH OF LAST TEXT
JRST VALRET
U VVAL,1 ;LENGTH OF LAST TEXT STRING PROCESSED
U VVALFR,1 ;VVAL USED IN FR COMMAND
;N= CAUSES THE VALUE OF N TO BE TYPED OUT.
PRNT: TXNN FF,ARG ;INSIST ON ARG BEFORE =
$FATAL (NAE,,<No argument before =>)
SETOM WINFLG ;SO DISPLAY DOESN'T ERASE WHAT = TYPES
PUSHJ P,PKRCH ;PEEK AT NEXT COMMAND CHARACTER
JRST PRNT9 ;NONE LEFT
CAIE CH,"=" ;ANOTHER = SIGN?
JRST PRNT9 ;NO
TXO F2,OCTALF ;YES, THAT MEANS OCTAL RADIX TYPE-OUT
PUSHJ P,SKRCH ;SWALLOW THE EXTRA =
TXZ F2,OCTALF ;AT END OF MACRO
PRNT9: SKIPE CMFTYO ;SUPPRESSING OUTPUT WHILE IN COMMAND FILE?
POPJ P, ;YES, DON'T ACTUALLY TYPE ANYTHING
PUSHJ P,PRNT9S ;PRINT NUMBER
JRST CRR ;CRLF AND RETURN TO CALLER
;TYPE C(B) IN OCTAL
OCTMS: TXOA F2,OCTALF ;SET OCTAL RADIX
;TYPE C(B) IN DECIMAL
DECMS: TXZ F2,OCTALF ;DECIMAL RADIX
PRNT9S: XMOVEI A,TYO ;OUTPUT ON TTY
PUSHJ P,DPT ;TYPE NUMBER
TXZ F2,OCTALF ;CLR RADIX FLAG
POPJ P,
;N^T OUTPUT ASCII CHARACTER "N" (E.G., "A" FOR N=^O101, ETC) TO
; COMMAND STREAM; IF "N" OMITTED, THEN ACCEPT AND RETURN VALUE
; OF NEXT COMMAND INPUT CHARACTER. IF EO .LE. 2 THEN "N" IGNORED
; AND COMMAND INPUT ALWAYS PERFORMED.
;
;NOTE WELL THAT THIS ROUTINE WILL READ FROM THE COMMAND FILE IF ONE
;IS IN EFFECT. THIS IS SO THAT A CRASH RECOVERY PROCEDURE SUCH AS
;"E@NNNTEC.TEB" WILL WORK - I.E., GET YOU BACK TO WHEREVER YOU LEFT
;OFF.
CMCCT: CHKEO EO25,CMCCTI ;OLD VERSIONS ALL FORMS ^T ARE TYPEIN
TXNN FF,ARG ;^T OR N^T FORM?
JRST CMCCTI ;^T, ACCEPT CHARACTER FROM COMMAND INPUT
SKIPE CMFTYO ;SUPPRESSING OUTPUT WHILE IN COMMAND FILE?
POPJ P, ;YES, DON'T ACTUALLY TYPE ANYTHING
MOVE CH,B ;POSITION CHARACTER
PUSHJ P,TYO ;TYPE OUT COMMAND'S CHARACTER
PUSHJ P,TYOOUT ;AND FORCE IT OUT NOW!
JRST RET ;NEXT COMMAND
CMCCTI: TXO FF,TIBKA ;ONE CHARACTER AT A TIME
PUSHJ P,TYI ;GET A SINGLE CHAR.
PJRST VCHRET ;RETURN VALUE IN "CH"
;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: 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
$FATAL (MUU,,<Macro ending with ^^>)
VCHRET: MOVE A,CH
JRST VALRET
;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: PUSHJ P,PKRCH ;PEEK AT NEXT COMMAND CHARACTER
JRST BAKSL0 ;NONE LEFT
CAIE CH,"\" ;ANOTHER BACKSLASH?
JRST BAKSL0 ;NO
TXO F2,OCTALF ;YES, SWITCH TO OCTAL RADIX THEN
PUSHJ P,SKRCH ;EAT THE SECOND BACKSLASH
TXZ F2,OCTALF ;END OF MACRO, NOT "\\" AFTER ALL
BAKSL0: TXZE FF,ARG ;WHICH KIND OF BACKSLASH?
JRST NBAKSL ;ARG TO MEMORY
MOVE I,PT ;MEMORY TO VALRET
CAML I,Z ;CAN WE READ ANOTHER?
JRST BAKSL3 ;NO
PUSHJ P,GETINC ;CHECK FOR + OR - SIGN
CAIN CH,"+"
JRST BAKSLA ;IGNORE +
CAIE CH,"-"
JRST BAKSL1 ;NO SIGN
TXO FF,ARG ;NEGATION FLAG
BAKSLA: CAML I,Z ;OVERDID IT ?
JRST BAKSL3 ;YES. EXIT
PUSHJ P,GETINC ;NO. GET A CHAR
BAKSL1: CAIG CH,"9" ;DIGIT?
CAIGE CH,"0" ;DIGIT?
SOJA I,BAKSL2 ;NOT A DIGIT. BACKUP AND LEAVE LOOP
TXNE F2,OCTALF ;OCTAL MODE?
CAIG CH,"7" ;YES, MORE STRINGENT REQUIREMENTS
CAIA ;VALID OCTAL/DECIMAL DIGIT
SOJA I,BAKSL2 ;NOT A VALID OCTAL DIGIT
SUBI CH,"0" ;CONVERT TO NUMBER
EXCH CH,SYL
TXNE F2,OCTALF ;OCTAL MODE?
IMULI CH,^D8 ;YES
TXNN F2,OCTALF ;DECIMAL MODE?
IMULI CH,^D10 ;YES
ADDM CH,SYL ;SYL:= 10.*SYL+CH
JRST BAKSLA ;LOOP
BAKSL3: MOVE I,Z ;HERE ON OVERFLOW
BAKSL2: TXZE FF,ARG ;MINUS SIGN SEEN?
MOVNS SYL ;YES. NEGATE
MOVEM I,PT ;MOVE POINTER PAST #
TXZ F2,OCTALF ;CLEAR USED-UP RADIX FLAG
JRST CD7 ;DONE
;NA (WHERE N IS A NUMERIC ARGUMENT) = VALUE IN 7-BIT ASCII OF THE
;CHARACTER TO THE RIGHT OF THE POINTER.
ACMD: TXNN FF,ARG ;DOES AN ARGUMENT PRECEED A?
JRST APPEND ;NO. THIS IN AN APPEND COMMAND.
MOVE A,Z ;IF POINTER IS AT END OF
SUB A,PT ; BUFFER OR IF BUFFER EMPTY,
JUMPE A,VALRET ; MUST GIVE 1A=0
MOVE I,PT ;YES.
PUSHJ P,GET ;CH:=CHARACTER TO THE RIGHT OF PT.
PJRST VCHRET ;RETURN CH AS VALUE
;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I.
USE: TXNN FF,ARG ;INSIST ON ARG BEFORE U
$FATAL (NAU,,<No argument before U>)
PUSHJ P,QREGVI ;CH:=Q-REGISTER INDEX.
PUSHJ P,USEQV ;STUFF B INTO NUMERIC Q-REG
JRST RET ;DONE
;HELPER TO STORE AC B AS NEW NUMERIC Q-REG VALUE
USEQV: TLNE B,400000 ;DOES THE ARG LOOK LIKE A TEXT POINTER?
TLNE B,300000 ;(IE., IS IT OUT OF RANGE?)
JRST USEQV2 ;NO, GO STORE IT
$FATAL (AOR,,<Argument out of range>)
USEQV2: MOVEM B,QTAB-"0"(CH) ;STORE ARGUMENT IN SELECTED Q-REG.
POPJ P, ;SUCCESSFUL RETURN
;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.
QREG: PUSHJ P,QTXTST ;GET Q-REG & CHECK FOR TEXT
JRST VALRET
;ROUTINE TO RETURN Q-REGISTER INDEX IN CH AND CONTENT IN A.
QREGVI: PUSHJ P,SKRCH ;CH:=NEXT COMMAND STRING CHARACTER.
$FATAL (MIQ,,<Macro ending with 00>)
QREGV2: CAIL CH,"a" ;LC LETTER?
CAILE CH,"z" ; . . .
CAIA ;NO.
TXZ CH,40 ;YES, SHIFT TO UPPER CASE SET
CAIL CH,"0" ;DIGIT?
CAILE CH,"9" ; . . .
CAIL CH,"A" ;LETTER?
CAILE CH,"Z" ; . . .
$FATAL (IQN,,<Illegal Q-register name "00">)
CAILE CH,"9" ;ALPHANUMERIC, IS DIGIT?
SUBI CH,"A"-"9"-1 ;NO, TRANSLATE LETTERS DOWN BY NUMBER OF
POPJ P, ;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q-REG'S
;N%I ADDS "N" TO THE QUANTITY IN Q-REGISTER I AND STANDS FOR THE
; NEW VALUE; IF "N" OMITTED, THEN "1" IS DEFAULT. IF EO .LT. 2
; THEN "1" ALWAYS, "N" IGNORED.
PCNT: CHKEO EO25,PCNT2 ;OLD FORMS ALWAYS ADD JUST 1
TXNN FF,ARG ;USER SPECIFY AN ARGUMENT?
PCNT2: MOVEI B,1 ;NO, DEFAULT VALUE OF "1"
PUSHJ P,QTXTST ;GET Q-REG & CHECK FOR TEXT
ADD B,A ;B:=NEW Q-REG NUMERIC VALUE
PUSHJ P,USEQV ;STORE NEW NUMERIC VALUE
MOVE A,B ;VALRET WANTS "A" TO HOLD VALUE
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,300000 ;..
POPJ P, ;NO,RETURN
$FATAL (NNQ,,<No numeric in Q-register 00>)
;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.
XCMD: PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS
;B:=SECOND STRING ARGUMENT ADDRESS.
PUSHJ P,CHK1 ;IS SECOND ARG. ADDR. GT FIRST ARG. ADDR.?
EXCH B,C ;YES.
SUB C,B ;C:=LENGTH OF STRING.
MOVNM C,VVAL ;SAVE LENGTH OF STRING
; (NEGATIVE SINCE PT NOT AFFECTED)
PUSHJ P,XQREG ;MOVE DATA TO Q-REG BUFR
PUSHJ P,QREGVI ;GET INDEX TO Q-REG
MOVEM B,QTAB-"0"(CH) ;STORE NEW Q-REG TEXT POINTER
JRST RET ;END OF COMMAND
;TRANSFER DATA TO Q-REGISTER BUFFER
;CALL IS:
;
; MOVX B,<ADR>
; MOVX C,<LEN>
; PUSHJ P,XQREG
; RETURN
;
;WHERE <ADR> IS THE STARTING CHARACTER ADDRESS OF THE TEXT STRING; AND
;<LEN> IS THE LENGTH OF THE STRING TO BE LOADING INTO A Q-REGISTER BUFFER.
;
;ON RETURN AC B HAS THE Q-REGISTER POINTER. IT IS THE CALLER'S RESPONSIBILITY
;TO SAVE THE POINTER.
;
;RDH ONE SUGGESTION THAT HAS BEEN MADE IS TO DELETE THE CURRENT Q-REG
; CONTENTS BEFORE TRYING TO LOAD IT IN ORDER TO MAXIMIZE THE CHANCES
; OF HAVING ENOUGH MEMORY TO HOLD THE NEW TEXT . . .
XQREG: PUSH P,PT ;PRESERVE USER'S "."
ADDI C,3 ;C:=LENGTH OF STRING + 3 (FOR BYTE COUNT)
MOVE T,BEG ;GET START CHARACTER ADDRESS OF TEXT BUFFER
MOVEM T,PT ;PT:=BEG
ADD T,C ;PROPOSED NEW BEG
IDIVI T,5 ;TT:=OFFSET FROM WORD-ALIGNEDNESS
CAIE TT,0 ;IF NOT WORD ALIGNED, THEN
SUBI TT,5 ;CALCULATE [NEGATIVE] FILL REQUIRED
SUB C,TT ;ADD IN NULL-FILL TO SPACE REQUEST
ADDM C,(P) ;(P):=PT + LENGTH OF STRING + 3 + NULL-FILL.
PUSHJ P,NROOMQ ;INSERT STRING AT BEG, RELOCATING SCREEN
SKIPE OU,RREL ;RELOCATION IF GARBAGE COLLECTION OCCURRED.
ADDM OU,(P) ;RELOCATE NEW TRUE "." IF NECESSARY
CAMGE B,BEG ;DON'T NEED TO RELOCATE IF *I
JRST XQREG3 ;STRING ADDRESS IS ALL SET
ADD B,C ;STRING IS FROM TEXT BUFFER, SHIFT IT UP
ADD B,OU ;B:=FIRST ADDR + LENGTH + 3 + NULL-FILL + RREL
XQREG3: MOVE OU,BEG ;OU:=ADDRESS OF Q-REG BUFFER
ADDM C,BEG ;BEG:=C(BEG)+LENGTH OF STRING + 3 + NULL-FILL
ADD C,TT ;C:=LENGTH OF STRING + 3
PUSHJ P,PTQCNT ;WRITE THE Q-REG LENGTH FIRST
MOVE I,B ;SOURCE TEXT ADDRESS FOR COPY
JRST XQREG7 ;START UP TEXT STRING COPY LOOP
XQREG5: PUSHJ P,GETINC ;PICK UP NEXT TEXT CHARACTER
PUSHJ P,PUTINC ;AND STUFF IT AWAY INTO Q-REG
XQREG7: SOJGE C,XQREG5 ;LOOP UNTIL ALL CHARACTERS COPIED
MOVE B,PT ;QTAB ENTRY := 4B2 + Q-REG BUFFER
SUB B,QRBUF ;ADDRESS RELATIVE TO C(QRBUF)
TLO B,400000
POP P,PT ;MOVE PT PAST STRING.
POPJ P,
;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:
SETZM VVAL ;CLR STRING LENGTH HOLD
PUSHJ P,QTEXT ;INIT Q-REG ACCESS
MOVE B,CH ;SAVE INDEX
PUSHJ P,GTQCNT ;C:=LENGTH OF STRING
JUMPE C,RET ;IF NO TEXT, ALL DONE
PUSHJ P,NROOMC ;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE CH,B ;RE-SET Q-REG NAME
PUSHJ P,QTEXTC ;FIND NEW [POSSIBLY GARBAGE-COLLECTED] Q-REG
PUSHJ P,GTQCNT ;SKIP COUNT FIELD
MOVE OU,PT
QGET1: PUSHJ P,GETINC ;GET NEXT Q-REG TEXT CHARACTER
PUSHJ P,PUT ;AND PUT IT INTO THE TEXT BUFFER
ADDI OU,1 ;ADVANCE OUTPUT POINTER
SOJG C,QGET1 ;LOOP FOR ENTIRE Q-REG'S WORTH OF TEXT
MOVEM OU,PT ;PUT "." JUST PAST THE "INSERT"
JRST RET ;ALL DONE
;INITIALIZE ACCESS OF TEXT FROM A Q-REGISTER
QTEXT: PUSHJ P,QREGVI ;A=QTAB ENTRY, CH=Q-REG INDEX
QTEXTC: MOVE A,QTAB-"0"(CH) ;GET Q-REGISTER POINTER
TLZE A,400000 ;MAKE SURE IT CONTAINS TEXT
TLZE A,300000
$FATAL (NTQ,,<No text in Q-register 00>)
ADD A,QRBUF
MOVE I,A ;I=Q-REG BUFFER ADDRESS
POPJ P,
;GET 21 BIT Q-REGISTER CHARACTER COUNT
GTQCNT: PUSHJ P,GETINC ;LOW ORDER 7 BITS
MOVEM CH,C
PUSHJ P,GETINC ;MIDDLE 7 BITS
LSH CH,7
IORM CH,C
PUSHJ P,GETINC ;HIGH 7 BITS
LSH CH,^D14
IORM CH,C
SUBI C,3 ;LESS 3 BYTES USED TO STORE THIS COUNT
POPJ P,
;SET 21-BIT Q-REGISTER CHARACTER COUNT
PTQCNT: MOVE CH,C ;FIRST CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS
PUSHJ P,PUTINC ;OF LENGTH OF STRING + 3
LSH CH,-7 ;SECOND CHARACTER = MIDDLE 7 BITS
PUSHJ P,PUTINC
LSH CH,-7
SUBI C,3 ;C:=LENGTH OF TEXT STRING
PJRST PUTINC ;STUFF LAST CHARACTER OF COUNT, RETURN
;MI PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS.
MAC: PUSHJ P,QTEXT ;INIT Q-REG ACCESS
PUSH P,COMMAX ;SAVE CURRENT COMMAND STATE
PUSH P,COMPTR ;SAVE CURRENT COMMAND BYTE POINTER
PUSH P,COMPTX ; (DOUBLE-WORD POINTER ADDRESS)
PUSH P,COMCNT ;SAVE CURRENT COMMAND CHARACTER COUNT
PUSH P,. ;FLAG MACRO ON PDL (LARGE POS. NO.)
PUSHJ P,GTQCNT ;GET NUMBER OF CHARACTERS IN MACRO
MOVEM C,COMCNT ;THAT MANY COMMANDS TO COUNT
MOVEM C,COMMAX ;AND MAX.
SUBI I,1 ;ADJUST TO SUIT BTAB
IDIVI I,5
HLLZ OU,BTAB(OU) ;MAKE A BYTE POINTER
TLZ OU,77 ;CLEAR OUT INDEXING/ETC.
SKIPE SECTN ;PC IN EXTENDED SECTION?
TLOA OU,(1B12) ;YES, USE DOUBLE-WORD POINTER
HRR OU,I ;NO, USE SINGLE-WORD LOCAL POINTER
MOVEM OU,COMPTR ;SET NEW COMMAND BYTE POINTER
MOVEM I,COMPTX ; (DOUBLE-WORD POINTER ADDRESS)
AOS EQM ;INCREMENT THE MACRO LEVEL
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: SKIPA C,[POP PF,]
;[I PUSHES Q-REGISTER I ONTO THE Q-REGISTER PUSHDOWN LIST.
OPENB: MOVSI C,261000+PF*40
PUSHJ P,QREGVI
HRRI C,QTAB-"0"(CH) ;C:=Q-REGISTER INDEX.
XCT C ;PUSH OR POP Q-REGISTER.
JRST RET
;E COMMANDS SELECT AND CONTROL FILE INPUT-OUTPUT MEDIA
ECMD: PUSHJ P,SKRCH ;GET CHAR AFTER E
$FATAL (MEE,,<Macro ending with E>)
MOVEI T,ECTABL ;INDEX DISPATCH TABLE
PUSHJ P,DISPAT
$FATAL (IEC,,<Illegal character "00" after E>)
;E-COMMAND DISPATCH TABLE
ECTABL: XWD EA, "A" ;EDIT ALL (READ IN WHOLE FILE)
XWD EB, "B" ;EDIT AND MAKE A BACKUP COPY OF A FILE
XWD EC, "C" ;FINISH FILE I/O AND CLOSE OUTPUT
XWD EF, "F" ;CLOSE OUTPUT FILE AS IS (NO MORE I/O)
XWD EG, "G" ;EXIT AND RE-EXECUTE LAST COMPIL-CLASS COMMAND
XWD EH, "H" ;(OBSOLETE) SET ERROR LEVEL TYPEOUT
XWD EK, "K" ;KILL (ABORT) THE OUTPUT FILE
XWD EM, "M" ;PERFORM MAGTAPE OPERATION
XWD EO, "O" ;SET OLD VERSION COMPATIBILITY
XWD EP, "P" ;PUSH TO A NEW CONTEXT
XWD ER, "R" ;SELECT FILE FOR READ ONLY
XWD ES, "S" ;SET AUTO-TYPEOUT ON SEARCH MATCH
XWD ET, "T" ;TERMINAL CONTROL
XWD EU, "U" ;SET UPPER VS LOWER CASE CONTROL
XWD EW, "W" ;SELECT FILE TO WRITE ONLY
XWD EX, "X" ;OUTPUT AND CLOSE OUTPUT FILE, EXIT
XWD EY, "Y" ;YANK COMMAND
XWD EZ, "Z" ;ZERO DECTAPE DIRECTORY
XWD CMFCMD, "@" ;READ COMMAND FILE
XWD 0,0 ;MARKS END OF LIST
;MISCELLANEOUS CHARACTER DISPATCHER
;CALL: MOVE CH,CHARCATER
; MOVEI T,TABLE ADDR
; PUSHJ P,DISPAT
; NOT FOUND RETURN
;ENTER AT DISP1 TO AVOID CONVERTING LC TO UC
DISPAT: CAIL CH,"a" ;LOWER CASE?
CAILE CH,"z" ; . . .
CAIA ;NO
TRZ CH,40 ;YES, CONVERT TO UPPER CASE
DISP1: PUSH P,A ;SAVE AC A WHILE WE USE IT
DISP2: HRRZ A,(T) ;GET TABLE ENTRY
JUMPE A,APOPJ ;"ERROR" RETURN IF NO MATCH
CAME A,CH ;TABLE ENTRY MATCH?
AOJA T,DISP2 ;NOT A MATCH
HLRZ A,(T) ;MATCH, GET DISPATCH ADDRESS
HRRM A,-1(P) ;SET DISPATCH ADDRESS (AS IF PJRST)
PJRST APOPJ ;RESTORE AC A & DISPATCH
;EA -- READ IN ENTIRE FILE INCLUDING <FF>'S
;EAFIL -- EA ENTRY POINT FROM RDFIL
EAFIL: TXZA FF,ARG ;CLEAR ARG FLAG
EA: TXNN FF,ARG ;USER TYPE NEA?
HRLOI B,377777 ;NO, ASSUME LARGE REPEAT COUNT
JUMPLE B,EASET ;IF 0 OR -1 SET EA MODE FLAG
TXNN FF,UREAD ;GOT AN INPUT FILE?
$FATAL (NFI,,<No file for input>)
PUSH P,B ;SAVE REPEAT COUNT
PUSHJ P,TRLFF ;CHECK FOR ANY TRAILING <FF> NEEDED
;ALLOCATE ROOM FOR THE WHOLE FILE
EA2: SKIPLE C,INSIZ ;BYTES REMAINING IN INPUT FILE
TXNE FF,ARG ;IF USER SPECIFIED REPEAT COUNT FOR APPEND
JRST EA6 ;JUST DO IT, GRABBING CORE AS NEEDED
;RDH SKIPE SECTN ;*** MONITOR HASN'T IMPLEMENTED EXTENDED DUMP
;RDH JRST EA6 ;*** MODE I/O YET, SO DO IT THE HARD WAY FOR NOW
DMOVE A,PT ;GET "." AND "Z"
MOVEM AA,PT ;TELL NROOM IT IS A DATA EXPANSION
ADDI C,^D3000 ;TECO'S ELBOW ROOM
PUSHJ P,NROOMC ;MAKE ROOM FOR REST OF INPUT FILE
ADD A,RREL ;RELOCATE "."
ADD AA,RREL ;AND Z IN CASE GARBAGE COLLECTION WAS DONE
DMOVEM A,PT ;RESTORE "." AND "Z" TO RIGHTFUL PLACES
IDIVI AA,5 ;AA:=WORD ADDRESS IN WHICH "." RESIDES
MOVEM B,EAXDEL ;CLEAR (OR PREPARE TO SET) FLAG
JUMPE B,EA2E ;IF NOT WORD ALIGNED DO IT THE HARD WAY
MOVNI B,5 ;CALCULATE
ADDM B,EAXDEL ;NUMBER OF BYTES OFFSET
ADDI AA,1 ;ROUND UP "Z" TO NEXT WORD BOUNDRY
EA2E: MOVE T,INSWT ;INPUT FILE SWITCHES
;RDH TXNN T,GENLSN!SUPLSN ;ANYTHING FUNNY HAPPENING?
SKIPLE BICNT ;OR HAVE WE STARTED BUFFERED INPUT?
JRST EA6 ;YUP, DO IT THE HARD WAY
MOVE T,INCHR ;GET INPUT DEVICE CHARACTERISTICS
TXNN T,DV.DSK ;NON-DISK?
JRST EA6 ;YUP, DO IT THE HARD WAY
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE TO DUMP IN THE WHOLE FILE IN ONE SWELL FOOP
EA3: POP P,B ;ADJUST STACK
MOVE T,INSIZ ;FILE SIZE IN BYTES
ADDI T,4 ;ROUND UP AND
IDIVI T,5 ;TRUNCATE TO NUMBER OF WORDS
MOVE C,T ;SAVE TOTAL WORD COUNT
SKIPE SECTN ;RUNNING EXTENDED?
JRST EA3E ;YES, DIFFERENT I/O THEN
;HERE TO DO OLDE-FASHIONED (NON-EXTENDED) DUMP-MODE I/O
IDIVI T,400000 ;TAKE MOD 128K
CAILE T,1 ;.GT. 256K?
HALT . ;CAN'T GET HERE
CAIE T,0 ;.LE. 128K?
SKIPA T,[400000] ;NO, .GT. 128K
EXCH T,TT ;YES, ONLY ONE IOWD NEEDED
MOVNS T ;NEGATIVE WORD COUNT
HRLZS T ; IN LEFT HALF
MOVNS TT ;NEGATIVE (OR ZERO) WORD COUNT
HRLZS TT ; IN LEFT HALF
HRRI T,-1(AA) ;FIRST WORD ADDRESS DUMP STYLE
CAIE TT,0 ;NEED TWO IOWDS?
HRRI TT,400000-1(AA) ;YES, SECOND PART OF COMMAND LIST
JRST EA3I ;GO DO DUMP-MODE INPUT
;HERE FOR NEW-FANGLED (EXTENDED) DUMP-MODE I/O
EA3E: MOVE TT,AA ;I/O ADDRESS IN 'BI-WORD' FORMAT
;HERE TO ACTUALLY PERFORM THE I/O
EA3I: DMOVEM T,IOLIST ;POSITION DUMP-MODE COMMAND LIST
SETZB T,TT ;A '0' TO
DMOVEM T,IOLIST+2 ;TO TERMINATE THE COMMAND LIST
MOVSI T,INCHN ;I/O CHANNEL
HRRI T,.FOSET ;FUNCTION: SETSTS
MOVEI TT,.IODMP ;TO SELECT DUMP-MODE I/O
MOVE CH,[2,,T] ;FILOP. ARG POINTER TO
FILOP. CH, ;SWITCH TO DUMP-MODE INPUT
JRST INERR ;DUH???
HRRI T,.FOINP ;FUNCTION: INPUT
SKIPE SECTN ;RUNNING EXTENDED?
HRRI T,.FOFXI ;YES, SELECT EXTENDED DUMP I/O
;*** XMOVEI TT,IOLIST ;ADDRESS OF DUMP-MODE COMMAND LIST
MOVEI TT,IOLIST ;*** ADDRESS OF DUMP-MODE COMMAND LIST
MOVE CH,[2,,T] ;FILOP. ARG POINTER TO
FILOP. CH, ;DUMP THE WHOLE FILE
JRST INERR ;I/O ERROR, FORGET IT
HRRI T,.FOSET ;FUNCTION: SETSTS (AGAIN)
MOVEI TT,IO.EOF+.IOASC;TO SWITCH BACK TO STANDARD ASCII
MOVE CH,[2,,T] ;FILOP. ARG POINTER TO
FILOP. CH, ;RESELECT ASCII I/O
JRST INERR ;DUH???
TXO FF,FINF ;GOT IT, TELL YANK3 ABOUT IT
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIUOS PAGE
;FILE IS READ IN, CHECK FOR EMBEDDED NULLS AND/OR LINE SEQUENCE NUMBERS
EA4: MOVN T,C ;COUNT OF WORDS TO CHECK
MOVE TT,AA ;START OF JUST-READ TEXT
ADD TT,C ;END (+1) OF JUST READ TEXT
MOVSI TT1,((T)) ;PREPARE TO INDEX VIA AC "T"
SKIPE SECTN ;RUNNING EXTENDED?
LSH TT1,IFX2EF ;YES, REPOSITION INDEX REGISTER
IOR TT,TT1 ;SET INDEXING FROM AC "T"
SKIPG S.OKNU ;OKNULLS? (USER WANTS SPEED)
JRST EA4L ;NO, CHECK FOR NULLS TOO
SKIPLE S.OKLS ;OKLSN?
JRST EA4OK ;YES, USER REALLY WANTS SPEED!
;JUST CHECK FOR LINE SEQUENCE NUMBERS, USER IS WILLING TO LIVE WITH NULLS
MOVEI TT1,1B35 ;THE LSN BIT
TDNN TT1,@TT ;GOT AN LSN HERE?
AOJL T,.-1 ;NO, CHECK NEXT WORD
JUMPGE T,EA4OK ;IF NO LSNS THEN ALL SET
JRST EA4N ;OOPS - SAW AN LSN!
;CHECK FOR BOTH NULLS AND LINE SEQUENCE NUMBERS
EA4L: MOVX CH,177B20 ;CENTER NULL CHECK MASK
EA4L0: SKIPN TT1,@TT ;GET A WORD FROM THE BUFFER
JRST EA4N ;FULL OF NULLS
TLNE TT1,(177B6) ;GOT A NULL?
TLNN TT1,(177B13) ;GOT A NULL?
JRST EA4N ;YEP
TDNE TT1,CH ;GOT A NULL?
TRNN TT1,177B27 ;GOT A NULL?
JRST EA4N ;YEP
TRNE TT1,177B34 ;GOT A NULL?
TRNE TT1,1B35 ;GOT A LSN?
JRST EA4N ;YEP
AOJL T,EA4L0 ;NO, CHECK NEXT WORD
JRST EA4OK ;IF NO LSN, BUFFER IS OK
;EITHER A LINE SEQUENCE NUMBER OR AN EMBEDDED NULL HAS BEEN DETECTED.
EA4N: XMOVEI TT1,@TT ;FROM WHENCE TO START RE-WRITING
SETZB A,AA ;INITIALIZE FOR LOOP
SUBI T,1 ;BACKUP FOR LOOP BELOW
MOVE I,INSWT ;COPY OF /GENLSN FOR LOOP TEST
TXO I,1B17 ;TEMP FIRST-TIME FLAG
;A := WORD BEING BUILT; AA := WORD BEING CHECKED
;T := NEGATIVE COUNT; @TT := ADDRESS OF NEXT AA; TT1 := ADDRESS FOR THIS A
EA4N1: LSH AA,7 ;DISCARD THIS NULL
JUMPN AA,EA4N6 ;AND CHECK REST OF WORD
AOJGE T,EA4N8 ;EXIT IF DONE
MOVE AA,@TT ;NEXT FRESHLY-READ FILE WORD
TXZE AA,1B35 ;IS THIS WORD AN LSN?
TXNN I,SUPLSN!1B17 ;YES, SUPPRESS UNLESS USER WANTS 'EM
JRST EA4N6 ;REGULAR TEXT OR DESIRED LSN
TXZ I,1B17 ;NOTE WE'VE SEEN AN LSN
TXNN I,SUPLSN ;NOW, DO WE REALLY CARE?
JRST EA4N6 ;NO
EA4N3: AOJGE T,EA4N8 ;AN UNDESIRED LSN
MOVE AA,@TT ;GET WORD FOLLOWING
TXNE AA,1B35 ;ANOTHER LSN?
JRST EA4N3 ;YES (??)
TLNE AA,(177B6-11B6) ;A TAB CHARACTER
JRST EA4N6 ;NO WAY, NOT SOS-STYLE
TLC AA,(11B6) ;MAYBE
TLCN AA,(11B6) ;TRAILING SOS-STYLE TAB?
LSH AA,7 ;YES, STRIP IT TOO
JRST EA4N6 ;GO HANDLE REST OF TEXT WORD
EA4N6: TLNN AA,(177B6) ;A NULL?
JRST EA4N1 ;YES, DISCARD IT
LSHC A,7 ;NO, CONCATENATE CHAR TO PREVIOUS
TLNN A,(177B7) ;GOT 5 MORE CHARACTERS YET?
JRST EA4N6 ;NO
LSH A,1 ;YES, LEFT-JUSTIFY THE CHARACTERS
MOVEM A,(TT1) ;AND WRITE THEM BACK TO THE BUFFER
SETZ A, ;RESET CHARACTER ACCUMULATOR
AOJA TT1,EA4N6 ;AND GET MORE CHARACTERS
EA4N8: LSH A,7 ;LEFT-JUSTIFY THE TEXT
TLNN A,(177B7) ;DONE YET?
JUMPN A,EA4N8 ;NO, FINISH WORD
LSH A,1 ;LEFT-JUSTIFY THE WORD
MOVEM A,(TT1) ;YES, CAP OFF TEXT BUFFER
TXNE I,1B17 ;DID WE SEE ANY LSNS?
JRST EA4N9 ;NO
MOVE OU,TT1 ;SAVE END ADDRESS
PUSHJ P,INBMES ;TELL HAPLESS USER
ASCIZ \% Line Sequence Number detected in input file\
TXO FF,SEQF ;NOTE WE'VE SEEN LSN'S
AOSA I,OU ;PUT ADDRESS IN I
EA4N9: AOS I,TT1 ;POSITION AND
IMULI I,5 ; CALCULATE POTENTIAL NEW "Z"
JRST EA4OK2 ;FINISH OFF THE BUFFER
;HERE TO RE-READ THE FILE THE HARD WAY
;
;EA4N: SETSTS INCHN,.IOASC ;SET ASCII MODE, CLEAR EOF
; USETI INCHN,1 ;POSITION TO FIRST BLOCK
; TXZ FF,FINF ;CLEAR OUR EOF FLAG
; HRLOI B,377777 ;SET LARGE REPEAT COUNT
; JRST EA7 ;AND READ THE FILE THE HARD WAY
;FILE HAS NO LINE SEQUENCE NUMBERS NOR EMBEDDED NULLS, SUPPRESS ANY
;TRAILING NULLS
EA4OK: MOVE I,Z ;WHERE WE STARTED READING
ADD I,INSIZ ;NEW "Z"
SUB I,EAXDEL ;ALLOW FOR ANY EXTRA NULLS PUT IN ABOVE
EA4OK2: SETZM INSIZ ;NOTE NO MORE TEXT LEFT IN INPUT FILE
MOVE B,Z ;SAVE OLD Z
SUBI I,1 ;BACKUP TO LAST CHARACTER
PUSHJ P,GET ;AND GET IT
JUMPE CH,.-2 ;IF NULL, CHUCK IT
ADDI I,1 ;THIS CHARACTER IS VALID
CAMGE I,PT ;SOME JOKER FEED US A FILE OF NULLS?
MOVE I,PT ;YEAH, WELL FOO ON HIM
MOVEM I,Z ;SET "Z", SUPPRESSING TRAILING NULLS
SKIPE C,EAXDEL ;GOT SOME EXCESS NULLS NEEDING DELETION?
CAML B,I ;YEAH, DO THEY STILL EXIST?
JRST EA4XT ;NO, TIME TO GET OUT
EXCH B,PT ;YES, SET "." TO START OF NULL FILL
PUSHJ P,NROOMC ;ABUT NEW FILE TEXT TO PREVIOUS TEXT
ADD B,RREL ;JUST IN CASE . . .
MOVEM B,PT ;RESTORE TRUE USER'S "."
EA4XT: POPJ P, ;RETURN HAVING READ ENTIRE FILE
;SHOULD ALSO DELETE INPUT BUFFERS!
;LOOP YANKING (APPENDING ACTUALLY) FROM INPUT FILE
EA6: POP P,B ;GET LOOP COUNT
EA7: MOVE OU,Z ;END OF EDITING BUFFER
PUSHJ P,YANK2 ;APPEND ANOTHER CHUNK OF INPUT TEXT
TXZE FF,FORM ;TERMINATED BY A <FF>?
AOS Z ;YES, ACCOUNT FOR THE <FF> TOO!
; THIS CODE DEPENDS ON YANK51'S ACTUALLY
; HAVING READ IN THE <FF> BUT NOT COUNTING
; IT IN Z.
TXNN FF,FINF ;MORE INPUT FILE LEFT?
SOJG B,EA7 ;YES, READ (APPEND) N TIMES
POPJ P, ;AND RETURN
U EAXDEL,1 ;NULL-FILL COUNT (NEGATIVE) FOR DUMP I/O
;HERE TO SET EA MODE DEFAULT
EASET: CAIE B,0 ;EA MODE OFF?
MOVEI B,1 ;NO, EA MODE ON
MOVEM B,S.EAMO ;SET FOR RDFIL TO SEE
POPJ P, ;ALL DONE
;EX -- FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.
;^Z -- FINISH OUTPUT (IF ANY) AND EXIT
FINISZ: TXNN FF,UWRITE ;HAVE WE GOT AN OUTPUT FILE?
JRST FINIZ3 ;NO
PUSHJ P,.RUNCK## ;YES, /RUN (ETC.) PENDING?
CAIA ;NO, NOT A SERIOUS PROBLEM
$FATAL (OFZ,,<Output file still OPEN, type "EX$$" to exit>)
$WARN (OFO,,<Output file still OPEN, type CONTINUE then "EX$$" to write it>)
JRST FINISM ;GO EXIT ANYWAY
FINIZ3: MOVE B,BEG ;START OF TEXT BUFFER
CAMN B,Z ;ANY TEXT IN BUFFER?
JRST FINISM ;NO, ALL CLEAR TO EXIT (EVEN /RUN)
PUSHJ P,.RUNCK## ;GOT A /RUN PENDING?
CAIA ;NO, NOT A SERIOUS PROBLEM
$FATAL (NFZ,,<No file for output>)
$INFO (NFO,,<No file for output>)
JRST FINISM ;GO EXIT ANYWAY
EX: PUSHJ P,EC ;FINISH UP.
FINISK: PUSHJ P,ZAPIN ;ZAP INPUT CHANNEL IF ANY
PUSHJ P,ZAPOU ;ZAP OUTPUT CHANNEL IF ANY
TXZ FF,UREAD+UWRITE+FINF+UBAK ;IN CASE OF A CONTINUE
FINISM: PUSHJ P,TEBFIN ;GET RID OF CRASH RECOVERY FILE
PUSHJ P,ZAPTT ;FLUSH OUT ANY LAST TERMINAL I/O
PUSHJ P,.RUNCM## ;CHECK FOR /RUN AND FRIENDS
FINISO: EXIT 1,
;GET TO HERE IF USER CONTINUES AFTER EX COMMAND
SETOM MESFLG ;SCREEN IS TRASH NOW
PUSHJ P,TTOPEN ;RE-OPEN THE COMMAND TERMINAL
PUSHJ P,GETTYP ;GET TERMINAL TYPE AGAIN
PUSHJ P,TTYGET ;GET CURRENT TTY MODES
PUSHJ P,TTYSEC ;SET UP OUR MODES AGAIN
SETZM TEBINF ;CALL TEBINI AGAIN
JRST GO
;EG -- "EX" AND RE-RUN COMPIL FOR LAST COMPIL-CLASS COMMAND
EG: PUSHJ P,EC ;FINISH FILE IO
PUSHJ P,TEBFIN ;DELETE CRASH RECOVERY FILE
SKIPE SCTYPE ;DOING FANCY VIDEO STUFF?
PUSHJ P,CRR ;YES, TIME TO GIVE A <CR><LF>
PUSHJ P,ZAPTT ;FLUSH OUT ANY LAST TERMINAL I/O
PUSHJ P,ZAPIN ;ZAP INPUT CHANNEL IF ANY
PUSHJ P,ZAPOU ;ZAP OUTPUT CHANNEL IF ANY
TXZ FF,UREAD+UWRITE+FINF+UBAK ;IN CASE OF A CONTINUE
MOVEI A,CCLBLK ;RUN COMPIL
HRLI A,1 ;AT START ADR PLUS ONE
RUN A, ;TRANSFER CONTROL BACK TO COMPIL
JRST FINISO ;JUST EXIT IF NO RUN.
CCLBLK: SIXBIT /SYS/
SIXBIT /COMPIL/ ;RUN SYS:COMPIL
REPEAT 4,<0>
;EC -- WRITE OUT BUFFER, REST OF INPUT FILE, AND CLOSE OUTPUT FILE
EC: TXNN FF,UWRITE ;DO WE HAVE AN OUTPUT FILE
$FATAL (NFO,,<No file for output>)
;RDH SKIPN SECTN ;*** MONITOR NOT YET READY FOR DUMP I/O
SKIPLE BOCNT ;HAVE WE ALREADY STARTED BUFFERED OUTPUT
JRST EC2 ;YES
MOVE T,OUTSWT ;GET OUTPUT SWITCHS
TXNN T,GENLSN ;USER EXPLICTLY WANT LSN'S?
TXNE F2,LSNF ;OR ARE LSN'S EMBEDDED IN TEXT BUFFER
JRST EC2 ;YES, DO IT THE HARD WAY
MOVE T,OUCHR ;GET OUTPUT DEVICE CHARACTERISTICS
TXNN T,DV.DSK ;NON-DISK DEVICE?
JRST EC2 ;YES, DO IT THE HARD WAY
TXNE FF,UREAD ;DO WE HAVE AN INPUT FILE?
TXNE FF,FINF ;AND HAVE WE READ IT ALL?
JRST EC4 ;YES, WE CAN DUMP THE TEXT BUFFER DIRECTLY
;THE SLOW HARD WAY OF COPYING THE FILE
EC2: TXO FF,PCHFLG ;KEEP <FF>'S
HRLOI E,377777 ;A LARGE COUNT
PUSHJ P,PUN1 ;COPY TEXT PAGES
JRST EC7 ;CLOSE OFF OUTPUT FILE
;SETUP FOR FAST DUMP I/O
EC4: MOVE A,BEG ;START CHARACTER ADDRESS
IDIVI A,5 ;A:=START WORD ADDRESS
JUMPE AA,EC4DO ;ALL SET IF WORD ALIGNED
MOVNS AA ;BOATS. CALCULATE
MOVEI C,5(AA) ;NULL-FILL REQUIRED
MOVE A,BEG ;GET START ADDRESS AGAIN
MOVE B,PT ;ALSO COPY OF "."
MOVEM A,PT ;TELL NROOMC TO FILL AT START
PUSHJ P,NROOMC ;PUT NULL-FILL AT START OF TEXT
ADDM C,BEG ;RELOCATE BEG PAST NULL-FILL
ADD B,C ;RELOCATE "." PAST NULL-FILL
ADD B,RREL ;RELOCATE "." IF NECESSARY
MOVEM B,PT ;RESTORE PROPER USER'S "."
MOVE A,BEG ;START CHARACTER ADDRESS
IDIVI A,5 ;START WORD ADDRESS
JUMPN AA,EC2 ;IF STILL NOT WORD ALIGNED JUST GIVE UP
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE TO DUMP THE TEXT BUFFER DIRECTLY (AND QUICKLY)
EC4DO: PUSHJ P,TRLFF ;CHECK FOR A TRAILING <FF>
MOVE I,Z ;END CHARACTER ADDRESS
PUSHJ P,TRAIL0 ;ZERO TRAILING BITS IN LAST WORD
MOVE T,Z ;END CHARACTER ADDRESS
CAMG T,BEG ;ANY CHARACTERS AT ALL?
JRST EC7 ;NO, JUST CLOSE OFF FILE THEN
SUBI T,1 ;POINT BACK AT LAST REAL CHARACTER
IDIVI T,5 ;WORD ADDRESS OF END
SUB T,A ;WORD COUNT OF TEXT BUFFER (ALMOST)
ADDI T,1 ;WORD COUNT OF TEXT BUFFER
PUSH P,T ;SAVE WORD COUNT FOR A MOMENT
SKIPE SECTN ;RUNNING EXTENDED?
JRST EC4E ;YES, NEW-FANGLED WAY THEN
;DUMP THE BUFFER THE OLDE-FASHIONED WAY
IDIVI T,400000 ;MOD 128K
CAIE T,0 ;.LE. 128K?
SKIPA T,[400000] ;NO, .GT. 128K - NEED TWO IOWDS
EXCH T,TT ;YES, ONLY ONE IOWD NEEDED
MOVNS T ;NEGATIVE COUNT
HRLZS T ;POSITION COUNT FOR IOWD
MOVNS TT ;GET SECOND PART
HRLZS TT ;POSITION IT TOO
HRRI T,-1(A) ;DUMP MODE IOWD
CAIE TT,0 ;NEED A SECOND HALF?
HRRI TT,400000-1(A) ;YES, MAKE SECOND IOWD COMMAND
JRST EC4O ;GO DO THE OUTPUT
;HERE TO FORMAT FOR EXTENDED 'BI-WORD' DUMP I/O
EC4E: MOVE TT,A ;POSITION I/O ADDRESS FOR BI-WORD FORMAT
;HERE TO DUMP OUT THE EDITING BUFFER
EC4O: DMOVEM T,IOLIST ;SET THE DUMP-MODE COMMAND LIST
SETZB T,TT ;AND SOME 0'S
DMOVEM T,IOLIST+2 ;TO TERMINATE THE COMMAND LIST
POP P,T ;RETRIEVE TOTAL WORD COUNT
MOVSI TT,((T)) ;SETUP TO INDEX OFF OF AC "T"
SKIPE SECTN ;RUNNING EXTENDED?
LSH TT,IFX2EF ;YUP, DIFFERENT INDEXING THEN
IOR TT,A ;BASE ADDRESS OF TEXT BUFFER
MOVEI TT1,1B35 ;ANNOYING BIT
TDNE TT1,@TT ;IS THE BIT SET IN THIS DATA WORD?
ANDCAM TT1,@TT ;YES, BLAST IT AWAY
SOJGE T,.-2 ;FINISH THE REST OF THE BUFFER
MOVSI T,OUTCHN ;I/O CHANNEL
HRRI T,.FOSET ;FUNCTION: SETSTS
MOVEI TT,.IODMP ;TO SELECT DUMP-MODE I/O
MOVE CH,[2,,T] ;FILOP. ARG POINTER TO
FILOP. CH, ;SWITCH TO DUMP-MODE OUTPUT
JRST OUTERR ;DUH???
HRRI T,.FOOUT ;FUNCTION: OUTPUT
SKIPE SECTN ;RUNNING EXTENDED?
HRRI T,.FOFXO ;YES, SELECT EXTENDED DUMP I/O
;*** XMOVEI TT,IOLIST ;ADDRESS OF DUMP-MODE COMMAND LIST
MOVEI TT,IOLIST ;*** ADDRESS OF DUMP-MODE COMMAND LIST
MOVE CH,[2,,T] ;FILOP. ARG POINTER TO
FILOP. CH, ;DUMP THE WHOLE BUFFER
JRST OUTERR ;I/O ERROR, FORGET IT
HRRI T,.FOSET ;FUNCTION: SETSTS (AGAIN)
MOVEI TT,.IOASC ;TO SWITCH BACK TO STANDARD ASCII
MOVE CH,[2,,T] ;FILOP. ARG POINTER TO
FILOP. CH, ;RESELECT ASCII I/O
JRST OUTERR ;DUH???
;FINISH OFF THE OUTPUT FILE
EC7: PUSHJ P,EF ;CLOSE OFF THE OUTPUT FILE
PUSHJ P,ZAPIN ;[252] CLEAN OUT THE NOW-USED-UP INPUT FILE
PJRST HK ;AND ZERO THE BUFFER
;ET COMMAND
ET: POP P,CH ;CLR RET. ADDR. FROM PDL
TXNE FF,ARG ;ARGUMENT?
JRST ET1 ;YES.
TXNE FF,TYOCTF ;NO, FLAG ON?
JRST FFOK ;YES, RETURN -1
JRST BEGIN ;NO, RETURN 0
ET1: TXZ FF,TYOCTF ;CLEAR ET FLAG
JUMPE B,RET ;ARGUMENT NON-ZERO?
TXO FF,TYOCTF ;YES. SET ET FLAG
JRST RET ;RETURN
;EO COMMAND
EO: POP P,CH ;CLR RET. ADDR. FROM PDL
TXNE FF,ARG ;ARGUMENT?
JRST EO1 ;YES, SET FLAG
MOVE A,EOFLAG ;NO, RETURN VALUE OF EOFLAG
JRST VALRET
EO1: CAIG B,0 ;N LE 0?
MOVEI B,EOVAL ;YES, SET TO STANDARD
CAILE B,EOVAL ;N GT STANDARD FOR THIS VERSION?
$FATAL (EOA,,<06EO argument too large>)
MOVEM B,EOFLAG ;SET EOFLAG
JRST RET
U EOFLAG,1 ;EDIT OLD FLAG
;EU COMMAND
EU: POP P,CH ;CLR RET. ADDR. FROM PDL
TXNE FF,ARG ;ARGUMENT?
JRST EU1 ;YES
MOVE A,TYCASF ;NO, RETURN VALUE OF TYPE-OUT CASE FLAG
JRST VALRET
EU1: MOVEM B,TYCASF ;SET TYPE-OUT CASE FLAG
JRST RET
U TYCASF,1 ;TYPE-OUT CASE FLAG: 0 = TYPE ' BEFORE LC
;+ = TYPE ' BEFORE UC; - = DON'T TYPE FLAGS
;EP COMMAND - PUSH TO A NEW CONTEXT
;Command is:
;
; [n]EPfile$
;
;Where file, if present, defaults to "SYS:" and indicates a push-and-run
;function. The optional numeric argument will then be the start-address offset.
;If file is not present, the arg is ignored and we do a push-and-halt.
ND EPDATL,0 ;CURRENTLY NOT USING THE ERROR TEXT FROM THE UUO
EP: MOVE T,[EPCTXB,,EPCTXB+1] ;XFER VECTOR
SETZM EPCTXB ;ZERO A WORD
BLT T,EPCTXB+.CTMAX-1 ;SPREAD THE ZEROS AROUND
XMOVEI T,EPDATB ;DATA BUFFER
MOVEM T,EPCTXB+.CTDBA ;SET FOR UUO
MOVEI T,EPDATL ;DATA BUFFER LENGTH
MOVEM T,EPCTXB+.CTDBL ;SET FOR UUO
MOVX T,<INSVL.(.CTMAX,CT.LEN)!INSVL.(.CTSVH,CT.FNC)>
;LOAD UP LENGTH & FUNCTION
MOVEM T,EPCTXB+.CTFNC ;SET FOR UUO
PUSHJ P,PKRCH ;CHECK FOR FILESPEC
$FATAL (UMP,,<Macro ending with unterminated PUSH ("EP") command>)
CAIE CH,.CHESC ;TERMINATING <ESC>?
JRST EP1 ;NO, GO GET THE FILESPEC
PUSHJ P,SKRCH ;YES, EAT THE CHARACTER FOR REAL
$FATAL (UMP,,<Macro ending with unterminated PUSH ("EP") command>)
JRST EP7 ;GO DO THE CTXUUO
;HERE TO READ THE FILESPEC FOR A PUSH-AND-RUN REQUEST
EP1: TXNE FF,ARG ;DID WE HAVE AN ARGUMENT?
MOVEM B,EPCTXB+.CTRNO ;YES, USE IT FOR START-ADDRESS OFFSET
MOVX T,<INSVL.(.CTSVH^!.CTSVR,CT.FNC)> ;CHANGE MASK FOR FUNCTION
XORM T,EPCTXB+.CTFNC ;CHANGE FROM PUSH-AND-HALT TO PUSH-AND-RUN
SETZ B, ;NO SWITCHES ALLOWED
PUSHJ P,FILSPC ;GET THE FILESPEC
SKIPN A,COMDEV ;GET THE DEVICE
MOVSI A,'SYS' ;DEFAULT TO SYS:
MOVEM A,EPRUNB+.RNDEV ;STORE FOR CTX'S RUN UUO
MOVE A,XNAM ;FILE NAME
MOVEM A,EPRUNB+.RNNAM ;STORE FOR IMPLICIT RUN UUO
MOVE A,XEXT ;EXTENSION
MOVEM A,EPRUNB+.RNEXT ; ...
MOVE A,XPPN ;PPN OR PATH POINTER
MOVEM A,EPRUNB+.RNPPN ; ...
SETZM EPRUNB+.RNMEM ;NO SECTION ARGUMENT
XMOVEI T,EPRUNB ;ADDRESS OF RUN BLOCK
MOVEM T,EPCTXB+.CTRNB ;SET FOR CTXUUO
FALL EP7 ;DO THE CTX. NOW
;GOT THE WHOLE COMMAND, DO THE PUSH
EP7: PUSHJ P,TEBURB ;FORCE COMMAND BACKUP UPDATE NOW
PUSHJ P,CLREOS ;CLEAR OUT JUNK AT BOTTOM OF SCREEN
PUSHJ P,CRR ;NEED A CRLF JUST IN CASE
PUSHJ P,TTYRST ;RESTORE ORIGINAL USER TTY MODES
PUSHJ P,ZAPTT ;FLUSH OUT ANY LAST TERMINAL I/O
XMOVEI T,EPCTXB ;ADDRESS OF CTX. ARG BLOCK TO
CTX. T, ;PUSH TO A FRESH CONTEXT
TDZA T,T ;REMEMBER ERROR
MOVEI T,1 ;OR SUCCESS
PUSH P,T ;PRESERVE FLAG
SETOM MESFLG ;SCREEN IS TRASH NOW
PUSHJ P,TTOPEN ;RE-OPEN THE COMMAND TERMINAL
PUSHJ P,GETTYP ;GET TERMINAL TYPE AGAIN
PUSHJ P,TTYGET ;GET CURRENT TTY MODES
PUSHJ P,TTYSEC ;SET UP OUR MODES AGAIN
POP P,T ;RESTORE ERROR/SUCCESS FLAG
SKIPN T ;ISSUE MESSAGE NOW IF FAILED
$FATAL (EPF,,<Can't PUSH to a new context>)
POPJ P, ;RETURN TO COMMAND PARSER
U EPCTXB,.CTMAX ;CTXUUO ARG BLOCK
U EPRUNB,.RNMEM+1 ;CTXUUO RUN BLOCK
U EPDATB,EPDATL ;CTXUUO DATA BUFFER
;ES COMMAND
ES: POP P,CH ;CLR RET ADDR FROM PDL
TXNE FF,ARG ;ARG?
JRST ES1 ;YES
MOVE A,AUTOF ;NO, RETURN VALUE OF FLAG
JRST VALRET
ES1: 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
U AUTOF,1 ;NON-ZERO IMPLIES AUTOTYPE AFTER SEARCHES
;POSITIVE IMPLIES TYPE AUTOF AS A PTR MARKER
;^V COMMAND
LOWCAS: TXNE FF,ARG ;ARG SEEN?
JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
TXZ F2,UCASE ;CLEAR ^W FLAG
TXO F2,LCASE ;& SET ^V FLAG
JRST RET
;^W COMMAND
STDCAS: TXNE FF,ARG ;ARG SEEN?
JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
TXZ F2,LCASE ;CLEAR ^V FLAG
TXOA F2,UCASE ;& SET ^W FLAG
CLRCAS: TXZ F2,LCASE+UCASE ;0^V OR 0^W CLEARS BOTH FLAGS
JRST RET
;^X COMMAND
SETMCH: TXNE FF,ARG ;ANY ARGUMENT?
JRST SETMC1 ;YES
TXNE FF,PMATCH ;NO, FORCED EXACT MATCH FLAG ON?
JRST FFOK ;YES, RETURN -1
JRST BEGIN ;NO, RETURN 0
SETMC1: TXZ FF,PMATCH ;CLR ^X FLAG
JUMPE B,RET ;IF ARG = 0, FLAG = 0
TXO FF,PMATCH ;OTHERWISE, SET FLAG
JRST RET
;EH COMMAND -- CHANGE ERROR MESSAGE DEFAULT
EH: POP P,CH ;DUMP EXTRANEOUS RETURN ADDRESS
TXNE FF,ARG ;DO WE HAVE AN ARGUMENT?
JRST EH1 ;YES, USE IT
SKIPE A,EHVAL ;NO, RETURN VALUE IF WE HAVE IT
JRST VALRET ;YEP
JSP OU,CALLSW ;CALL SCAN/WILD
EXP 0 ;T1 IS JUNK HERE
IFIW .VERBO## ;GET OUR MESSAGE BITS
MOVE A,SCNT1 ;GET WHAT SCAN RETURNED TO US
ANDI A,7 ;MASK DOWN
MOVE A,EHVTBL(A) ;CONVERT TO USER ARGUMENT
JRST VALRET ;RETURN IT TO THE USER
EH1: CAIL B,0 ;IF NOT IN A REASONABLE RANGE,
CAILE B,3 ;EITHER WAY,
SETZ B, ;DEFAULT TO USING .VERBO
MOVEM B,EHVAL ;SAVE FOR LATER USER REFERENCE
MOVE B,EHUTBL(B) ;GET .VERBO-STYLE EQUIVALENT
MOVEM B,EHUVAL ;SAVE FOR MSG. LUUO
JRST RET ;AND THAT IS THE END OF THAT
EHVTBL: EXP 0,1,2,2,3,3,3,3 ;PLAUSIBLE FAKE USER VALUES FOR JWW.??
EHUTBL: EXP 0,JWW.PR,JWW.PR!JWW.FL,JWW.PR!JWW.FL!JWW.CN
;PLAUSIBLE SCAN VALUES FOR USER nEH ARGS
U EHVAL,1 ;USER'S ARGUMENT
U EHUVAL,1 ;EQUIVALENT FOR MSG. LUUO
;E@ READ COMMAND FILE
CMFCMD: SKIPN A,CMFLVL ;ALREADY IN A COMMAND FILE?
JRST CMFCM3 ;NO, FIRST LEVEL
CAIL A,CMFMAX ;YES, CAN WE NEST DOWN STILL FURTHER?
JRST CMFER1 ;NO, ERROR, NESTING LEVEL EXCEEDED
MOVEI A,CMFCHN ;YES, CURRENT COMMAND FILE I/O CHANNEL
DEVCHR A, ;SEE WHAT IS OUT THERE NOW
TXNN A,DV.DSK ;IS IT A DISK?
JRST CMFER2 ;NO, THEN WE CAN'T DO A LATER USETI
SKIPN A,CMFPDP ;GET COMMAND FILE STACK POINTER
MOVEI A,CMFPDL ;NONE YET, START AT BEGINING
HRLI A,CMFBLK ;BLT POINTER TO "PUSH" CURRENT FILE SPECS
MOVEI AA,CMFLEN(A) ;HOW FAR TO COPY TO
BLT A,-1(AA) ;"PUSH" CURRENT COMMAND FILE SPECS
MOVEM AA,CMFPDP ;SAVE STACK POINTER
RELEAS CMFCHN, ;TOSS OUT CURRENT COMMAND FILE
CMFCM3: MOVEI B,CMFSWT ;COMMAND FILE SWITCHES
PUSHJ P,FILSPC ;GO PARSE COMMAND FILE SPECIFICATION
CMFCM4: SKIPE COMEXT ;WAS NON-BLANK EXTENSION TYPED?
JRST CMFCM7 ;YES
MOVSI A,'TEC' ;NO, USE OUR DEFAULT
MOVEM A,COMEXT ;SET IN COMXXX BLOCK
MOVEM A,XEXT ;AND IN LOOKUP BLOCK TOO
; THIS DOES PRECLUDE NUL EXTENSIONS ON
; COMMAND FILES (WHICH IS A BUG) BUT
; YOU CAN'T WIN EM ALL!
CMFCM7: MOVE A,[COMBLK,,CMFBLK] ;BLT POINTER TO
BLT A,CMFBLK+COMBLN-1 ;SAVE COMMAND FILE SPECS
PUSHJ P,CMFOPN ;OPEN AND INITIALIZE COMMAND FILE I/O
AOS CMFLVL ;NOTE WE ARE NESTED DOWN ANOTHER LEVEL
SETZM CMFCTR ;START WITH CHARACTER 0
SKIPE A,CMFPDP ;POINTER TO PREVIOUS LEVEL SPECS
MOVE A,-<CMFLEN-<CMFSWC-CMFBLK>>(A) ;GET HIGHER LEVELS' SWITCHES
IORB A,CMFSWC ;COMBINE WITH THIS LEVEL'S /ECHO AND /TYO
TXNE A,1B0 ;/ECHO?
TDZA B,B ;YES, ECHO INPUT
SETO B, ;NO, DO NOT ECHO INPUT
MOVEM B,CMFECH ;SET ECHO CONTROL
TXNN A,1B0 ;FORCE /TYO IF /ECHO
TXNE A,1B1 ;/TYO?
TDZA B,B ;YES, ALLOW REGULAR PROGRAM OUTPUT
SETO B, ;NO, SUPPRESS NORMAL PROGRAM OUTPUT
MOVEM B,CMFTYO ;SET OUTPUT CONTROL
TXO FF,CFOF ;MARK READING FROM COMMAND FILE
POPJ P, ;ALL DONE HERE
;HERE TO SETUP COMMAND FILE I/O
CMFOPN: MOVEI A,.IOASC ;ASCII I/O MODE
DPB A,[POINTR OPNSTS,IO.MOD] ;SET IN OPEN BLOCK
MOVEI A,CMFIBH ;BUFFER RING HEADER BLOCK
MOVEM A,OPNBUF ;SET IN OPEN BLOCK
OPEN CMFCHN,OPNBLK ;GET COMMAND FILE DEVICE
JRST CMFER4 ;OPEN FAILURE
MOVEI A,OPNBLK ;DEVICE BLOCK
DEVSIZ A, ;SEE HOW BIG THE BUFFERS ARE
MOVEI A,BLKSIZ+3 ;DEFAULT SIZE
ANDI A,-1 ;JUST THE BLOCK SIZE
CAILE A,BLKSIZ+3 ;WITHIN TOLERANCES?
JRST CMFER5 ;NO, BUFFER TOO BIG
LOOKUP CMFCHN,XFIBLK ;FIND THE ACTUAL COMMAND FILE
JRST CMFER6 ;LOOKUP FAILURE
;GOT THE FILE, SET UP BUFFER RING TO READ IT
MOVE A,[BF.VBR+CMFBF1+.BFHDR] ;INITIAL BUFFER RING POINTER
MOVEM A,CMFIBH+.BFADR ;SET UP HEADER BLOCK
HRLI A,BLKSIZ+1 ;OUR BUFFER SIZE
MOVEM A,CMFBF1+.BFHDR ;ONE-BUFFER RING LINKED TO ITSELF
SETZM CMFIBH+.BFCTR ;JUST TO MAKE SURE
POPJ P, ;ALL SET UP, READY TO READ
;HERE TO SETUP INIT FILE AS A COMMAND FILE
CMFINI: SETOM CMFINF ;NOTE CMFINI HAS BEEN CALLED
SKIPN A,S.INIT+.FXDEV ;AN INIT FILE SPECIFIED?
POPJ P, ;NO, JUST RETURN
MOVEM A,COMDEV ;YES, INIT FILE DEVICE
MOVEI T,S.INIT+.FXDIR ;DIRECTORY SPEC IN SCAN BLOCK
MOVE TT,[-6,,COMPPN] ;COM??? DIRECTORY SPEC
CMFIN2: MOVE A,(T) ;GET FIRST/NEXT DIRECTORY WORD
MOVEM A,(TT) ;SET IN COM??? BLOCK
ADDI T,2 ;NEXT ENTRY IN SCAN BLOCK
AOBJN TT,CMFIN2 ;NEXT ENTRY IN COM??? BLOCK
MOVE A,S.INIT+.FXNAM ;INIT FILE NAME
MOVEM A,COMNAM ;SET IN COM??? BLOCK
HLLZ A,S.INIT+.FXEXT ;INIT FILE EXTENSION
MOVEM A,COMEXT ;SET IN COM??? BLOCK
SETZM SWITC ;NO ECHO, NO TYPEOUT OF INIT FILE
PUSHJ P,FILALT ;SETUP OPEN/LOOKUP/ETC
PJRST CMFCM4 ;PROCESS COMMAND FILE NORMALLY HEREAFTER
;COMMAND FILE ERROR ROUTINES
;NESTING LEVEL TOO DEEP
CMFER1: PUSHJ P,TYICNR ;CLEAR OUT COMMAND FILE STUFF
$FATAL (CND,,<Command file nested too deep>)
;TRYING TO NEST AWAY FROM A NON-DISK DEVICE
CMFER2: PUSHJ P,TYICNR ;CLEAR OUT COMMAND FILE STUFF
$FATAL (PCD,,<Previous command file not a disk>)
;CAN'T OPEN COMMAND FILE DEVICE
CMFER4: PUSHJ P,TYICNZ ;CLEAR OUT COMMAND FILE STUFF
$FATAL (IDV,,<Input device 04 not available>)
;COMMAND FILE BLOCKSIZE TOO BIG
CMFER5: PUSHJ P,TYICNR ;CLEAR OUT COMMAND FILE STUFF
$FATAL (CBB,,<Command file block size too big>)
;LOOKUP FAILURE FOR COMMAND FILE
CMFER6: PUSHJ P,TYICNR ;CLEAR OUT COMMAND FILE STUFF
$FATAL (LKP,,<LOOKUP error 03 for 09>)
;COMMAND FILE STORAGE VARIABLES
U CMFBLK,0 ;START OF COMMAND FILE BLOCK
U CMFDEV,1 ;COMMAND FILE DEVICE,
U CMFNAM,1 ; FILE NAME,
U CMFEXT,1 ; EXTENSION,
U CMFPPN,1 ; PROJECT/PROGRAMMER NUMBER,
U CMFSFD,5 ; AND SFD'S.
U CMFSWC,2 ;COMMAND FILE SWITCH JUNK
U CMFCTR,1 ;CHARACTER POSITION WITHIN FILE
U CMFECH,1 ;.NE. 0 THEN DON'T ECHO COMMAND FILE INPUT
U CMFTYO,1 ;.NE. 0 THEN SUPPRESS GENERAL PROGRAM OUTPUT.
; THIS DOES NOT APPLY TO ERROR MESSAGE OUTPUT
; NOR TO ^ATEXT^A OUTPUT.
CMFLEN==CMFTYO-CMFBLK+1 ;LENGTH OF COMMAND FILE AREA SAVED
U CMFINF,1 ;.NE. 0 IF INIT FILE HAS BEEN PROCESSED
U CMFLVL,1 ;NESTING LEVEL OF COMMAND FILES
U CMFPDP,1 ;PUSHDOWN STACK POINTER TO NESTED COMMAND FILES
U CMFPDL,<CMFLEN*CMFMAX>;STACK AREA FOR NESTED COMMAND FILE SPECS
U CMFIBH,3 ;COMMAND FILE BUFFER RING HEADER
U CMFBF1,<BLKSIZ+3> ;COMMAND FILE BUFFER RING
;ER PREPARE TO READ FILE
ER: TXZ FF,FINF+UREAD ;NOT EOF & CLOSE PREVIOUS INPUT
PUSHJ P,ZAPIN ;ZAP ANY INPUT FILE
SETZM SWITC ;NO FILE SWITCHES TYPED YET
MOVEI B,TXTSWT ;TEXT FILE SWITCHES
PUSHJ P,FILSPC ;GET FILE SPEC
PUSHJ P,RDFIL ;LOOKUP FILE, IF POSSIBLE
PUSHJ P,TYPFFI ;FOUND ON LIBRARY
TXZ FF,SEQF ;CLR SEQUENCE NUMBER FLAG
;RDH TXZE FF,CCLFLG ;YANK REQUESTED?
;RDH PUSHJ P,YANK ;YES, DO IT
POPJ P,
U INDEV,1
U INBUF,1
U INCHR,1
U INPTH,2
U INPPN,1
U INSFD,6
U INNAM,1
U INEXT,1
U INSIZ,1 ;SIZE OF INPUT FILE (BYTES)
U INVER,1 ;[252] INPUT FILE VERSION
U INDSZ,2 ;INPUT BUFARG AND ADDRESS
;SUBROUTINE TO OPEN THE INPUT DEVICE, SET UP BUFFERS, AND LOOKUP
;THE INPUT FILE. DOES NOT RETURN IF AN OPEN OR LOOKUP FAILURE OCCURS.
;NON-SKIP RETURN IF FILE FOUND IN LIB:, SKIP IF FILE IS OK.
RDFIL: SETZM OPNSTS ;ASCII MODE
MOVEI E,IBUF
MOVEM E,OPNBUF
MOVE E,OPNDEV ;PICKUP INPUT DEVICE
MOVEM E,INDEV ;SAVE FOR ERRORS
MOVE E,OPNCHR ;DEVCHR WORD, TOO
MOVEM E,INCHR ;ERROR PROCESSOR NEEDS IT
OPEN INCHN,OPNBLK ;OPEN INPUT FILE
$FATAL (IDV,,<Input device 04 not available>)
SETZM BICNT ;NO BUFFERED INPUTS YET
MOVEI A,OPNBLK ;ADDRESS OF OPEN BLOCK
DEVSIZ A, ;ASK MONITOR ABOUT BLOCKSIZE
CAIA ;DUH?
TXNE E,DV.DSK ;INPUT A DISK?
MOVE A,[DSKBFN,,DSKBSZ+3] ;YES, USE LARGE BUFFERS THEN
MOVEI B,IBUF ;INPUT BUFFER RING HEADER
PUSHJ P,GETBF ;ALLOCATE AND LINK BUFFER RING
$FATAL (NSI,,<No space for input buffers>)
DMOVEM A,INDSZ ;SAVE FOR LATER RECLAIMATION
MOVE A,[XNAM,,INNAM] ;COPY INPUT FILE NAME
BLT A,INEXT ;FOR ERROR MESSAGES
MOVE A,SWITC ;PICKUP USER'S SWITCHES
TXC A,GENLSN!SUPLSN ;SEE IF BOTH ARE SET
TXCN A,GENLSN!SUPLSN ;ARE THEY?
$FATAL (COS,,<Contradictory switches>)
MOVEM A,INSWT ;STORE SETTING FOR INPUT
TXNN E,DV.DIR ;LOOKUP UUO NEEDED?
JRST RDFIL8 ;NO, DON'T DO ONE
TXNE E,DV.DTA ;IS IT DECTAPE?
JRST RDFIL6 ;YES, DO SHORT LOOKUP
LOOKUP INCHN,XFILNM ;EXTENDED LOOKUP
JRST LKUPER ;ERROR
MOVE A,XSIZ ;SIZE OF FILE IN WORDS
IMULI A,5 ;A:=SIZE OF FILE IN BYTES
MOVEM A,INSIZ ;SAVE FOR EA COMMAND
MOVE A,XVER ;[252] INPUT FILE VERSION
MOVEM A,INVER ;[252] SAVE IN CASE FAKERW NEEDS IT
TXO FF,UREAD ;INPUT FILE NOW OPEN
SKIPE XSIZ ;ANYTHING IN THE FILE?
SKIPG S.EAMO ;USER WANT WHOLE FILE DUMPED IN?
JRST RDFIL3 ;NO TO EITHER, NORMAL YANK-IT-IN MODE
PUSHJ P,EAFIL ;YES
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
RDFIL3: MOVEI E,INCHN ;INPUT CHANNEL
MOVEM E,PTHBLK ;PUT INTO PATH BLOCK
MOVE E,[PTHLEN,,PTHBLK] ;DO PATH UUO
PATH. E, ;TO DETERMINE WHERE FILE WAS FOUND
JRST CPOPJ1 ;PROBABLY A TTY: OR TSK:
MOVE E,[PTHPPN,,INPPN] ;COPY PATH TO FILE
BLT E,INSFD+5 ;FOR ERROR MESSAGE PROCESSOR
PUSHJ P,CHKPTH ;WAS IT FOUND WHERE SAID IT WAS?
POPJ P, ;NO, NON-SKIP RETURN
JRST CPOPJ1 ;YES, ALL IS WELL
RDFIL6: LOOKUP INCHN,SFILNM ;SHORT LOOKUP
JRST LKUPER ;LOOKUP FAILURE
RDFIL8: TXO FF,UREAD ;INPUT FILE NOW OPEN
AOS (P) ;DECTAPES DON'T HAVE LIB'S
POPJ P, ;RETURN
EBAKUP:
EB: TXNE FF,UBAK ;IS EB ALREADY IN PROGRESS?
$FATAL (EBO,,<E00 Before Current EB Job Closed>)
TXZ FF,UBAK!UREAD!FINF ;INPUT FILE CLOSED
PUSHJ P,ZAPIN ;ZAP ANY INPUT FILE
PUSHJ P,EF ;CLOSE OUTPUT FILE IF ANY
SETZM SWITC ;NO I/O SWITCHES TYPED YET
MOVEI B,TXTSWT ;TEXT FILE SWITCHES
PUSHJ P,FILSPC ;PARSE USER'S FILE SPEC
MOVE E,SWITC ;GET SWITCHES USER TYPED
TXC E,GENLSN!SUPLSN ;CHECK FOR CONFLICTING SWITCHES
TXCN E,GENLSN!SUPLSN ;DID HE GIVE BOTH?
$FATAL (COS,,<Contradictory switches>)
MOVEM E,INSWT ;NO, STORE BOTH AS INPUT...
MOVEM E,OUTSWT ;AND AS OUTPUT SWITCHES
MOVE E,[<"00000">B34+1] ;SETUP INITIAL LSN
MOVEM E,LSNCTR ;FOR OUTPUT FILE
SKIPE E,OPNCHR ;GET CHARACTERISTICS OF HIS DEVICE
TXNE E,DV.DSK!DV.DTA ;IF DEVICE EXISTS BUT ISN'T RIGHT
CAIA ;DOESN'T EXIST (GET BETTER MESSAGE
;WHEN OPEN FAILS) OR IS OK
$FATAL (EBD,,<EB with device 04 is illegal>)
HLRZ A,XEXT ;GET PROPOSED EXTENSION
TLC E,-1-<(DV.TTA)> ;CONTRARY TO POPULAR BELIEF,
TLCE E,-1-<(DV.TTA)> ;NUL: DOESN'T PROHIBIT UFD/SFD!
TXNN E,DV.DSK ;IS EB DEVICE A DISK?
JRST EBAKU0 ;NO, DIRECTORY NAMES LEGAL
CAIE A,'SFD' ;CAN'T DO EB TO DIRECTORIES,
CAIN A,'UFD' ; SINCE RENAMES WOULD FAIL AT EF
$FATAL (EBF,,<EB with illegal file 02>)
EBAKU0: CAIN A,'BAK' ;IS IT BAK?
$FATAL (EBF,,<EB with illegal file 02>)
CAIE A,'TMP' ;USER'S EXTENSION .TMP?
JRST EBAKU1 ;NO, FILENAME IS OK TO USE
MOVE A,XNAM ;CAN'T ALLOW NNNTEC.TMP,
CAMN A,TMPTEC ;SINCE THAT'S OUR TEMP OUTPUT FILE
$FATAL (EBF,,<EB with illegal file 02>)
EBAKU1: PUSHJ P,RDFIL ;OPEN DEVICE & LOOKUP FILE
JRST FAKERW ;ON LIB:, CAN'T DO EB, DO ER/EW
SETZM PTHBLK ;CLEAR RETURNED JUNK
SETZM PTHFLG ; IN CASE MONITOR LOOKS AT IT
MOVE E,OPNCHR ;GET DEVCHR OF EB DEVICE
MOVEM E,EBCHR ;STORE FOR BAKCLS
SETZM OPNSTS ;ASCII MODE FOR OPNOU
MOVE E,[XNAM,,EBNAM] ;SAVE EB FILE & EXT FOR BAKCLS
BLT E,EBEXT ;..
MOVE E,[PTHPPN,,EBPPN] ;SAVE EB PATH TOO
BLT E,EBSFD+4 ;..
MOVE E,OPNCHR ;GET EB DEVICE
TXNN E,DV.DSK ;IS IT A DSK: ?
JRST EBAKU4 ;NO, DON'T BOTHER WITH PROTECTIONS
;FALL THROUGH TO NEXT PAGE
;HERE IF EB TO A DISK. CHECK THAT THE INPUT FILE ISN'T TOO PROTECTED TO
;ALLOW ALL THE RENAMES TO HAPPEN AT END OF EDITING. NOTE THAT OTHER
;PROTECTION FAILURES CAN OCCUR (.BAK FILE PROTECTED ETC.), BUT WE ARE
;ONLY CHECKING THIS CASE BECAUSE IT IS BY FAR THE MOST COMMON ERROR.
;WE WILL ALLOW AN EB IF 1) WE ARE THE OWNER OF THE FILE (HAVE CHANGE
;PROTECTION RIGHTS) AND CAN WRITE THE FILE (PROTECTION 0,1, OR 2 IN
;5.07) (NOTE THAT WE COULD ALWAYS EDIT A <777> FILE IN THE USER'S AREA
;WITH ENOUGH RENAMES TO CHANGE THE PROTECTION, BUT WE WILL ARBITRARILY
;DISALLOW EDITING IF THE USER CAN'T EVEN WRITE THE FILE WITHOUT CHANGING
;ITS PROTECTION) OR 2) WE HAVE RENAME ACCESS TO THE FILE (PROTECTED 0
;OR 1 IN 5.07).
LDB A,[POINT 9,XPRV,8] ;PICKUP FILE PROTECTION
MOVEM A,EBPROT ;SAVE FOR BAKCLS
HRLI A,.ACREN ;CHECK NEEDED RENAME ACCESS
MOVE AA,PTHPPN ;FILE'S PPN IN LOC + 1
MOVE B,.MYPPN## ;USER'S IN LOC + 2
MOVEI E,A ;POINT TO 3 CONTIGUOUS ACS
CHKACC E, ;SEE IF WE CAN RENAME IT
SETZ E, ;DON'T KNOW, ASSUME OK
JUMPE E,EBAKU3 ;IF CHKACC WON, GO EDIT FILE
;HERE IF WE CAN'T RENAME THE FILE. CAN STILL EDIT IT IF WE CAN BOTH
;CHANGE THE PROTECTION & WRITE THE FILE. OTHERWISE, GIVE AN ERROR.
HRROS EBPROT ;SET LH=-1 AS FLAG FOR BAKCLS
;THAT 2 RENAMES WILL BE NEEDED
HRLI A,.ACCPR ;CHECK .ACCPR TO SEE IF WE OWN IT
MOVEI E,A ;POINT TO THE ARG BLOCK
CHKACC E, ;CHECK IF WE CAN CHANGE PROTECTION
SETZ E, ;PATH UUO BUT NO CHKACC?
JUMPE E,EBAKU2 ;OK, NOW CHECK WRITE ACCESS
$FATAL (EBP,,<EB illegal because of file 02 protection>)
EBAKU2: HRLI A,.ACWRI ;WE OWN IT, BUT CAN WE WRITE IT?
MOVEI E,A ;(MIGHT BE <555>)
CHKACC E, ;ASK FILSER
SETZ E, ;NEVER BOMB USER HERE
JUMPE E,EBAKU3 ;OK, GO EDIT IT
$FATAL (EBP,,<EB illegal because of file 02 protection>)
;HERE IF OK TO EDIT A DISK FILE. SETUP THE PROPER STRUCTURE FROM
;THE INPUT CHANNEL SO THAT THE NEW FILE WILL BE ON THE SAME STR.
EBAKU3: MOVE E,XDEV ;GET REAL INPUT FILE UNIT
MOVEM E,DCBLK ;STORE FOR DSKCHR
MOVE E,[DCLEN,,DCBLK];DO DSKCHR TO GET STR
DSKCHR E, ; THAT FILE WAS FOUND ON
JRST EBAKU4 ;FAILED, USE WHAT WE HAVE
MOVE E,DCSNM ;OK, PICKUP STR NAME
MOVEM E,OPNDEV ;STORE IN NEW OPEN BLOCK
MOVX E,UU.PHS ;USE PHYSICAL ONLY OPEN
MOVEM E,OPNSTS ;SINCE WE HAVE PHYSICAL STR NAME
;ENTER HERE IF GOING TO A DECTAPE.
EBAKU4: MOVE E,[OPNBLK,,EBSTS] ;SAVE STS & DEV FOR BAKCLS
BLT E,EBDEV ;..
PUSHJ P,OPNOU ;OPEN EB DEVICE
MOVE E,[-XFILEN+1,,XFILNM] ;PDL TO LOOKUP BLOCK
PUSHJ P,STOMP ;PUT THE RIGHT THING IN .RBPPN
PUSH E,TMPTEC ;FILE NAME IS NNNTEC
PUSH E,['TMP '] ;EXTENSION IS TMP (WIPE DATES)
MOVX E,<777>B8 ;CLEAR ALL DATES FOR ENTER
ANDM E,XPRV ; BUT KEEP ORIGINAL PROTECTION
MOVX E,<100>B8 ;GET LOWEST NON-ZERO PROTECTION
SKIPN XPRV ;IF EDITING A <000> FILE,
MOVEM E,XPRV ; DO ENTER WITH <100> SO WON'T
; GET SYSTEM DEFAULT PROTECTION
;[252] SETZM XVER ;EDITING CHANGES FILE VERSIONS!
MOVE E,XSIZ ;NOW SETUP OUTPUT ESTIMATE
ADDI E,777 ;ROUND UP INPUT + 2 RIBS + 1
LSH E,-7 ;CONVERT TO BLOCKS
MOVEM E,XEST ;STORE FOR OUTPUT ENTER
SETZM XALC ;NO NEED FOR CONTIGUITY
SETZM XPOS ;CERTAINLY NO SPECIFIC PLACE!
PUSHJ P,WTFIL ;DO ENTER ON .TMP FILE
TXO FF,UWRITE+UBAK ;IT ALL WORKED! TURN ON FLAGS
EBAKU5:
;RDH TXZE FF,CCLFLG ;CALLED FROM TECO COMMAND?
;RDH PUSHJ P,YANK ;YES, DO A Y
POPJ P, ;DONE
;HERE IF THE EB FILE WAS FOUND ON SOME LIBRARY AREA. TURN THE EB
;INTO AN ER/EW, SO THAT THE FILE ON THE LIBRARY WON'T BE MODIFIED.
FAKERW: PUSHJ P,TYPFFI ;TELL WHAT WE'RE DOING
PUSHJ P,FILALT ;PUT OUTPUT FILE EXACTLY WHERE
SETZM OPNSTS ; THE USER SPECIFIED. ITS KNOWN
; NOT TO EXIST, SINCE A LOOKUP
; FOUND IT ONLY ON LIB
MOVE A,INVER ;[252] GET INPUT FILE'S VERSION
MOVEM A,XVER ;[252] PRESERVE IT ACROSS THE "EB" COMMAND
PUSHJ P,OPNOU ;[252] OPEN/INITIALIZE OUTPUT CHANNEL
PUSHJ P,WTFIL ;[252] AND CREATE THE NEW OUTPUT FILE
TXO FF,UWRITE ;EW SUCCESSFULLY INITIATED
PJRST EBAKU5 ;DO A Y IF FROM A TECO COMMAND
U TMPTEC,1 ;SAVE FOR ###TEC. FILE NAME
U FDAEM,1 ;NON-ZERO MEANS FTFDAE ON IN MON.
U EBSTS,1 ;SAVED MODE FOR EB DEVICE
EBOPN==EBSTS ;ALTERNATE NAME
U EBDEV,1 ;DEVICE FOR EB
U EBBUF,1 ;BUFFER ADDR (NOT USED)
U EBCHR,1 ;EB DEVICE DEVCHR
U EBPTH,2 ;PATH BLOCK HEADER (NOT USED)
U EBPPN,1 ;PPN THAT EB FILE CAME FROM
U EBSFD,5 ;SFD'S IN EB FILE'S PATH
U EBNAM,1 ;EB FILE NAME
U EBEXT,1 ;EB EXTENSION
U EBPROT,1 ;LH=-1 IF EDITING OWNER'S <2XX>
; FILE, RH=ORIGINAL FILE'S PROT
;INPUT FILE LOOKUP ERROR
LKUPER: PUSHJ P,ZAPIN ;ZAP THE INPUT CHANNEL
TXZ FF,UREAD+FINF ;LET GO OF INPUT DEVICE
$FATAL (LKP,,<LOOKUP error 03 for 09>)
;TYPE OUTPUT ERROR
ENTERR: PUSHJ P,ZAPOU ;ZAP THE OUTPUT FILE
TXZ FF,UWRITE+UBAK ;LET GO OF OUTPUT DEVICE & EB FLAG
LDB E,[POINT 15,XEXT,35] ;ERROR CODE
CAIE E,ERPRT% ;MAYBE DTA FULL?
JRST ENTER2 ;NO
MOVE A,OUCHR ;YES
TXNE A,DV.DTA ;IF DTA ITS FULL, ELSE ENTER ERROR
$FATAL (FUL,,<Device 04: directory full>)
ENTER2: $FATAL (ENT,,<ENTER error 03 for 01>)
;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).
;EW SELECTS THE OUTPUT DEVICE AND OPENS THE FILE SPECIFIED (IF ANY)
EZ: TXOA FF,EZTMP ;FLAG EZ COMMAND, NOT EW
EW: TXZ FF,EZTMP ;THIS IS A REAL EW COMMAND
TXNE FF,UBAK ;EB IN PROGRESS?
$FATAL (EBO,,<E00 Before Current EB Job Closed>)
PUSHJ P,EF ;GIVE HIM A FREE EF ON OLD FILE
SETZM SWITC ;NO I/O SWITCHES TYPED YET
MOVEI B,TXTSWT ;TEXT FILE SWITCHES
PUSHJ P,FILSPC ;PARSE NEW FILE SPEC, SET UP X???
MOVE E,SWITC ;GET SWITCHES HE TYPED
TXC E,GENLSN+SUPLSN ;CHECK FOR BOTH BEING ON
TXCN E,GENLSN+SUPLSN ;WITH TRIED & TRUE TXC, TXCN TRICK
$FATAL (COS,,<Contradictory switches>)
MOVEM E,OUTSWT ;OK, STORE WHAT HE TYPED
MOVE E,[<"00000">B34+1] ;SETUP INITIAL LSN
MOVEM E,LSNCTR ;FOR OUTPUT FILE
SETZM OPNSTS ;ASCII MODE
PUSHJ P,OPNOU ;OPEN OUTPUT DEVICE, SETUP BUFFERS
TXZN FF,EZTMP ;WAS THIS AN EZ COMMAND?
JRST OPNWR0 ;NO, CONTINUE
UTPCLR OUTCHN, ;YES, ZERO DIRECTORY
MTREW. OUTCHN, ;AND REWIND THE "DECTAPE"
MTWAT. OUTCHN, ;WAIT FOR IT IN CASE MTA
OPNWR0: MOVEI E,OUTCHN ;LOAD E WITH THE OUTPUT CHANNEL
DEVNAM E, ;FIND OUT THE "REAL" DEVICE NAME
JFCL ;WELL, WE LOSE.
CAME E,[SIXBIT/NUL/] ;IS IT NUL:?
JRST OPNWRA ;NO - CONTINUE.
$WARN (OTN,,<Output is to NUL:>)
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
OPNWRA: MOVE E,OPNCHR ;DEVCHR OF DEVICE WE JUST OPENED
TXNN E,DV.DIR ;A DIRECTORY DEVICE?
JRST OPNWR3 ;NO, CAN'T SUPERSEDE EXISTING FILE
TLC E,-1-<(DV.TTA)> ;CAN NEVER SUPERCEDE
TLCN E,-1-<(DV.TTA)> ; ON DEVICE NUL:
JRST OPNWR3 ;YUP, IT'S NUL:. DON'T CHECK.
TXNE E,DV.DTA ;IF A DECTAPE..
JRST OPNWR1 ;MUST GO DO SHORT LOOKUP
LOOKUP OUTCHN,XFILNM ;SEE IF HE'S GOING TO SUPERSEDE
JRST OPNWR3 ;NOT A CHANCE
MOVEI E,OUTCHN ;MAYBE, SEE IF THE FILE
MOVEM E,PTHBLK ;IS REALLY WHERE HE SAID IT WAS
MOVE E,[PTHLEN,,PTHBLK] ;OR ON SOME LIB
PATH. E, ;BY DOING A PATH UUO & COMPARING
JRST OPNWR3 ;?? OH WELL, MESSAGE NOT CRITICAL
PUSHJ P,CHKPTH ;COMPARE FOUND WITH SOUGHT
JRST OPNWR3 ;FOUND IN A LIB, IGNORE IT
JRST OPNWR2 ;WILL SUPERSEDE, WARN USER
;HERE IF WRITING TO A DECTAPE
OPNWR1: LOOKUP OUTCHN,SFILNM ;DO SHORT LOOKUP
JRST OPNWR3 ;NOT THERE
OPNWR2: $WARN (SEF,,<Superseding existing file>)
OPNWR3: CLOSE OUTCHN, ;WE DON'T WANT UPDATE MODE (!!)
PUSHJ P,FILALT ;RE-SET UP THE ENTER BLOCK
PUSHJ P,WTFIL ;DO ENTER ON OUTPUT FILE
TXO FF,UWRITE ;OUTPUT FILE NOW OPEN
POPJ P, ;DONE
;SUBROUTINE TO OPEN THE OUTPUT DEVICE AND SETUP THE OUTPUT BUFFERS
;USES E,T
OPNOU: MOVSI E,OBUF ;SETUP ADDR OF OUTPUT HEADER
MOVEM E,OPNBUF ;IN OPEN BLOCK
OPEN OUTCHN,OPNBLK ;FIND THE DEVICE
$FATAL (ODV,,<Output device 04 not available>)
SETZM BOCNT ;NO BUFFERED OUTPUTS YET
MOVE E,OPNDEV ;GET DEVICE WE JUST OPENED
MOVEM E,OUDEV ;SAVE FOR ERRORS
MOVE E,OPNCHR ;NEED DEVCHR, TOO
MOVEM E,OUCHR ;(SEE ENTERR)
MOVEI A,OPNBLK ;ADDRESS OF OPEN BLOCK
DEVSIZ A, ;ASK MONITOR FOR BUFFER SIZE
CAIA ;DUH?
TXNE E,DV.DSK ;A DISK OUTPUT DEVICE?
MOVE A,[DSKBFN,,DSKBSZ+3] ;YES, USE OUR OWN DEVSIZ THEN
MOVEI B,OBUF ;OUTPUT BUFER RING HEADER
PUSHJ P,GETBF ;ALLOCATE AND INITIALIZE BUFFER RING
$FATAL (NOS,,<No space for output buffers>)
DMOVEM A,OUDSZ ;REMEMBER FOR LATER RECLAIMATION
POPJ P, ;DONE
;SUBROUTINE TO ENTER OUTPUT FILE. DOES SHORT ENTER IF DTA. USES E.
WTFIL: MOVE E,[XNAM,,OUNAM] ;SAVE FILENAME & EXTENSION
BLT E,OUEXT ;FOR PRETTY ERROR MESSAGES
MOVE E,OPNCHR ;SHORT ENTER IF DTA
TXNE E,DV.DTA ;IS IT?
JRST WTFIL1 ;YES
MOVE T,Z ;NO, DISK. END CHARACTER ADDRESS
SUB T,BEG ;STARTING CHARACTER ADDRESS
ADD T,INSIZ ;PLUS ANY WE KNOW TO BE LEFT IN INPUT FILE
IDIVI T,5*^D128 ;T:=ESTIMATED BLOCKSIZE OF OUTPUT FILE
ADDI T,20 ;PLUS A LITTLE FOR EXPANSION
MOVEM T,XEST ;TELL MONITOR OUR GUESS
ENTER OUTCHN,XFILNM ;DO EXTENDED ENTER
JRST ENTERR ;WARN OF FAILURE
MOVEI E,OUTCHN ;DETERMINE PATH TO FILE CREATED
MOVEM E,PTHBLK ;BY DOING PATH UUO ON CHANNEL
MOVE E,[10,,PTHBLK] ;POINT TO PATH BLOCK
PATH. E, ;READ THE PATH TO THE FILE
POPJ P, ;NOT A DIRECTORY DEVICE
MOVE E,[PTHPPN,,OUPPN] ;NOW SAVE PATH AWAY
BLT E,OUPPN+5 ;IN CASE OF OUTPUT ERRORS
POPJ P, ;SUCCESS
;HERE IF DTA
WTFIL1: ENTER OUTCHN,SFILNM ;SHORT ENTER FOR DTA
JRST ENTERR ;FULL?
POPJ P, ;OK, RETURN
U OUDEV,1
U OUBUF,1
U OUCHR,1
U OUPTH,2
U OUPPN,1
U OUSFD,6
U OUNAM,1
U OUEXT,1
U OUDSZ,2 ;OUTPUT BUFARG AND ADDRESS WORDS
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
EF: PUSHJ P,TEBURB ;FORCE UPDATE OF RECOVERY FILE NOW
TXNN FF,UWRITE ;..
POPJ P,
CLOSE OUTCHN, ;CLOSE OUTPUT COMPLETELY
STATZ OUTCHN,IO.ERR ;ANY LAST MOMENT ERRORS?
JRST OUTERR
TXZ FF,UWRITE ;CLEAR NOW IN CASE ERROR IN BAKCLS
TXNE FF,UBAK ;EB IN PROGRESS?
PUSHJ P,BAKCLS ;YES
TXZ FF,UBAK ;CLEAR WRITE AND EB FLAGS
PJRST ZAPOU ;ZAP THE OUTPUT CHANNEL NOW
;EK KILL (ABORT) OUTPUT FILE
EK: MOVEI A,OUTCHN ;OUTPUT FILE CHANNEL
RESDV. A, ;STOMP IT DEAD
JFCL ;HO HUM
TXZ FF,UWRITE!UBAK ;NO FILE FOR OUTPUT ANYMORE
PJRST ZAPOU ;RECLAIM BUFFERS ETC.
;EM EXECUTE MTAPE UUO.
EM: TXNN FF,UREAD
$FATAL (EMD,,<EM with no input device open>)
PUSHJ P,CHK2
CAIGE B,1
$FATAL (EMA,,<EM With Illegal Argument 06>)
WAIT INCHN, ;WAIT FOR BUFFERS TO FILL
MTAPE INCHN,0(B)
HRRZ A,IBUF+.BFADR ;GET ADDR OF FIRST BUFFER
MOVE E,A ;COPY TO TEMP AC
MOVX T,BF.IOU ;GET "BUFFER IN USE" BIT
EMTAP1: ANDCAM T,.BFHDR(E) ;CLEAR IT IN CURRENT BUFFER
HRRZ E,.BFHDR(E) ;PICKUP ADDRESS OF NEXT
CAME E,A ;DONE WITH ALL BUFFERS IN RING?
JRST EMTAP1 ;NO, LOOP
SETOM IBUF+.BFCTR ;INSURE NEXT IN GETS NEW RECORD
MTWAT. INCHN, ;MAKE SURE SPACING COMPLETES
POPJ P, ;END OF 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: TXZ FF,UREAD+FINF ;AN EB EF WIPES INPUT CHANNEL, TOO
PUSHJ P,ZAPIN ;ZAP ANY INPUT FILE
MOVE E,[EBOPN,,OPNBLK] ;RETRIEVE EB DEVICE
BLT E,OPNDEV ;FROM EB SAVE AREA
SETZM OPNBUF ;NO BUFFERS NEEDED FOR RENAMES
OPEN INCHN,OPNBLK ;RE-GRAB DEVICE
$FATAL (IRN,,<Cannot re-init device 04 for rename process>)
SETZM XFILNM ;SETUP LOOKUP BLOCK
MOVE E,[XFILNM,,XFILNM+1] ; TO DELETE OLD BAK FILE
BLT E,XFILNM+XFILEN-1 ;FIRST, BLT TO ZERO
MOVE E,[-XFILEN,,XFILNM-1] ;SET UP PDL TO XFILNM
PUSH E,[XFILEN-1] ;SETUP LENGTH OF BLOCK
PUSHJ P,STOMP ;PUT THE RIGHT THING IN .RBPPN
PUSH E,EBNAM ;SET .RBNAM TO ORIG FILE NAME
PUSH E,['BAK '] ;EXTENSION IS BAK
MOVE E,EBCHR ;GET EB DEV CHARACTERISTICS
TXNE E,DV.DTA ;IS IT A DECTAPE?
JRST BKCLS2 ;YES, GO DO DTA'ISH THINGS
SETZM PTHBLK ;NO, CLEAR OUT PATH BLOCK
SETZM PTHFLG ;SINCE MONITOR LOOKS AT FLAGS
MOVE E,[EBPPN,,PTHPPN] ;RESTORE PATH FROM EB SAVE
BLT E,PTHBLK+PTHLEN-2 ;EBPPN IS ONLY 5 WORDS
SETZM PTHBLK+PTHLEN-1 ;PTHBLK HAS XTRA 0 ON END
HRRZ B,EBPROT ;SETUP AC B TO BE PROTECTION THAT
ANDCMI B,300 ; WE WILL GIVE .BAK FILE IF NONE
SKIPN FDAEM ; NOW EXISTS
ANDCMI B,400 ; (I.E <0XX> OR <4XX> IF FDAEM)
LOOKUP INCHN,XFILNM ;FIND OLD .BAK FILE
JRST BKCLS3 ;NONE THERE, GO MAKE ONE
LDB B,[POINT 9,XPRV,8] ;MAKE NEW .BAK HAVE SAME
;PROTECTION AS OLD ONE DID
SETZM XNAM ;DELETE OLD .BAK FILE
RENAME INCHN,XFILNM ;BY RENAMING TO 0 . . .
$FATAL (BAK,,<Cannot delete old backup file>)
JRST BKCLS3 ;OK, GO RENAME SOURCE TO BAK
;HERE IF OLD BAK FILE SOUGHT ON A DECTAPE. USE SHORT LOOKUP/RENAME
BKCLS2: LOOKUP INCHN,SFILNM ;LOOK FOR THE FILE
JRST BKCLS3 ;NONE, DON'T SWEAT IT
SETZM XNAM ;DELETE BY RENAMING TO ZERO
RENAME INCHN,SFILNM ;..
$FATAL (BAK,,<Cannot delete old backup file>)
;HERE TO RENAME THE OLD SOURCE FILE TO FILE.BAK
BKCLS3: MOVE E,[-XFILEN+1,,XFILNM] ;RESET THINGS TO EB FILE
PUSHJ P,STOMP ;LAST LOOKUP MIGHT HAVE WIPED PPN
PUSH E,EBNAM ;WE WIPED XNAM
PUSH E,EBEXT ;EXTENSION DEFINITELY ISN'T BAK
MOVE E,EBCHR ;GET ORIGINAL EB DEVICE DEVCHR
TXNE E,DV.DTA ;DECTAPE?
JRST BKCLS5 ;YES, DO SHORT LOOKUP/RENAME
SETZM PTHBLK ;NO, MAKE SURE PTHBLK SETUP RIGHT
SETZM PTHFLG ;MONITOR RETURNS STUFF ON LOOKUP
LOOKUP INCHN,XFILNM ;FIND ORIGINAL SOURCE FILE
$FATAL (ILR,,<Cannot Lookup input file 10 to rename it>)
SKIPL EBPROT ;NEED TO LOWER PROTECTION?
JRST BKCLS4 ;NO, JUST RENAME IT TO .BAK
MOVX E,<300>B8 ;CLEAR THESE BITS
ANDCAM E,XPRV ;TO MAKE PROTECTION REASONABLE
RENAME INCHN,XFILNM ;DOWN GOES THE PROTECTION
$FATAL (IRB,,<Cannot Rename input file 10 to 08.BAK>)
BKCLS4: MOVE A,XEXT ;SAVE DATES FOR ERROR RECOVERY
MOVSI E,'BAK' ;NEW FILE NAME IS FILE.BAK
HLLM E,XEXT ;KEEP SAME DATES ETC.
DPB B,[POINT 9,XPRV,8] ;STORE BAK FILE PROTECTION
RENAME INCHN,XFILNM ;MAKE OLD SOURCE INTO BAK
CAIA ;TRY TO RECOVER
JRST BKCLS6 ;NOW GO MAKE .TMP FILE NEW SOURCE
;HERE IF RENAMING THE OLD SOURCE FILE TO FILE.BAK WITH A LOWER
;PROTECTION FAILED. IT COULD BE THAT THE FILE IS PROTECTED RENAME
;BUT NO CHANGE PROTECTION AGAINST US. IF THIS IS THE CASE, WE WILL
;GO AHEAD AND CHANGE THE EXTENSION TO BAK, BUT LEAVE THE PROTECTION
;ALONE.
LDB E,[POINT 15,XEXT,35] ;PICKUP RENAME ERROR CODE
CAIE E,ERPRT% ;PROTECTION FAILURE?
$FATAL (IRB,,<Cannot Rename input file 10 to 08.BAK>)
MOVEM A,XEXT ;YES, RESTORE DATES WIPED BY ERROR
LOOKUP INCHN,XFILNM ;LOOKUP OLD SOURCE AGAIN
$FATAL (ILR,,<Cannot Lookup input file 10 to rename it>)
MOVSI E,'BAK' ;NEW EXTENSION
HLLM E,XEXT ;CHANGE ONLY EXTENSION
RENAME INCHN,XFILNM ;TRY IT AGAIN
$FATAL (IRB,,<Cannot Rename input file 10 to 08.BAK>)
JRST BKCLS6 ;WON, GO MAKE .TMP NEW SOURCE
;HERE TO MAKE FILE.SRC BE FILE.BAK IF ON A DTA
BKCLS5: LOOKUP INCHN,SFILNM ;FIND OLD SOURCE FILE
$FATAL (ILR,,<Cannot Lookup input file 10 to rename it>)
MOVSI E,'BAK' ;NEW EXTENSION IS .BAK
HLLM E,XEXT ;KEEP DATES ETC.
RENAME INCHN,SFILNM ;CHANGE NAME TO FILE.BAK
$FATAL (IRB,,<Cannot Rename input file 10 to 08.BAK>)
;HERE TO FIND OUTPUT NNNTEC.TMP FILE, AND RENAME IT TO NEW SOURCE FILE.
BKCLS6: PUSHJ P,ZAPIN ;MAKE SURE INPUT DEVICE FINISHED
SETZM XFILNM ;CAN'T BE TOO CAREFUL
MOVE E,[XFILNM,,XFILNM+1] ;SO BLT LOOKUP BLOCK TO 0
BLT E,XFILNM+XFILEN-1 ;..
MOVE E,[-XFILEN,,XFILNM-1] ;SETUP PDL TO LOOKUP BLOCK
PUSH E,[XFILEN-1] ;RESET LENGTH WORD
PUSHJ P,STOMP ;RESET .RBPPN
PUSH E,TMPTEC ;SET .RBNAM TO NNNTEC
PUSH E,['TMP '] ;EXTENSION IS TMP
MOVE E,EBCHR ;DEVCHR OF EB DEVICE
TXNE E,DV.DTA ;DECTAPE?
JRST BKCLS8 ;YES, DO SHORT LOOKUPS
SETZM PTHBLK ;ZAP BITS MONITOR RETURNS
SETZM PTHFLG ;ON LOOKUPS OR RENAMES
LOOKUP OUTCHN,XFILNM ;FIND THE .TMP FILE
$FATAL (OLR,,<Cannot Lookup output file 02 to rename it>)
SKIPL EBPROT ;NEED TO LOWER PROTECTION?
JRST BKCLS7 ;NO, GO CHANGE NAME
SKIPN FDAEM ;FILE DAEMON MONITOR?
SKIPA A,[POINT 3,XPRV,2] ;NO, OWNER FIELD 3 BITS
MOVE A,[POINT 2,XPRV,2] ;YES, ONLY 2 BITS
SETZ E, ;LOWEST POSSIBLE PROTECTION
DPB E,A ;STORE IN OWNER FIELD
RENAME OUTCHN,XFILNM ;LOWER PROTECTION OF FILE
$FATAL (RNO,,<Cannot Rename output file 01>)
BKCLS7: MOVE E,EBNAM ;GET SOURCE FILE NAME
MOVEM E,XNAM ;STORE FOR RENAME
MOVE E,EBEXT ;GET SOURCE EXTENSION
HLLM E,XEXT ;STORE WITHOUT TOUCHING DATES
MOVE E,EBPROT ;MAKE PROTECTION SAME AS OLD
DPB E,[POINT 9,XPRV,8] ;..
RENAME OUTCHN,XFILNM ;TURN TMP FILE INTO NEW SOURCE
$FATAL (RNO,,<Cannot Rename output file 01>)
POPJ P, ;ALL DONE
;HERE TO RENAME TMP FILE TO NEW SOURCE FILE ON A DTA
BKCLS8: LOOKUP OUTCHN,SFILNM ;DO SHORT LOOKUP TO FIND FILE
$FATAL (OLR,,<Cannot Lookup output file 02 to rename it>)
MOVE E,EBNAM ;GET SOURCE FILE NAME
MOVEM E,XNAM ;STORE FOR RENAME
MOVE E,EBEXT ;PICKUP EB EXTENSION
HLLM E,XEXT ;STORE WITHOUT TOUCHING DATES
RENAME OUTCHN,SFILNM ;LAST RENAME OF THE JOB
$FATAL (RNO,,<Cannot Rename output file 01>)
POPJ P, ;DONE
; THIS ROUTINE POINTS TO THE PATH BLOCK IF SUB FILE DIRECTORIES ARE
;IMPLEMENTED, OTHERWISE IT WILL PUT THE PPN IN .RBPPN.
STOMP: TXNN F2,SFDS ;SEE IF SUB FILE DIRECTORIES EXIST
JRST .+3 ;THEY DON'T
PUSH E,[PTHBLK] ;YES, POINT TO THE PATH BLOCK
POPJ P, ;..
PUSH E,COMPPN ;USE THE GIVEN PPN OR THE DEFAULT PPN
POPJ P, ;..
;ROUTINE TO DETERMINE IF THE FILE FOUND BY A LOOKUP UUO WAS
;ACTUALLY FOUND WHERE THE USER SPECIFIED, OR ON SOME LIBRARY
;AREA. IT EXPECTS THE USER'S LAST COMMAND TO STILL BE IN COM???,
;THE FILE TO HAVE BEEN LOOKED UP USING THE XFILNM BLOCK, AND A PATH
;UUO ON THE CHANNEL TO HAVE BEEN DONE INTO THE PTHBLK BLOCK.
;CALL:
; PUSHJ P,CHKPTH
; HERE IF FOUND ON A LIBRARY AREA
; HERE IF FOUND WHERE SOUGHT
;USES AC'S A AND E.
;HERE WHEN CPATH & PTHBLK SET UP. COMPARE THE PATHS.
CHKPTH: SKIPN E,COMDEV ;GET DEVICE USER TYPED
MOVSI E,'DSK' ;BLANK DEFAULTS TO DSK:
MOVEM E,CPATH ;STORE IN OUR PATH BLOCK
MOVE E,[CPTLEN,,CPATH] ;DO A PATH UUO ON IT
PATH. E, ;TO SEE IF USER MEANT HIS PPN
JFCL ;PROBABLY MTA: OR TSK:
MOVE E,CFLG ;PICKUP FLAGS WORD
TXNN E,PT.IPP ;IS THIS AN ERSATZ DEVICE?
JRST CMPDSK ;NO, MUST BE DSK: OF SOME SORT
;HERE IF AN ERSATZ DEVICE. COPY SFD'S FROM USER SPECIFICATION, SINCE
;AN ERSATZ DEVICE OVERRIDES ONLY THE PPN PORTION OF THE PATH.
MOVE E,[COMSFD,,CSFD] ;COPY SFD'S ONLY
BLT E,CPATH+CPTLEN-1 ;..
JRST CMPPTH ;NOW GO COMPARE PATHS
;HERE IF DEVICE DOES NOT IMPLY A PPN. PATH BLOCK IS OK IF USER
;DIDN'T SPECIFY A PPN, OTHERWISE WE MUST COPY OVER WHAT HE TYPED.
CMPDSK: SKIPG COMPPN ;IS DEFAULT PATH OK?
JRST CMPPTH ;YES, GO COMPARE WITH FOUND
MOVE E,[COMPPN,,CPPN] ;NO, GET WHAT USER SAID
BLT E,CPATH+CPTLEN-1 ;ONLY PPN & SFD'S
CMPPTH: SETZ A, ;SETUP TO LOOP OVER PATH
CMPLUP: MOVE E,CPPN(A) ;GET NEXT WORD OF PATH
CAME E,PTHPPN(A) ;MATCH WHERE IT WAS FOUND?
POPJ P, ;NO, IN A LIBRARY
SKIPE E ;DONE IF ZERO
AOJA A,CMPLUP ;ELSE COMPARE MORE SFD'S
AOS (P) ;PATHS WERE THE SAME
POPJ P, ;SO GIVE SKIP RETURN
;ROUTINE TO TYPE THE "%FILE FOUND IN ..." MESSAGE. EXPECTS
;THE PATH TO BE IN PTHBLK. USES A,B,C,CH,TT
TYPFFI: $WARN (FFI,,<File found in 05>)
POPJ P,
;ROUTINE TO PARSE FILE DESIGNATOR
;STORES WHAT USER TYPED IN COM???, AND COPIES IT INTO X????,
;READY TO DO A LOOKUP OR ENTER. NULL DEVICE DEFAULTS TO DSK:
;
;CALL WITH ADDRESS OF SWITCH TABLE IN B.
;
;ENTER AT FILALT TO COPY COM??? AREA TO X???? AREA.
;
;USES AC'S A, AA, B, E, CH
FILSPC: TXZ FF,FEXTF ;INITIALIZE FILE SCANNING FLAGS
SETZM COMZR ;ZERO AREA THAT WE USE
MOVE AA,[COMZR,,COMZR+1] ;INCLUDES COM???, X????
BLT AA,COMEZR ;..
MOVEM B,SWITAB ;SET SWITCH TABLE ADDRESS
;BACK HERE TO PARSE A NEW FIELD OF THE FILE SPECIFICATION
NEWFLD: PUSHJ P,FILWRD ;ACCUMULATE SIXBIT INTO AC E
CAIN CH,":" ;WAS TERMINATOR A COLON?
JRST FILDEV ;YES, GO PROCESS DEVICE
CAIN CH,"." ;A PERIOD?
JRST FILNAM ;YES, STORE FILENAME & FLAG EXT.
PUSHJ P,STRFLD ;ALL OTHER TERMINATORS START A
;FIELD, SO STORE END OF LAST ONE
CAIN CH,"[" ;PATH DESIGNATOR?
JRST FILPTH ;YES, GO READ IN PATH
CAIN CH,"/" ;A SWITCH?
JRST FILSWT ;YES, GO READ IT
CAIE CH,.CHESC ;ONLY OTHER DELIMITER AN ALT
$FATAL (IFN,,<Illegal character "00" in file specification>)
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HERE WHEN FILESPEC FINISHED (ALTMODE SEEN). COPY COM??? TO X??? & POPJ.
;
;USES A AND AA.
FILALT: SETZM XFIBLK ;ZERO LOOKUP BLOCK AGAIN
MOVE AA,[XFIBLK,,XFIBLK+1] ;INCASE ENTRY AT FILALT
BLT AA,XFIBLK+XFILEN-1 ;BUT NOT TOO FAR
SKIPN AA,COMDEV ;PICKUP USER DEVICE IF ANY
MOVSI AA,'DSK' ;NONE, SO USE DSK:
MOVEM AA,OPNDEV ;STORE FOR OPEN
DEVCHR AA, ;ALSO NEED CHARACTERISTICS
MOVEM AA,OPNCHR ;SO WE CAN TELL DECTAPES FROM DSK:
TXNE AA,DV.TTY ;IS IT A TTY?
TXNN AA,DV.TTA ;YES, CONTROLLING A JOB (OURS)?
CAIA ;NO TO EITHER
$FATAL (TTY,,<Illegal TTY I/O device>)
MOVE A,[-XFILEN,,XFILNM-1] ;SETUP PDL INTO LOOKUP BLK
PUSH A,[XFILEN-1] ;FIRST WORD IS LENGTH
SKIPG COMPPN ;DID USER SPECIFY A PATH?
TDZA AA,AA ;NO, USE A ZERO FOR DEFAULT
MOVEI AA,PTHBLK ;YES, POINT TO PATH BLOCK
TXNN F2,SFDS ;SEE IF SFDS ARE USED
MOVE AA,COMPPN ;IF NOT, THEN USE A PPN.
PUSH A,AA ;STORE PATH POINTER OR ZERO OR PPN
PUSH A,COMNAM ;STORE FILE NAME
PUSH A,COMEXT ;EXTENSION
SETZM PTHBLK ;SETUP PTHBLK FROM COMPPN
SETZM PTHFLG ;ZERO 1ST 2 WORDS FOR MONITOR
MOVE A,[COMPPN,,PTHPPN] ;COPY REST FROM COMMAND
BLT A,PTHBLK+PTHLEN-2 ;..
SETZM PTHBLK+PTHLEN-1 ;MAKE SURE IT TERMINATES WITH A 0
POPJ P,
;HERE WHEN ":" TYPED. STORE THE DEVICE NAME.
FILDEV: SKIPE E ;USER TYPE A DEVICE?
TXNE FF,FEXTF ;MAYBE, REALLY AN EXTENSION?
$FATAL (NDV,,<Null device illegal>)
MOVEM E,COMDEV ;YES, STORE IT
JRST NEWFLD ;AND GO PARSE THE NEXT FIELD
;HERE WHEN "." TYPED. STORE ANY FILE NAME THAT'S BEEN ACCUMULATING
;ALSO, SET FLAG SO NEXT FIELD SEEN WILL BE STORED AS EXTENSION
FILNAM: TXOE FF,FEXTF ;SET EXTENSION FLAG
$FATAL (DEX,,<Double extension illegal>)
JUMPE E,NEWFLD ;MAYBE NO FILENAME (FOO[,].BAR)
SKIPE COMNAM ;THERE IS, DUPLICATE?
$FATAL (DFN,,<Double filename illegal>)
MOVEM E,COMNAM ;NO, STORE THE FILE NAME
JRST NEWFLD ;READY FOR THE NEXT FIELD
;HERE WHEN "/" OR "[" OR <ALT> TYPED. STORE FILE OR EXT. FIRST
STRFLD: TXZE FF,FEXTF ;WAITING FOR AN EXTENSION?
JRST STREXT ;YES, GO STORE IT
JUMPE E,CPOPJ ;DON'T STORE IF NOTHING THERE
SKIPE COMNAM ;FILE NAME ALREADY SEEN?
$FATAL (DFN,,<Double filename illegal>)
MOVEM E,COMNAM ;NO, STORE THE FILE NAME
POPJ P, ;RETURN
;HERE IF WE SHOULD STORE AN EXTENSION
STREXT: JUMPE E,CPOPJ ;DON'T STORE IF NOT TYPED
SKIPE COMEXT ;DOUBLE EXTENSION?
$FATAL (DEX,,<Double extension illegal>)
HLLZM E,COMEXT ;NO, STORE EXTENSION
POPJ P, ;DONE
;HERE WHEN "[" TYPED. READ IN A PATH SPECIFICATION.
FILPTH: SKIPE COMPPN ;ONLY ONE PER CUSTOMER
$FATAL (DDI,,<Double directory illegal>)
PUSHJ P,FILOCT ;READ THE PROJECT
CAIN CH,"-" ;[-] MEANS DEFAULT PATH
JUMPE E,FILDFP ;BUT [123-] DOESN'T
CAIN CH,"," ;ONLY LEGAL TERMINATOR IS ","
TDNE E,[-1,,400000] ;AND PROJECT MUST BE .LE. 377777
$FATAL (IPJ,,<Improper project number>)
SKIPN E ;[, ???
HLRZ E,.MYPPN## ;YES, USE LOGGED-IN PROJECT
MOVSM E,COMPPN ;STORE FOR RETURN
PUSHJ P,FILOCT ;GET PROGRAMMER
TLNE E,-1 ;ONLY HALF WORD ALLOWED
$FATAL (IPG,,<Improper programmer number>)
SKIPN E ;[FOO,]??
HRRZ E,.MYPPN## ;YES, USE LOGGED IN PROGRAMMER
HRRM E,COMPPN ;STORE ANSWER
CAIN CH,.CHESC ;ALLOW X:Y.Z[,<ALT>
JRST FILALT ; ..
CAIN CH,"]" ;END OF SPEC?
JRST NEWFLD ;YES, GO READ MORE
CAIE CH,"," ;LAST CHANCE
$FATAL (IFN,,<Illegal character "00" in file specification>)
;HERE TO COLLECT SFD'S FROM THE COMMAND STRING
MOVE B,[XWD -5,COMSFD] ;MAX SFD'S ALLOWED
FILSFD: PUSHJ P,FILWRD ;PARSE SFD NAME
SKIPN E ;MUST BE ONE
$FATAL (NSF,,<Null SFD illegal>)
MOVEM E,(B) ;OK, STORE IT
CAIN CH,.CHESC ;END OF IT ALL?
JRST FILALT ;FINISH UP
CAIN CH,"]" ;NO, END OF PATH?
JRST NEWFLD ;YES, LOOK FOR SWITCHES ETC
CAIE CH,"," ;MORE SFD'S?
$FATAL (IFN,,<Illegal character "00" in file specification>)
AOBJN B,FILSFD ;GO AFTER MORE SFD'S
$FATAL (SFD,,<SFDs nested too deep>)
;HERE ON "[-". SET COMPPN TO -1 TO INDICATE DEFAULT PATH.
FILDFP: SETOM COMPPN ;DEFAULT PATH
PUSHJ P,FILCHR ;NEXT CHARACTER
CAIN CH,.CHESC ;ALLOW IT TO END HERE
JRST FILALT ;FINISH UP
CAIE CH,"]" ;ELSE MUST FINISH RIGHT
$FATAL (IFN,,<Illegal character "00" in file specification>)
JRST NEWFLD ;GO GET MORE
;HERE ON A "/". READ IN THE SWITCH.
FILSWT: PUSHJ P,FILWRD ;READ THE SWITCH NAME
MOVEM E,SWITHL ;STORE FOR ERROR MSGS
SKIPE B,SWITAB ;POINT TO SWITCH TABLE
FILSWL: SKIPN (B) ;DONE?
$FATAL (UIS,,<Unknown I/O switch>)
CAME E,(B) ;MATCH?
AOJA B,FILSWL ;NO, TRY NEXT
SUB B,SWITAB ;CONVERT SWITCH TO OFFSET
MOVNS B ;NEED NEGATIVE FOR LSH
MOVSI E,(1B0) ;1B0 IS 1ST SWITCH, 1B1 IS SECOND
LSH E,(B) ;CONVERT TO RIGHT BIT
IORM E,SWITC ;STORE FOR RETURN
CAIN CH,"/" ;ANOTHER SWITCH COMING?
JRST FILSWT ;YES, PROCESS IT
CAIN CH,.CHESC ;END OF IT ALL?
JRST FILALT ;YES, GO FINISH UP
$FATAL (IFN,,<Illegal character "00" in file specification>)
;FILE SELECTION COMMAND SWITCH TABLE
TXTSWT: SIXBIT /GENLSN/ ;GENERATE LINE SEQ#'S ON OUTPUT
SIXBIT /SUPLSN/ ;SUPPRESS LSN (INPUT OR OUTPUT)
0
;COMMAND FILE SWITCH TABLE
CMFSWT: SIXBIT /ECHO/ ;ALLOW ECHOING OF COMMAND CHARACTERS INPUT
SIXBIT /TYO/ ;ALLOW REGULAR PROGRAM OUTPUT
0 ;END OF SWITCH TABLE
U SWITAB,1 ;ADDRESS OF SWITCH TABLE
U INSWT,1 ;INPUT SWITCHES
U OUTSWT,1 ;OUTPUT SWITCHES
U LSNCTR,1 ;LSN GENERATION CTR
;SWITCH BITS -- LEFT HALF
GENLSN==1B0
SUPLSN==1B1
;HERE TO READ AN ALFAMERIC WORD INTO E IN SIXBIT. USES A.
FILWRD: SETZ E, ;INITIALIZE ACCUMULATOR AC
MOVE A,[POINT 6,E] ;SETUP TO STORE IN IT
FILWRL: PUSHJ P,FILCHR ;GET NEXT CHAR
CAIL CH,"A" ;A LETTER?
CAILE CH,"Z" ;MAYBE, IS IT?
CAIA ;NO, COULD BE A DIGIT
JRST FILWR1 ;IT IS A LETTER. STORE IT.
CAIL CH,"0" ;DIGIT?
CAILE CH,"9" ;IS IT?
POPJ P, ;NOPE, END OF WORD
FILWR1: SUBI CH,"A"-'A' ;CONVERT TO SIXBIT
TLNE A,770000 ;AC E FULL YET?
IDPB CH,A ;NO, STORE THE CHARACTER
JRST FILWRL ;LOOP FOR ENTIRE WORD
;HERE TO READ AN OCTAL NUMBER INTO E.
FILOCT: SETZ E, ;INITIALIZE ANSWER
FILOCL: PUSHJ P,FILCHR ;GET NEXT DIGIT
CAIL CH,"0" ;A DIGIT?
CAILE CH,"7" ;(OCTAL, THAT IS)
POPJ P, ;NO, END OF OCTAL NUMBER
LSH E,3 ;YES, MAKE ROOM
ADDI E,-"0"(CH) ;ADD IN NEXT DIGIT
JRST FILOCL ;LOOP FOR ENTIRE NUMBER
;GET A CHAR FOR FILEPSPECIFICATION
;IGNORE SPACE, TAB, LF, VT, FF, CR; CONVERT LC TO UC
FILCHR: PUSHJ P,SKRCH
$FATAL (UFS,,<Macro ending with unterminated file selection command>)
CAIL CH,"a"
CAILE CH,"z"
JRST .+2
TRZ CH,40
CAIN CH," "
JRST FILCHR
CAIL CH,.CHTAB
CAILE CH,.CHCRT
POPJ P,
JRST FILCHR
;ZAPTT -- ZAP THE TERMINAL CHANNEL
ZAPTT: CLOSE TTYCHN, ;FLUSH OUT ANY OUTPUT STILL PENDING
SETSTS TTYCHN,.IOASC ;CLEAR OUT FUNNY MODES
PUSHJ P,TTYRST ;RESTORE TTY STATE
RELEAS TTYCHN, ;AND RELEASE CONTROL OF THE TERMINAL
POPJ P, ;ALL DONE
;ZAPIN -- ZAP THE INPUT FILE AND BUFFERS (IF ANY)
ZAPIN: RELEAS INCHN, ;TOSS OUT INPUT FILE
SETZM INVER ;[252] NO MORE INPUT FILE VERSION
SKIPN INDSZ ;INPUT BUFFERS SETUP?
POPJ P, ;NO, ALL DONE
DMOVE A,INDSZ ;YES, GET BUFARG AND ADDRESS
MOVEI B,IBUF ;AND RING HEADER ADDRESS
PUSHJ P,FREBF ;DEALLOCATE THE INPUT BUFFER RING
HALT .+1 ;CAN'T HAPPEN
SETZM INDSZ ;NO BUFFERS NOW
SETZM BICNT ;NOR BUFFERED INPUTS EITHER
POPJ P, ;ALL DONE
;ZAPOU -- ZAP THE OUTPUT FILE AND BUFFERS (IF ANY)
ZAPOU: RELEAS OUTCHN, ;TOSS OUT THE OUTPUT FILE
SKIPN OUDSZ ;OUTPUT BUFFERS SETUP?
POPJ P, ;NO, ALL DONE
DMOVE A,OUDSZ ;YES, GET BUFARG AND ADDRESS
MOVEI B,OBUF ;AND RING HEADER ADDRESS
PUSHJ P,FREBF ;DEALLOCATE THE OUTPUT BUFFER RING
HALT .+1 ;CAN'T HAPPEN
SETZM OUDSZ ;NO OUTPUT BUFFERS NOW
SETZM BOCNT ;NOR BUFFERED OUTPUTS EITHER
POPJ P, ;ALL DONE
;GETBF -- ALLOCATE AND CONSTRUCT I/O BUFFERS
;SETBF -- CONSTRUCT I/O BUFFERS
;FREBF -- DEALLOCATE I/O BUFFERS
;CALL IS:
;
; MOVX A,<BUFARG>
; MOVX AA,<ADDR> ;SETBF/FREBF ONLY
; MOVX B,<RHDR>
; PUSHJ P,GETBF/SETBF/FREBF
; ERROR RETURN
; NORMAL RETURN
;
;WHERE <BUFARG> IS COUNT OF DESIRED BUFFERS IN RING STRUCTURE IN THE LEFT
;HALF AND SIZE OF INDIVIDUAL BUFFER IN THE RIGHT HALF (SAME FORMAT AS THAT
;RETURNED ON A DEVSIZ MONITOR CALL); <ADDR> (SETBF ONLY) IS THE ADDRESS OF
;THE .BFHDR WORD OF THE FIRST BUFFER; AND <RHDR> IS THE ADDRESS OF THE
;BUFFER RING HEADER CONTROL BLOCK.
;
;ON ERROR RETURN (GETBF ONLY) NO PAGES WERE AVAILABLE IN WHICH TO CONSTRUCT
;EVEN ONE BUFFER.
;
;ON NORMAL RETURN (GETBF) THE PAGES NEEDED TO HOLD THE RING STRUCTURE HAVE
;BEEN ALLOCATED, (GETBF AND SETBF) THE BUFFER RING STRUCTURE HAS BEEN LINKED
;TOGETHER AND INITIALIZED (READY FOR FIRST IN/OUT) AND A/AA WILL CONTAIN
;<BUFARG> AND <ADDR> AS ABOVE. ON NORMAL RETURN FROM FREBF THE PAGES WHICH
;CONTAINED THE RING STRUCTURE HAVE BEEN DEALLOCATED.
;
;USES T, TT, TT1.
GETBF: PUSH P,A ;SAVE BUFARG
HLRZ AA,A ;COUNT OF BUFFERS
IMULI AA,(A) ;TOTAL WORDS NEEDED
MOVE A,AA ;POSITION COUNT FOR GETPW TO
PUSHJ P,GETPW ;GET SOME FREE PAGES FOR RING STRUCTURE
SKIPA A,(P) ;NOT ENOUGH PAGES
JRST GETBF3 ;AA HAS PAGES ALLOCATED
ANDI A,-1 ;TRY FOR JUST ONE PAGE (OR BUFFER IF LARGER)
PUSHJ P,GETPW ;MINIMUM AVAILABLE?
JRST [POP P,A ;NO, RESTORE STACK
POPJ P,] ;AND TAKE ERROR RETURN
MOVEI T,PAGSIZ ;SIZE OF MINIMUM REQUEST
IDIVI T,(A) ;HOW MANY BUFFERS?
CAIGE TT,1 ;AT LEAST ONE?
MOVEI TT,1 ;YES - BY DEFINITION AT LEAST ONE
HRLM TT,(P) ;CONTRUCT APPROPRIATE BUFARG
GETBF3: POP P,A ;RESTORE BUFARG FOR SETBF
LSH AA,PG2WRD ;WORD ADDRESS FOR RING STRUCTURE
;FALL INTO SETBF
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
SETBF: CAIGE B,.JBDA ;REASONABLE ADDRESS?
HALT . ;BLETCH
ADDI AA,.BFHDR ;RELOCATE TO LINK WORD OF FIRST BUFFER
HLRZ T,A ;COUNT OF BUFFERS IN RING
HRRZ TT,AA ;START OF RING (FIRST BUFFER)
HRRZ TT1,TT ;START OF START OF NEXT BUFFER IN RING
TLOA TT1,-2(A) ;SET DATA SIZE + 1 IN LH OF .BFHDR WORD
SETBF3: ADDI TT,(A) ;ADDRESS OF NEW CURRENT BUFFER
ADDI TT1,(A) ;ADDRESS OF NEXT POSSIBLE BUFFER IN RING
MOVEM TT1,(TT) ;LINK CURRENT BUFFER TO NEXT BUFFER
SOJG T,SETBF3 ;LOOP TILL LAST BUFFER IN RING
HRRM AA,(TT) ;LINK LAST BUFFER TO FIRST BUFFER
TXO AA,BF.VBR ;THE VIRGIN BUFFER RING BIT
MOVEM AA,(B) ;LINK CONTROL BLOCK TO RING STRUCTURE
TXZ AA,BF.VBR ;RESTORE JUST ADDRESS
JRST CPOPJ1 ;I/O BUFFERS ALL SET FOR I/O
FREBF: SETZM .BFADR(B) ;BREAK RING STRUCTURE FROM HEADER
HLRZ T,A ;COUNT OF BUFFERS
IMULI T,(A) ;COUNT OF WORDS USED BY BUFFERS
MOVE A,T ;POSITION FOR FREPW TO
PUSHJ P,FREPW ;FREE UP I/O PAGES
HALT .+1 ;CAN'T HAPPEN
JRST CPOPJ1 ;ALL DONE
;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.
YANK: SKIPN EQM ;IF IN A MACRO, ALLOW OLDE "Y" COMMAND
$WARN (UEY,,<Use "EY" rather than "Y">)
EY:
YANK1: MOVE OU,BEG
MOVEM OU,PT ;PT:=BEG
TXZ F2,LSNINF ;CLEAR THE CLEARING FLAG
YANK2: TXNE FF,FINF ;IF WE FINISHED ALREADY
JRST YANK51 ;THEN GET OUT
TXZ FF,FORM ;RESET THE YANK,APPEND FORM FEED FLAG
TXNN FF,UREAD ;ERROR IF INPUT NOT SPECIFIED
$FATAL (NFI,,<No file for input>)
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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
MOVEM OU,NRMGCZ ;SET BIZARRE GARBAGE-COLLECTION FLAG
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
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: SOSLE IBUF+.BFCTR ;IS DEVICE BUFFER EMPTY?
JRST YANK5 ;NO.
TXNE FF,FINF ;YES, HAVE WE ALREADY EA'ED IT ALL?
JRST YANK37 ;YES, THEN ALL USED UP
AOS BICNT ;COUNT IN'S DONE IN CASE LATER EA
IN INCHN, ;ASK FOR ANOTHER BUFFER
JRST YANK5 ;GOT IT, COUNT IT DOWN
STATZ INCHN,IO.ERR ;ERROR?
JRST INERR ;YES.
STATO INCHN,IO.EOF ;NO. END OF FILE?
HALT .+1 ;NO??? SOMEBODY IS MESSED UP!
YANK37: TXO FF,FINF ;YES, MARK NO MORE INPUT
JRST YANK51 ;CLEAR BUFFER AND RETURN.
YANK5: ILDB CH,IBUF+.BFPTR ;CH:=NEXT CHARACTER.
SOS INSIZ ;COUNT DOWN BYTES LEFT (FOR EA)
TXZN F2,LSNINF ;WAS THE LAST THING A SUPPRESSED LSN?
JRST YANK52 ;NO
CAIE CH,.CHCRT ;YES, IGNORE THE NEXT CHARACTER
CAIN CH,.CHTAB ;IF IT'S A CR (FOR SOS) OR A TAB
JRST YANK3 ; IGNORE IT
YANK52: JUMPE CH,YANK3 ;IF NULL, IGNORE IT.
HRRZ T,IBUF+.BFPTR ;GET BYTE POINTER'S ADDRESS FIELD
MOVE T,0(T) ;GET CURRENT DATA WORD
TRNE T,1 ;SEQUENCE NUMBER?
JRST YNKSEQ ;YES
YANK50: PUSHJ P,PUT ;NO. PUT CHARACTER IN DATA BUFFER.
CAIE CH,.CHFFD ;FORM FEED?
AOJA OU,YANK4 ;NO. UPDATE DATA BUFFER PTR AND CHECK FOR OVERFLOW.
TXO FF,FORM ;YANK AND/OR APPEND TERMINATED ON A FORM FEED
YANK51: MOVEM OU,Z ;YES. SET END OF DATA BUFFER AND RETURN
POPJ P,
YNKSEQ: MOVE T,INSWT ;SUPPRESS SEQ# FLAG ON?
TXNE T,SUPLSN
JRST YNKSEZ ;YES, STRIP THEM OFF AS IN DAYS OF YORE
TXON FF,SEQF ;SET SEQ FILE AND
;JRST IF ALREADY SEEN
TXNE T,GENLSN ;DOES USER WANT LSN'S?
JRST YANK50 ;IF SO DON'T BOTHER HIM
;HERE IF NO LSN SWITCH AND SEQUENCED FILE. TELL USER WHAT'S ABOUT TO HAPPEN
MOVE T,CH ;SAVE THE CHARACTER
PUSHJ P,INBMES ;OUTPUT THE MESSAGE
ASCIZ /% Line Sequence Number detected in input file/
MOVE CH,T ;RESTORE CHARACTER
JRST YANK50 ;..
YNKSEZ: MOVEI T,4 ;CTR FOR REST OF SEQ #
IBP IBUF+.BFPTR ;MOVE PTR OVER THIS CHAR
SOS IBUF+.BFCTR ;& CTR TOO
SOJG T,.-2
TXO F2,LSNINF!LSNF ;IGNORE NEXT CHAR IF TAB
TXO FF,SEQUIN ;IGNORE NEXT CHAR IF IT IS A TAB
JRST YANK3
INERR: GETSTS INCHN,B ;SAVE ERROR FLAGS
PUSHJ P,ZAPIN ;ZAP ANY INPUT FILE
TXZ FF,UREAD
$FATAL (INP,,<Input error 11 on file 09>)
;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.
APPEND: MOVE OU,Z ;STORE DATA AT END OF BUFFER.
PUSHJ P,YANK2
JRST RET
;INSERT TRAILING FORM FEED IF NEEDED
TRLFF: TXZN FF,FORM ;ALREADY HAVE NEED OF A <FF>?
POPJ P, ;NO
PUSH P,PT ;PRESERVE "." ACCROSS INSERT
MOVE OU,Z ;POINT TO END OF BUFFER
MOVEM OU,PT ;SET "." THERE
MOVEI CH,.CHFFD ;GET A <FF> CHARACTER
PUSHJ P,TAB2 ;INSERT A <FF> THE HARD WAY
POP P,PT ;RESTORE "." AFTER INSERT
SKIPE CH,RREL ;ALLOW FOR RELOCATION OF TEXT
ADDM CH,PT ; (IF ANY)
POPJ P, ;RETURN
;^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,ARG!SLSL ;NO ARGUMENT WANTED
TXO FF,TABSRT ;FLAG THIS IS A TABBED INSERT
;AND TREAT AS NORMAL (ALMOST) INSERT
;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,ARG ;IS THERE AN ARGUMENT?
JRST INS1A ;YES. NI COMMAND.
;ENTER HERE FOR "FR" COMMAND
INSERA: MOVEI CH,.CHESC ;NORMAL TERMINATOR
TXZN FF,SLSL ;DID @ PRECEED I?
JRST INSERB ;NO, TERMINATOR = ALTMODE
PUSHJ P,SKRCH ;YES. CH:=USER SELECTED TERMINATOR.
$FATAL (UIN,,<Unterminated input string>)
;ENTER HERE FOR "FS", "FN", AND "F_" COMMANDS TO SCAN INSERT ARGUMENT
INSERB: MOVEI B,(CH) ;B=INSERTION TERMINATOR.
PUSH P,COMPTR ;SAVE CURRENT POSITION IN CMD STRING
PUSH P,COMPTX ; (DOUBLE-WORD POINTER ADDRESS)
PUSH P,COMCNT ;SAVE COMMAND CHARACTER COUNT TOO
TXNN FF,TABSRT ;IS THIS A TABBED INSERT?
TDZA C,C ;NO, REGULAR INSERT
MOVEI C,1 ;YES, THEN TAB IS FIRST CHARACTER
MOVEI CH,IN5T1B ;ASSUME MODERN ('80S) CONVENTIONS
CHKEO EO21,[MOVEI CH,IN3T1B ;GUESSED WRONG
JRST INSERC] ;USE ANCIENT CONVENTIONS
CHKEO EO25,[MOVEI CH,IN1T1B ;GUESSED WRONG
JRST INSERC] ;USE OLD CONVENTIONS
INSERC: MOVEM CH,CHTB ;REMEMBER CHARACTER DISPATCH TABLE
;COUNT # CHARACTERS TO INSERT IN C AND MOVE COMPTR TO END OF STRING.
INSER0: PUSHJ P,SKRCH ;GET NEXT CHARACTER
$FATAL (UIN,,<Unterminated input string>)
CAIN CH,(B) ;IS IT THE TERMINATOR?
JRST INSER2 ;YES, END OF 1ST PASS
TXO FF,F.NNUL ;[MHK] FLAG NON NULL INSERT
MOVE T,CHTB ;CHECK FOR SPECIAL CONTROL CHARACTERS
TXNE F2,TXTCTL ;^T FLAG ON?
ADDI T,IN2T1B-IN1T1B ;YES, USE RESTRICTED TABLE
PUSHJ P,DISP1
TXNN F2,TXTCTL ;IF ^T ON, ALL OTHER CTL-CHARS LEGAL TEXT
PUSHJ P,CKNCC ;CHECK FOR OTHER ILLEGAL CONTROL-CHARS
INSER1: AOJA C,INSER0 ;COUNT TEXT CHARACTERS
;SETUP FOR INSERT (CHAR COUNT IN C)
INSER2: MOVEM C,VVAL ;SAVE LENGTH OF STRING
TXZ F2,TXTCTL ;REFRESH ^T FLAG
TXNE F2,S.REPL ;DOING FS OR FN?
JRST SERCHJ ;YES
POP P,COMCNT ;RESET TO BEGINNING OF INSERT TEXT
POP P,COMPTX ; (DOUBLE-WORD POINTER ADDRESS)
POP P,COMPTR ;AND COMMAND BYTE POINTER
TXNN F2,S.FRCM ;IF REGULAR INSERT COMMAND, THEN
JRST INSE2N ;JUST DO INSERT
SKIPG C,VVALFR ;FR COMMAND, GET LAST STRING ARG SIZE
ADDM C,PT ;RELOCATE "." TO START OF LAST STRING ARG
; AND IF THE USER HAS MOVED SINCE THEN,
; IT'S HIS TOUGH LUCK (WHO KNOWS, HE MIGHT
; EVEN KNOW WHAT HE'S DOING!)
MOVMS C ;ABSOLUTE SIZE OF PREVIOUS STRING ARG
MOVNS C ;(DON'T HAVE SUB AC FROM MEMORY)
ADD C,VVAL ;C:=DIFFERENCE IN STRING SIZES
CAIA ;GROW/SHRINK TEXT BUFFER AS NEEDED
INSE2N: PJUMPE C,CPOPJ ;EXIT IF NULL INSERT
CAIE C,0 ;DON'T TRY TO EXPAND/CONTRACT IF NOT NEEDED
PUSHJ P,NROOM ;MOVE FROM PT THROUGH Z UP C POSITIONS.
TXNN F2,S.FRCM ;IF REGULAR INSERT,
JRST INS1B ;JUST DO THE INSERT
SKIPN VVAL ;FR COMMAND, DO THE INSERT IF ANYTHING TO INSERT
POPJ P, ;UNLESS ONLY "-ND" EFFECT WANTED
; I.E., "FR$" COMMAND
;MOVE INSERTION INTO DATA BUFFER
INS1B: MOVE OU,PT ;INSERT STARTING AT "."
MOVEI CH,IN5T2B ;ASSUME MODERN CONVENTIONS
CHKEO EO21,[MOVEI CH,IN3T2B ;GUESSED WRONG
JRST INS1B2] ;USE ANCIENT CONVENTIONS
CHKEO EO25,[MOVEI CH,IN1T2B ;GUESSED WRONG
JRST INS1B2] ;UES OLD CONVENTIONS
INS1B2: MOVEM CH,CHTB ;REMEMBER CHARACTER DISPATCH TABLE
TXZE FF,TABSRT ;IS THIS A TABBED INSERT?
SKIPA CH,[.CHTAB] ;YES, FIRST INSERT A TAB
INS1C: PUSHJ P,GCH ;CH:=CHARACTER FROM COMMAND STRING.
INS1F: CAIN CH,(B) ;IS IT THE TERMINATOR?
JRST INS1L ;YES. DON'T STORE IT.
MOVE T,CHTB ;CHECK FOR CONTROL CHARACTERS
TXNE F2,TXTCTL ;^T FLAG ON?
ADDI T,IN2T2B-IN1T2B ;YES, USE RESTRICTED TABLE
PUSHJ P,DISP1
INS1E: PUSHJ P,CASE ;CONVERT UC TO LC IF FLAGS WARRANT
INS1D: PUSHJ P,PUT ;NO. STORE CHARACTER IN DATA BUFFER
AOJA OU,INS1C ;ADVANCE "." AND LOOP
INS1L: MOVEM OU,PT ;SET NEW "."
POPJ P, ;AND RETURN SANS STORING THE TERMINATOR
;EO=1,2 DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (COUNT PASS)
IN1T1B: XWD INSER0,.CHCNV ;^V
XWD INSER0,.CHCNW ;^W
XWD INSER0,36 ;^^
IN2T1B: XWD INSER4,.CHCNT ;^T
XWD INSER3,.CHCNR ;^R
IN3T1B: XWD 0,0 ;END OF LIST
;EO=3 DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (COUNT PASS)
IN5T1B: XWD INSER0,.CHCNA ;^A (LOWER CASE)
XWD INSER0,.CHCNB ;^B (UPPER CASE)
XWD INSER0,36 ;^^ (SORTA SHIFT)
XWD INSER4,.CHCNT ;^T (LITERAL TEXT)
XWD INSER3,.CHCNV ;^V (QUOTE CHARACTER)
XWD 0,0 ;END OF TABLE
;EO=1,2 DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (INSERT PASS)
IN1T2B: XWD INSLOW,.CHCNV ;^V
XWD INSSTD,.CHCNW ;^W
XWD INSSPC,36 ;^^
IN2T2B: XWD INSMAC,.CHCNT ;^T
XWD INSIGR,.CHCNR ;^R
IN3T2B: XWD 0,0 ;END OF LIST
;EO=3 DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (INSERT PASS)
IN5T2B: XWD INSLOW,.CHCNA ;^A (LOWER CASE)
XWD INSSTD,.CHCNB ;^B (UPPER CASE)
XWD INSSPC,36 ;^^ (SORTA SHIFTED)
XWD INSMAC,.CHCNT ;^T (LITERAL TEXT)
XWD INSIGR,.CHCNV ;^V (QUOTED CHARACTER)
XWD 0,0 ;END OF LIST
;QUOTE NEXT CHARACTER
INSER3: PUSHJ P,SKRCH ;READ IN THE QUOTED CHARACTER
$FATAL (UIN,,<Unterminated input string>)
JRST INSER1 ;AND COUNT AS ONLY ONE CHARACTER FOR INSERT
;CHANGE NO-CONTROL-COMMANDS FLAG
INSER4: TXC F2,TXTCTL
JRST INSER0 ;DON'T COUNT ^T
;EO=1,2:
; ^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)
;EO=3:
; ^A CAUSES THE NEXT CHARACTER TO BE CONVERTED TO LOWER CASE (IF UPPER CASE)
; ^A^A SETS LOWER CASE MODE UNTIL THE END OF THE TEXT STRING (OR FURTHER NOTICE)
INSLOW: PUSHJ P,C.VA ;SET ^V/^A FLAGS
JRST INS1C ;CONTINUE TO NEXT CHAR.
;EO=1,2:
; ^W CAUSES NEXT CHAR. TO BE TAKEN AS IS (STANDARD MODE)
; ^W^W SETS STANDARD MODE UNTIL END OF TEXT STRING (OR FURTHER NOTICE)
;EO=3:
; ^B CAUSES NEXT CHAR. TO BE TAKEN AS IS (STANDARD MODE)
; ^B^B SETS STANDARD MODE UNTIL END OF TEXT STRING (OR FURTHER NOTICE)
INSSTD: PUSHJ P,C.WB ;SET ^W/^B FLAGS
JRST INS1C ;CONTINUE TO NEXT CHAR.
;EO=1,2:
; ^R UNCONDITIONALLY QUOTES THE NEXT CHARACTER (TREATS AS TEXT)
;EO=3:
; ^V UNCONDITIONALLY QUOTES THE NEXT CHARACTER (TREATS AS TEXT)
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
;^T -- CHANGE NO-CONTROL-COMMANDS MODE
INSMAC: TXC F2,TXTCTL ;COMPLEMENT ^T FLAG
JRST INS1C ;GO ON TO NEXT CHAR
;SET ^V/^A FLAGS
C.VA: TXON F2,CTLVA ;SET ^V/^A FLAG -- WAS IT ON BEFORE?
POPJ P, ;NO
TXZ F2,CTLVA+CTLWWB ;YES, SET ^V^V/^A^A FLAG & CLR OTHERS
TXO F2,CTLVVA
POPJ P,
;SET ^W/^B FLAGS
C.WB: TXON F2,CTLWB ;SET ^W/^B FLAG -- WAS IT ON BEFORE?
POPJ P, ;NO
TXZ F2,CTLWB+CTLVVA ;YES, SET ^W^W/^B^B FLAG & CLR OTHERS
TXO F2,CTLWWB
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,LCASE ;PREVAILING LOWER CASE?
TRO CH,40 ;YES, CONVERT TO LOWER
TXNE F2,UCASE ;PREVAILING UPPER CASE?
TRZ CH,40 ;YES, CONVERT TO UPPER
TXNE F2,CTLVVA ;DOUBLE ^V/^A ON?
TRO CH,40 ;YES, CONVERT TO LC
TXNE F2,CTLWWB ;DOUBLE ^W/^B ON?
TRZ CH,40 ;YES, CONVERT TO UC
TXZE F2,CTLVA ;SINGLE ^V/^A ON?
TRO CH,40 ;YES, CONVERT TO LC
TXZE F2,CTLWB ;SINGLE ^W/^B ON?
TRZ CH,40 ;YES, CONVERT TO UC
CASE3: TXZ F2,CTLVA+CTLWB ;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,
;CHECK FOR NON-CONTROL CHARACTERS
;IF <CH LT 10>, OR <15 LT CH LT 33>, OR <33 LT CH LT 40>,
; THEN CH IS AN ILLEGAL CONTROL-CHAR
CKNCC: CAIGE CH," "
CAIG CH,.CHCRT
CAIGE CH,.CHCNH
CAIN CH,.CHESC
POPJ P, ;IT IS 10-15 OR 33 OR 40+
MOVEI B,(CH) ;SAVE CHAR FOR ERROR MSG ROUTINE
$FATAL (ICT,,<Illegal control command 18 in text argument>)
;NI INSERT AT THE POINTER A CHARACTER WHOSE 7-BIT ASCII CODE IS N
; (BASE 10). THE POINTER IS MOVED TO THE RIGHT OF THE NEW CHARACTER.
INS1A: CHKEO EO21,INS1X ;IF EO=1 SKIP NEXT STUFF
PUSHJ P,SKRCH ;GET CHAR AFTER I
$FATAL (NAI,,<No Altmode before nI>)
CAIE CH,.CHESC ;IT HAD BETTER BE AN ALTMODE
$FATAL (NAI,,<No Altmode before nI>)
INS1X: MOVE CH,NUM ;CH:=NUM
;INSERT CH IN DATA BUFFER AT PT
TAB2: MOVEI C,1 ;MOVE FROM PT THROUGH Z UP 1 POSITION.
PUSHJ P,NROOMC
AOS OU,PT ;PT:=PT+1
SOJA OU,PUT ;STORE CH AT PT-1
;NBACKSLASH INSERT AT THE CURRENT POINTER LOCATION THE ASCII NUMBERS
; EQUAL TO N.
NBAKSL: MOVE T,[POINT 7,STAB];STORE NUMBER IN STAB MOMENTARILY
MOVEI C,0 ;COUNT # DIGITS IN C.
XMOVEI A,NBAKS9 ;SET DPT TO RETURN TO NBAKS9
PUSHJ P,DPT ;CONVERT C(B) TO ASCII AND STORE STRING IN STAB.
MOVE B,[POINT 7,STAB];POINTER TO NUMBER (DIGIT STRING)
PUSHJ P,NROOMC ;MOVE FROM PT THROUGH Z UP C POSITIONS.
NBAKS5: MOVE OU,PT ;POSITION TO PUT CHAR IN
ILDB CH,B ;GET NEXT CHAR OF THE #
PUSHJ P,PUT ;STORE THE CHAR
AOS PT ;MOVE THE POINTER
SOJG C,NBAKS5 ;DECREMENT THE CHAR CTR
TXZ F2,OCTALF ;CLEAR USED-UP RADIX FLAG
JRST RET
NBAKS9: IDPB CH,T ;STORE DIGIT IN STAB
AOJA C,CPOPJ ;C:=C+1. RETURNS TO DPT CALL + 1 ON COMPLETION.
;NT TYPE OUT THE STRING OF CHARACTERS STARTING AT THE RIGHT OF THE
; POINTER AND CONTINUING THROUGH THE NTH LINE FEED ENCOUNTERED.
; IF N IS NEGATIVE, N LINES TO THE LEFT OF THE POINTER ARE TYPED.
;T SAME AS 1T.
;I,JT TYPE OUT THE (I+1)TH THROUGH THE JTH CHARACTER OF THE BUFFER.
TYPE: SKIPE COLUMN ;AT NICE FRESH START OF A COLUMN?
SKIPE TYOTCT ;NO, HAS ANYTHING PRECEDED US?
CAIA ;DON'T DO ANYTHING
PUSHJ P,CRR ;FIRST OUTPUT, GET TO A FRESH LINE FOR NEATNESS
; THIS ALLOWS "<SBLAH$;0TT>" TO LINE UP NICELY
; ON SUCCESSIVE LINES WHEN ON A VIDEO TERMINAL
MOVEI D,TYO ;D:=ADDRESS OF OUTPUT ROUTINE.
SKIPE CMFTYO ;SUPPRESSING OUTPUT DUE TO COMMAND FILE?
MOVEI D,CPOPJ ;YES
SETOM WINFLG ;SO DISPLAY DOESN'T ERASE WHAT GETS TYPED
TYPE0: PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS.
;B:=SECOND STRING ARGUMENT ADDRESS.
TYPE1: PUSHJ P,CHK1 ;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
MOVE I,C ;START GETTING CHARACTERS AT C.
TYPE3: CAML I,B ;DONE?
JRST TYPE5 ;YES.
MOVE TT,I ;NO. GET NEXT CHAR
IDIVI TT,5 ;THIS IS A COPY OF GETINC
LDB CH,BTAB(TT1) ;COPIED TO SPEED IT UP
PUSHJ P,(D) ;OUTPUT IT
AOJA I,TYPE3 ;LOOP
TYPE5: TLZE D,-1 ;*** JUST TO MAKE SURE
HALT .+1 ;*** DUH?
CAIN D,PPA ;D=PPA?
TXNE FF,ARG2 ;[251] YES, "P" COMMAND, I,JP FORM?
JRST TYPE7 ;[251] DO NOT APPEND <FF>
MOVEI CH,.CHFFD ;[251] IF PUNCHING, APPEND FF.
TXNE FF,PCHFLG ;[251] IS THIS AN "N" SEARCH?
TXNE FF,FORM ;[251] DID LAST Y,A TERMINATE ON A FORM FEED?
PUSHJ P,PPA ;[251] APPEND A FORM FEED
TYPE7: TXNE FF,TYOF ;[251] ANY OUTPUT LEFT LYING AROUND?
PJRST TYOOUT ;[251] YEAH, FORCE IT OUT
POPJ P, ;[251] NO, JUST RETURN
PPA: TXNN FF,UWRITE ;ERROR IF NO OUTPUT FILE
$FATAL (NFO,,<No file for output>)
PPA00: MOVE A,OUTSWT ;[250] GET OUTPUT SWITCHES
TXNN FF,SEQF ;[250] IF ALREADY LINE-SEQUENCED FILE, OR
TXNE A,GENLSN ;[250] IF GENERATING LINE SEQUENCE NUMBERS
JRST PPA02 ;[250] THEN DO LSN PROCESSING
PPA01: SOSGE OBUF+.BFCTR ;[250] ROOM IN BUFFER FOR ANOTHER CHARACTER?
JRST PPA01O ;[250] NO, GET ANOTHER BUFFER
IDPB CH,OBUF+.BFPTR ;CH TO OUTPUT BUFFER.
POPJ P, ;RETURN
PPA01O: PUSHJ P,PPAOU ;[250] ADVANCE OUTPUT BUFFER
JRST PPA01 ;[250] AND TRY AGAIN
;HERE FOR LINE SEQUENCE NUMBER PROCESSING OF SOME SORT
PPA02: TXNN FF,SEQUIN ;WAS LAST CHAR AN EOL OR BEG OF BUFR?
JRST PPA03 ;NO, MIDDLE OF LINE, CHECK FOR EOL
;BEGINING OF A LINE, NEED TO PREFIX A LSN
MOVE AA,OUTSWT ;GET OUTPUT SWITCHES
TXNE AA,SUPLSN ;SUPPRES SEQ # ?
JRST PPA02F ;[250] YES, SKIP PADDING
PUSHJ P,PPAZNL ;[250] NO, PAD WITH NULLS TO WORD BOUNDRY
PPA02F: TXZ FF,SEQUIN ;MOVED DOWN FROM PPA07-1
TXNE FF,SEQF ;REMOVE PPA06 LABEL
;GENERATE NEW LSN OR OUTPUT EXISTING LSN?
JRST PPA04 ;OUTPUT EXISTING LSN
CAIN CH,.CHFFD ;HANDLE A FORM-FEED?
JRST PPA14 ;GO DO 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
PPA02L: AOS OBUF+.BFPTR ;& OUTPUT THE 5 DIGITS + BIT 35
HRRZ T,OBUF+.BFPTR ;EXTRACT BYTE POINTER ADDRESS FIELD
MOVEM A,(T) ;STASH THE 5 FULL BYTES
MOVEI A,.CHTAB ;FOLLOWED BY TAB
IDPB A,OBUF+.BFPTR
MOVNI A,6 ;[250] ACCOUNT FOR THE 6 CHARACTERS
ADDM A,OBUF+.BFCTR ;[250] HALLUCINATED BY THE ABOVE
PPA03: PUSHJ P,CKEOL ;IS THIS CHAR AN EOL?
JRST PPA01 ;NO
TXO FF,SEQUIN ;YES, SET EOL FLAG
CAIN CH,.CHFFD ;[250] A FORM FEED?
TXNE AA,SUPLSN ;[250] YES, SUPPRESSING LSN'S?
JRST PPA01 ;[250] OUTPUT CHARACTER DIRECTLY
PUSHJ P,PPAZCL ;[250] PAD TO WORD BOUNDRY, WITH <CR><LF>
JRST PPA14 ;MARK THE PAGE
;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
PUSHJ P,GETINC ;GET NEXT BUFFER CHAR
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
PUSHJ P,GETINC ;GET NEXT CHARACTER
JRST 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: PUSHJ P,GETINC ;PICK IT UP AND
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
FALL PPA08B ;MUST BE USER'S SPACES!
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
; HERE IF NOT 5 SPACES FOLLOWED BY TAB OR CR. THIS IMPLIES
; THAT ANY SPACES SEEN WERE USER'S TEXT.
PPA08B: SUBI I,5 ;BACK UP TO FIRST CHARACTER
ADD I,LSNCTR ;AND OUTPUT IT WITH BLANK LSN
PUSHJ P,GETINC ;GET PROPER CHARACTER
MOVE AA,OUTSWT ;GET SWITCHES
TXNE AA,SUPLSN ;SUPPRESS SEQ#
JRST PPA01 ;YES
TRO A,1 ;NO, SET BIT 35
JRST PPA02L ;OUTPUT SEQ# WITH A TAB
PPA09: MOVE AA,OUTSWT ;GET SWITCHES
TXNE AA,SUPLSN ;SUPPRESS SEQ#'S?
JRST PPA13 ;YES
TRO A,1 ;SET BIT 35
AOS OBUF+.BFPTR ;& OUTPUT SEQ #
HRRZ T,OBUF+.BFPTR ;EXTRACT ADDRESS FIELD FROM BYTE POINTER
MOVEM A,(T) ;STASH 5 BYTES
MOVNI A,5 ;[250] ADJUST THE CHAR COUNT
ADDM A,OBUF+.BFCTR ;[250] BY 5 DIGIT'S WORTH
JRST PPA03 ; CONTINUE
PPA13: CAIE CH,.CHCRT ;ELIMINATE CR (FOR SOS)
CAIN CH,.CHTAB ;IS TERMINATOR A TAB?
AOSA OBUF+.BFCTR ;YES, FIX POINTER AND
JRST PPA01 ;NO, OUTPUT IT
POPJ P, ;OMIT IT
;
; HERE TO INSERT A SOS STYLE PAGE MARK.
;
PPA14: MOVE A,OBUF+.BFPTR ;[250] A BIT OF PARANOIA
TLNE A,320000 ;[250] SHOULD BE ON A WORD BOUNDRY!
HALT .+1 ;[250] HO HUM
MOVE A,[<ASCII\ \>+1] ;[250] FIVE SPACES + B35
AOS OBUF+.BFPTR ;OUTPUT IT
HRRZ T,OBUF+.BFPTR ;ADDRESS FROM BYTE POINTER
MOVEM A,(T) ;STASH THESE FIVE BYTES
MOVE A,[BYTE(7) .CHCRT,.CHFFD,0,0,0] ;AND CR,FF
AOS OBUF+.BFPTR ;INCREMENT THE POINTER
HRRZ T,OBUF+.BFPTR ;INCREMENTED ADDRESS
MOVEM A,(T) ;AND DEPOSIT
MOVNI A,12 ;[250] ALLOW FOR 10 CHARACTERS
ADDM A,OBUF+.BFCTR ;[250] MUNGED BY THE ABOVE
TXO FF,SEQUIN ;SET THE EOL FLAG
MOVE A,[<ASCII\00000\>+1] ;[250] RESET THE LSN
MOVEM A,LSNCTR
POPJ P, ;[] AND RETURN
PPAZCL: MOVEI A,.CHCRT ;[250] CARRIAGE RETURN
PUSHJ P,PPAZZC ;[250] STUFF IN BUFFER
MOVEI A,.CHLFD ;[250] SECOND HALF OF <CR><LF>
PUSHJ P,PPAZZC ;[250] STUFF IN BUFFER
PPAZNL: MOVE A,OBUF+.BFPTR ;[250] OUTPUT BYTE POINTER
TLNN A,320000 ;[250] ON A WORD BOUNDRY?
JRST PPAZNW ;[250] YES
PPAZNO: SETZ A, ;[250] NO
PUSHJ P,PPAZZC ;[250] PAD WITH A NULL
JRST PPAZNL ;[250] KEEP WORKING ON IT
PPAZNW: SKIPG A,OBUF+.BFCTR ;[250] ROOM LEFT IN BUFFER
JRST PPAZNZ ;[250] EMPTY, GET FRESH BUFFER
CAIGE A,^D10 ;[250] LSN'S NEED AT LEAST TWO WORDS
JRST PPAZNO ;[250] PAD OUT BUFFER
POPJ P, ;[250] ALL SET
PPAZNZ: PUSHJ P,PPAOU ;[250] GET FRESH BUFFER
JRST PPAZNW ;[250] VERIFY IT
PPAZZC: SOSGE OBUF+.BFCTR ;[250] ROOM FOR ANOTHER CHARACTER?
JRST PPAZZO ;[250] NO, NEED ANOTHER BUFFER
IDPB A,OBUF+.BFPTR ;[250] STUFF CHARACTER
POPJ P, ;[250] RETURN
PPAZZO: PUSHJ P,PPAOU ;[250] FLUSH OUTPUT BUFFER
JRST PPAZZC ;[250] TRY AGAIN
PPAOU: AOS BOCNT ;[250] COUNT BUFFERED OUT'S FOR EP
OUT OUTCHN,0 ;[250] BUFFERED MODE, ADVANCE TO NEW BUFFER
POPJ P, ;[250] RETURN TO FILL EMPTY BUFFER
GETSTS OUTCHN,AA ;[250] GET OUTPUT I/O STATUS
TXNE AA,IO.ERR ;[250] ACTUAL I/O ERROR?
JRST PPAOUE ;[250] YES, REPORT IT
MOVE A,OUCHR ;..
TXNE A,DV.MTA ;..
TXNN AA,IO.EOT ;[250] IF MTA AND EOT
POPJ P, ;[250] NO, IGNORE (???)
PPAOUE: SKIPA B,AA ;[250] MAGTAPE HIT EOT, CALL THAT ERROR TOO
OUTERR: GETSTS OUTCHN,B ;SAVE ERROR FLAGS
PUSHJ P,ZAPOU ;ZAP ANY OUTPUT DEVICE
TXZ FF,UWRITE+UBAK ;CLEAR OUTPUT FILE OPEN INDICATOR.
$FATAL (OUT,,<Output error 11 - output file 01 closed>)
;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,PPA ;SELECT PPA FOR OUTPUT
TXNE FF,ARG2 ;I,JP?
JRST TYPE0 ;YES. GET STRING ARGUMENTS AND OUTPUT.
MOVE E,B ;NO. E:=N
PUSHJ P,PKRCH ;PEEK AHEAD ONE COMMAND CHARACTER
SETO CH, ;NONE LEFT
MOVE T,CH ;PROTECT PEEK'ED CHARACTER
TRZ T,40 ;FILTER L.C.
JUMPL E,CPOPJ ;IF N LT 0, IGNORE P.
CHKEO EO21,PUN1 ;OLD STYLE P ALWAYS GIVES FORM FEED
CAIE T,"W" ;PW ALWAYS GIVES FORM FEED
TXO FF,PCHFLG ;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: MOVE C,Z
CAMN C,BEG ;EMPTY BUFFER?
TXNN FF,FINF ;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,FORM ;AND THE FORM FEED FLAG
JRST YANK51 ;SET Z=BEG & POPJ
PUNCHR: MOVE C,BEG ;OUTPUT DATA BUFFER.
MOVE B,Z
MOVEI D,PPA
CAME B,C ;IS PAGE BUFFER EMPTY?
JRST TYPE1 ;NO; IF SEQUENCED FILE, START PAGE WITH SEQ#
;EDIT 173 OBSOLECES PUNCH1
TXNE FF,FORM ;YES, IS THERE A FORM-FEED ON THIS BLANK PAGE?
JRST TYPE5 ;YES, OUTPUT IT
POPJ P, ;NO, DON'T OUTPUT ANYTHING
PUN3: TXNE FF,UREAD ;ANY INPUT FILE?
TXNE FF,FINF ;DONT TRY TO READ IF NO DATA LEFT
JRST PUN2
PUSHJ P,YANK1 ;RENEW BUFFER
JRST PUN4 ;CONTINUE
;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 N GT 0: MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
; PASSED OVER N LINE FEEDS.
; N LT 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.
LCMD: PUSHJ P,LINE ;DO THE WORK
JRST RET ;BACK TO COMMAND PROCESSOR
LINE: TXNE FF,ARG2 ;ERROR IF THERE ARE 2 ARGS
$FATAL (TAL,,<Two arguments with L>)
PUSHJ P,GETARG ;NO. C:=FIRST STRING ARGUMENT ADDRESS,
;B:=SECOND STRING ARGUMENT ADDRESS.
XOR B,C
XORM B,PT
POPJ P, ;DONE
;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
;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
PUSHJ P,DELN ;DELETE "N" CHARACTERS AS APPROPRIATE
JRST RET ;RETURN
;DELETE C(B) CHARACTERS FROM "."
DELN: 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.
JUMPE C,RET ;THE SIMPLE CASE IS REALLY SIMPLE!
PUSHJ P,NROOM ;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
DELED: MOVNI B,3 ;COMMAND EXECUTION COUNT
MOVEM B,TOOBIG ;TO TRY TO RECLAIM MEMORY PAGES
POPJ P, ;ALL DONE HERE
;HK - DELETE ENTIRE BUFFER
HK: MOVE B,BEG ;START OF BUFFER
MOVEM B,PT ;SET NEW "."
MOVEM B,Z ;AND NEW END OF BUFFER
JRST DELED ;NOTE SOMETHING DELETED
;ROUTINE TO CHECK DATA BUFFER POINTER
;CALL MOVE B,POINTER
; PUSHJ P,CHK
; RETURN IF B LIES BETWEEN BEG AND Z
CHK: CAMG B,Z
CAMGE B,BEG
$FATAL (POP,,<Attempt to move pointer off page with 00>)
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
CHK1: CAMLE C,B ;C GT B? (CHECK FIRST!)
$FATAL (SAL,,<Second argument less than first>)
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 ;
CAMN C,BEG ;YES; BEG OF BUFFER?
JRST CHK1.5 ;YES
MOVE TT,C ;NO; BEG OF LINE?
SUBI TT,1 ;GET PREV CHAR
IDIVI TT,5 ;WORD ADDRESS
LDB CH,BTAB(TT1) ;
PUSHJ P,CKEOL ;PREV CHAR = EOL?
POPJ P, ;NO; RETURN
CHK1.5: TXO FF,SEQUIN ;YES; SET FLAG
POPJ P, ;RETURN
;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,ARG ;IS THERE AN ARGUMENT?
POPJ P, ;YES. IT'S ALREADY IN B.
CHK22: LDB B,[XWD 340200,DLIM] ;B:=1 WITH SIGN OF LAST OPERATOR.
MOVNS B
AOJA B,CPOPJ
;DECREMENT ASCII BYTE PTR
DBP: ADD TT,[7B5] ;BACK UP POINTER
JUMPGE TT,.+2 ;SKIP IF P NOT NOW 44 OR MORE
SUB TT,[43B5+1] ;FIX FUNNY POINTERS
POPJ P,
;ROUTINE TO ADJUST BYTE ASCII BYTE POINTER IN TT BY A BYTES
ADJUST: IDIVI A,5 ;LEAVES WORDS WORTH OF MODIFICATION IN A
;AND LEFTOVER BYTE QUANTITY IN AA
ADD TT,A ;ACCOUNT FOR FULL WORDS'S WORTH
LSH AA,36 ;PUT BYTE COUNT IN P FIELD
IMULI AA,7 ;CHANGE TO BIT COUNT
SUB TT,AA ;MODIFY BYTE POINTER P FIELD
JUMPGE TT,CPOPJ ;EXIT UNLESS FUNNY RESULTANT P FIELD
CAILE AA,0 ;FUNNY P; HOW TO FIX IT ??
ADD TT,[43B5+1] ;ADD IF POSITIVE ADJUSTMENT
CAIGE AA,0
SUB TT,[43B5+1] ;SUBTRACT FOR NEGATIVE ADJUSTMENT
POPJ P,
;ROUTINE TO SKIP ON NON-UPPER CASE CHARACTER
SNUPER: CAIL CH,101
CAILE CH,132
AOS (P)
POPJ P,
;ROUTINE TO SKIP ON NON-LOWER CASE LETTER
SNLOWR: CAIL CH,"a"
CAILE CH,"z"
AOS (P)
POPJ P,
;ROUTINE TO SKIP IF CHARACTER SHOULD BE FLAGGED (WRONG CASE OR CONTROL)
SFLAGC: CAIGE CH," " ;IS CHARACTER A CONTROL ??
JRST SFLGC2 ;YES, SO IT IS A FLAGGED CHARACTER
TXNN F2,LINCHR+TYMSGF;DON'T FLAG IF TTY LC OR TYPING MESSAGE
SKIPGE TYCASF ;CASE SWITCH UPPER ??
POPJ P, ;CASE SWITCH 0, NO FLAG
SKIPG TYCASF ;SKIP IF FLAGGING UPPERS
JRST SFLGC1 ;FLAGGING LOWERS
PUSHJ P,SNUPER ;SKIP IF THIS CHAR NOT UPPER CASE
AOS (P) ;SKIP, BECAUSE CH IS UPPER CASE AND WE'RE FLAGGING THEM
POPJ P,
SFLGC2: CAIE CH,.CHTAB ;<TAB>?
CAIN CH,.CHCRT ;OR <CR>?
POPJ P, ;YES, NO FLAGGING
CAIE CH,.CHESC ;ALTMODE AS CONTROL IS NOT ^[, SO NO FLAG
AOS (P) ;YES
POPJ P,
SFLGC1: PUSHJ P,SNLOWR ;SWITCH LOWER, IS THIS CH LOWER ??
AOS (P)
POPJ P, ;NO, SO NO FLAG
CFLAG=="'" ;CHARACTER FOR FLAGGING WRONG CASE
SUBTTL SEARCHING
;FN, FS, F_, FD, FK, AND FR COMMANDS
FCMD: PUSHJ P,SKRCH ;GET CHAR AFTER F
$FATAL (MEF,,<Macro ending with F>)
TXO F2,S.REPL ;SET F-SEARCH FLAG
MOVEI T,FCTABL ;INDEX DISPATCH TABLE
PUSHJ P,DISPAT
$FATAL (IFC,,<Illegal character "00" after F>)
;F-COMMAND DISPATCH TABLE
FCTABL: XWD SERCHP, "N" ;FN SEARCH
XWD SERCH, "S" ;"S" SEARCH AND REPLACE
XWD LARR, "_" ;"_" SEARCH AND REPLACE
XWD FD, "D" ;"S" SEARCH AND DELETE
XWD FK, "K" ;"S" SEARCH AND KILL (OLD "." TO NEW ".")
XWD FR, "R" ;REPLACE WITH NO SEARCH
XWD FV, "V" ;RETURN LAST STRING "VALUE" (SIZE)
XWD 0, 0
FD: TXOA F2,S.DELE ;DELETE THE MATCHED STRING
FK: TXO F2,S.KILL ;KILL INCLUSIVELY TO MATCHED STRING
TXZ F2,S.REPL ;NOT A "REPLACE" OPERATION
JRST SERCH ;GO DO THE SEARCH
FR: TXNE FF,ARG!ARG2 ;FR DOESN'T UNDERSTAND NUMBERS IN FRONT
$FATAL (FRA,,<FR command with numeric arguments illegal>)
MOVE E,VVAL ;GET LAST STRING ARGUMENT SIZE
MOVNM E,VVALFR ;SAVE FOR "-ND" EFFECT
TXC F2,S.REPL!S.FRCM;NOTE JUST FR COMMAND, NO SEARCH WANTED
PUSHJ P,INSERA ;GO DO THE "RETROACTIVE" REPLACE
JRST RET ;RETURN F-COMMAND STYLE
FV: MOVN A,VVAL ;LAST STRING SIZE
JRST VALRET ;RETURN THAT AS VALUE
;_ SEARCH
LARR: TXOA FF,FINDR ;FINDR:=1 FOR LEFT ARROW SEARCH
;N SEARCH
SERCHP: TXO FF,PCHFLG ;PCHFLG:=1 FOR N SEARCH
;S SEARCH
SERCH: TXZ F2,S.MINS ;CLEAR MINUS SEARCH FLAG
MOVE E,PT ;OLD POINT
MOVEM E,SCHPT ;SAVE IN CASE THE SEARCH FAILS
MOVEM E,UPPERB ;PT IS UPPER BOUND ON BACKWARD SEARCHES
PUSHJ P,SETQTE ;SETUP QUOTING CHARACTERS
SETZ E, ;ASSUME FIRST OCCURRENCE IN CASE BOUNDED
TXZE FF,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,ARG ;THERE MUST BE NO ARG
$FATAL (ISA,,<06 Argument with 00 search>)
SERC33: SKIPGE E,B ;GET ARG WHERE IT WANTS IT
TXOA F2,S.MINS ;MINUS SEARCH
SETZM UPPERB ;NO UPPERBOUND ON FORWARD SEARCHES
JRST SERCHA
;HERE IF BOUNDED SEARCH, SET UP BOUNDS
BOUNDS: PUSHJ P,GETAG6 ;GET THE STRING POINTERS
TXZ FF,PCHFLG!FINDR!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,SLSL ;@ SEEN?
JRST SERCHB ;NO, TERMINATOR = ALTMODE
PUSHJ P,SKRCH ;YES. CH:=USER SPECIFIED DELIMITER.
$FATAL (USR,,<Unterminated search command>)
;DETERMINE WHETHER WE CAN USE THE PREVIOUS PATTERN
SERCHB: MOVEM CH,B ;B:=PATTERN SOURCE STRING DELIMITER
MOVEM CH,FSNTRM ;SAVE DELIMITER FOR FS INSERTION
SETZM SCNEST ;SEARCH NEST LEVEL IS ZERO
PUSHJ P,SKRCH ;LOOK AHEAD 1 CHARACTER
$FATAL (USR,,<Unterminated search command>)
CAIE CH,(B) ;IS IT THE DELIMITER?
JRST SERCHT ;NO, AN ARGUMENT IS GIVEN
SKIPL SCHCTR ;YES, USE PREVIOUS PATTERN STRING
; UNLESS THERE WAS NONE OR LAST HAD ERROR
$FATAL (SNA,,<Initial search with no argument>)
SKIPN SCTLGA ; BUT NOT IF REMEMBERED PATTERN SOURCE USED ^GI
JRST SCH.E ;OK, USE PREVIOUS MATRICES
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;MOVE A NEW PATTERN SOURCE TO STORAGE
SERCHT: TXZ F2,XMATCH ;CLEAR EXACT MATCH FLAG
STORE A,SMATRX,SMATRX+SCLRLN-1,0 ;CLEAR PREVIOUS MATRICES
SETZM SCHCTR ;CLEAR SOURCE PATTERN LENGTH COUNTER
SETZM SCTLGA ;ASSUME PATTERN SOURCE DOESN'T USE ^GI
MOVE AA,[POINT 7,SCHARG] ;POINT TO START OF STORAGE AREA
JRST SERCHD ;1ST CHARACTER ALREADY IN
SERCHC: PUSHJ P,SKRCH ;GET NEXT CHARACTER OF PATTERN SOURCE
$FATAL (USR,,<Unterminated search command>)
SERCHD: CAME CH,CHQTE ;QUOTING CHARACTER?
CAMN CH,CHQTE2 ;OR ALTERNATE QUOTING CHARACTER?
JRST SERCHG ;YES, NEXT CHARACTER IS TEXT
CAIN CH,(B) ;THE DELIMITER?
JRST SERCHX ;YES
CAMN CH,CCQTE ;CONTROL-CHARACTER QUOTER?
JRST SERCHU ;YES
TXNE F2,TXTCTL ;CONTROL-CHARACTER QUOTE FLAG ON?
JRST SERCHF ;YES, LOWER/UPPER CASE QUOTERS NORMAL TEXT
;RDH CAME CH,LCQTE ;LOWER-CASE QUOTER?
;RDH CAMN CH,UCQTE ;UPPER-CASE QUOTER?
;RDH TXO F2,XMATCH ;YES, SET EXACT MATCH FLAG
SERCHF: AOS A,SCHCTR ;BUMP STRING COUNTER
CAILE A,SRCHMX ;STILL FIT IN STORE?
$FATAL (STL,,<Search string too long>)
IDPB CH,AA ;YES, STORE CHARACTER
JRST SERCHC ; AND GO BACK FOR MORE
SERCHG: AOS A,SCHCTR ;COUNT THE QUOTING CHARACTER
CAILE A,SRCHMX ;WILL IT FIT?
$FATAL (STL,,<Search string too long>)
IDPB CH,AA ;YES, STORE IT
PUSHJ P,SKRCH ;GET NEXT CHARACTER
$FATAL (USR,,<Unterminated search command>)
JRST SERCHF ; AND STORE IT AS TEXT
SERCHU: TXC F2,TXTCTL ;COMPLEMENT CONTROL COMMAND SWITCH
JRST SERCHF
SERCHX: TXZ F2,TXTCTL ;REFRESH CONTROL-CHARACTER QUOTE FLAG
MOVE B,SCHCTR ;SET SOURCE PATTERN LENGTH COUNTER
MOVE AA,[POINT 7,SCHARG] ; 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?
CAME CH,CHQTE ;QUOTING CHARACTER?
CAMN CH,CHQTE2 ;OR ALTERNATE QUOTING CHARACTER?
JRST CNTLQ ;YES, ACCEPT NEXT CHARACTER VERBATIM
CAMN CH,CCQTE ;CONTROL-CHARACTER QUOTING?
JRST CNTLT ;YES, TOGGLE CONTROL-CHAR CONTROL
MOVEI T,S2TABL ;NORMAL CONTROL-CHARACTER DISPATCH
TXNE F2,TXTCTL ;CONTROL-CHARACTER QUOTE FLAG ON?
MOVEI T,S3TABL ;YES, OTHER CONTROL'S ARE TEXT
PUSHJ P,DISP1 ;DISPATCH ON SPECIAL CONTROL'S
CAMN CH,LCQTE ;LOWER-CASE QUOTER?
JRST CNTLV ;YES, NEXT CHAR MUST BE LOWER-CASE ONLY
CAMN CH,UCQTE ;UPPER-CASE QUOTER?
JRST CNTLW ;YES, NEXT CHAR MUST BE UPPER-CASE ONLY
SCH.1T: CHKEO EO21,SCH.4 ;NOT CONTROL, IF EO=1, FORCE EXACT MODE
TXNN F2,TXTCTL ;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,EMATCH ;FORCED EITHER MATCH ON?
JRST SCH.3 ;YES, MATCH EITHER
TXNN F2,XCASE ;NO, WANT AN EXACT MATCH?
TXNE FF,PMATCH ;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 - (<CH>-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
$FATAL (STL,,<Search string too long>)
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 ;FINISHED, CONVERT INDEX TO PATTERN LENGTH
MOVEM D,PATLEN ; AND SAVE IT
MOVNS SCHCTR ;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 CNTLX,.CHCNX ;^X (SUPERSEDED BY ^EX)
XWD CNTXN,.CHCNN ;^N (SUPERSEDED BY ^EN)
XWD CNTLS,.CHCNS ;^S (SUPERSEDED BY ^E5)
XWD CNTLBS,.CHCBS ;^\
XWD CNTXCF,.CHCCF ;^^
;SHORTER TABLE USED FOR ^T ON MODE STARTS HERE
S3TABL: XWD CNTLLB,.CHESC ;ESCAPE
XWD 0,0 ;END OF LIST
;CONTROL S MATCHES ANY NON-RADIX 50 CHARACTER
CNTLS: CHKEO EO25,CNTLE5
OUTSTR [ASCIZ |% Use ^E5 instead of ^S|]
JRST CNTLE5
;CONTROL X MATCHES ANY SINGLE CHARACTER
CNTLX: CHKEO EO25,CNTLEX
OUTSTR [ASCIZ |% Use ^EX instead of ^X|]
JRST CNTLEX
;QUOTE THE NEXT 7-BIT CHARACTER
CNTLQ: ILDB CH,AA ;GET THE NEXT CHARACTER
SOJA B,SCH.2 ; AND PROCESS IT AS ORDINARY TEXT
;SET LOWER-CASE FOR THE NEXT CHARACTER, AND POSSIBLLY PERMANENTLY
;IF TWO CONSECUTIVE LOWER-CASE QUOTERS
CNTLV: CHKEO EO21,SCH.5 ;IF EO=1, ^V IS JUST TEXT
PUSHJ P,C.VA ;SET LOWER-CASE'ING
JRST SCH.1 ; AND ON TO NEXT CHARACTER
;SET UPPER CASE FOR THE NEXT CHARACTER, AND POSSIBLY PERMANENTLY
;IF TWO CONSECUTIVE UPPER-CASE QUOTERS
CNTLW: CHKEO EO21,SCH.5 ;IF EO=1, ^W IS JUST TEXT
PUSHJ P,C.WB ;SET UPPER-CASE'ING
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,EMATCH ;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
CNTXCF: CHKEO EO21,SCH.5 ;IF EO=1, ^^ IS JUST TEXT
JUMPE B,SCH.1 ;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
;INVERT 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,TXTCTL ;COMPLEMENT CURRENT SETTING
JRST SCH.1 ; AND ON TO NEXT CHARACTER
;INVERT THE SENSE OF THE FOLLOWING "CHARACTER", I.E. ACCEPT
; ANYTHING BUT THE SPECIFIED CHARACTER
CNTXN: CHKEO EO25,CNTLEN
OUTSTR [ASCIZ |% Use ^EN instead of ^N|]
JRST CNTLEN
;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: $FATAL (ICE,,<Illegal Control-E command in search argument>)
;DISPATCH TABLE FOR ^E COMMANDS
S4TABL: XWD CNTLE5,"5" ;^E5 ACCEPT ANY NON-RADIX 50 CHARACTER
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 CNTLEN,"N" ;^EN ACCEPT ANY CHARACTER BUT THE FOLLOWING
XWD CNTLES,"S" ;^ES ACCEPT A STRING OF SPACES AND/OR TABS
XWD CNTLEX,"X" ;^EX ACCEPT ANY SINGLE CHARACTER
XWD CNTLEO,"<" ;^E<N> ACCEPT THE ASCII CHARACTER <N>
; (ANGLES MATCHED AT CNTLEO)
XWD CNTLEB,"[" ;^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,<XWD 377777,777000> ;ALL LETTERS
IORM T,BITMAT+2(D) ; UPPER CASE ON
;CONTROL EV - ACCEPT ANY LOWER CASE ALPHABETIC CHARACTER
CNTLEV: MOVX T,<XWD 377777,777000> ;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,<XWD 377777,777000> ;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,<XWD 000003,776000> ;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,<XWD 000340,000000> ;LF, VT, AND FF
IORM T,BITMAT(D) ; ON
MOVX T,<XWD 000000,000004> ; END OF PAGE
IORM T,BITMAT+3(D) ; ON
JRST SCH.6 ; AND ON TO NEXT CHARACTER
;CONTROL EN - ACCEPT ANY CHARACTER BUT THE FOLLOWING
CNTLEN: MOVSI T,-4 ;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) ;STARTING AT THE HIGH END 'CAUSE OF STACK
CTLEN1: 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,CTLEN1 ; AND LOOP THROUGH ALL 4 WORDS
JRST SCH.6 ;DONE THIS "CHARACTER" POSITION
;CONTROL ES - ACCEPT ANY STRING OF SPACES AND/OR TABS
CNTLES: MOVX T,<XWD 000400,000000> ;A TAB
IORM T,BITMAT(D) ; ON
MOVX T,<XWD 400000,000000> ;A SPACE
IORM T,BITMAT+1(D) ; ON
MOVX T,<XWD 000000,000002> ;THE SPECIAL SPACE/TAB BIT
IORM T,BITMAT+3(D) ; ON
JRST SCH.6 ; AND ON TO NEXT CHARACTER
;CONTROL EX - ACCEPT ANY SINGLE CHARACTER
CNTLEX: MOVX T,<XWD 377777,777760> ;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 E5 - ACCEPT ANY NON-RADIX 50 CHARACTER
CNTLE5: MOVX T,<XWD 377777,777760> ;ALL CONTROL CHARACTERS BUT NULL (?)
IORM T,BITMAT(D) ; ON
MOVX T,<XWD 747764,001760> ;ALL NON-SYMBOL SPECIAL CHARACTERS
IORM T,BITMAT+1(D) ; ON
MOVX T,<XWD 400000,000760> ;UPPER CASE RANGE SPECIALS
IORM T,BITMAT+2(D) ; ON
MOVX T,<XWD 400000,000774> ;LOWER CASE RANGE SPECIALS + ENDS OF PAGE
IORM T,BITMAT+3(D) ; ON
JRST SCH.6 ;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?
$FATAL (ICE,,<Illegal Control-E command in search argument>)
SOS SCNEST ;YES, ONE FEWER LEVEL OF NESTING NOW
JRST SCH.6 ; AND HAVE FINISHED A "CHARACTER" POSITION
;CONTROL E<NNN> - ACCEPT THE ASCII CHARACTER WHOSE OCTAL REPRESENTATION IS NNN
CNTLEO: MOVEI A,0 ;CLEAR NUMBER ACCUMULATOR
CTEO.1: ILDB CH,AA ;GET AN OIT
SOJL B,CNTLER ;ERROR IF RUN OUT
CAIN CH,">" ;THE OTHER END OF THE NUMBER?
JRST CTEO.2 ;YES, DONE
CAIL CH,"0" ;IS IT AN OIT?
CAILE CH,"7"
$FATAL (ICE,,<Illegal Control-E command in search argument>)
LSH A,3 ;YES, SCALE UP THE PREVIOUS VALUE
ADDI A,-60(CH) ; AND ADD IN THE NEW OIT
JRST CTEO.1 ; THEN GO TRY FOR MORE
CTEO.2: CAILE A,177 ;MAKE SURE IT'S LEGITIMATE
$FATAL (ICE,,<Illegal Control-E command in search argument>)
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,[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
SKIPN CH,ROTLEN ;GET THE DISTANCE FROM THE RIGHT END
MOVX CH,SLARGE ;AT 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 36X131 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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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
LSH AA,1(D) ; CLEARING EXTRA BEGIN PAGE BITS)
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;PATTERN IS .GT. 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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
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 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 ;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, 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)
IOR TT,TT1
MOVE TT1,BITMAT+2(D)
ANDCM TT1,BITMAT+2(I)
IOR TT,TT1
MOVE TT1,BITMAT+3(D)
ANDCM TT1,BITMAT+3(I)
IOR 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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
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 [MOVE T,AA ;YES, THEN WE CAN SHIFT IT BASED ON HOW
MOVE TT,I ; FAR THE HIGHEST LEVEL LOOP IS FROM
LSH TT,-2 ; THE RIGHT END OF THE PATTERN
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 [MOVEI AA,-4(I) ;YES, NEED TO ADJUST THE AMOUNT WE
LSH AA,-2 ; CAN SHIFT WHEN NEDSET IS USED
JRST .+1] ; IMMEDIATELY ABOVE
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:
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;NOW, IF F SEARCH, SCAN INSERT ARGUMENT
SCH.E: TXNN F2,S.REPL ;F? SEARCH?
JRST WCHSCH ;NO, GO START SEARCH
TXZ F2,TXTCTL ;REFRESH ^T FLAG
MOVE CH,FSNTRM ;GET FS/FN DELIMITER BACK
TXZ FF,F.NNUL ;RESET NON-NULL STRING FLAG
JRST INSERB ;GO SCAN INSERT ARGUMENT
SERCHJ: POP P,FSNCNT ;SAVE POINTERS FOR THE INSERTION (COMCNT)
POP P,FSNPTX ; (COMPTX)
POP P,FSNPTR ; (COMPTR)
;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
;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,ARG ;IS THIS AN NSFOO$$?
JUMPLE E,FND ;YES, DONE IF WE'VE FOUND THAT MANY
MOVSI B,(IFIW 0(C)) ;IFIW INDEXING USING AC "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
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS 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 EXISTANCE IN THE PATTERN
JUMPLE C,FSTS.3 ; AND LOOP UNLESS IT'S 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
;SLOW SEARCH COMES HERE
SLOSCH: 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,ARG ;IS THERE AN ARGUMENT?
JUMPLE E,FND ;YES. SEEN STRING N TIMES?
MOVE TT,I ;NO, FORM BYTE PTR WHICH WILL BE
IDIVI TT,5 ;INCREMENTED BEFORE USE
HLLZ TT1,BTAB-1(TT1) ;GET PROTOTYPE BYTE POINTER
TLZ TT1,77 ;MASK OUT INDEXING/ETC
SKIPE SECTN ;PC IN EXTENDED SECTION?
TLOA TT1,(1B12) ;YES, MUST USE EXTENDED BYTE POINTER
HRR TT1,TT ;NO, MUST USE LOCAL BYTE POINTER
MOVEM TT1,SCHPTR ;SET "STATIC" BYTE POINTER
MOVEM TT,SCHPTX ;SET "STATIC" BYTE POINTER EXTENDED ADDRESS
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
DMOVE TT,SCHPTR ;SET DYNAMIC PTR = STATIC PTR
SETOM BCOUNT ;FLAG 1ST IS BEGPAG
JRST S4B ;ENTER SEARCH LOOP
;SLOW SEARCH LOOP
S3: MOVSI D,400000 ;START SEEKING MATCH FOR 1ST CHAR
DMOVE TT,SCHPTR ;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,TT ;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 SCHPTR ;MOVE STATIC BYTE PTR
JRST S3 ;KEEP LOOKING
SR4A: SOS I,PT ;DECREMENT PT
CAMGE I,LOWERB ;DONE
JRST NOFND
MOVNI TT,1 ;COUNT OF -1
ADJBP TT,SCHPTR ;DECREMENT STATIC BYTE POINTER
DMOVEM TT,SCHPTR ;AND LEAVE IT IN PLACE
JRST S3 ;KEEP ON SEARCHIN'
;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?
CAIA ;YES, THEN ACCEPT MORE
JRST S4E ;NO, LOOK AT NEXT PATTERN POSITION
DMOVEM TT,ERR2 ;SET INITIAL PEEK-AHEAD POINTER
SPTB.1: DMOVE TT,ERR2 ;SET REAL POINTER TO LAST SPACE/TAB CHARACTER
ADDI I,1 ;ADVANCE TO NEXT BUFFER LOCATION
CAML I,UPPERB ;END OF BUFFER?
JRST S4C ;YES, NO MORE THEN
ILDB CH,ERR2 ;PEEK AHEAD AT NEXT CHARACTER
CAIE CH," " ;IS IT A SPACE?
CAIN CH,.CHTAB ; OR A TAB?
JRST SPTB.1 ;YES, KEEP ON TRUCKING
JRST S4C ; AND CONTINUE SEARCH
;HERE WHEN THE SEARCH HAS MATCHED A CHARACTER STRING IN THE TEXT BUFFER
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
; CAMLE I,SCHPT ;LEGAL FIND?
; 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
TXZE F2,S.DELE ;FIND AND DELETE?
JRST FDFND ;YES
TXZE F2,S.KILL ;FIND AND KILL?
JRST FKFND ;YES
TXZE F2,S.REPL ;FIND AND REPLACE?
JRST FSFND ;YES
MOVEM A,VVAL ;SAVE LENGTH OF STRING
FND2: TXNN F2,S.MINS ;BACKWARDS SEARCH?
JRST FND3 ;NO
MOVNS C,VVAL ;YES, INDICATE IN VVAL
ADDM C,PT ;AND SET "." TO BACKWARDS END OF SEARCH
FND3: PUSHJ P,ZEROTT ;AUTOTYPE ("ES") IF NEEDED
TXNE F2,NALTFS ;WAS THIS A BLASTED "FS---$$" STYLE COMMAND?
JRST ALTM1 ;YES, GET OUT NOW (YECCCCCCH)
TXZE FF,COLONF ;COLON MODIFIER?
JRST FFOK ;YES, RETURN VALUE
CHKEO EOVAL,FND4 ;IF OLD TECO, MUST CHECK FOR < ... >
JRST RET ;DON'T RETURN A VALUE
FND4: SKIPL (P) ;IN AN ITERATION?
JRST RET ;NO, RETURN NO VALUE
MOVSI A,(MOVE B,) ;YES, IMPLICIT ":"; RESET DELIM
HLLM A,DLIM ;SO "-SXXX$" DOESN'T RETURN VALUE OF -(-1)
; (YES, THIS REALLY SUCKS THE BIG HAIRY ONE,
; BUT . . . )
FFOK: SETOB A,B ;RETURN VALUE OF -1
; IN "A" FOR VALRET; IN "B" FOR CLOSEC
JRST CLOSEC ;AND CLOSE THE ":"'S FREE "()"
;HERE FOR FD COMMAND TO DELETE THE MATCHED STRING
FDFND: MOVN B,A ;B:=SIZE OF MATCHED STRING
PJRST FKFND7 ;GO DELETE CHARACTERS
;HERE FOR FK COMMAND TO DELETE FROM STARTING POINT THROUGH MATCHED STRING
FKFND: TXNN F2,S.MINS ;BACKWARDS SEARCH?
JRST FKFND3 ;NO
MOVNS A ;YES, MINUS LENGTH OF STRING
ADDM A,PT ;SET "." TO BACKWARDS END OF SEARCH
FKFND3: MOVE B,SCHPT ;GET OLD PT
SUB B,PT ;B:=OLD "." TO END OF MATCHED STRING
FKFND7: PUSHJ P,DELN ;-ND COMMAND
SETZM VVAL ;NO STRING LEFT
JRST FND3 ;GO CHECK FOR ":" VALUE RETURN
;HERE FOR FN, FS, AND F_ COMMANDS TO REPLACE THE MATCHED STRING
FSFND: MOVE C,VVAL ;GET INSERT SIZE
SUB C,A ;INSERT MINUS DELETE
MOVNS A ;SET PT TO BEGINNING OF STRING FOUND
ADDM A,PT
MOVE A,FSNCNT ;RESET COMCNT & COMPTR TO BEGINNING
MOVEM A,COMCNT ;OF FS/FN INSERT ARGUMENT
DMOVE A,FSNPTR ;NOTE: ***MUST *** BE DONE BEFORE CALL
DMOVEM A,COMPTR ; TO NROOM SINCE FSNPTR IS NOT RELOCATED!
CAIE C,0 ;[MHK] DON'T BOTHER IFF SAME SIZE
PUSHJ P,NROOM ;STRETCH OR SCRUNCH THE HOLE
MOVE B,FSNTRM ;GET FS/FN TERMINATOR TO LOOK FOR
PUSHJ P,INS1B ;INSERT THE 2ND ARG
MOVE CH,FSNTRM ;THE FS/FN TERMINATOR AGAIN
TXZN FF,F.NNUL ;WAS THERE A NON-NULL INSERT?
CAIE CH,.CHESC ;ALTMODE TERMINATOR?
JRST FND2 ;NO
TXO F2,NALTFS ;FLAG SO 2ND ALTMODE STAYS AROUND
JRST FND2 ;YES, FS<STRING>$$ TERMINATES EXECUTION
; BUT GO CHECK FOR BACKWARDS SEARCH,
; AUTOTYPEOUT, AND SO FORTH FIRST
;HERE WHEN THE SEARCH FAILS TO MATCH A CHARACTER STRING
NOFND: TDNN D,SMATRX+ENDPAG ;ENDPAG GOOD FOR A MATCH HERE?
JRST NOFND3 ;NO
CAMN I,Z ;YES, BUT ONLY IF WE'RE AT Z
JRST FND ;ENDPAG MATCHES!
;THE SEARCH REALLY DID FAIL
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,PCHFLG!FINDR ;MINUS SEARCHES NEVER DO, BUT N AND _ DO
JRST RESTPT ;NO NEW BUFFER, THE SEARCH LOST
MOVEM E,SCHCNT ;YES. SAVE SEARCH COUNT
MOVEI B,1 ;PUNCH 1 PAGE ONLY
TXNE FF,PCHFLG ;N SEARCH?
PUSHJ P,PUNCHA ;YES. PUNCH THIS BUFFER AND REFILL IT.
TXNN FF,UREAD ;ANY INPUT FILE?
JRST BEGIN1 ;NO
TXNE FF,FINF ;MORE DATA?
TXNE FF,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,FINDR ;LEFT ARROW SEARCH?
PUSHJ P,YANK1 ;YES. FILL BUFFER.
MOVE E,SCHCNT ;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 EO25,BEGIN1 ;LEAVE POINTER AT TOP FOR EO OF 2 OR LESS
MOVE A,SCHPT ;GET OLD PT
MOVEM A,PT ;RESTORE IT
BEGIN1: TXZ FF,PCHFLG+FINDR ;CLEAR N AND _ .
TXNN F2,S.REPL ;F-SEARCH?
JRST NOFND5 ;NO
MOVE CH,FSNTRM ;GET FS/FN INSERT TERMINATOR
TXZN FF,F.NNUL ;WAS IT A NULL INSERT?
CAIE CH,.CHESC ;YES, WAS IT AN ALTMODE TERMINATOR?
JRST NOFND5 ;NO
TXO F2,NALTFS ;FLAG SO SECOND ALTMODE GETS PUT IN *I
NOFND5: TXZE FF,COLONF ;COLON MODIFIED?
JRST NOFND6 ;YES, RETURN A 0
NOFND2: SKIPL (P) ;IN AN ITERATION?
$FATAL (SRH,,<Cannot find "17">)
MOVSI A,(MOVE B,) ;YES, IMPLICIT ":"; RESET DELIM
HLLM A,DLIM ;ON G.P.'S
NOFND6: TXNE F2,NALTFS ;WAS IT A NULL INSERT?
JRST ALTM1 ;YES, THAT TERMINATES EXECUTION
SETZB A,B ;NO, RETURN A 0
; IN "A" FOR VALRET; IN "B" FOR CLOSEC
JRST CLOSEC ;AND TERMINATE THE FREE "()" FROM THE ":"
;IF AUTOF IS NON-ZERO
;INCLUDE POINTER MARKER = ASCII CHAR IN AUTOF IF AUTOF GT 0
ZEROTT: TXNE FF,COLONF ;NO AUTOTYPE ON COLON SEARCHES
POPJ P,
SKIPL -1(P) ;IN AN ITERATION?
SKIPN AUTOF ;AUTOTYPE WANTED?
POPJ P,
TXO FF,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,ARG
POPJ P,
;<> ITERATION BRACKETS. COMMAND INTERPRETATION IS SENT
; BACK TO THE < WHEN THE > IS ENCOUNTERED.
LSSTH: PUSH P,ITERCT ;SAVE ITERATION COUNT
PUSH P,COMMAX ;KEEP MAX. FOR GARBAGE COLLECTION
PUSH P,COMPTR ;SAVE COMMAND STATE
PUSH P,COMPTX ; (DOUBLE-WORD POINTER ADDRESS)
PUSH P,COMCNT ;COMMAND CHARACTER COUNT
SETOM ITERCT ;ITERCT:=-1
PUSH P,ITERCT ;-1 FLAGS ITERATION ON PDL
TXZN FF,ARG ;IS THERE AN ARGUMENT?
JRST RET ;NO
JUMPLE B,INCMA1 ;IF ARG .LE. 0, SKIP OVER <>
MOVEM B,ITERCT ;YES. ITERCT:=ARGUMENT
JRST RET
GRTH: SKIPGE A,(P) ;IS THERE A LEFT ANGLE BRACKET?
JRST GRTH2 ;YES. OTHERWISE IT'S A MISSING ONE OR
SOJE A,GRTH9 ;SOMETHING LIKE <...(...>
$FATAL (MLA,,<Missing left angle bracket>)
GRTH2: SOSN ITERCT ;ITERCT:=ITERCT-1. DONE?
JRST INCMA2 ;YES
MOVE A,-1(P) ;START-OF-ITERATION COMMAND COUNT
MOVEM A,COMCNT ;BECOMES NEW CURRENT COMMAND COUNT (AGAIN)
DMOVE A,-3(P) ;START-OF-ITERATION COMMAND POINTER
DMOVEM A,COMPTR ;BECOMES NEW CURRENT COMMAND POINTER (AGAIN)
TXNE FF,TRACEF ;TRACING?
PUSHJ P,CRR ;YES. OUTPUT CRLF
JRST RET
GRTH9: $FATAL (MRP,,<Missing right parenthesis>)
U ITERCT,1 ;
U SFINDF,1 ;
;; 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 <...>
$FATAL (NSI,,<; not in an iteration>)
TXNN FF,ARG ;YES. IF NO ARG,
MOVE B,SFINDF ;USE LAST SEARCH SWITCH (0 OR -1).
JUMPL B,CD ;IF ARG LT 0, JUST RET AND EXECUTE LOOP
INCMA1: MOVEI TT1,"<" ;IGNORE <...> STRINGS
MOVEI TT,">" ;WHILE SKAN'ING FOR END OF ITERATION
PUSHJ P,SKAN
$FATAL (MRA,,<Missing right angle bracket>)
INCMA2: ADJSP P,-4 ;PITCH THE FLAG, COMCNT, COMPTX, AND COMPTR
POP P,COMMAX ;PRESERVE THE COMMAND BUFFER LIMIT WORD
POP P,ITERCT ;AND THE ITERATION COUNT/FLAG
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 !
$FATAL (UTG,,<Unterminated tag>)
CAIE CH,"!"
JRST EXCLAM
JRST RET
;OTAG$ GO TO THE TAG NAMED TAG. THE TAG MUST APPEAR IN THE
; CURRENT MACRO OR COMMAND STRING.
OCMD: MOVE A,COMPTR ;CURRENT COMMAND BYTE POINTER
SKIPE SECTN ;PC IN EXTENDED SECTION?
HRR A,COMPTX ;YES, FAKE UP A PSEUDO ONE-WORD BYTE POINTER
MOVE AA,A ;A SCRATCH COPY USED TO
IDIVI AA,17 ;GENERATE A "HASH" VALUE (SORT OF, MAYBE)
CAMN A,TAGSYM(B) ;DO WE ALREADY KNOW ABOUT THIS GUY?
JRST OCMD70 ;YES, JUST SET NEW COMPTR
SKIPN TAGSYM(B) ;NO, IS THIS SLOT EMPTY?
JRST OCMD10 ;SLOT EMPTY, DON'T KNOW THIS TAG'S VALUE
CAMN A,TAGSYM+1(B) ;SLOT FULL - MAYBE IN NEXT SLOT?
OCMD03: AOJA B,OCMD70 ;YES, WE WIN AFTER ALL!
SKIPN TAGSYM+1(B) ;NO, NEXT SLOT EMPTY?
AOJA B,OCMD10 ;YES, WE MUST SEARCH FOR THE TAG
CAMN A,TAGSYM+2(B) ;ONE LAST TRY - LOOK AT THIRD SLOT
AOJA B,OCMD03 ;GOT IT! THIRD TIME'S THE CHARM . . .
SKIPN TAGSYM+2(B) ;NOT IN THIRD EITHER, IS IT EMPTY?
ADDI B,2 ;YES, SELECT IT FOR OUR "HASH" SLOT
;TAG NOT KNOWN, MUST SEARCH FOR IT, FIRST BUILD TAG NAME IN SEARCH TABLE
OCMD10: PUSH P,A ;SAVE CURRENT PSEUDO POINTER
PUSH P,B ;SAVE "HASH" INDEX
MOVEI T,STAB ;GLOM ONTO SEARCH TABLE FOR OUR USE
OCMD11: CAILE T,STAB+STABLN-2 ;IS THE TAG TOO LONG?
$FATAL (TTL,,<Tag too long>)
PUSHJ P,SKRCH ;GET NEXT COMMAND [TAG NAME] CHARACTER
$FATAL (MEO,,<Macro ending with unterminated O command>)
MOVEM CH,(T) ;BUILD THE NAME IN THE SEARCH TABLE
CAIE CH,.CHESC ;END OF O COMMAND TAG YET?
AOJA T,OCMD11 ;NO, ACCUMULATE REST OF TAG NAME
MOVEI A,"!" ;TAG TERMINATOR
MOVEM A,(T) ;GOES INTO THE SEARCH STRING TOO
SETZM 1(T) ;MARK END OF SEARCH STRING
MOVE A,COMCNT ;COUNT OF COMMAND CHARACTERS LEFT
SUB A,COMMAX ;NEGATIVE COUNT OF COMMAND CHARACTERS PROCESSED
ADJBP A,COMPTR ;BACKUP COMMAND POINTER TO START OF COMMAND
DMOVEM A,COMPTR ;RESET COMMAND POINTER FOR SEARCH LOOP
MOVE B,COMMAX ;TOTAL NUMBER OF COMMAND CHARACTERS
MOVEM B,COMCNT ;RESET COMMAND CHARACTER COUNTER
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;SEARCH THE CURRENT COMMAND BUFFER FOR THE NAMED TAG
OCMD20: MOVEI TT,"!" ;SKAN FOR !
MOVEI TT1,-1 ;NO SECONDARY CHAR.
PUSHJ P,SKAN ;SKAN COMMAND STRING UNTIL "!" CHARACTER
$FATAL (TAG,,<Missing tag !12>)
TXO F2,NOTRAC ;DON'T TYPE EVERY TAG WHILE TRACING
MOVEI T,STAB ;INIT SEARCH STRING TO 1ST CHAR AFTER !
;AT A TAG, SEE IF RIGHT ONE
OCMD22: SKIPN (T) ;OVER STRING?
JRST OCMD30 ;YES - WE FOUND THE DESIRED TAG
PUSHJ P,SKRCH ;NO. GET ANOTHER CHARACTER
$FATAL (TAG,,<Missing tag !12!>)
CAMN CH,(T) ;THIS CHARACTER MATCH?
AOJA T,OCMD22 ;YES. MOVE ON.
CAIN CH,"!" ;NO, ARE WE AT END OF A TAG?
JRST OCMD20 ;YES, LOOK FOR THE NEXT TAG
;WRONG TAG, SKIM TO END OF CURRENT TAG
OCMD26: PUSHJ P,SKRCH ;GET NEXT CHAR OF [FAILED] TAG
$FATAL (UTG,,<Unterminated tag>)
CAIE CH,"!" ;END OF THIS TAG YET?
JRST OCMD26 ;NO, KEEP GOING
JRST OCMD20 ;YES, LOOK FOR ANOTHER TAG
;HERE WITH WINNING TAG (PUT IT IN SYMBOL TABLE)
OCMD30: TXZ F2,NOTRAC ;RE-ENABLE TRACING
POP P,B ;GET INDEX TO SYMBOL TABLE
POP P,TAGSYM(B) ;SAVE PSEUDO POINTER OF THIS O COMMAND
MOVE A,COMCNT ;CHARACTER COUNTER IMMED AFTER TAG
MOVEM A,TAGCNT(B) ;SAVE COUNTER IN "SYMBOL" TABLE
DMOVE A,COMPTR ;COMMAND BYTE POINTER AFTER TAG
MOVEM A,TAGPTR(B) ;SAVE BYTE POINTER IN "SYMBOL" TABLE
MOVEM AA,TAGPTX(B) ; (DOUBLE-WORD BYTE POINTER ADDRESS)
JRST RET ;RESUME COMMAND EXECUTION FOLLOWING TAG
;HERE WHEN TAG ALREADY KNOWN AND IN SYMBOL TABLE
OCMD70: MOVE A,TAGPTR(B) ;SAVED COMMAND BYTE POINTER FOLLOWING TAG
MOVE AA,TAGPTX(B) ; (DOUBLE-WORD BYTE POINTER ADDRESS)
DMOVEM A,COMPTR ;"JUMP" THE COMMAND BYTE POINTER
MOVE A,TAGCNT(B) ;SAVED COMMAND BYTE COUNTER FOLLOWING TAG
MOVEM A,COMCNT ;ADJUST TO REFLECT TAG'S POSITION
JRST RET ;RESUME COMMAND EXECUTION FOLLOWING TAG
;N"G SEND COMMAND TO MATCHING ' UNLESS N GT 0.
;N"L SEND COMMAND TO MATCHING ' UNLESS N LT 0.
;N"E SEND COMMAND TO MATCHING ' UNLESS N EQ 0.
;N"N SEND COMMAND TO MATCHING ' UNLESS N NE 0.
;N"F SEND COMMAND TO MATCHING ' UNLESS N EQ 0 (I.E., "FALSE").
;N"U SEND COMMAND TO MATCHING ' UNLESS N EQ 0 (I.E., "UNSUCCESSFUL").
;N"T SEND COMMAND TO MATCHING ' UNLESS N LT 0 (I.E., "TRUE").
;N"S SEND COMMAND TO MATCHING ' UNLESS N LT 0 (I.E., "SUCCESSFUL").
;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,ARG ;ERROR IF NO ARG BEFORE "
$FATAL (NAQ,,<No argument before ">)
PUSHJ P,SKRCH ;GET CHAR AFTER "
$FATAL (MEQ,,<Macro ending with ">)
MOVEI T,DQTABL ;INDEX DISPATCH TABLE
PUSHJ P,DISPAT ;DISPATCH FOR CHAR. AFTER "
$FATAL (IQC,,<Illegal command "00>)
;" 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
;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,47 ;SKAN FOR '
MOVEI TT1,42 ;IGNORE "...' STRINGS
PUSHJ P,SKAN
$FATAL (MAP,,<Missing '>)
JRST RET
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND
QUESTN: TXNN FF,TRACEF ;DID WE TOGGLE INTO TRACE MODE ??
SETOM WINFLG ;YES, SO DON'T DISPLAY BUFFER
TXCE FF,TRACEF ;COMPLEMENT TRACE FLAG
PUSHJ P,CRR ;TYPE CR/LF AFTER TRACE MODE EXIT
JRST RET
COMMEN: SKIPE COLUMN ;AT NICE FRESH START OF A COLUMN?
SKIPE TYOTCT ;NO, HAS ANYTHING PRECEDED US?
CAIA ;DON'T DO ANYTHING
PUSHJ P,CRR ;FIRST OUTPUT, GET TO A FRESH LINE FOR NEATNESS
COMMET: PUSHJ P,SKRCH ;GET A COMMENT CHAR
$FATAL (UCA,,<Unterminated ^A command>)
CAIN CH,.CHCNA ;^A
JRST COMMEX ;YES, END OF OUTPUT
TXNN FF,TRACEF
PUSHJ P,TYOM ;TYPE IT
JRST COMMET
COMMEX: TXNE FF,TRACEF ;IF TRACING,
TXNN FF,TYOF ;OR NO OUTPUT
CAIA ;DON'T BOTHER
PUSHJ P,TYOOUT ;OTHERWISE FORCE OUT ANY OUTPUT
JRST RET ;RETURN
;OLD ^G EXIT COMMAND AND ILLEGAL COMMANDS
BELDMP: CHKEO EO21,FINISZ ;IF EO=1, DO ^Z,
ERRA: $FATAL (ILL,,<Illegal command 00>)
TDDT: SKIPN A,.JBBPT ;IS THERE A DDT LOADED?
$FATAL (DDT,,<DDT is not loaded>)
TLNN A,-1 ;ALREADY SPECIFIED A PARTICULAR SECTION?
HLL A,SECTN ;NO, SELECT OUR CURRENT PC SECTION
SETOM MESFLG ;SCREEN WILL BE ZAPPED
JSR @A ;CAUSE UNSOLICITED BREAKPOINT
DDTECO::JRST RET ;COMMAND IS DONE
;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
;SETUP QUOTING CHARACTERS
SETQTE: MOVEI TT1,.CHCNT ;CONTROL-CHARACTER QUOTER
MOVEM TT1,CCQTE ;SET IT UP
CHKEO EO21,SETQ21 ;DO ANCIENT STUFF
CHKEO EO25,SETQ25 ;DO OLD STUFF
MOVEI TT1,.CHCNV ;CHARACTER QUOTER
MOVEM TT1,CHQTE ;SET IT UP
SETOM CHQTE2 ;NO OTHER CHARACTER-QUOTER
MOVEI TT1,.CHCNA ;LOWER-CASE QUOTER
MOVEM TT1,LCQTE ;SET IT UP
MOVEI TT1,.CHCNB ;UPPER-CASE QUOTER
MOVEM TT1,UCQTE ;SET IT UPT
POPJ P, ;ET C'EST CA
SETQ25: MOVEI TT1,.CHCNR ;CHARACTER QUOTER
MOVEM TT1,CHQTE ;SET IT UP
MOVEI TT1,.CHCNQ ;ALTERNATE CHARACTER QUOTER
MOVEM TT1,CHQTE2 ;SET IT UP
MOVEI TT1,.CHCNV ;LOWER-CASE QUOTER
MOVEM TT1,LCQTE ;SET IT UP
MOVEI TT1,.CHCNW ;UPPER-CASE QUOTER
MOVEM TT1,UCQTE ;SET IT UP
POPJ P, ;OLD STYLE NOW SELECTED
SETQ21: MOVEI TT1,.CHCNQ ;CHARACTER QUOTER
MOVEM TT1,CHQTE ;SET IT UP
SETOM CHQTE2 ;NO OTHER QUOTER
SETOM LCQTE ;NO LOWER-CASE QUOTER
SETOM UCQTE ;NO UPPER-CASE QUOTER
POPJ P, ;NOTHING ELSE HERE
U CHQTE,1 ;GENERAL CHARACTER QUOTER
U CHQTE2,1 ;ALTERNATE CHARACTER QUOTER
U CCQTE,1 ;CONTROL-CHARACTER QUOTER
U LCQTE,1 ;LOWER-CASE QUOTER
U UCQTE,1 ;UPPER-CASE QUOTER
SUBTTL SCREEN DISPLAY ROUTINES
;NV SCROLL SCREEN DISPLAY BY N LINES
;I,JV MAKE DISPLAY WINDOW FROM I TO J
VCMD: SKIPN SCTYPE ;V IS REALLY T IF NOT IN DISPLAY MODE
JRST TYPE ;WE'RE NOT !!
TXNE FF,ARG2 ;NV OR I,JV?
JRST VCMD2 ;I,JV
DMOVE A,SCRNA ;NV, CURRENT BASE OF SCREEN DISPLAY
MOVE D,B ;HOW FAR TO SHIFT IT
PUSHJ P,DISMV ;GET ADJUSTED BASE
PJRST VUNXTV ;AND DO IMMEDIATE SCREEN UPDATE
;MAKE SCREEN WINDOW BE EXACTLY FROM I (INCLUSIVE) TO J (EXCLUSIVE)
VCMD2: PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS.
;B:=SECOND STRING ARGUMENT ADDRESS.
PUSHJ P,CHK1 ;C:=MAX(C(C),BEG), B:=MIN(C(B),Z)
MOVEM C,SCRNA ;SET BASE OF SCREEN
SETZM SCRNAA ;SKIP NO LINES
MOVEM B,SCRNVZ ;AND PREMATURE END OF SCREEN
PJRST VUNXTX ;AND DO IMMEDIATE SCREEN UPDATE
;VUPRV -- VIEW PREVIOUS WINDOW, BUT DON'T CHANGE "."/CURSOR
VUPRV: SKIPE MESFLG ;SCREEN MESSED UP (ERROR MSG, ETC.)?
SKIPE CMFTYO ;YES - SUPPRESSING TYPEOUT?
CAIA ;DON'T ERASE SCREEN
PUSHJ P,ZAPSCN ;YES, START FROM SCRATCH
DMOVE A,SCRNA ;CURRENT SCREEN BASE
MOVN D,DLENTH ;ONE SCREENFUL BACKWARDS
ADDI D,1 ;(ALLOW FOR BLANK LINE AT THE END)
PUSHJ P,DISMV ;ADJUST SCREEN POINTERS
PJRST VUNXTV ;GO MAKE NEW SCREEN DISPLAY
;VUNXT -- VIEW NEXT WINDOW, BUT DON'T CHANGE "."/CURSOR
VUNXT: SKIPE MESFLG ;SCREEN MESSED UP (ERROR MSG, ETC.)?
SKIPE CMFTYO ;YES - SUPPRESSING TYPEOUT?
CAIA ;DON'T ERASE SCREEN
PUSHJ P,ZAPSCN ;YES, START FROM SCRATCH
DMOVE A,DISCA ;GET LAST KNOWN MARGIN POINT
VUNXTV: DMOVEM A,SCRNA ;AND SET FOR WINFIL
MOVE TT,Z ;END OF TEXT BUFFER
MOVEM TT,SCRNVZ ;ALLOW TO END OF BUFFER
VUNXTX: PUSHJ P,DISPLA ;GENERATE AND DISPLAY NEXT SCREEN
SETOM VFREEZ ;REALLY BY DAMN FREEZE THE SCREEN!
POPJ P, ;ALL DONE
;WINIT -- ROUTINE TO CALCULATE STARTING POINT OF SCREEN DISPLAY.
;
;BASICALLY THIS ROUTINE WILL ATTEMPT TO POSITION THE CURSOR APPROXIMATELY
;1/3 OF THE WAY DOWN THE SCREEN WINDOW DISPLAY. FOR A VT50 (12 LINE
;SCREEN, 9 LINES OF DISPLAY WINDOW) THIS RESULTS IN THE POINTER BEING ON
;THE FOURTH LINE (3 LINES ABOVE, 5 LINES BELOW THE POINTER). FOR A VT52
;(24 LINE SCREEN, 19 LINES OF DISPLAY WINDOW) THIS RESULTS IN THE POINTER
;BEING ON THE SEVENTH LINE (6 LINES ABOVE AND 12 LINES BELOW THE POINTER).
;
;ON EXIT, SCRNA HAS THE ABSOLUTE BASE OF THE SCREEN DISPLAY, SCRNAA HAS
;THE COUNT OF LINES TO SKIP BEFORE THE SCREEN STARTS.
WINIT: MOVE A,PT ;START WITH "."
SETZ AA, ;WE KNOW NOTHING
MOVN D,CLENTH ;HOW FAR DOWN WE LIKE THE CURSOR
;POSITION START OF SCREEN C(D) LINES BACK FROM C(I) IF POSSIBLE, STOPPING
;AT BEG IF NECESSARY.
PUSHJ P,DISMV ;CALCULATE A NICE SCREEN BASE
DMOVEM A,SCRNA ;REMEMBER ABSOLUTE BASE INFORMATION
POPJ P, ;RETURN READY FOR WINFIL
;DISMV -- MOVE DISPLAY POINTERS AROUND
;CALL IS:
;
; MOVX A,<BASE>
; MOVX AA,<SKIP>
; MOVX D,<COUNT>
; PUSHJ P,DISMV
; RETURN
;
;WHERE <BASE> IS THE CURRENT ABSOLUTE BASE OF THE SCREEN; <SKIP> IS THE
;SKIP COUNT TO THE ACTUAL START OF THE SCREEN; AND <COUNT> IS HOW FAR
;TO MOVE (NEGATIVE IS BACKWARDS - TOWARDS BEG).
;
;ON RETURN, A AND AA ARE NEW PROPOSED <BASE> AND <SKIP>. IF <COUNT> WAS
;POSITIVE, I WILL BE THE CHARACTER ADDRESS OF THE NEW SCREEN START
;RE A AND AA.
;
;USES A, AA, B, C, D, I, OU.
DISMV: MOVE I,A ;START UP POINTER
PUSHJ P,DISINI ;INITIALIZE DISCHR
ADD AA,D ;SEE HOW FAR WE HAVE TO MOVE
CAIN AA,0 ;EXACT MATCH?
POPJ P, ;YES - RARE BUT IT DOES HAPPEN
JUMPL AA,DISMV5 ;NO, FORWARDS OR BACKWARDS?
;MOVE FORWARDS
SETZ C, ;START NEW DISPLAY LINE
DISMV2: PUSHJ P,DISCHR ;NEXT DISPLAY CHARACTER
CAIN CH,.CHCRT ;BEGINING OF END OF DISPLAY LINE?
MOVNI C,1 ;YES (FOR DISCON'S BENEFIT)
CAIE CH,.CHLFD ;END OF DISPLAY LINE?
AOJA C,DISMV2 ;NO
SOJG AA,DISMV2 ;MOVED FAR ENOUGH?
DMOVE A,DISCA ;YES, GET NEW POSSIBLE BASE/SKIP PAIR
POPJ P, ;RETURN
;MOVE BACKWARDS
DISMV5: MOVN D,AA ;D:=BACKWARDS SKIP COUNT
DISMV6: PUSHJ P,DSBCK ;SETUP BACKWARDS INFORMATION
CAMG D,AA ;FOREKNOWLEDGE EXTEND BACK FAR ENOUGH?
JRST DISMV9 ;YES, ADJUST AS NECESSARY
CAMG A,BEG ;NO, STILL HAVE TEXT LEFT?
JRST DISMV8 ;NO, BIT START OF TEXT BUFFER
SUBI D,1(AA) ;YES, D:=NEW BACKWARDS LINE COUNT
SOS I,A ;PREVIOUS LIMIT OF FOREKNOWLEDGE
JRST DISMV6 ;SCAN BACKWARDS SOME MORE
DISMV8: TDZA AA,AA ;HIT BEG, SO BASE IS BASE IS BASE
DISMV9: SUB AA,D ;AA:=SKIP COUNT FROM BASE
POPJ P, ;RETURN ALL SET
;DSBCK -- BACKWARDS PEEKING HELPER FOR WINIT
DSBCK: MOVEM I,OU ;SAVE STARTING POINT
TDZA CH,CH ;ENTER LOOP
DSBCK1: PUSHJ P,GET ;GET PRECEDING CHARACTER
DSBCK2: CAMG I,BEG ;RUN INTO START OF TEXT?
JRST DSBCK4 ;YES, THEN STOP THERE
CAIE CH,.CHVTB ;NOT YET, SEEING A <VT>?
CAIN CH,.CHFFD ;OR A <FF>?
AOJA I,DSBCK4 ;YES, THEN WE KNOW STATE OF SCREEN
CAIE CH,.CHLFD ;NO, HOW ABOUT <LF>?
SOJA I,DSBCK1 ;NO, RANDOM, KEEP LOOKING
SUBI I,1 ;BACK ONE MORE CHARACTER
PUSHJ P,GET ;GET CHARACTER PRECEDING <LF>
CAIE CH,.CHCRT ;A <CR>?
JRST DSBCK2 ;NO, CHECK FOR OTHER STUFF
ADDI I,2 ;YES, KNOWN STATE, SKIP <CR><LF>
;HERE WITH C(I) BEING A KNOWN FORCED BOL CONDITION (<CR><LF>, <FF>, ETC.)
;SCAN FORWARDS UNTIL WE KNOW WHERE C(OU)'S LINE STARTS
DSBCK4: PUSHJ P,DISINI ;START DISCHR FRESH
MOVE A,I ;SET ABSOLUTE BASE
MOVE B,I ;AND PROPOSED START OF LINE
SETZB AA,C ;CLEAR LINES SKIPPED AND CHAR POSITION
CAMN I,OU ;BACK WHERE WE STARTED?
POPJ P, ;YES, THEN ALL SET
DSBCK6: PUSHJ P,DISCHR ;GET NEXT DISPLAY CHARACTER
CAMGE I,OU ;GOT BACK TO OUR STARTING POINT YET?
CAML I,Z ;JUST CHECKING . . .
POPJ P, ;YES, ALL DONE
CAIN CH,.CHCRT ;BEGINING OF END OF DISPLAY LINE?
MOVNI C,1 ;YES (FOR DISCON'S BENEFIT)
CAIE CH,.CHLFD ;END OF A DISPLAY LINE?
AOJA C,DSBCK6 ;NOT YET
MOVE B,I ;SAVE NEW START OF LINE
AOJA AA,DSBCK6 ;COUNT LINES SKIPPED
;WINFIL -- ROUTINE TO FILL WINEW WITH NEW PICTURE TO BE DISPLAYED
;
;SCRNA HAS THE ABSOLUTE BASE OF THE SCREEN IMAGE AND SCRNAA HAS THE
;NUMBER OF LINES TO SKIP BEFORE STARTING THE SCREEN. THIS IS SO THAT THE
;SCREEN IS ALWAYS "RIGHT" AND CONSISTENT IRRESPECTIVE OF HOW THE SCREEN
;WAS DERIVED (SCANNING FORWARDS OR BACKWARDS). THIS MAY RESULT IN A LOT
;OF COMPUTES FOR THE PSYCHOPATHIC CASES, BUT THEY WILL BE HANDLED!
;
;ON EXIT, SCRNB HAS FIRST CHARACTER ADDRESS ON SCREEN, AND SCRNZ HAS
;THE LAST CHARACTER ADDRESS PLUS ONE ON THE SCREEN (THE FIRST CHARACTER
;TO APPEAR IN THE FOLLOWING SCREEN). DISCA AND DISCAA ARE "PROPOSED"
;SCRNA AND SCRNAA FOR VUNXT TO DISPLAY THE NEXT SCREENFULL.
WINFIL: DMOVE A,SCRNA ;GET SCREEN BASE
SETZ D, ;SKIP ONLY TO START OF SCREEN DISPLAY TEXT
PUSHJ P,DISMV ;GET SCREEN START IN I
WINFI2: MOVEM I,SCRNB ;REMEMBER START [CHAR] ADDRESS OF SCREEN
SKIPGE DISPTF ;WAS POINTER ALREADY DISPLAYED?
SETZM DISPTF ;YES, THEN NOT ON CURRENT SCREEN
; (THIS FOR GOSC'S BENEFIT)
MOVE D,DLENTH ;COUNT OF LINES ON THE DISPLAY WINDOW
SUBI D,1 ;ONE BLANK LINE TWEEN DISPLAY AND COMMANDS
SETZM WINEW ;CLEAR OUT OLD NEW STUFF
MOVE A,[WINEW,,WINEW+1] ;BLT POINTER TO
BLT A,WINEW+WINTOP-1;ZERO NEW SCREEN IMAGE AREA
MOVEI A,0 ;POINTER TO DISPLAY NEW MEMORY
WINFI5: MOVE AA,[POINT 7,WINEW(A)] ;POINTER TO NEW DISPLAY IMAGE
TDZA C,C ;ZERO # OF CHARS ON THIS SCREEN LINE SO FAR
WINFI6: IDPB CH,AA ;PUT THIS CHAR INTO WINDOW
PUSHJ P,DISCHR ;GET DISPLAY CHARACTER FROM BUFFER
CAIN CH,.CHCRT ;<CR> (END OF LINE)?
MOVNI C,1 ;AOJA WILL TURN THIS TO 0
CAIE CH,.CHLFD ;LF MEANS END OF SCREEN LINE
AOJA C,WINFI6 ;COUNT CHARACTER AND GO GET ANOTHER
LDB T,[POINT 6,AA,5];GET POSITION FIELD OF POINTER
ADDI T,7 ;COVER LAST CHAR, TOO
DPB T,[POINT 12,AA,11] ;SIZE GETS P+7, CLEAR P
MOVEI C,0
DPB C,AA ;CLEAR REST OF WORD
ADDI A,WINDEX ;A POINTS TO NEXT SCREEN LINE
SOJG D,WINFI5 ;FILLED WINDOW YET?
MOVEM I,SCRNZ ;REMEMBER FIRST CHARACTER NOT DISPLAYED
WINFI8: CAILE A,WINTOP-1 ;HAS WHOLE DISPLAY AREA BEEN UPDATED??
POPJ P, ;YES
SETOM WINDOW(A) ;NO, MARK REST OF SCREEN "BLANK"
ADDI A,WINDOW+1 ;CONCOCT
HRLI A,-1(A) ; A BLT POINTER
BLT A,WINDOW+WINTOP-1 ;TO "BLANK" REST OF THE SCREEN
POPJ P, ;RETURN
;DISPLAY INITIALIZATION ROUTINE
DISINI: MOVEM I,DISCA ;PRESET LAST KNOWN LINE START
SETZM DISCAA ;AND COUNT OF LINES PAST THAT POINT
DISZER: SETZM TABFIL ;TAB FLAG
SETZM EOBFLG ;END OF BUFFER FLAG
SETZM DISPTF ;POINTER IN DISPLAY FLAG
SETZM DISCTF ;NON-ZERO MEANS CONTROL CHARACTER
SETZM SEOL ;END OF LINE SEEN FLAG
SETZM SEOL2 ;CLEAR FREE <CR><LF> NEEDED FLAG
SETZM SEOL3 ;CLEAR ^J FILLER DISPLAY
TXZ F2,TYMSGF!TYSPCL;CLEAR FUNNY TYO-MODE FLAGS
POPJ P,
;ROUTINE TO RETURN NEXT DISPLAY LINE CHARACTER IN T, TAKES
;TWO CALLS TO GET ^* FOR CONTROL-CHARACTER. CARRIAGE RETURN
;AND LINEFEED ARE RETURNED AS ^J AND ^M UNLESS THEY APPEAR
;IN THE BUFFER AS CRLF. THE CONTENTS OF TCOCH IS GIVEN
;IF LINE IS ABOUT TO GO OVER RIGHT MARGIN, AND TABS ARE CONVERTED
;TO THE PROVERBIAL "APPROPRIATE NUMBER OF SPACES", WITH THE CONTENTS
;OF TABSIZE USED TO SAYiOOST NUMBER OF SPACES EVER TO USE FOR TAB.
;POINTER IS DISPLAYED AS CHARACTER STRING THAT IS THE CONTENTS OF
;PTRCHR. EVERY DISPLAY LINE
;ENDS WITH CRLF EITHER BECAUSE THE TEXT BUFFER HAD ONE, OR END OF
;DISPLAY LINE IS REACHED.
DISCHR: CAIG C,0 ;START OF NEW LINE?
SETZM TABUNF ;YES, THEN CHARACTER POSITION IS IN PHASE
; WITH ITS PHYSICAL SCREEN POSITION
SKIPE SEOL ;NON-ZERO SEOL MEANS END OF DISPLAY LINE
JRST DISEOL ;END OF LINE
CAML C,SWIDTH ;BEGINNING OF END OF LINE ???
JRST DISCON ;HANDLE END OF LINE
SKIPE CH,DISCTF ;OUTPUTTING CONTROL CHARACTER ??
JRST DISCT2 ;YES, GO FINISH SECOND HALF OF ^X
AOSG SEOL2 ;NEED A FREE <CR><LF>?
JRST DISEOC ;YES
SKIPLE DISPTF ;DISPLAYING POINTER "PICTURE"
JRST DISPT2 ;YES, CONTINUE POINTER SEQUENCE
MOVEI CH," " ;SPACE FILLER CHARACTER
SOSGE SEOL3 ;DOING ^J (NEXT LINE) FILL?
SOSL TABFIL ;OR TAB FILL?
POPJ P, ;YES
SKIPE EOBFLG ;END OF BUFFER ??
JRST EOBCHR ;YES, JUST SEND CRLFS
CAMN I,PT ;ARE WE AT "."?
JRST DISPTR ;YES, START UP POINTER SEQUENCE
DISCH2: CAME I,SCRNVZ ;HIT FORCED END OF SCREEN?
CAML I,Z ;OR END OF TEXT?
JRST EOBCH4 ;YES, FILL WITH <CF><LF>S THEN
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PRECEDING PAGE
DISCH3: PUSHJ P,GETINC ;GET THE NEXT TEXT CHARACTER
CAIN CH,.CHTAB ;TAB ??
JRST DISTAB ;YES, START GIVING SOME SPACES
CAIN CH,.CHESC ;ALTMODE ??
MOVEI CH,"$" ;ALTMODE REGULAR NON-CONTROL CHARACTER
CAIN CH,.CHCRT ;CR ??
JRST SCR ;YES, MAYBE END OF LINE (IF LINEFEED NEXT)
CAIN CH,.CHLFD ;LF ??
JRST SLF ;YES, PART OF END OF LINE ??
CAIN CH,.CHDEL ;A RUBOUT?
JRST DISDEL ;YES, TREAT SORT OF LIKE CONTROL CHARACTER
CAIE CH,.CHVTB ;<VT>?
CAIN CH,.CHFFD ;OR <FF>?
CAIA ;YES - NEEDS A FREE <CR><LF>
JRST DISCH8 ;NO, CHECK FOR OTHER CONTROL CHARACTER
DISCH5: SETOM SEOL2 ;YES, GIVE A FREE <CR><LF> FOLLOWING
MOVEM I,DISCA ;SAVE LAST KNOWN LEFT MARGIN ADDRESS
SETOM DISCAA ;AND SKIP LINES FOR VUNXT
DISCH8: CAIGE CH," " ;OTHER CONTROL CHARACTER ??
JRST DISCTL ;YES, GO DISPLAY IT
PUSHJ P,SFLAGC ;FLAG THIS CHARACTER ??
POPJ P, ;NO
MOVEM CH,DISCTF ;REMEMBER WHAT CH WAS FLAGGED
AOS TABUNF ;COUNT SCREEN SPACE USED UP
MOVEI CH,CFLAG ;GET FLAG CHARACTER
POPJ P,
;HERE TO DISPLAY CONTROL CHARACTER IN ^X FORMAT (<DEL> AS ^?)
DISCTL: TROA CH,100 ;MAKE X PART OF ^X
DISDEL: MOVEI CH,"?" ;MARK A <DEL>
MOVEM CH,DISCTF ;FLAG IT FOR NEXT CALL TO DISCHR
MOVEI CH,"^" ;PRINT UPARROW FIRST
DISCT0: AOS TABUNF ;WE JUST SWIPPED A SCREEN SPACE
POPJ P,
DISCT2: SETZM DISCTF ;END OF CONTROL CHARACTER SEQUENCE
POPJ P, ;RETURN WITH SECOND HALF (X OF ^X)
;HERE TO HANDLE TABS (FILL WITH SPACES FOR DISPLA)
DISTAB: MOVE CH,C ;GET COLUMN COUNT SO FAR
SUB CH,TABUNF ;CH:=WHERE WE OUGHT TO BE ON SCREEN
IDIV CH,TABSIZ ;SEE HOW MANY TAB STOPS OVER WE ARE
IMUL CH,TABSIZ ;CHANGE TO COLUMNS AGAIN
ADD CH,TABSIZ ;GET TO NEXT TAB STOP
SUBI CH,1(C) ;CH:=SPACE FILL FOR REST OF TAB
MOVEM CH,TABFIL ;FLAG SPACE FILL NEEDED (MAYBE)
CAIL CH,0 ;ARE WE BACK IN PHASE WITH THE SCREEN POSITION?
SETZ CH, ;YES!
MOVNM CH,TABUNF ;NOT CAUGHT UP, BUT CLOSER!
MOVEI CH," " ;START TAB SEQUENCE
POPJ P,
EOBCHR: SKIPL EOBFLG ;EOBFLG NEGATIVE IF JUST REACHED END OF LINE
JRST EOBCH6 ;DIDN'T JUST, SO OSCILLATE BETWEEN CR AND LF
EOBCH4: MOVEI CH,.CHLFD ;SO CR BEFORE LF IN OSCILLATION
MOVEM CH,EOBFLG
EOBCH6: MOVEI CH,.CHCRT+.CHLFD;CR+LF
SUBB CH,EOBFLG ;CHANGE CR TO LF AND LF TO CR
POPJ P, ;T HAS CR OR LF BECAUSE NO MORE BUFFER
DISEOC: MOVEI CH,.CHCRT ;<CR> OF FREE <CR><LF> PAIR
MOVEM CH,SEOL ;REMEMBER TO DO THE <LF>
POPJ P, ;RETURN WITH <CR>
DISEOL: MOVEI CH,.CHCRT+.CHLFD;CR + LF
SUBB CH,SEOL ;CHANGE ONE TO THE OTHER
CAIE CH,.CHLFD ;SEE IF WE'VE PRINTED ONE SET YET
POPJ P, ;NO
SETZM SEOL ;YES, CLEAR FLAG
AOS DISCAA ;AND COUNT DISPLAY LINES SEEN
POPJ P, ;RETURN WITH <LF>
DISPTR: SKIPLE DISPTF ;HAVE WE STARTED POINTER PICTURE YET?
JRST DISPT2 ;YES, JUST CONTINUE IT
SKIPE DISPTF ;HAVE WE ALREADY FINISHED IT?
JRST DISCH2 ;YES ("." AT END OF TEXT)
MOVE CH,DISCA ;LAST LINE BASE
MOVEM CH,DIPTA ;SAVE CURSOR BASE
MOVE CH,DISCAA ;LAST LINE SKIP COUNT
MOVEM CH,DIPTAA ;SAVE CURSOR SKIP
MOVEM C,DIPTC ;SAVE SCREEN POSITION OF START OF CURSOR
MOVEM I,DIPTI ;SAVE ACTUAL CURRENT VALUE OF "."
MOVE CH,[POINT 7,PTRCHR] ;POINTER TO POINTER PICTURE
MOVEM CH,DISPTF ;NOTE IN POINTER SEQUENCE
; (DISPT2'S ILDB ENSURES DISPTF .GT. 0
; WHICH FLAGS POINTER IN PROGRESS)
DISPT2: ILDB CH,DISPTF ;NEXT CHARACTER IN PICTURE
MOVE T,DISPTF ;SCRATCH COPY OF BYTE POINTER
ILDB T,T ;PEEK AT NEXT CHARACTER
CAIN T,0 ;CURRENT POINTER CHAR THE LAST ONE?
SETOM DISPTF ;YES, FLAG POINTER COMPLETELY IN DISPLAY WINDOW
JRST DISCT0 ;RETURN BOGUS CHARACTER
SCR: CAME I,SCRNVZ ;FORCED TO BREAK HERE?
CAMN I,PT ;CURSOR AFTER <CR>?
JRST DISCTL ;CURSOR AFTER <CR> = ^M
PUSHJ P,GET ;GET CHARACTER AFTER <CR>
CAIN CH,.CHLFD ;LF ??
JRST SCR1 ;YES
MOVEI CH,.CHCRT ;NO, ^M
JRST DISCTL ;GO DO CONTROL CHARACTER SEQUENCE
SCR1: MOVEI CH,.CHCRT ;CRLF, SO CARRIAGE RETURN NOT HACKED
POPJ P,
SLF: SUBI I,1 ;CHARACTER ADDRESS OF <LF>
CAMG I,BEG ;<LF> FIRST IN BUFFER?
AOJA I,SLF2 ;YES, DISPLAY AS ^J
SUBI I,1 ;CHARACTER IN FRONT OF <LF>
PUSHJ P,GETINC ;GET IT
CAIE CH,.CHCRT ;A <CR><LF> PAIR?
AOJA I,SLF2 ;NO, THEN GETS DISPLAYED AS ^J
MOVEI CH,.CHLFD ;GET BACK THE <LF> CHARACTER
CAMN I,PT ;YES, IS CURSOR SANDWICHED INBETWEEN?
AOJA I,DISCH5 ;YES, DISPLAY AS ^J WITH FREE CRLF
ADDI I,1 ;NO, NORMAL <CR><LF>
MOVEM I,DISCA ;SAVE LAST KNOWN LEFT MARGIN ADDRESS
SETZM DISCAA ;AND SKIP LINES FOR VUNXT
POPJ P, ;RETURN WITH THE <LF>
;HERE FOR A STANDALONE LINE FEED, GIVE ^J THEN "ECHO" A <LF>
SLF2: SETOM SEOL2 ;FLAG A FREE <CR><LF> NEEDED
MOVEI CH,2(C) ;CURRENT LINE POSITION (COUNTING ^J)
CAML CH,SWIDTH ;JUST HAPPEN TO HAVE A FULL LINE WITH THE ^J?
SETZ CH, ;YES, START NEW LINE THEN
MOVEM CH,SEOL3 ;NEED LEADING SPACE FILL ON NEXT LINE
MOVEI CH,.CHLFD ;THE LINE FEED CHARACTER AGAIN
JRST DISCTL ;DISPLAY IT AS ^J
DISCON: SETZM TABFIL ;NO MORE TAB FILLING ON THIS LINE
SETZM TABUNF ;ALSO NO MORE SPACE TO RECLAIM
MOVEM I,DISCI ;SAVE I ACROSS OUR MUNGING BELOW
CAMN I,PT ;ARE WE [POSSIBLY FRESHLY] AT "."?
SKIPGE DISPTF ;YES, BUT ARE WE DONE WITH THE POINTER?
SKIPE DISCTF ;POINTER PICTURE OK - IN MIDDLE OF CTL CHR?
JRST DISCO9 ;INCOMPLETE POINTER OR CONTROL CHARACTER
CAME I,SCRNVZ ;JUST HIT FORCED END OF SCREEN?
CAML I,Z ;OR END OF TEXT BUFFER?
JRST EOBCH4 ;YES, CAP OFF WITH <CR><LF>'S THEN
PUSHJ P,GETINC ;PEEK AT NEXT TEXT CHARACTER
CAMN I,PT ;IF POINTER HERE
JRST DISCO9 ;THEN CONTINUATION LINE
CAIN CH,.CHCRT ;IF <CR>
JRST DISCO4 ;CHECK FOR <CR><LF>
CAIE CH,.CHTAB ;NOT <CR>, HOW ABOUT A <TAB>
CAIN CH,.CHESC ;OR AN <ESC>?
JRST DISCO2 ;YEAH, COUNT AS NORMAL CHARACTERS
CAIE CH,.CHDEL ;HOW ABOUT A <DEL>
CAIGE CH," " ;OR RANDOM CONTROL CHARACTER?
JRST DISCO9 ;YES, THEN A CONTINUATION LINE
DISCO2: PUSHJ P,SFLAGC ;IS THIS CHARACTER FLAGGED?
CAIA ;NO, NORMAL PRINTING CHARACTER
JRST DISCO9 ;YES, THEN CONTINUATION LINE
CAME I,SCRNVZ ;FORCED END OF DISPLAY HERE?
CAML I,Z ;OR END OF TEXT BUFFER?
JRST DISCO6 ;YES, THEN NO CONTINUATION NEEDED
PUSHJ P,GETINC ;PEEK AT NEXT CHARACTER
CAIN CH,.CHCRT ;<CR> IS THE ONLY POSSIBILITY ALLOWED
CAMN I,PT ;BUT EVEN THEN ONLY IF NOT FOLLOWED BY "."
JRST DISCO9 ;<CR> AS ^M, CONTINUATION NEEDED
DISCO4: CAME I,SCRNVZ ;FORCED END OF DISPLAY AFTER <CR>?
CAML I,Z ;OR END OF TEXT?
JRST DISCO9 ;YES, <CR> AS ^M, CONTINUATION NEEDED
PUSHJ P,GETINC ;ONE MORE CHARACTER
CAIE CH,.CHLFD ;<LF> OR NOTHING!
JRST DISCO9 ;NOTHING, NEED CONTINUATION
DISCO6: MOVE I,DISCI ;CONTINUATION NOT NEEDED AFTER ALL
JRST DISCH2 ;SO PROCESS CHARACTER NORMALLY
DISCO9: MOVE I,DISCI ;CONTINUATION NEEDED, RESTORE CHARACTER
MOVEI CH,.CHLFD ;PRESET SEOL
MOVEM CH,SEOL ;TO RETURN <CR><LF> ON NEXT DISCHR CALL
MOVE CH,TCOCH ;PICKUP AND
POPJ P, ;RETURN CONTINUATION LINE FLAG
;ROUTINE TO DISPLAY NEW WINDOW
REPEAT 0,<
DISPLA: PUSHJ P,WINFIL ;FILL WINEW WITH NEW DISPLAYFUL
DISPLX: SKIPE CMFTYO ;SUPPRESSING OUTPUT DUE TO COMMAND FILE?
POPJ P, ;YES, RETURN NOW IN THAT CASE
SETZB B,AA ;B IS BUFFER POINTER, AA IS LINE COUNTER
DISPL1: MOVE T,B ;BASE OF LINE COMPARE
CAML AA,SLENTH ;IF SCREENFUL DONE, QUIT
POPJ P, ;YES, SO QUIT
DISCOM: MOVE C,WINDOW(T) ;GET SOME FROM CURRENT DISPLAY
CAME C,WINEW(T) ;SAME AS DESIRED?
JRST DISDIF ;NO, SO LINES ARE DIFFERENT
TRNE C,177_1 ;END OF ASCIZ LINE?
AOJA T,DISCOM ;NO, LOOK AT NEXT WORD
DISPL2: ADDI B,WINDEX ;LINES THE SAME, NEEDN'T DISPLAY
AOJA AA,DISPL1
DISDIF: MOVEI T,.TOTTC ;TOTAL MONITOR-HELD INPUT CHARACTERS
MOVE TT,TTYUDX ;UDX OF TERMINAL
MOVE C,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. C, ;SKIP IF THERE IS ANY TYPEIN
JRST DISPL7 ;NO, OUTPUT THIS LINE
JUMPE C,DISPL7 ;IS THERE ANY TYPEIN AVAILABLE?
SETOM WINDOW(B) ;YES, ECHO LIKELY CLOBBERED LAST LINE
POPJ P, ;AND GO PROCESS TYPEIN
DISPL7: MOVEI CH,(AA) ;FIND WHAT DISPLAY LINE POSITION TO
PUSHJ P,LINECH ;GO TO AND GO THERE
PUSHJ P,CLREOL ;CLEAR TO END OF LINE (WIPE OUT OLD LINE)
MOVEI C,WINEW(B) ;ADDRESS OF NEW LINE OF TEXT
PUSHJ P,VTSTR ;OUTPUT ASCIZ STRING
MOVE T,B ;GET COPY OF POINTER TO DISPLAY AREA
HRL T,T ;COPY IT TO LEFT HALF
ADD T,[WINEW,,WINDOW] ;MAKE BLT POINTER
BLT T,WINDOW+WINDEX-1(B) ;AND MOVE LINE FROM WINEW TO WINDOW AREA
JRST DISPL2 ;GO BACK FOR REST
> ;END REPEAT 0
;NEW VERSION OF DISPLAY
REPEAT 1,<
DISPLA: PUSHJ P,WINFIL ;GENERATE NEW SCREEN IMAGE (INTO WINEW)
DISPLX: SKIPE CMFTYO ;SUPPRESSING OUTPUT DUE TO COMMAND FILE?
POPJ P, ;YES, RETURN NOW
SETZ C, ;INIT LINE COUNTER
;LOOP OVER EACH LINE LOOKING FOR ANY DIFFERENCES BETWEEN NEW AND OLD SCREEN
DISPL0: CAML C,SLENTH ;DONE FULL SCREEN YET?
JRST DISPLZ ;YES, ALL DONE HERE
MOVE A,C ;COPY OF LINE COUNTER
IMULI A,WINDEX ;A:=OFFSET INTO WINDOW AREA OF LINE
ADD A,[POINT 7,WINDOW] ;A:=BYTE POINTER TO OLD SCREEN LINE
MOVE T,A ;COPY OF BYTE POINTER
HRRI T,WINEW-WINDOW(T) ;T:=BYTE POINTER TO NEW LINE
SETZ B, ;NO DIFFERENCES YET THIS LINE
;LOOP OVER EACH CHARACTER WITHIN THE LINE
DISPL2: ILDB AA,A ;GET NEXT OLD CHARACTER
ILDB TT,T ;AND NEXT NEW CHARACTER
CAME AA,TT ;ANY CHANGES?
JRST DISPL4 ;YES, MUST UPDATE VIDEO SCREEN
JUMPN TT,DISPL2 ;NO, LOOP BACK FOR REST OF NEW LINE
JUMPN AA,DISPL7 ;NEW LINE ENDED, BUT OLD HASN'T, MUST ERASE
; THIS MAY ACTUALLY SUPERFLUOUSLY ERASE,
; BUT IT WON'T HURT THE SCREEN
JUMPN B,DISPL8 ;BOTH ENDED TOGETHER, BUT THERE WAS A
; DIFFERENCE, UPDATE WINDOW FROM WINEW
AOJA C,DISPL0 ;GO CHECK NEXT LINE
;STILL IN REPEAT 1
;HERE WHEN A CHANGE IN THE SCREEN IS NEEDED
DISPL4: JUMPN B,DISPL5 ;FIRST DIFFERENCE THIS LINE?
MOVE AA,T ;YES, SAVE T A MOMENT
MOVEI T,.TOTTC ;TOTAL MONITOR-HELD INPUTTABLE CHARACTERS
; MOVEI T,.TOSIP ;***SKIP IF TYPEIN AVAILABLE
MOVE TT,TTYUDX ;FOR APPROPRIATE TTY
MOVE B,[2,,T] ;TRMOP. ARG POINTER TO
TRMOP. B, ;SEE IF USER HAS TYPED AHEAD
SETZ B, ;ASSUME NO TYPEAHEAD
; TDZA B,B ;***
; MOVEI B,1 ;***
JUMPN B,DISPLZ ;IF TYPEAHEAD GET OUT NOW
MOVE T,AA ;RESTORE T
MOVE CH,C ;GET LINE NUMBER
PUSHJ P,LINECH ;AND POSITION TO IT
MOVE B,C ;LINE NUMBER AGAIN
IMULI B,WINDEX ;B:=OFFSET INTO WINDOW REGION
ADD B,[POINT 7,WINEW] ;B:=BYTE POINTER TO NEW LINE
;NOW POSITION TO CHANGED CHARACTER ON LINE
DISPL5: ILDB CH,B ;NEXT NEW LINE CHARACTER
JUMPE CH,DISPL7 ;NULL MEANS SHORTER NEW LINE
PUSHJ P,TYOCH ;OUTPUT CHARACTER
CAME B,T ;CAUGHT UP TO DIFFERENCE YET?
JRST DISPL5 ;NO, KEEP GOING
JRST DISPL2 ;YES, CHECK REST OF LINE
;HERE WHEN NEW LINE IS SHORTER THAN OLD LINE, ERASE REST OF OLD LINE
DISPL7: MOVE B,COLUMN ;LAST SCREEN COLUMN POSITION
CAMG B,SWIDTH ;AT RIGHT EDGE OF SCREEN?
; SOME TERMINALS WILL ERASE THE LAST
; CHARACTER ON EOL IF AT RIGHT MARGIN
PUSHJ P,CLREOL ;NO - ERASE SCREEN TO END OF LINE
;UPDATE WINDOW FROM WINEW TO REFLECT CHANGED LINE
DISPL8: MOVE B,C ;LINE NUMBER
IMULI B,WINDEX ;B:=OFFSET INTO WINDOW REGION
ADDI B,WINDOW ;B:=ADDRESS OF OLD LINE
MOVE T,B ;COPY
HRLI T,WINEW-WINDOW(T) ;T:=BLT POINTER TO
BLT T,WINDEX-1(B) ;COPY NEW LINE TO OLD LINE
AOJA C,DISPL0 ;NOW GO CHECK NEXT LINE
DISPLZ: MOVE CH,DLENTH ;GET BOTTOM OF DISPLAY WINDOW
PJRST LINECH ;AND POSITION THERE
> ;END OF REPEAT 1
ZAPSCN: SETZM MESFLG ;SCREEN AND MEMORY AGREE
SETOM WINDOW ;TRASH THE WINDOW BUFFER
MOVE TT,[WINDOW,,WINDOW+1] ;BLT POINTER TO
BLT TT,WINDOW+WINTOP-1 ;TRASH THE ENTIRE BUFFER AREA
;SO THAT DISPLA WILL RE-WRITE IT
SKIPN SCTYPE ;DISPLAY MODE?
PJRST CRR ;NO, JUST TYPE A <CR><LF>
PJRST HOMEUP ;YES, POSITION TO TOP OF SCREEN
CLRSCN: SETZM MESFLG ;SCREEN AND MEMORY AGREE
MOVE TT,[WINDOW,,WINDOW+1] ;BLT POINTER FOR FIRST HALF
MOVE TT1,DLENTH ;DISPLAY WINDOW LENGTH
IMULI TT1,WINDEX ;FIRST LOC PAST WINDOW IN BUFFER
ADDI TT1,WINDOW ;RELOCATE INTO WINDOW REGION
SETZM WINDOW ;CLEAR WINDOW PICTURE
BLT TT,-1(TT1) ;AS FAR AS WE KNOW ABOUT IT
SETOM (TT1) ;AND ZAP REST OF THE IMAGE
HRLI TT1,1(TT1) ;CONCOCT BLT POINTER
MOVS TT1,TT1 ; . . .
BLT TT1,WINDOW+WINTOP-1 ;AND ZAP BUFFER OUTSIDE OF THE WINDOW
SKIPN SCTYPE ;CLEAR SCREEN UNLESS NOT IN DISPLAY MODE
JRST CRR ;IN WHICH CASE JUST TYPE A <CR><LF>
PUSHJ P,HOMEUP ;GET TO TOP OF SCREEN
;AND CLEAR FROM THERE DOWN
CLREOS: SKIPA CH,TEREOS ;ERASE TO EOS CODES
CLREOL: MOVE CH,TEREOL ;ERASE TO EOL CODES
PJRST VT5CD ;OUTPUT CODES
CUP: SOSGE CURLIN ;DISPLAY CURSOR MOVES UP
SETZM CURLIN ;OOPS - HIT TOP OF SCREEN
MOVE CH,TCUP ;CURSOR UP CODES
PJRST VT5CD ;OUTPUT CODES
CBACK: PUSH P,CH
MOVEI CH,10 ;BACKSPACE (CONTROL H)
PUSHJ P,TYOA ;TYPE MAGIC CHARACTER AND MAKE SURE IT HAPPENS NOW
SOSGE COLUMN ;NOTE BACKWARDS CURSOR MOVEMENT
SETZM COLUMN ;OOPS - HIT LEFT MARGIN
POP P,CH
POPJ P,
HOMEUP: SETZM CURLIN ;CURSOR MOVES TO LINE 0
SETZM COLUMN ;AND COLUMN 0
MOVE CH,THOME ;CURSOR TO HOME CODES
PJRST VT5CD ;OUTPUT CODES
;ROUTINE TO PUT CURSOR ON LINE SPECIFIED BY CONTENTS OF CH
LINECH: SETZM COLUMN ;ALWAYS LEAVES US IN COLUMN 0
PUSH P,CH ;SAVE CH
SUB CH,CURLIN ;HOW FAR IS THAT?
JUMPE CH,[PUSHJ P,VTCR ;OUTPUT A <CR>
POP P,CH
POPJ P,]
JUMPL CH,LINEUP
CAILE CH,4 ;CLOSE ENOUGH SO LINE FEEDS PAY?
JRST CHDCA ;NO, USE DIRECT CURSOR ADDRESSING
PUSHJ P,VTCR ;GET TO LEFT MARGIN
PUSHJ P,VTLF ;GO DOWN A LINE
SOJG CH,.-1 ;LOOP ENOUGH
POP P,CURLIN
POPJ P,
LINEUP: AOJL CH,CHDCA ;IF MORE THAN ONE UP, USE DCA
PUSHJ P,VTCR ;IF JUST ONE, GET TO LEFT MARGIN
POP P,CH
PJRST CUP ;GO UP ONE LINE
CHDCA: MOVE CH,0(P)
MOVEM CH,CURLIN ;SET POSITION
PJRST @TDCAD ;GO TO APPROPRIATE ROUTINE
;VT05-STYLE CURSOR ADDRESSING PROCESSOR
VT05LN: MOVEI CH,16 ;CONTROL N IS MAGIC CURSOR ADDRESSING CHARACTER
PUSHJ P,TYOA ;TYPE IT
POP P,CH ;RECOVER LINE NUMBER DESIRED
ADDI CH,40 ;FIRST ON SCREEN
PUSHJ P,TYOA ;OUTPUT IT
MOVE CH,[BYTE(7) 040,177,177,177,177] ;LEFT MARGIN WITH FILLERS
PJRST VT5CD ;OUTPUT SPECIAL CODES
;VT50-STYLE CURSOR ADDRESSING PROCESSOR
VT50LN: MOVE CH,THOME ;HOME UP SEQUENCE
PUSHJ P,VT5CD ;GET TO UPPER LEFT
POP P,CH ;GET DESIRED LINE #
JUMPE CH,CPOPJ ;WE'RE ALREADY AT ZERO
PUSHJ P,VTLF ;USE LINE FEEDS TO GET THERE
SOJG CH,.-1
POPJ P,
;VT52-STYLE CURSOR ADDRESSING PROCESSOR
VT52LN: MOVE CH,[BYTE(7) 033,"Y",000,000,000] ;CURSOR ADDRESS STARTER
PUSHJ P,VT5CD ;START UP DCA SEQUENCE
POP P,CH ;DESIRED LINE #
ADDI CH,40
PUSHJ P,TYOA ;OUTPUT LINE INDEX
MOVEI CH,40 ;LEFT MARGIN
PJRST TYOA ;OUTPUT CHARACTER INDEX
;ANSI (VT100) SYTLE CURSOR ADDRESSING PROCESSOR
VTANLN: MOVE CH,[BYTE(7) 033,"[",000,000,000] ;CURSOR ADDRESS STARTER
PUSHJ P,VT5CD ;START UP ESCAPE SEQUENCE
POP P,CH ;RESTORE LINE NUMBER
ADDI CH,1 ;ANSI STARTS WITH LINE 1, DT WITH LINE 0
PUSHJ P,VTAPN ;OUTPUT NUMERIC ANSI PARAMETER
MOVE CH,[BYTE(7) ";","0","H",000,000] ;END OF DCA
PJRST VT5CD ;FINISH OFF CURSOR ADDRESS
;SUPPORT ROUTINES FOR SCREEN ROUTINES ABOVE
VT5CD: ROT CH,7 ;POSITION NEXT CHARACTER
PUSHJ P,TYOA ;OUTPUT IT
ANDCMI CH,177 ;TOSS IT OUT
JUMPN CH,VT5CD ;MORE CHARACTERS?
POPJ P, ;NO, ALL DONE
;VTSTR - OUTPUT ASCIZ STRING
VTSTR: TLOA C,(POINT 7,) ;MAKE 7-BIT BYTE POINTER
VTSTR0: PUSHJ P,TYOA ;OUTPUT THE CHARACTER
ILDB CH,C ;NEXT CHARACTER
JUMPN CH,VTSTR0 ;OUTPUT IT
POPJ P, ;END OF STRING, DONE
;VTAPN - OUTPUT NUMERIC ANSI PARAMETER
VTAPN: PUSH P,CH-1 ;NEED A SCRATCH AC
PUSHJ P,VTAPN0 ;OUTPUT IT
POP P,CH-1 ;RESTORE AC
POPJ P, ;AND RETURN
VTAPN0: MOVE CH-1,CH ;POSITION FOR IDIVI
VTAPN2: IDIVI CH-1,^D10 ;GET A DECIMAL DIGIT
JUMPE CH-1,VTAPN5 ;DONE?
PUSH P,CH ;NO, MORE PARAMETER LEFT
PUSHJ P,VTAPN2 ;OUTPUT REST OF NUMBER
POP P,CH ;GET BACK LAST DECIMAL DIGIT
VTAPN5: ADDI CH,"0" ;ASCIIZE IT
PJRST TYOA ;AND OUTPUT IT
;OUTPUT <CR>, PRESERVING AC CH
VTCR: PUSH P,CH ;SAVE AC
MOVEI CH,.CHCRT ;A CARRIAGE RETURN CHARACTER
PUSHJ P,TYOA ;OUTPUT IT
SETZM COLUMN ;NOW IN COLUMN 0
POP P,CH ;RESTORE CH
POPJ P, ;DONE
;OUTPUT <LF>, PRESERVING AC CH
VTLF: PUSH P,CH ;SAVE AN AC
MOVEI CH,.CHLFD ;A LINE FEED CHARACTER
PUSHJ P,TYOA ;OUTPUT IT
POP P,CH ;RESTORE CH
POPJ P, ;DONE
;TABLE OF SCREEN POINTERS TO BE RELOCATED BY NROOMC
SCRNRP: IFIW @SCRNRT(AA) ;POINTER INTO TABLE OF POINTERS
SCRNRT: IFIW SCRNA ;SCREEN BASE
IFIW SCRNB ;START OF SCREEN
IFIW SCRNZ ;END OF SCREEN (+1)
IFIW DISCA ;NEXT SCREEN'S SCRNA
IFIW DIPTA ;CURSOR BASE/SKIP
SCRNRL==.-SCRNRT ;LENGTH OF RELOCATION TABLE
;DISPLAY ROUTINE VARIABLE AREA
U SCRNA,1 ;ABSOLUTE BASE OF SCREEN (CHARACTER ADDRESS)
U SCRNAA,1 ;LINE OFFSET BETWEEN SCRNA AND SCRNB
U SCRNB,1 ;FIRST CHARACTER ON SCREEN (CHARACTER ADDRESS)
U SCRNVZ,1 ;FORCED END OF SCREEN (CHARACTER ADDRESS)
U SCRNZ,1 ;FIRST CHARACTER PAST SCREEN (CHARACTER ADDRESS)
U DISCA,1 ;DISCHR'S UPDATED SCRNA FOR VUNXT
U DISCAA,1 ;DITTO FOR SCRNAA
U DIPTA,1 ;CURSOR BASE AND
U DIPTAA,1 ;SKIP COUNT TO START OF SCREEN LINE
U DIPTC,1 ;POSITION WITH SCREEN LINE OF CURSOR
U DIPTI,1 ;TEXT ADDRESS OF "." FOR DIPT?? ABOVE
U MESFLG,1 ;SET TO -1 TO MEAN DISPLAY IS MESSED UP
U SWIDTH,1 ;SCREEN PRINTING COLUMN QUANTITY, NOT COUNTING CONTINUATION CHARACTER
U SSIZE,1 ;HOLDS SCREEN LENGTH
U SLENTH,1 ;HOLDS NUMBER OF SCREEN LINES TO DISPLAY
U DLENTH,1
U CLENTH,1 ;HOW FAR DOWN WE LIKE THE CURSOR
U TABSIZ,1 ;MAXIMUM SPACES PRINTED FOR TAB
U PTRCHR,2 ;ASCII STRING TO REPRESENT POINTER
;SCREEN STORAGE
U WINDOW,WINTOP ;STORAGE OF WHAT IS SHOWING ON SCREEN NOW
U WINEW,WINTOP ;NEW SCREENFUL ABOUT TO BE DISPLAYED
U WINFLG,1 ;SET TO -1 BY COMMAND ROUTINES LIKE = AND ^A
; THAT DON'T WANT SCREEN WRITTEN OVER THEIR OUTPUT
U VFREEZ,1 ;.NE. 0 THEN "V" COMMAND HAS FROZEN THE SCREEN
U EOBFLG,1 ;END OF BUFFER FLAG
U TABFIL,1 ;.GT. 0 THEN TAB FILLER COUNTER
U TABUNF,1 ;.GT. 0 THEN TAB UNFILLER (RECLAIM BOGUS SPACE)
U SEOL,1 ;END OF DISPLAY LINE FLAG
U SEOL2,1 ;.LT. 0 THEN WANT TO DO A <CR><LF> AT NEXT DISCHR
U SEOL3,1 ;.GT. 0 THEN ^J FILLER COUNTER
U DISCTF,1 ;CONTROL CHARACTER FLAG
U DISPTF,1 ;POINTER ON SCREEN FLAG
U DISCI,1 ;SCRATCH FOR DISCON
U SCTYPE,1 ;TERMINAL TYPE:
; 0 UNKNOWN OR HARDCOPY TERMINALS
; 1 DEC VT05
; 2 DEC-STANDARD ESCAPE SEQUENCE, NO CURSOR ADDRESSING (VT50)
; 3 DEC-STANDARD ESCAPE SEQUENCE, CURSOR ADDRESSING (VT52)
; 4 ANSI-STANDARD ESCAPE SEQUENCE, CURSOR ADDRESSING (VT100)
SUBTTL LOCAL UUO HANDLER
UUOINI: SKIPE SECTN ;ARE WE RUNNING EXTENDED SECTIONS?
JRST UUOIN3 ;YES, DIFFERENT TRAP THEN
MOVE T,[PUSHJ P,UUOH];DISPATCH TO UUO HANDLER
MOVEM T,.JB41 ;SETUP UUO TRAP SERVICE
JRST CPOPJ1 ;SECTION 0 UUO SERVICE ENABLED.
UUOIN3: XMOVEI TT1,XUUOB ;EXTEDNED-ADDRESS UUO TRAP HANDLER BLOCK
MOVEI TT,0 ;WHICH IS "TRAP 0"
MOVEI T,1 ;WHICH IS ONLY ONE TRAP PAIR
MOVE A,[.UTSET,,T] ;UTPR. ARG POINTER TO
UTRP. A, ;ENABLE FOR UUO TRAPS
POPJ P, ;THIS IS AWFUL
XMOVEI A,XUUOH ;ADDRESS OF SECTION-N TRAP HANDLER
MOVEM A,XUUOB+3 ;STASH IN UUO BLOCK
JRST CPOPJ1 ;SECTION N UUO SERVICE ENABLED
U XUUOB,4 ;SECTION-N UUO TRAP BLOCK
U UUOCD,1 ;UUO OPCODE
U UUOAC,1 ;UUO AC
U UUOEF,1 ;UUO EFFECTIVE ADDRESS
U UUORA,1 ;UUO [NEW] RETURN ADDRESS
;HERE ON SECTION-0 UUOS
UUOH: MOVEM B,ARGSTO ;SAVE POSSIBLE ARG
HRRZ B,.JBUUO ;EFFECTIVE ADDRESS OF UUO
MOVEM B,UUOEF ;SET EFFECTIVE ADDRESS
LDB B,[POINT 4,.JBUUO,12] ;GET UUO AC FIELD
MOVEM B,UUOAC ;SET AC FIELD
LDB B,[POINT 9,.JBUUO,8] ;GET UUO TYPE
MOVEM B,UUOCD ;SAVE UUO OPCODE
PUSHJ P,UUOSR ;DISPATCH TO UUO SERVICE ROUTINE
SKIPE B,UUORA ;WANT NEW ADDRESS FOR UUO?
HRRM B,0(P) ;YES, SET NEW PC
MOVE B,ARGSTO ;RESTORE TRASHED AC
POPJ P, ;RETURN FROM UUO
;HERE ON SECTION-N UUOS
XUUOH: MOVEM B,ARGSTO ;SAVE POSSIBLE ARG
MOVE B,XUUOB+2 ;UUO EFFECTIVE ADDRESS
MOVEM B,UUOEF ;SET EFFECTIVE ADDRESS
LDB B,[POINT 4,XUUOB+0,12+18] ;UUO AC FIELD
MOVEM B,UUOAC ;SET AC FIELD
LDB B,[POINT 9,XUUOB+0,8+18] ;UUO OPCODE
MOVEM B,UUOCD ;SET OPCODE
PUSHJ P,UUOSR ;DISPATCH TO UUO SERVICE
SKIPE B,UUORA ;WANT NEW ADDRESS?
HRRM B,XUUOB+1 ;YES, SET NEW PC
MOVE B,ARGSTO ;RESTORE TRASHED AC
XJRSTF XUUOB ;RETURN FROM UUO
;DISPATCH TO SELECTED UUO SERVICE ROUTINE
UUOSR: SETZM UUORA ;INITIALIZE NEW RETURN ADDRESS
CAIN B,20 ;CHKEO?
PJRST CEO ;YES
CAIN B,1 ;MESSAGE UUO?
PJRST MSGUUO ;YES
$FATAL (UUO,,<Illegal UUO>)
SUBTTL MSG. UUO (INFORMATIONAL/WARNING/ERROR MESSAGES)
MSGUUO: PUSHJ P,TEBURB ;Checkpoint the TEB file
SETOM WINFLG ;Messages screw up the screen
PUSHJ P,SCNCTX ;Switch to SCAN's context
MOVE T1,COMMAX ;Get # of characters in command buffer
SUB T1,COMCNT ;- # of characters to be processed
MOVEM T1,ERR1 ;Store for command echo
DMOVE T1,COMPTR ;Get byte pointer to command buffer
DMOVEM T1,ERR2 ;Store for command echo
MOVE T1,UUOEF ;Get address of argument block
DMOVE T2,(T1) ;Copy arguments
DMOVEM T2,MSGARG ;Store for easy reference
MOVEM T3,UUORA ;Store new return address
SKIPN T1,EHUVAL ;Verbosity from EH command
PUSHJ P,.VERBO## ;Zero--Get our verbosity bits
MOVEM T1,MSGBIT ;Store them
SKIPE COLUMN ;If not at the left margin, then
PUSHJ P,.TCRLF## ;Start with a new line
MOVE T1,UUOAC ;Pick up AC field
MOVEM T1,MSGSEV ;Store severity level
MOVE T1,[EXP "[" ;Comment message
EXP "%" ;Warning message
EXP "?"](T1);Fatal message
PUSHJ P,.TCHAR## ;Type severity character
HLRZ T1,MSGARG ;Get the 3 character prefix
HRLI T1,'TEC' ;Include our identifier
MOVE T2,MSGBIT ;Get verbosity bits
TXNE T2,JWW.PR ;Want a prefix ?
PUSHJ P,.TSIXN## ;Yes - type prefix
PUSHJ P,.TSPAC## ;Type a space for cleanliness
HRRZ T1,MSGARG ;Get address of text
HRLI T1,(POINT 7) ;Make a byte pointer
MOVEM T1,MSGPTR ;Store it
MOVE T1,MSGBIT ;Get our verbosity bits
TXNE T1,JWW.FL ;Want a first line ?
PUSHJ P,ERRPRN ;Yes - type it
MOVE T1,MSGBIT ;Get our verbosity bits
TXNE T1,JWW.CN ;Want continuation text ?
PUSHJ P,ERRTYP ;Yes - type it
MOVEI T1,"]" ;Incase we're typeing a comment
SKIPN MSGSEV ;Zero severity level means a comment
PUSHJ P,.TCHAR## ;Finish it properly
PUSHJ P,.TCRLF## ;Type a new line to finish the message
PUSHJ P,TECCTX ;Switch to TECO's context
MOVE B,ARGSTO ;Restore real "B" from UUOH
SOSLE MSGSEV ;Return on comments or warnings
TXZN FF,CCLFLG ;MAKE or TECO command produce error ?
POPJ P, ;Return somewhere
POPJ P, ;*** TEMP ***
LDB CH,[POINT 15,XEXT,35] ;CHECK FOR ?FNF-00
JUMPN CH,CPOPJ ;IT'S NOT
MOVE CH,UUOEF ;MAYBE
CAIE CH,(SIXBIT /FNF/) ;..
POPJ P,
CLOSE OUTCHN,CL.RST ;YES - DON'T SUPERCEDE OLD FILE.
JRST FINISZ ;YES, POP UP TO MONITOR
U MSGARG,2 ;MSG. UUO arguments
U MSGSEV,1 ;MSG. UUO severity level
U MSGBIT,1 ;MSG. UUO verbosity bits
U MSGPTR,1 ;MSG. UUO byte pointer
U ARGSTO,1 ;STORE FOR ARGUMENT (IF ANY)
ERRPRN: PUSHJ P,ERRCHR ;Get a character
POPJ P, ;End of line
CAXE CH,.CHCNN ;Check for the special flag character
JRST ERRPR1 ;Not the one
PUSHJ P,ERRCHR ;Get the next character
POPJ P, ;End of line
MOVEI T1,-"0"(CH) ;Convert ASCII to octal
IMULI T1,12 ;Shift T1 by a power of 10
PUSHJ P,ERRCHR ;Get second digit
POPJ P, ;End of line
ADDI T1,-"0"(CH) ;Add it in
CAILE T1,ETABLN ;Does it fit?
HALT ERRPRN ;No???^%$#$#(*%$#&^)&%$#!
PUSHJ P,@ETABL(T1) ;Dispatch to typeout routine
JRST ERRPRN ;Loop back for rest of message
ERRPR1: MOVE T1,CH ;Put character in a better place
PUSHJ P,.TCHAR## ;Type it
JRST ERRPRN ;Loop back
;Get a character from the error text
ERRCHR: ILDB CH,MSGPTR ;Load a byte
SKIPE CH ;End of line ?
AOS (P) ;Skip
POPJ P, ;Return
ERRT.1: ILDB T1,P1 ;Get a character
CAMG T4,ERR1 ;Was it in the command buffer ?
PUSHJ P,SCNTYS ;Type possible funny character
CAMN P1,ERR2 ;Reached the bad command yet ?
CAME P1+1,ERR2+1 ; . . .
SOJA T4,ERRT.1 ;No - loop
MOVEI T1,[ASCIZ | <---|] ;Arrow marking the end
PJRST .TSTRG## ;Type it and return
ERRTYP: SKIPN ERR1 ;Is there anything to type?
POPJ P, ;No, punt it now
PUSHJ P,.SAVE2## ;Need a coupla PEAs too
PUSHJ P,.TCRLF## ;Type a CRLF
MOVEI T1,[ASCIZ | ---> |] ;Arrow marking the begining
PUSHJ P,.TSTRG## ;Type it
MOVNI P1,12 ;Backup
MOVN P2,ERR1 ;Alternate backup
CAMGE P1,P2 ;Will the usual 12 fit?
MOVE P1,P2 ;No, fix it
MOVM T4,P1 ;Keep the count of characters
ADJBP P1,ERR2 ;COMPTR before the error
CAMGE P1+1,CMDPTX ;Is this pointer below the buffer?
DMOVE P1,CMDPTR ;Yes, make sure we stay in bounds
JRST ERRT.1 ;Match angle brackets
;Routine to output a 6 digit octal quantity with leading zeros
; Call: MOVE T1,word to output
; PUSHJ P,HLFWRD
; <return>
HLFWRD: PUSH P,T1 ;Save argument
HRLOS T1 ;T1:= xxx,,-1
JFFO T1,.+1 ;Get number of leading one bits
IDIVI T2,3 ;Get number of digits to pad
SKIPA T1,["0"] ;Load a leading zero
PUSHJ P,.TCHAR## ;Type it
SOJG T2,.-1 ;Loop
POP P,T1 ;Restore original argument
PJRST .TOCTW## ;Type number in octal and return
U ERR1,1 ;
U ERR2,2 ;
;DISPATCH TABLE FOR SPECIAL INFORMATION TYPEOUT
;BASED ON CHARACTER AFTER CONTROL-N
ETABL: IFIW ECOMCH ;00 - LAST COMMAND CHARACTER (COMPTR)
IFIW EOUTFL ;01 - OUTPUT FILE SPECIFICATION (OUNAM)
IFIW EFILEN ;02 - LAST FILE SPECIFICATION (XNAM)
IFIW EERNUM ;03 - LAST FILE UUO ERROR (XEXT)
IFIW EDEVNM ;04 - DEVICE NAME (OPNBLK)
IFIW EPROJN ;05 - FILE PATH (PTHBLK)
IFIW EARG1 ;06 - DECIMAL COMMAND ARGUMENT (ARGSTO)
IFIW EPROTC ;07 - FILE PROTECTION (XPRV)
IFIW EEBFN ;08 - EB FILENAME (EBNAM)
IFIW EINFIL ;09 - INPUT FILE SPEC (INFIL)
IFIW EEBFIL ;10 - EB FILE SPEC (EBNAM)
IFIW EIOFLG ;11 - I/O STATUS (ARGSTO)
IFIW ESTAB ;12 - TAG (STAB)
IFIW ESKIP ;13 - UNUSED
IFIW EISKIP ;14 - UNUSED
IFIW EFILSP ;15 - LAST FILE SPEC (XNAM)
IFIW EEOVAL ;16 - "EO" FLAG VALUE (EOVAL)
IFIW EESCH ;17 - SEARCH STRING (SCHARG)
IFIW EECTRL ;18 - CHARACTER (ARGSTO)
IFIW EESWIT ;19 - FILE SWITCH (SWITHL)
IFIW EEBPTH ;20 - EB PATH (EBPTH)
IFIW EINFSP ;21 - INPUT FILE SPEC (INNAM)
IFIW EOUFSP ;22 - OUTPUT FILE SPEC (OUNAM)
IFIW EPATH ;23 - PATH (PTHBLK)
ETABLN==.-ETABL ;MAX TYPEOUT ROUTINE
;SPECIAL INFORMATION TYPEOUT ROUTINES
EECTRL: SKIPA T1,ARGSTO ;GET BAD CHAR FROM TEXT STRING
ECOMCH: LDB T1,COMPTR ;GET LAST COMMAND STRING CHAR.
PJRST SCNTYS ;AND TYPE IT OUT IN A READABLE MANNER
EOUTFL: MOVEI TT1,OUNAM ;AIM AT OUTPUT FILENAME
EOUTF2: PJRST EFILE ;TYPE THE FILE
;HERE TO TYPE A FILENAME.EXTENSION
EFILE: MOVE T1,(TT1) ;PICK UP FILE NAME
PUSHJ P,.TSIXN##
HLLZ T1,1(TT1)
JUMPE T1,.POPJ## ;SKIP REST IF NO EXTENSION
MOVEI T1,"."
PUSHJ P,.TCHAR##
HLLZ T1,1(TT1)
PUSHJ P,.TSIXN##
POPJ P,
EFILEN: MOVEI TT1,XNAM ;GET FILENAME REF'D BY UUO
PJRST EFILE
EERNUM: LDB T1,[POINT 15,XEXT,35] ;GET 2-DIGIT ERROR CODE
EERNU1: PJRST .TOCTW## ;TYPE IT
EDEVNM: MOVE T1,OPNDEV ;GET DEVICE NAME
EDEVN1: PJRST .TSIXN## ;PRINT THE DEVICE NAME
EPROJN: SKIPE PTHPPN ;LOOKUP/ENTER ON DEFAULT PATH?
SKIPN T1,PTHBLK+.PTSTR;NO, GET ACTUAL PATH STRUCTURE (IF ANY)
JRST EPROJP ;NO STRUCTURE TO TYPE
PUSHJ P,.TSIXN## ;TYPE DEVICE/STRUCTURE
PUSHJ P,.TCOLN## ;AND THE SEPARATING ":"
SKIPA T1,[PTHBLK+.PTPPN] ;NO, GET PATH WE USED
EPROJP: MOVEI T1,.MYPTH##+.PTPPN ;YES, POINT TO DEFAULT PATH
TLO T1,1 ;FLAG PATH SPEC
PJRST .TDIRB## ;AND TYPE DIRECTORY PATH
EESWIT: MOVE T1,SWITHL ;GET I/O SWITCH NAME
PJRST .TSIXN##
EARG1: MOVE T1,ARGSTO ;GET ARG BACK
EARG1A: PJRST .TDECW## ;PRINT IT
EPROTC: LDB T1,[POINT 9,XPRV,8] ;GET FILE PROTECTION
PJRST .TOCTW## ;TYPE IT
EEBFN: MOVE T1,EBNAM ;EB FILENAME
PJRST .TSIXN##
EINFIL: MOVEI TT1,INNAM ;AIM AT INPUT FILENAME
PJRST EFILE ;TYPE THE FILE
EEBFIL: MOVEI TT1,EBNAM ;AIM AT EB ORIGINAL FILENAME
PJRST EFILE
EIOFLG: HRRZ T1,ARGSTO ;GET I/O STATUS
PJRST HLFWRD ;TYPE IT
ESTAB: MOVEI T2,STAB ;INDEX STAB WHERE TAG RESIDES
ESTAB1: SKIPN T1,(T2)
POPJ P,
PUSHJ P,SCNTYS
AOJA T2,ESTAB1
EISKIP:
ESKIP: HALT .+1
POPJ P,
EEOVAL: MOVEI T1,EOVAL ;GET MAXIMUM EOFLAG FOR THIS VERSION
PJRST .TDECW##
EESCH: MOVE T3,[POINT 7,SCHARG] ;GET PTR TO SEARCH STRING
MOVM T4,SCHCTR ;[MHK] & STRING CTR
EESCH2: ILDB T1,T3 ;GET STRING CHAR
PUSHJ P,SCNTYS ;TYPE IT
SOJG T4,EESCH2 ;LOOP FOR REST OF STRING
POPJ P, ;RETURN TO ERRPRN
EFILSP: MOVEI TT1,XNAM ;POINT TO FILE NAME
MOVEI C,PTHBLK ;AND DEVICE, CHR'S, PATH
JRST ETSPEC ;JOIN COMMON ROUTINE
EPATH: SKIPA C,[PTHBLK] ;POINT TO PTHBLK
EEBPTH: MOVEI C,EBPTH ;POINT TO EB PATH
JRST EDSPTH ;GO DISPLAY IT
EINFSP: MOVEI TT1,INNAM ;SETUP INPUT FILE NAME
MOVEI C,INPTH ;AND INPUT PATH
JRST ETSPEC ;MERGE WITH COMMON CODE
EOUFSP: MOVEI TT1,OUNAM ;OUTPUT FILE NAME
MOVEI C,OUPTH ;OUTPUT PATH
JRST ETSPEC ;COMMON CODE
;HERE TO TYPE PATH C POINTS TO IF FROM A DISK.
EDSPTH: MOVE E,-1(C) ;GET DEVCHR WORD
TXNN E,DV.DSK ;A DISK?
POPJ P, ;NO, DONE
SKIPE 2(C) ;THIS PATH BLOCK SET UP?
JRST EDSPT1 ;YES, PROCEED
MOVE E,-3(C) ;NO, PICKUP DEVICE
MOVEM E,0(C) ;STORE IN PATH BLOCK
MOVSI E,10 ;ASSUME 10 WORDS LONG
HRRI E,0(C) ;NOW SET UP FOR PATH UUO
PATH. E, ;FIND OUT DEVICE'S PATH
POPJ P, ;NOT A DISK, FORGET IT
EDSPT1: MOVEI T1,(C) ;POINT TO THE PATH BLOCK
PJRST .TDIRB## ;TYPE IT
ETSPEC: MOVE T1,-3(C) ;Get device name
PUSHJ P,.TSIXN## ;Type it
PUSHJ P,.TCOLN## ;Type a colon
MOVE T1,(TT1) ;Get file name
PUSHJ P,.TSIXN## ;Type it
MOVEI T1,"." ;Get a dot
PUSHJ P,.TCHAR## ;Type it
HLLZ T1,1(TT1) ;Get extension
PUSHJ P,.TSIXN## ;Type it
MOVEI T1,2(C) ;Point to path block
PJRST .TDIRB## ;Type it
;CHKEO EO#,ADDR
;IF EOFLAG GT EO#, RETURN AT CALL+1 (FEATURE IS LEFT ON)
;OTHERWISE GO TO ADDR (FEATURE IS TURNED OFF)
CEO: PUSH P,A ;SAVE AC
MOVE B,UUOAC ;GET EO TEST VALUE
MOVE A,EOFLAG ;GET LAST SETTING OF EOFLAG
CAIG A,(B) ;EOFLAG GT TEST VALUE?
JRST CEO1 ;NO
CEO2: POP P,A ;RESTORE AC A
MOVE B,ARGSTO ;RESTORE AC B
POPJ P, ;RETURN
CEO1: MOVE A,UUOEF ;GET DISPATCH ADDR
MOVEM A,UUORA ;SET AS NEW RETURN ADDRESS
JRST CEO2
SUBTTL MISCELLANEOUS SUBROUTINES
;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 GT 1, THE EOL CHARS ARE LF, VT, AND FF (& END OF BUFFER IF
;LAST CHAR IN BUFR IS NOT AN EOL)
GETARG: TXNE FF,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,
;GET - GET CHARACTER FROM TEXT STRING
;GETINC - GET ADDRESSED CHARACTER, INCREMENT ADDRESS
;Call is:
;
; MOVX I,<ADR>
; PUSHJ P,GET/GETINC
; normal return
;
;<ADR> is absolute text address of desired character.
;
;On normal return, the addressed character is in CH.
;
;Uses TT, TT1
GET: MOVE TT,I ;TEXT ADDRESS OF DESIRED CHARACTER
IDIVI TT,5 ;WORD ADDRESS . . .
LDB CH,BTAB(TT1) ;GET ADDRESSED CHARACTER
POPJ P, ;RETURN WITH CHARACTER IN CH
GETINC: MOVE TT,I ;TEXT ADDRESS OF DESIRED CHARACTER
IDIVI TT,5 ;WORD ADDRESS . . .
LDB CH,BTAB(TT1) ;GET ADDRESSED CHARACTER
ADDI I,1 ;ADVANCE "INPUT" (OR "GET") POINTER
POPJ P, ;RETURN WITH CHARACTER IN CH
;PUT - PUT/STORE CHARACTER AS ADDRESSED
;PUTINC - PUT CHARACTER AS ADDRESSED, INCREMENT ADDRESS
;Call is:
;
; MOVX I,<ADR>
; PUSHJ P,PUT/PUTINC
; normal return
;
;<ADR> is absolute text address to receive <CHR>.
;
;On normal return, the character in CH has been stored as directed
;by <ADR>.
;
;Uses TT, TT1
PUT: MOVE TT,OU ;TEXT ADDRESS FOR PENDING CHARACTER
IDIVI TT,5 ;WORD ADDRESS . . .
DPB CH,BTAB(TT1) ;PUT CHARACTER IN MEMORY
POPJ P, ;RETURN WITH CHARACTER STORED
PUTINC: MOVE TT,OU ;TEXT ADDRESS FOR PENDING CHARACTER
IDIVI TT,5 ;WORD ADDRESS . . .
DPB CH,BTAB(TT1) ;PUT CHARACTER IN MEMORY
ADDI OU,1 ;ADVANCE "OUTPUT" (OR "PUT") POINTER
POPJ P, ;RETURN WITH CHARACTER STORED
;FILL OUT WORD POINTED AT BY I WITH NULLS
TRAIL0: SUBI I,1 ;POINT AT LAST REAL CHARACTER
MOVE TT,I ;TEXT ADDRESS OF DESIRED CHARACTER
IDIVI TT,5 ;WORD ADDRESS . . .
SETZ CH, ;LOTS OF ZERO BITS
DPB CH,BT0TAB(TT1) ;CLEAR OUT TRAILING BITS IN WORD
POPJ P, ;AND RETURN
;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT OF A CHARACTER ADDRESS POINTER
POINT 07,0(TT),-1 ;PRECEDING BYTE
BTAB: POINT 07,0(TT),06 ;FIRST BYTE WITHIN WORD
POINT 07,0(TT),13 ;SECOND BYTE WITHIN WORD
POINT 07,0(TT),20 ;THIRD BYTE WITHIN WORD
POINT 07,0(TT),27 ;FOURTH BYTE WITHIN WORD
POINT 07,0(TT),34 ;FIFTH BYTE WITHIN WORD
;DITTO FOR TRAILING BITS
BT0TAB: POINT 29,0(TT),35 ;FOUR TRAILING BYTES WITHIN WORD
POINT 22,0(TT),35 ;THREE TRAILING BYTES WITHIN WORD
POINT 15,0(TT),35 ;TWO TRAILING BYTES WITHIN WORD
POINT 08,0(TT),35 ;ONE TRAILING BYTE WITHIN WORD
POINT 01,0(TT),35 ;ONE DANGLING BIT WITHIN WORD
;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 MEMORY MANAGEMENT - TEXT EXPANSION/CONTRACTION
;*** THIS CODE NEEDS TO BE INTERLOCKED WRT ^C TRAPPING . . .
;NROOMQ - ALLOCATE ROOM FOR A Q-REGISTER
NROOMQ: SETOM NRQFLG ;FLAG REQUEST IS FOR A Q-REGISTER
JRST NROOM0 ;JOIN COMMON CODE
;NROOMC - ALLOCATE ROOM FOR REGULAR TEXT CHARACTERS
NROOMC: MOVEM C,VVAL ;SAVE LENGTH OF STRING
NROOM: SETZM NRQFLG ;NOTE REGULAR TEXT EXPANSION/CONTRACTION
;FIRST SAVE ALL THE REGISTERS. THIS IS LARGELY HISTORICAL, AS THE "BYTE-BLT"
;ROUTINE NO LONGER RUNS IN THE ACS.
NROOM0: MOVEM 16,AC0+16 ;SAVE A REGISTER
MOVEI 16,AC0 ;BLT POINTER TO
BLT 16,AC0+15 ;SAVE ACS 0-15
CAIN C,0 ;REQUEST A NO-OP?
HALT .+1 ;HMMM
CAIGE C,0 ;EXPANSION OR DELETION?
SKIPN NRQFLG ;DELETION - FOR REQULAR TEXT?
CAIA ;OK
HALT .+1 ;DELETION OF A Q-REGISTER?
SETZM CRREL
SETZM RREL
JUMPL C,NRMDL0 ;IF DELETE, GO SHRINK THE TEXT BUFFER
MOVE T,PT
CAMN T,Z ;PT=Z? I.E., DATA BUFFER EXPANSION?
SKIPE NRQFLG ;YES, UNLESS Q-REG REQUEST
JRST NRMIN0 ;Q-REG OR TEXT INSERT (THE HARD WAY)
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;TEXT INSERTION (EXPANSION) THE EASY WAY, WHERE PT=Z.
NROOM1: ADD T,C ;TOTAL SPACE REQUIREMENT
CAMGE T,MEMSIZ ;IS THERE ENOUGH?
JRST NROOMZ ;YES, JUST ADVANCE Z AND RETURN
;THE EASY INSERTION/EXPANSION CASE, BUT NOT ENOUGH ROOM IMMEDIATELY AVAILABLE.
NROOM3: PUSHJ P,GC ;GARBAGE COLLECT Q-REG/TEXT AREA
JFCL ;ERROR?
MOVE T,Z ;GET TOTAL SO FAR
ADD T,C ;ADD IN THE REQUEST
CAMGE T,MEMSIZ ;STILL IN NEED OF CORE?
JRST NROOMZ ;NO, ALL SET, JUST ADVANCE "Z"
PUSHJ P,GRABAK ;YES, GET THE REQUIRED CORE FROM THE MONITOR
JRST GCRERR ;CAN'T EXPAND, INSUFFICIENT MEMORY
;COMMON EXIT FOR NROOM1, NRMIN?, NRMDL? (I.E., ALL THE HAIRY CASES)
NROOMZ: ADDM C,Z ;UPDATE END-OF-BUFFER ("Z") POINTER
NROOMA: SETZM NRMGCZ ;CLEAR YANK6'S "Z" ADDRESS
MOVSI 16,AC0 ;BLT POINTER TO
BLT 16,16 ;RESTORE ACS 0-16
POPJ P, ;AND RETURN
;INSUFFICIENT MEMORY FOR EXPANSION
GCRERR: PUSHJ P,NROOMA ;RESTORE THE BY-NOW-THOROUGHLY-TRASHED ACS
CORERR: $FATAL (COR,,<Storage capacity exceeded>)
U NRQFLG,1 ;.NE. 0 IF NROOM REQUEST IS FOR Q-REGISTER
U NRMGCZ,1 ;.NE. 0 THEN "Z" ADDRESS FOR GC
U NRMPTR,1 ;TO-BE-PRESERVED-BITS BYTE POINTER FOR BYTE-BLT
U NRMPTX,1 ; (DOUBLE-WORD POINTER ADDRESS)
;TEXT INSERTION (EXPANSION) THE HARD WAY
NRMIN0: MOVE T,Z ;CURRENT END TEXT ADDRESS
ADD T,C ;DESIRED NEW END TEXT ADDRESS
CAMGE T,MEMSIZ ;WILL REQUEST OVERFLOW MEMORY?
JRST NRMIN2 ;NO, ALL SET, JUST MOVE STRING TO MAKE ROOM
;INSUFFICIENT ROOM REMAINING FOR EXPANSION, MUST MAKE MORE ROOM
PUSHJ P,GC ;FIRST TRY FOR GARBAGE COLLECTION
JFCL ;ERROR?
MOVE T,Z ;CURRENT END TEXT ADDRESS
ADD T,C ;DESIRED NEW END TEXT ADDRESS
CAMGE T,MEMSIZ ;WILL REQUEST FIT NOW?
JRST NRMIN2 ;YES, ALL SET, JUST MOVE STRING TO MAKE ROOM
PUSHJ P,GRABAK ;NO, TRY TO EXPAND MEMORY
JRST GCRERR ;INSUFFICIENT MEMORY, ERROR
;RELOCATE SCREEN POINTERS AFFECTED BY THE INSERTION. THIS CODE DOESN'T
;HANDLE THE REALLY BAD CASES (INSERT BETWEEN SCRNA AND SCRNB FOR EX-
;AMPLE), BUT WORKS FOR "REASONABLE" TEXT FILES. THIS NEEDS TO BE DONE
;IN ORDER TO ALLOW THE "V" COMMAND TO WORK AS PART OF A "LONG AND COM-
;PLICATED" COMMAND WHICH FIRST CAUSES THE EDIT BUFFER TO MOVE AND THEN
;DOES THE "V" COMMAND. THE ALTERNATIVE WOULD BE TO RELOCATE THE SCREEN
;POINTERS AT BOTH GOSC AND VCMD.
NRMIN2: PUSH P,C ;SAVE COPY OF INSERTION/EXPANSION COUNT
MOVE A,PT ;STARTING POINT OF EXPANSION
MOVSI AA,-SCRNRL ;INDEX INTO TABLE OF POINTERS
SKIPN NRQFLG ;REGULAR OR Q-REGISTER REQUEST?
SKIPA TT,[CAMGE A,@SCRNRP] ;REGULAR - ONLY RELOCATE SOME OF 'EM
MOVSI TT,(JFCL) ;Q-REGISTER - RELOCATE ALL SCREEN PARAMETERS
NRMIN3: XCT TT ;GROWTH IN FRONT OF THIS POINTER?
ADDM C,@SCRNRP ;YES, RELOCATE THE POINTER
AOBJN AA,NRMIN3 ;RELOCATE REST OF POINTERS
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;MOVE FROM PT THROUGH Z UP C POSITIONS
NRMIN4: MOVE A,PT ;TEXT ADDRESS OF START OF INSERTION/EXPANSION
IDIVI A,5 ;WORD ADDRESS OF . . .
MOVNI AA,-5(AA) ;COUNT OF BYTES PAST "." MODULO WORD
IMULI AA,7 ;COUNT OF [DATA] BITS . . .
MOVE T,[POINT 0,@AA,34] ;PROTOTYPE LAST PARTIAL WORD POINTER
DPB AA,[POINT 6,T,11] ;SIZE FIELD OF LAST PARTIAL WORD POINTER
MOVEM T,NRMPTR ;HOLD ONTO LAST PARTIAL WORD POINTER
MOVE AA,C ;TEXT SIZE OF EXPANSION
IDIVI AA,5 ;WORD SIZE OF . . .
ADD AA,A ;AA := INITIAL "DESTINATION" POINTER (WORD ADR)
ADDI AA,1 ; . . .
IMULI B,7 ;[DATA] BIT SIZE OF EXPANSION MODULO WORDS
MOVN C,B ;C := BYTE-BLT COMBINING LSHC VALUE
MOVEI D,-43(B) ;D := BYTE-BLT REMAINDER LSH VALUE
MOVE T,Z ;TEXT END ADDRESS
IDIVI T,5 ;WORD END ADDRESS
AOS B,T
SUB B,A ;B := POSITIVE NUMBER OF BYTE-BLT'ED WORDS
MOVSI T,((B)) ;IFIW INDEXING OFF OF AC "B"
SKIPE SECTN ;PC IN EXTENDED SECTION?
LSH T,IFX2EF ;YES, SELECT EFIW INDEXING THEN
IOR A,T ;INDEX "SOURCE" POINTER
IOR AA,T ;INDEX "DESTINATION" POINTER
SOJL B,NRMIN9 ;SKIP LOOP IF NULL, ELSE ENTER BYTE-BLT LOOP
;LOOP "BLT"ING THE BYTES A WORD-AT-A-TIME
;
; A/ "SOURCE" POINTER (WORD ADDRESS, INDEXED OFF OF "B")
; AA/ "DESTINATION" POINTER (WORD ADDRESS, INDEXED OFF OF "B")
NRMIN7: MOVE T,@A ;FETCH NEXT SOURCE WORD
LSH T,-1 ;RIGHT JUSTIFY FOR LSHC CONCATENATION
LSHC T,(C) ;COMBINE WITH PREVIOUS LEFTOVERS
MOVEM TT,@AA ;STORE THIS DESTINATION WORD
LSHC T,(D) ;REMAINDER OF THIS SOURCE WORD (LEFT JUSTIFIED)
SOJGE B,NRMIN7 ;LOOP FOR ENTIRE SOURCE STRING
NRMIN9: CAME B,[-1] ;*** DEBUGGING (NRMPTR DEPENDS ON @AA)
HALT .+1 ;*** (REPLACE WITH SETO . . .)
ROTC T,43(C) ;POSITION LAST PARTIAL WORD.
DPB T,NRMPTR ;AND STORE IT IN MEMORY
POP P,C ;RESTORE INSERT/EXPANSION COUNT
JRST NROOMZ ;RETURN, UPDATING "Z" AND RESTORING THE ACS
;TEXT DELETION
NRMDL0: PUSH P,C ;SAFE COPY OF DELETION COUNT
MOVE A,PT ;STARTING POINT OF DELETION
MOVE B,A ;COPY
SUB B,C ;B:=ENDING POINT OF DELETION
MOVSI AA,-SCRNRL ;INDEX INTO TABLE OF POINTERS
NRMDL3: CAMGE A,@SCRNRP ;POINTER IN AREA BEING DELETED?
CAMG B,@SCRNRP ; . . .
CAIA ;NO, RELATIVELY SAFE THEN
MOVEM B,@SCRNRP ;YES, THEN WILL SOON CEASE TO EXIST
CAMGE A,@SCRNRP ;WILL THIS POINTER BE AFFECTED BY DELETION?
ADDM C,@SCRNRP ;YES, RELOCATE IT
AOBJN AA,NRMDL3 ;RELOCATE REST OF POINTERS
MOVNI B,3 ;COMMAND EXECUTION COUNT
MOVEM B,TOOBIG ;TO TRY TO RECLAIM MEMORY PAGES
;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
NRMDL4: MOVE T,PT ;TEXT ADDRESS OF START OF DELETEION
IDIVI T,5 ;WORD ADDRESS OF . . .
MOVEM T,NRMPTX ;INITIAL DESTINATION ADDRESS
SKIPE SECTN ;RUNNING EXTENDED?
MOVSI T,(1B12) ;YES, DOUBLE-WORD BYTE POINTER
IMULI TT,7 ;[DATA] BITS PRECEDING "." MODULO WORD
DPB TT,[POINT 6,T,11] ;SIZE FIELD OF TO-BE-PRESERVED-BITS POINTER
MOVNI TT,-44(TT) ;[DATA] BITS PAST "." MODULO WORD
DPB TT,[POINT 6,T,5] ;POS FIELD OF TO-BE-PRESERVED-BITS POINTER
MOVEM T,NRMPTR ;SET TO-BE-PRESERVED-BITS BYTE POINTER
MOVE A,Z ;TEXT ADDRESS OF END OF TEXT
IDIVI A,5 ;WORD ADDRESS OF . . .
ADDI A,1 ;INITIAL "SOURCE" POINTER (WORD ADR)
MOVE AA,C ;TEXT SIZE OF DELETION
IDIVI AA,5 ;WORD SIZE OF . . .
ADD AA,A ;INITIAL "DESTINATION" POINTER (WORD ADR)
SUBI AA,1 ; . . .
IMULI B,7 ;[DATA] BIT SIZE OF DELETION MODULO WORDS
MOVN C,B ;C := BYTE-BLT COMBINING LSHC VALUE
MOVNI D,-43(C) ;D := BYTE-BLT REMAINDER LSH VALUE
MOVE B,NRMPTX ;FIRST DESTINATION WORD ADDRESS
SUB B,AA ;B := NEGATIVE NUMBER OF BYTE-BLT'ED WORDS
SUBI B,1 ; . . .
MOVSI T,((B)) ;IFIW INDEXING OFF OF AC "B"
SKIPE SECTN ;PC IN EXTENDED SECTION?
LSH T,IFX2EF ;YES, SELECT EFIW INDEXING
IOR A,T ;INDEX "SOURCE" POINTER
IOR AA,T ;INDEX "DESTINATION" POINTER
LDB T,NRMPTR ;PRESERVED PORTION OF FIRST "DESTINATION" WORD
PUSH P,T ;SAVE TO-BE-PRESERVED SOURCE BITS
MOVE T,@A ;PRELOAD FIRST "SOURCE" WORD
ROT T,-1 ; (RIGHT JUSTIFIED)
AOJG B,NRMDL9 ;SKIP LOOP IF NULL, ELSE ENTER BYTE-BLT LOOP
;LOOP "BLT"ING THE BYTES A WORD-AT-A-TIME
;
; A/ "SOURCE" POINTER (WORD ADDRESS, INDEXED OFF OF "B")
; AA/ "DESTINATION" POINTER (WORD ADDRESS, INDEXED OFF OF "B")
NRMDL7: MOVE TT,@A ;FETCH NEXT SOURCE WORD
LSHC T,(C) ;COMBINE WITH PREVIOUS LEFTOVERS
LSH T,1 ;LEFT-JUSTIFY (CLEARING BIT 35)
MOVEM T,@AA ;STORE THIS DESTINATION WORD
LSHC T,(D) ;REMAINDER OF THIS SOURCE WORD (RIGHT JUSTIFIED)
AOJLE B,NRMDL7 ;LOOP FOR ENTIRE SOURCE STRING
NRMDL9: POP P,T ;RETRIEVE TO-BE-PRESERVED INITIAL BITS
DPB T,NRMPTR ;AND RESTORE THEM INTO INITIAL DESTINATION WORD
POP P,C ;RETRIEVE DELETION COUNT
JRST NROOMZ ;RETURN, UPDATING "Z" AND RESTORING THE ACS
SUBTTL MEMORY MANAGEMENT - GARBAGE COLLECTION
GC: SETOM GCPTR ;GCPTR:=-1
SETZM TAGSYM ;CLEAR "O" COMMAND TAG SYMBOL TABLE
MOVE T,[XWD TAGSYM,TAGSYM+1] ;IT WILL BE REBUILT AS NEEDED
BLT T,SYMEND-1 ;BY SUBSEQUENT "O" COMMANDS
MOVEI T,COMPTR ;COMMAND BUFFER
PUSHJ P,GCMBP ;GARBAGE-COLLECT IT AS A BYTE POINTER
MOVEI T,-1(P) ;PROGRAM STACK
PUSHJ P,GCMBP ;GARBAGE COLLECT ALL BYTE POINTERS ON IT.
CAILE T,PDLST
SOJA T,.-2
HRRZ T,AC0+PF ;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
CAIL T,PFL
PUSHJ P,GCMQR
CAILE T,PFL
SOJA T,.-2
MOVE T,[XWD -QTBLEN,QTAB] ;GARBAGE COLLECT Q-REGISTERS.
PUSHJ P,GCMQR
AOBJN T,.-1
MOVE I,BEG ;MAKE SURE STUFF BEFORE BEG IS COLLECTED
MOVEI T,0 ;MARK THIS AS LAST COLLECTION
PUSHJ P,GCMQR3 ;STORE IT ON THE GC LIST
;COMPACT QREG STRING STORAGE AREA
MOVE I,QRBUF ;I: NEXT FREE ADDR. TO USE
;FIND STRING WITH LOWEST ADDRESS IN AREA
GCS10: MOVSI TT,200000 ;TT GT MAX. NO. CHARACTERS IN WORLD
MOVE OU,GCPTR ;GO BACKWARDS THROUGH GCTAB
GCS11: MOVE A,GCTABC(OU) ;GET CHARACTER ADDRESS OF STRING FOUND ABOVE
CAMGE A,I ;PTR ABOVE AREA ALREADY DONE?
JRST GCS12 ;NO, NOT INTERESTED
CAMGE A,TT ;THIS LOWEST PTR IN GC AREA?
MOVE TT,A ;YES, REMEMBER IT
GCS12: SOJGE OU,GCS11
CAMN TT,[1B1] ;ANYTHING IN GCTAB?
JRST GCS40 ;NO, DON'T SAVE INFINITY
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;HAVE FOUND A STRING, MOVE IT AND EVERYTHING AFTER IT DOWN TO
;LOWEST FREE ADDRESS.
GCS20: SKIPG A,NRMGCZ ;CALLED FROM YANK6?
MOVE A,Z ;NO, USE "NORMAL Z" ADDRESS
IDIVI A,5 ;WORD ADDRESS . . .
MOVE AA,TT ;HIGHEST CHARACTER.
IDIVI AA,5 ;LENGTH OF STRING
MOVE B,I ;TEXT ADDRESS TO BLT TO
IDIVI B,5 ;WORDS TO OFFSET
CAIE E,0 ;FRACTIONATED WORD?
AOS B ;YES, ROUND UP
MOVE T,AA ;SOURCE ADDRESS
SUB T,B ;COMPUTE DISTANCE OF MOVE
JUMPLE T,GCS40 ;ANYTHING TO GET?
SUB A,T ;FINAL DESTINATION (SOURCE MINUS DISTANCE)
SKIPE SECTN ;NORMAL OR EXTENDED BLT NEEDED?
JRST GCS24 ;EXTENDED
;SECTION-0 BLT NEEDED
GCS23: HRL B,AA ;GENERATE SOURCE,,DEST ADDRESS POINTER TO
BLT B,(A) ;MOVE STRING(S) DOWN
JRST GCS25 ;GO RELOCATE THINGS
;EXTENDED SECTION BLT NEEDED
GCS24: SUB A,B ;NUMBER OF WORDS TO BE BLT'ED
ADDI A,1 ;DON'T FORGET THE LAST WORD
EXTEND A,[XBLT] ;MOVE STRING(S) DOWN
GCS25: MOVNS OU,T ;GET NEG DISTANCE
IMULI OU,5 ;IN TERMS OF CHARACTERS
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;NOW RELOCATE MOST OF THE WORLD'S POINTERS
; T/ WORD COUNT
; OU/ BYTE COUNT
GCS30: 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
MOVSI AA,-SCRNRL ;INDEX INTO TABLE OF SCREEN POINTERS
GCS32: ADDM OU,@SCRNRP ;RELOCATE SCREEN
AOBJN AA,.-1 ;RELOCATE REST OF POINTERS
MOVE CH,GCPTR ;UPDATE INSERTER
GCS33: MOVE A,GCTABC(CH) ;CHARACTER ADDRESS OF STRING
CAMGE A,TT
JRST GCS39
ADDM OU,GCTABC(CH) ;RELOCATE PTR
HRRZ A,GCTABA(CH) ;GET ADDRESS OF CHARACTER ADDRESS
JUMPE A,GCS39 ;NO PTR TO BEG
CAIN A,COMPTR ;IN COMMAND BUFFER?
ADDM T,CRREL ;YES. UPDATE COMMAND POINTER RELOCATION
SKIPGE (A) ;Q-REG?
JRST GCS37 ;YES, RELOCATE TEXT ADDRESS
SKIPE SECTN ;NO, BYTE POINTER. PC IN EXTENDED SECTION?
ADDI A,1 ;YES, FULL WORD ADDRESS FOLLOWS POINTER
ADDM T,(A) ;RELOCATE WORD ADDRESS
JRST GCS39 ;CHECK OUT REST OF GCTAB?
GCS37: ADDM OU,(A) ;YES. RELOCATE BASE POINTER.
GCS39: SOJGE CH,GCS33 ;DONE?
ADD TT,OU ;YES. IN:=C(TT)-5*NREG
GCS40: CAML TT,BEG ;LAST COLLECTION?
POPJ P, ;YES, RETURN
MOVE I,TT
PUSH P,C
PUSHJ P,GTQCNT
ADD I,C
POP P,C
JRST GCS10
;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMBP: 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,2(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
SKIPE SECTN ;PC IN EXTENDED SECTION?
SKIPA TT,1(T) ;YES, FETCH DOUBLE-WORD POINTER ADDRESS
HRRZ TT,(T) ;NO, POINTER WORD ADDRESS (UNRELOCATED)
IMULI TT,5 ;5*ADDRESS
ADD TT,TT1
SUBM TT,I ;5*ADDRESS-NO. CHARS+2+CT-MAX
JRST GCMQR2
;MARK ACTIVE QREG STRING
; T: ADDRESS OF QREG STRING PTR
GCMQR: MOVE I,(T)
TLZE I,400000 ;DOES Q-REG CONTAIN TEXT?
TLZE I,300000
POPJ P, ;NO
ADD I,QRBUF ;YES. ENTER POINTER IN GCTAB
GCMQR2: CAML I,BEG ;REGION BEFORE TEXT BUFFER?
POPJ P, ;NO. FORGET IT.
CAMGE I,QRBUF ;IN Q-REG STORAGE AREA?
POPJ P, ;NO, FORGET IT.
GCMQR3: AOS TT,GCPTR ;YES. TO BE GRABBED.
CAIL TT,GCTBLN ;AM I WINNING?
$FATAL (GCE,,<Garbage collector error>)
HRRZM T,GCTABA(TT) ;SAVE ADDRESS OF STRING POINTER
MOVEM I,GCTABC(TT) ;SAVE CHARACTER ADDRESS OF STRING
POPJ P, ;DONE THIS POINTER
;SHRINK - TRY TO SHRINK DOWN ACTIVE PHYSICAL MEMORY USAGE IF FEASIBLE
SHRINK: MOVE T,Z ;LAST ACTIVE TEXT ADDRESS
ADDI T,<XSPGMX*PAGSIZ*5> ;"EXCESS" ALLOCATION (MODULO CHARACTERS)
CAML T,MEMSIZ ;GOT TOO MUCH EXCESS MEMORY ALLOCATED?
POPJ P, ;NO, ALL SET
;QUERY: IS IT WORTHWHILE TO DO A GARBAGE COLLECT HERE?
MOVE T,MEMSIZ ;CURRENT MEMORY LIMIT (TEXT)
IDIVI T,5 ;CURRENT MEMORY LIMIT (WORDS)
LSH T,WRD2PG ;TRUNCATE TO CURRENT LAST PAGE
MOVE TT,Z ;CURRENT END OF TEXT (TEXT)
IDIVI TT,5 ;CURRENT END OF TEXT (WORDS)
MOVE TT1,TT ; (COPY)
IORI TT1,PAGSIZ-1 ;ROUND UP TO LAST WORD WITHIN NEW LAST PAGE
;FF MOVEM TT1,.JBFF ;SET NEW FIRST FREE POINTER
IMULI TT1,5 ;A:=LAST BYTE ADDRESS IN NEW LAST PAGE
MOVEM TT1,MEMSIZ ;SET NEW SIZE OF MEMORY
LSH TT,WRD2PG ;TRUNCATE TO NEW LAST MEMORY PAGE
SUB T,TT ;T:=COUNT OF PAGES TO BE DELETED
ADDI TT,1 ;TT:=FIRST PAGE TO BE DELETED
PUSHJ P,PGDES ;FREE UP THE EXCESS MEMORY PAGES
HALT .+1 ;DUH?
POPJ P, ;ALL DONE HERE
SUBTTL MEMORY MANAGEMENT - MEMORY ALLOCATION
;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.
GRABAK: PUSHJ P,GRABAC ;SAVE SOME ACS
IDIVI T,5 ;T:=DESIRED HIGHEST WORD ADDRESS
ADDI T,1 ;(MEMSIZ ITSELF IS A BUFFER WORD)
LSH T,WRD2PG ;T:=DESIRED HIGHEST PAGE ADDRESS
MOVE TT1,T ;(COPY)
MOVE TT,MEMSIZ ;CURRENT Q-REG/TEXT AREA LIMIT
MOVEM TT,OJBFF ;(SAVE IN CASE OF ERROR)
IDIVI TT,5 ;TT:=CURRENT HIGHEST WORD ADDRESS
LSH TT,WRD2PG ;TT:=CURRENT HIGHEST PAGE ADDRESS
SUB T,TT ;T:=COUNT OF PAGES NEEDED
ADDI TT,1 ;TT:=FIRST PAGE TO ALLOCATE
CAIL TT,DSECTN*1000 ;ALLOCATING IN EXTENDED DATA SECTIONS?
JRST GRABK4 ;YES, GO FOR IT!
;VERIFY THAT PAGE WON'T RUN INTO RANDOM PAGES OR HISEG
MOVE TT1,T ;COUNT OF PAGES TO ALLOCATE
ADD TT1,TT ;TT1:=PROPOSED NEW FIRST NON-EX PAGE
CAIL TT1,HIORGP ;REQUEST RUN INTO HIGH SEGMENT?
JRST GRABKF ;YES, THEN DEFINITELY WON'T FIT
SKIPN IOFIR ;IOFIR BEEN SET YET?
JRST GRABK4 ;NO, THEN WE'RE OK
CAML TT1,IOFIR ;WILL EXPANSION RUN INTO I/O BUFFERS
; (NOTE THAT A NON-EX PAGE MUST BE KEPT
; BETWEEN LOW SEGMENT AND I/O BUFFERS IN
; ORDER TO PROTECT .JBREL!)
JRST GRABKF ;YES, NO ROOM
;HERE WITH ENOUGH ROOM AVAILABLE TO EXPAND THE LOW SEGMENT.
GRABK4: PUSHJ P,PGCRE ;ALLOCATE NEW PAGES
JRST GRABKE ;CAN'T EVEN GET VIRTUAL MEMORY!
GRABK6: ADD T,TT ;FIRST NEW NON-EX PAGE
SUBI T,1 ;NEW LAST Q-REG/TEXT AREA PAGE
LSH T,PG2WRD ;WORD ADDRESS
IORI T,PAGSIZ-1 ;LAST WORD IN NEW LAST PAGE
IMULI T,5 ;LAST CHAR IN NEW LAST PAGE
MOVEM T,MEMSIZ ;SET NEW Q-REG/TEXT AREA LIMIT
JRST CPOPJ1 ;EXIT SUCCESSFULLY
;NO CORE AVAILABLE (OR NOT ENOUGH)
GRABKE: DMOVE T,OJBFFT ;RETRIEVE CREATION QUANTITY (FROM PGCRE)
PUSHJ P,PGZAP ;MAKE SURE DOESN'T PLAGUE US
JFCL ;SIGH
GRABKF: MOVE T,OJBFF ;GET LAST FIGURE OF CORE BOUND
MOVEM T,MEMSIZ ;RESTORE IT
POPJ P, ; AND RETURN ERROR
;GRABAC - AC-SAVE COROUTINE FOR GRABAK
GRABAC: PUSH P,T ; . . .
PUSH P,TT ; . . .
PUSH P,TT1 ; . . .
PUSHJ P,@-3(P) ;COROUTINE BACK TO GRAB?? (OR WHOMEVER)
CAIA ;ERROR RETURN
AOS -4(P) ;SUCCESSFUL (SKIP) RETURN
POP P,TT1 ; . . .
POP P,TT ; . . .
POP P,T ; . . .
ADJSP P,-1 ;DISCARD NOW-USELESS COROUTINE CALLER PC
POPJ P, ;RETURN AS DIRECTED
U OJBFF,1 ;HOLD .JBFF IN CASE OF GROWTH PAINS
U OJBFFT,2 ;T AND TT TO RECOVER FOR PARTIAL GROWTH
U TOOBIG,1 ;WHEN AOS'ED TO 0 TRY TO SHRINK MEMORY
SUBTTL MEMORY MANAGEMENT - PAGE MANIPULATION
;GETPG -- FIND AND ALLOCATE SOME FREE PAGES
;GETPW -- SAME, BUT WITH WORD ARGUMENTS
;CALL IS:
;
; MOVX A,<COUNT>
; PUSHJ P,GETPG/GETPW
; ERROR RETURN
; NORMAL RETURN
;
;WHERE <COUNT> IS A COUNT OF WORDS NEEDED IF CALL TO GETPW OR A COUNT
;OF THE PAGES NEEDED IF A CALL TO GETPG.
;
;ON ERROR RETURN NO FREE PAGES ARE AVAILABLE (OR NOT ENOUGH TO SATISFY
;REQUEST).
;
;ON NORMAL RETURN <COUNT> PAGES HAVE BEEN FOUND AND ALLOCATED. THE PAGE
;ADDRESS IS RETURNED IN AA.
;
;USES T, TT, TT1.
GETPW: ADDI A,PAGSIZ-1 ;ROUND UP AND
LSH A,WRD2PG ;TRUNCATE TO PAGE COUNT
GETPG: PUSHJ P,FNDPG ;SEE IF ANY PAGES AVAILABLE
POPJ P, ;NOPE, ERROR RETURN
DMOVE T,A ;YES, POSITION COUNT AND PAGE ADDRESS
PUSHJ P,PGCRE ;GRAB THE FREE PAGES
POPJ P, ;MONITOR BEING STINGY
SKIPE IOFIR ;THIS THE FIRST I/O AREA IN USE?
CAMGE AA,IOFIR ; OR IS THIS AREA ABOVE PREVIOUS BUFFER AREA?
MOVEM AA,IOFIR ;YES, SET NEW FIRST I/O AREA
JRST CPOPJ1 ;TAKE SUCCESSFUL RETURN
;FREPG -- FREE UP PAGES
;PREPW -- SAME AS FREPG BUT WITH WORD ARGUMENTS
;CALL IS:
;
; MOVX A,<COUNT>
; MOVX AA,<ADDR>
; PUSHJ P,FREPG/FREPW
; ERROR RETURN
; NORMAL RETURN
;
;WHERE <COUNT> IS THE WORD COUNT IF CALL TO FREPW OR THE PAGE COUNT IF CALL
;TO FREPG OF THE PAGES TO BE FREED; <ADDR> IS THE WORD ADDRESS IF CALL TO
;FREPW OR PAGE ADDRESS IF CALL TO FREPG OF THE FIRST PAGE TO BE FREED.
;
;ERROR RETURN CANNOT OCCUR.
;
;ON NORMAL RETURN THE SPECIFIED PAGES HAVE BEEN DEALLOCATED.
;
;USES T, TT, TT1.
FREPW: ADDI A,PAGSIZ-1 ;ROUND UP AND
LSH A,WRD2PG ;TRUNCATE TO PAGE COUNT
LSH AA,WRD2PG ;TRUNCATE TO PAGE ADDRESS
FREPG: DMOVE T,A ;POSITION COUNT AND ADDRESS
PUSHJ P,PGDES ;DESTROY THE PAGES
HALT .+1 ;BLETCH
CAME AA,IOFIR ;WAS THIS FIRST I/O AREA?
JRST CPOPJ1 ;NO
MOVE TT,AA ;YES, IT WAS
ADD T,A ;SKIP PAST JUST-DEALLOCATED AREA
FREPG3: AOS T,TT ;ADVANCE TO NEXT PAGE
HRLI T,.PAGCA ;MAKE PAGE. ARG BLOCK TO
PAGE. T, ;ASK MONITOR ABOUT THE PAGE
CAIA ;DUH?
JUMPL TT1,FREPG3 ;IF PAGE DOESN'T EXIST KEEP LOOKING
.CREF PA.GNE ;THE APPROPRIATE SYMBOL
MOVEM TT,IOFIR ;PAGE EXISTS, MARK FIRST PAGE IN USE
; NOTE THIS MAY WELL BE THE HIGH SEGMENT!
JRST CPOPJ1 ;RETURN
;FNDPG -- FIND FREE PAGES
;CALL IS:
;
; MOVX A,<COUNT>
; PUSHJ P,FNDPG
; ERROR RETURN
; NORMAL RETURN
;
;WHERE <COUNT> IS THE NEEDED COUNT OF CONTIGUOUS FREE PAGES.
;
;ON ERROR RETURN THERE ARE NOT ENOUGH CONTIGUOUS FREE PAGES AVAILABLE.
;
;ON NORMAL RETURN A HAS THE COUNT AND AA HAS THE PAGE ADDRESS OF THE
;FIRST FREE PAGE WHICH MATCHS.
;
;USES T, TT, TT1.
FNDPG: MOVE TT,.JBREL ;LAST ADDRESS IN LOW SEGMENT
ADDI TT,PAGSIZ ;ROUND UP AND
LSH TT,WRD2PG ;TRUNCATE TO FIRST FREE PAGE PAST LOW SEGMENT
ADD TT,SECTNP ;RELOCATE TO PC SECTION
MOVEI AA,HIORGP ;WHERE TO START THE PAGE SEARCH
ADD AA,SECTNP ;RELOCATE TO PC SECTION
FNDPG2: MOVE T,A ;[P]RESET THE PAGE COUNT NEEDED
FNDPG3: SOS TT1,AA ;NEXT PAGE TO TRY
CAMG TT1,TT ;HIT LOW SEGMENT YET?
; (MUST ALWAYS KEEP ONE FREE PAGE AFTER .JBREL
; IN ORDER TO PROTECT .JBREL)
POPJ P, ;YES, NO FREE PAGES THEN
HRLI TT1,.PAGCA ;NO, MAKE PAGE. ARG BLOCK TO
PAGE. TT1, ;SEE IF PAGE EXISTS
POPJ P, ;DUH?
JUMPGE TT1,FNDPG2 ;IF PAGE EXISTS RESTART SEARCH
.CREF PA.GNE ;CREF REFERENCE TO APPROPRIATE SYMBOL
SOJG T,FNDPG3 ;PAGE IS AVAILABLE - FOUND ENOUGH YET?
JRST CPOPJ1 ;YES - ALL SET THEN
;PGCRE -- CREATE [ALLOCATE] MEMORY PAGES
;PGCRP -- CREATE [ALLOCATE] MEMORY PAGES, PHYSICAL
;PGCRV -- CREATE [ALLOCATE] MEMORY PAGES, VIRTUAL
;PGDES -- DESTROY [DEALLOCATE] MEMORY PAGES
;PGZAP -- DESTROY [OK IF NON-EXISTENT] MEMORY PAGES
;PSZAP -- DESTROY [OK IF NON-EXISTENT] MEMORY SECTIONS (512 PAGES)
;PGMDN -- MOVE PAGES DOWN [TOWARDS HIGH SEGMENT]
;PGMUP -- MOVE PAGES UP [TOWARDS 0]
;PGPIN -- PAGE IN [FROM SWAPPING SPACE] MEMORY PAGES
;PGPOU -- PAGE OUT [TO SWAPPING SPACE] MEMORY PAGES
;CALL IS:
;
; MOVX T,<COUNT>
; MOVX TT,<PAGE>
; PUSHJ P,P1XXX/PGXXX
; ERROR RETURN
; NORMAL RETURN
;
;WHERE <PAGE> IS THE PAGE NUMBER OF THE FIRST PAGE TO BE AFFECTED
;(CREATED, MOVED, ETC.) AND <COUNT> IS THE COUNT OF CONSECUTIVE PAGES
;AFFECTED. CALL AT P1XXX WITHOUT SETTING UP T IF THE COUNT IS ONE.
;
;ON ERROR RETURN A FATAL ERROR (PAGING I/O ERROR, ETC.) HAS OCCURRED.
;THE ERROR CODE (PAG??%) IS IN AC T.
;
;ON NORMAL RETURN, THE APPROPRIATE PAGES HAVE BEEN WHATEVERED.
;
;USES T, TT, TT1
;CREATE [ALLOCATE] PAGES
P1CRE: MOVEI T,1 ;COUNT OF ONE
PGCRE: DMOVEM T,OJBFFT ;HANG ONTO ALLOCATION QUANTITIES
PUSHJ P,PGCRP ;TRY FOR PHYSICAL ALLOCATION
CAIA ;CAN'T ALLOCATE PHYSICALLY
JRST PGCRE7 ;GOT 'EM, SUCCESSFUL RETURN
CAIE T,PAGLE% ;[PHYSICAL] LIMIT EXCEEDED?
POPJ P, ;NO, FATAL ERROR, ABORT
DMOVE T,OJBFFT ;YES, TRY AGAIN, BUT THIS TIME
PUSHJ P,PGCRV ;TRY FOR VIRTUAL ALLOCATION
POPJ P, ;NO GO
PGCRE7: DMOVE T,OJBFFT ;RESTORE CALLER'S ARGS
JRST CPOPJ1 ;AND RETURN SUCCESSFULLY
;CREATE [ALLOCATE] PAGES (PHYSICALLY IN MEMORY)
P1CRP: MOVEI T,1 ;COUNT OF ONE
PGCRP: MOVSI TT1,.PAGCD ;CREATE FUNCTION
PUSH P,. ;NO IGNORABLE ERROR
PJRST PGUUO ;GO DO PAGE.(S)
;CREATE [ALLOCATE] PAGES (VIRTUALLY ON DISK, "ALLOCATED BUT ZERO")
P1CRV: MOVEI T,1 ;COUNT OF ONE
PGCRV: MOVSI TT1,.PAGCD ;CREATE FUNCTION
TXO TT,PA.GCD ;"ALLOCATED BUT ZERO"
PUSH P,. ;NO IGNORABLE ERROR
PJRST PGUUO ;GO DO PAGE.(S)
;DESTROY [DEALLOCATE] PAGES
P1DES: MOVEI T,1 ;COUNT OF 1
PGDES: MOVSI TT1,.PAGCD ;DESTROY FUNCTION
TXO TT,PA.GAF ; (OTHER HALF OF DESTROY FUNCTION)
PUSH P,. ;NO IGNORABLE ERROR
PJRST PGUUO ;GO DO PAGE.(S)
;ZAP [DEALLOCATE] PAGES, OK IF NONE
P1ZAP: MOVEI T,1 ;COUNT OF 1
PGZAP: MOVSI TT1,.PAGCD ;DESTROY FUNCTION
TXO TT,PA.GAF ; (OTHER HALF OF DESTROY FUNCTION)
PUSH P,[PAGME%] ;IGNORABLE ERROR
PJRST PGUUO ;GO DO PAGE.(S)
;ZAP [DEALLOCATE] SECTIONS, OK IF NONE
PSZAP: MOVSI TT1,.PAGSC ;DESTROY (SECTIONS) FUNCTION
TXO TT,PA.GAF ; (OTHER HALF OF DESTROY FUNCTION)
PUSH P,[PAGSM%] ;IGNORABLE ERROR
PJRST PGUUO ;GO DO PAGE.(S)
;MOVE PAGES DOWN IN ADDRESSING SPACE
P1MDN: MOVEI T,1 ;COUNT OF 1
PGMDN: PUSH P,T ;SAVE COUNT
HRL T,T ;PAGE ADDRESS IN BOTH HALVES
ADD TT,T ;POINT TO LAST PAGE TO BE MOVED
PGMDN2: MOVEI T,1 ;MOVE ONE PAGE AT A TIME
MOVE TT1,[.PAGEM,,T] ;MOVE PAGE FUNCTION
PAGE. TT1, ;MOVE ONE PAGE DOWN IN MEMORY
JRST PGMDN9 ;ANY ERROR IS FATAL
SUB TT,[1,,1] ;MOVE BACKWARDS ONE PAGE
SOSLE 0(P) ;NEED TO MOVE IT TOO?
JRST PGMDN2 ;YES
AOS -1(P) ;NO, ALL PAGES SUCCESSFULLY MOVED
PGMDN9: POP P,T ;ADJUST STACK
POPJ P, ;RETURN AS APPROPRIATE
;MOVE PAGES UP IN ADDRESSING SPACE
P1MUP: MOVEI T,1 ;COUNT OF 1
PGMUP: MOVSI TT1,.PAGEM ;MOVE FUNCTION
PUSH P,[-1] ;ALL ERRORS FATAL
PJRST PGUUO ;GO DO PAGE.(S)
;PAGE IN [FROM SWAPPING SPACE] MEMORY PAGES
P1PIN: MOVEI T,1 ;COUNT OF 1
PGPIN: MOVSI TT1,.PAGIO ;PAGEIN FUNCTION
PUSH P,[PAGCI%] ;IGNORABLE ERROR
PJRST PGUUO ;GO DO PAGE.(S)
;PAGE OUT [TO SWAPPING SPACE] MEMORY PAGES
P1POU: MOVEI T,1 ;COUNT OF 1
PGPOU: MOVSI TT1,.PAGIO ;PAGEOUT FUNCTION
TXO TT,PA.GAF ; (OTHER HALF OF PAGEOUT FUNCTION CODE)
PUSH P,[PAGMI%] ;IGNOREABLE ERROR
PJRST PGUUO ;GO DO PAGE.(S)
;PGUUO -- DO REAL WORK OF PGXXX ROUTINES
PGUUO: PUSH P,TT1 ;SAVE FUNCTION CODE
PUSH P,T ;SAVE REPEAT COUNT IN CASE NEEDED LATER
HRRI TT1,T ;ADDRESS OF PAGE. ARG BLOCK
MOVNS T ;NEGATIVE COUNT = REPEAT COUNT
PAGE. TT1, ;TRY OUR BEST SHOT
CAIA ;BUTTS, MUST NOT BE IMPLEMENTED
JRST PGUUO5 ;SUCCESS - RETURN NOW
IFN RUN603,< ;6.03 RETURNS YET A DIFFERENT ERROR
CAIN TT1,PAGIA% ;"ILLEGAL ARGUMENT"?
MOVEI TT1,PAGIP% ;YES, FAKE OUT CODE BELOW
> ;END IFN RUN603
CAIE TT1,PAGIP% ;STUPID MONITOR'S ERROR CODES
CAMN TT1,-2(P) ;THIS ERROR RECOVERABLE?
CAIA ; . . .
JRST PGUUO9 ;NOPE, FATAL, GO AWAY NOW
;TRY IT THE HARD WAY - ONE PAGE AT A TIME
PGUUO2: MOVE TT1,-1(P) ;RETRIEVE FUNCTION CODE
HRRI TT1,T ;ADDRESS OF PAGE. ARG BLOCK
MOVEI T,1 ;ONE PAGE AT A TIME
PAGE. TT1, ;FUNCTIONIZE JUST THIS ONE PAGE
JRST PGUUO8 ;CHECK OUT THE ERROR
PGUUO3: TLNE TT,77777 ;MOVE-TYPE FUNCTION CODE?
ADD TT,[1,,0] ;YES, ADJUST LEFT HALF TOO
SOSLE 0(P) ;COUNT DOWN REPEAT COUNTER
AOJA TT,PGUUO2 ;GO DO ANOTHER PAGE
PGUUO5: ADJSP P,-3 ;ADJUST THE STACK
JRST CPOPJ1 ;SUCCESSFUL (USUALLY) RETURN
;CHECK OUT PAGE. ERROR
PGUUO8: CAMN TT1,-2(P) ;EXPECTING THIS TYPE OF ERROR?
JRST PGUUO3 ;YEAH, JUST IGNORE THIS PAGE
PGUUO9: MOVE T,TT1 ;NO, FATAL, PUT ERROR CODE IN T
ADJSP P,-3 ;CLEAN UP THE STACK
POPJ P, ;AND PROPAGATE THE ERROR
SUBTTL COMMAND DISPATCH TABLE
DEFINE DSP (C1,A1,C2,A2)<
XWD <<C1>B20+<A1-<HIORGP_PG2WRD>>>,<<C2>B20+<A2-<HIORGP_PG2WRD>>>>
;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,ERRA) ;^B ^C
DSP(JR,TDDT,JR,FFEED) ;^D ^E
DSP(JR,LAT,JR,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(JR,ERRA,JR,ERRA) ;^P ^Q
DSP(JR,ERRA,JR,ERRA) ;^R ^S
DSP(MV,CMCCT,JR,ERRA) ;^T ^U
DSP(MV,LOWCAS,MV,STDCAS) ;^V ^W
DSP(MV,SETMCH,JR,ERRA) ;^X ^Y
DSP(JR,FINISZ,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,MV,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,JR,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,LCMD,JR,MAC) ;L M
DSP(MV,SERCHP,JR,OCMD) ;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,ERRA) ;V W
DSP(MV,XCMD,HR,YANK) ;X Y
DSP(JR,END1,MV,OPENB) ;Z [
DSP(MV,BAKSL,MV,CLOSEB) ;BKSLH ]
DSP(JR,UAR,MV,LARR) ;^ LFTARR
XLIST ;THE LITERALS
LIT
LIST
SUBTTL GENERAL IMPURE STORAGE
U PDLST0,1 ;"TOP" OF STACK (FLAG 0, SEE "GO")
U PDLST,PDLEN ;PROGRAM STACK
U PSIVEC,4 ;BASE OF PSI VECTORS
U PSICCV,4 ;CONTROL-C INTERUPT VECTOR
;GENERAL MEMORY CONTROL AND RELATED STUFF
U SECTN,1 ;SECTION,,0 IN WHICH DTECO IS RUNNING
U SECTNP,1 ;PAGE OFFSET FOR SECTN
U RMWBAS,1 ;RANDOM MEMORY BASE ADDRESS (WORDS)
U RMWEND,1 ;RANDOM MEMORY END ADDRESS (WORDS)
U CMDBAS,1 ;COMMAND BUFFER BASE ADDRESS (WORDS)
U CMDEND,1 ;COMMAND BUFFER END ADDRESS (WORDS)
U CMDPTR,1 ;COMMAND BUFFER BYTE POINTER (MASTER COPY)
U CMDPTX,1 ; (DOUBLE-WORD POINTER ADDRESS)
;*** DO NOT SEPARATE *** SEE GC ROUTINE***
U COMMAX,1 ;TOTAL CHARACTERS AT CURRENT COMMAND LEVEL
U COMPTR,1 ;EXECUTION-TIME COMMAND STRING BYTE POINTER
U COMPTX,1 ; (DOUBLE-WORD POINTER ADDRESS)
U COMCNT,1 ;CHARACTERS REMAINING AT CURRENT COMMAND LEVEL
U QRBUF,1 ;Q-REG/TEXT AREA BASE ADDRESS (CHARACTERS)
; (THE Q-REGS FIT 'TWEEN QRBUF AND BEG)
;*** DO NOT SEPARATE ***
U BEG,1 ;EDITING TEXT BASE ("B") ADDRESS (CHARACTERS)
U PT,1 ;EDITING TEXT POINT (".") ADDRESS (CHARACTERS)
U Z,1 ;EDITING TEXT END ("Z") ADDRESS (CHARACTERS)
U MEMSIZ,1 ;Q-REG/TEXT AREA END ADDRESS (CHARACTERS)
;GARBAGE COLLECTION (GC) DATA
U GCPTR,1 ;INDEX INTO GCTABA/GCTABC
U GCTABA,GCTBLN ;ADDRESS OF STRING POINTER FOR GC
U GCTABC,GCTBLN ;CHARACTER ADDRESS OF STRING FOR GC
U CRREL,1 ;
U RREL,1 ;
;CORRECT FOR 2/3 BUFFER FILLING ERROR.M23 IS 2/3'S AND M23PL IS 2/3
;PLUS THE OTHER THIRD-128 CHARACTERS.
U M23,1 ;
U M23PL,1 ;
;SWITCH STORAGE FOR SWITCH.INI SWITCHES
U S.CRDI,1 ;.LT. 0 IGNORE
;.EQ. 1 THEN NO CRASH RECOVERY FILE
;.EQ. 2 THEN DELETE FILE ON EXIT
;.EQ. 3 THEN PRESERVE FILE ON EXIT
U S.CRPR,1 ;.GE. 0 THEN CRASH RECOVERY FILE PROTECTION
U S.CRSA,1 ;.GE. 0 THEN TEBSAV VALUE
U S.EAMO,1 ;.LT. 0 IGNORE
;.EQ. 0 DEFAULT NO EA ON ER
;.GT. 0 DEFAULT EA ON ER
U S.EOMO,1 ;.GE. 0 THEN EO VALUE IF TIMESHARING
U S.EOBA,1 ;.GE. 0 THEN EO VALUE IF BATCH
U S.OKLS,1 ;.LT. 0 IGNORE
;.EQ. 0 THEN SUPPRESS LSNS ON INPUT
;.GT. 0 THEN LSNS ARE "OK" ON INPUT
U S.OKNU,1 ;.LT. 0 THEN IGNORE
;.EQ. 0 THEN SUPPRESS NULLS IN INPUT
;.GT. 0 THEN NULLS ARE OK IN INPUT FILE
U S.SFT,1 ;.NE. 0 THEN NO [TECSFT ...] MESSAGES
BOSWT==S.CRDI ;START OF SWITCHES AREA
EOSWT==S.SFT ;END OF SWITCHES AREA
U S.CRFI,.FXLEN ;CRASH FILE SPEC SCAN BLOCK
U S.INIT,.FXLEN ;INIT FILE SPEC SCAN BLOCK
U CCLSW,1
U LISTF5,1 ;OUTPUT DISPATCH
U AC0,20-1 ;SAVE AC0-AC16 IN NROOM ROUTINE
U CHTB,1 ;CONTROL CHARACTER DISPATCH TABLE
;Search stuff
U SCHCTR,1 ;# OF CHARS IN SEARCH ARGUMENT (MUST PRECEDE SCHARG)
U SCHARG,<<SRCHMX/5>+1> ;STORE FOR SEARCH ARGUMENT
U SCHPT,1 ;SAVED START OF SEARCH POINT
U SCHCNT,1 ;SEARCH COUNT STORE
U SCHPTR,1 ;SLOW-SEARCH'S "STATIC" BYTE POINTER
U SCHPTX,1 ;SLOW-SEARCH'S "STATIC" BYTE POINTER EXTENDED ADDRESS
U FSNTRM,1 ;FS, FN 2ND ARG TERMINATOR
U FSNCNT,1 ;STORE FOR COMCNT DURING FS, FN
U FSNPTR,1 ;DITTO COMPTR
U FSNPTX,1 ;DITTO COMPTX
; *** Do not separate vvv
U SMATRX,SMATXN ;The old TECO search bit table
U BITMAT,BITMLN*^D36 ;The new rotated search bit table
U DELTA2,^D36 ;The table which knows what the pattern looks like
SCLRLN==SMATXN+<BITMLN*^D36>+^D36
; *** Do not separate ^^^
U DELTA0,SMATXN ;The tables which know where characters are
U DELTA1,SMATXN ; in the pattern
U INDMAT,^D36 ;A table of indicies into the pattern
U PATLEN,1 ;Number of positions in pattern
U ROTLEN,1 ;Current distance from the right end of the pattern
U SCNEST,1 ;Nest level counter during searches, 0 if none
U SCHTYP,1 ;0 if old TECO search, -1 if new search
U SCTLGA,1 ;0 if pattern source has no ^Gi, -1 if it does
U CTGLEV,1 ;SEARCH FOR TEXT IN Q-REG NEST COUNTER
U STAB,STABLN ;SEARCH MATRIX
COMZR==STAB ;BEGINNING OF AREA TO ZERO
;WHEN ENTERING COMMAND SCANNER
COMBLK==COMZR ;COMMAND BLOCK (FOR FILE SPEC)
COMDEV=STAB ;DEVICE USER TYPED
COMNAM=COMDEV+1 ;FILENAME " "
COMEXT=COMNAM+1 ;EXTENSION " "
COMPPN=COMEXT+1 ;PPN " "
COMSFD=COMPPN+1 ;SFD'S " "
SWITC=COMSFD+5 ;SWITCHES " "
SWITHL=SWITC+1 ;LAST SWITCH TYPED, IN SIXBIT
COMBLN==SWITHL-COMBLK+1 ;LENGTH OF COM??? AREA
OPNBLK=<OPNSTS=SWITHL+1> ;STATUS TO DO OPEN WITH
OPNDEV=OPNSTS+1 ;DEVICE TO OPEN
OPNBUF=OPNDEV+1 ;BUFFER ADDRESS
OPNCHR=OPNBUF+1 ;DEVCHR OF DEVICE IN OPNDEV
PTHBLK=OPNCHR+1 ;1ST WORD OF PATH BLOCK
PTHFLG=PTHBLK+1 ;SCAN SWITCH & OTHER FLAGS
PTHPPN=PTHFLG+1 ;PROJ-PROG PAIR
PTHSFD=PTHPPN+1 ;FIRST SFD
PTHLEN==PTHSFD+5-PTHBLK+1 ;LENGTH OF PATH BLOCK
XFIBLK=PTHBLK+PTHLEN ;EXTENDED OPEN BLOCK
XFILNM==XFIBLK ;EXTENDED OPEN BLOCK
XCNT=XFILNM+.RBCNT ;COUNT OF ARGS FOLLOWING
XPPN=XFILNM+.RBPPN ;POINTER TO PATH BLOCK
XNAM=XFILNM+.RBNAM ;FILE NAME
XEXT=XFILNM+.RBEXT ;EXTENSION
XPRV=XFILNM+.RBPRV ;PROT. & DATES
XSIZ=XFILNM+.RBSIZ ;FILE SIZE (WORDS)
XVER=XFILNM+.RBVER ;VERSION
XSPL=XFILNM+.RBSPL ;SPOOLING NAME
XEST=XFILNM+.RBEST ;ESTIMATED SIZE
XALC=XFILNM+.RBALC ;BLOCKS ALLOCATED TO FILE
XPOS=XFILNM+.RBPOS ;POSITION OF FILE ON DISK
XNCA=XFILNM+.RBNCA ;NON-PRIVED CUST. ARG.
XDEV=XFILNM+.RBDEV ;UNIT OF STR THAT FILE CAME FROM
XFILEN==XDEV-XFILNM+1 ;LENGTH OF LOOKUP BLOCK
SFILNM==XNAM ;ALTERNATE NAME FOR DTA LOOKUPS
CPATH=XFILNM+XFILEN ;SECOND PATH BLOCK FOR CHKPTH
CFLG=CPATH+1 ;SCAN SWITCH
CPPN=CFLG+1 ;PPN
CSFD=CPPN+1 ;1ST SFD
CPTLEN==CSFD+5-CPATH+1 ;LENGTH OF PATH BLOCK
DCBLK=CPATH+CPTLEN ;DSKCHR BLOCK FOR EB OPEN
DCSNM=DCBLK+.DCSNM ;STRUCTURE NAME FILE IS ON
DCLEN==DCSNM-DCBLK+1 ;LENGTH OF DSKCHR BLOCK
COMEZR==DCBLK+DCLEN-1 ;LAST LOCATION TO ZERO IN SCANNER
IFL <STABLN-<COMEZR-COMZR+1>>,<PRINTX ? MOVE X??? BLOCKS TO BIGGER AREA>
U BCOUNT,1 ;BEGPAG MATCH FLAG FOR SLOSCH
;TAG SYMBOL TABLE USED BY "O" COMMAND FOR FAST EXECUTION
U TAGSYM,22 ;PSEUDO-POINTER USED TO IDENTIFY "O" COMMAND
U TAGPTR,22 ;COPY OF COMPTR FOR THIS "O" COMMAND
U TAGPTX,22 ;COPY OF COMPTX FOR THIS "O" COMMAND
U TAGCNT,22 ;COPY OF COMCNT FOR THIS "O" COMMAND
U SYMEND,0 ;END OF TAG SYMBOL TABLE (FOR BLT)
U EQM,1 ;LEVEL OF MACRO NESTING
U PFL,LPF ;Q-REGISTER STACK
U QTAB,QRGMAX ;Q-REGISTER TABLE
U COMSAV,1 ;SAVED Q-REG VALUE FOR *I
QTBLEN==QRGMAX+1 ;FOR GARBAGE COLLECTION (INCLUDES COMSAV
;AS A "HIDDEN" Q-REGISTER).
U COMLEN,1 ;LENGTH OF BASIC COMMAND STRING
U LOWERB,1 ;BOUNDED-SEARCH LOWER BOUND
U UPPERB,1 ;BOUNDED-SEARCH UPPER BOUND
U LOWEND,0 ;END OF THE IMPURE/LOWSEG
END TECO