github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 01:19:17 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/teco/teco.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

5499 lines
170 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE TECO VERSION 24A(235)
SUBTTL TEXT EDITOR AND CORRECTOR RC CLEMENTS/PMH/CAM/EAR/DML/JNG/BGS/DCE/MHK/CGN
EDIT==235
VERSION==XWD 2401,EDIT
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1971,1972,1975,1976,1977,1984,1985,1986. ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH UUOSYM,MACTEN ;[175]
; . . . EDIT 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 COLLCETION ROUTINE TO CHECK FOR
; ANYTHING TO SAVE PRIOR TO ATTEMPTING A BLT.
; AREAS AFFEDTED: GCS2
; 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, CMDBFR
; 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 .>2**18 WE WONT 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
;
;233 If TECO is editing a file in a non-default path with
; a prot. of <257>, it can't rename the source
; file to it's backup. The RENAME UUO to drop
; protection of the file causes loss of path info.
;
;234 None. BAH 2-Oct-84.
; Update copyrights.
;
;235 None. LEO 22-Aug-85
; Do copyrights.
;
;[END OF REVISION HISTORY]
;DEFAULT DEFINITIONS FOR ASSEMBLY SWITCHES & PARAMETERS:
IFNDEF CCL, <CCL== 1> ;CCL CAPABILITY
IFNDEF TEMP, <TEMP== 1> ;TMPCOR UUO CAPABILITY
IFNDEF PDP6, <PDP6== 0> ;PDP-10 VERSION
IFNDEF ERRMSG, <ERRMSG==2> ;MEDIUM LENGTH ERROR MESSAGES
IFNDEF NORUNS, <NORUNS==0> ;RUN UUO CAPABILITY
IFNDEF AUTOFS, <AUTOFS==0> ;DEFAULT IS NON-AUTOTYPE AFTER SEARCHES
IFNDEF TYCASW, <TYCASW==0> ;DEFAULT TYPE-OUT MODE CAUSES FLAGGING OF
;CHARACTERS IN THE LOWER CASE RANGE WITH '
IFNDEF SRCHSW, <SRCHSW==0> ;DEFAULT PREVAILING SEARCH MODE IS ACCEPT
;EITHER LC OR UC ALPHABETICS AS A MATCH
IFNDEF BUFSIZ, <BUFSIZ==^D128> ;128 WORD I/O BUFFERS
IFNDEF LPDL, <LPDL== 120> ;80 WORD PDL
IFNDEF LPF, <LPF== 40> ;32 WORD Q-REGISTER PDL
IFNDEF VC, <VC== 0> ;V COMMAND NOT IMPLEMENTED
IFNDEF EOVAL, <EOVAL== 2> ;THE STANDARD SETTING OF THE EO FLAG FOR
;THIS VERSION IS 2
IFNDEF BUGSW, <BUGSW==0> ;[140] STANDARD IS DON'T SAVE SYMBOLS
IFN BUGSW,<.TEXT "/SYMSEG:HIGH"> ;[226] LOAD SYMBOLS INTO
;[226] HI SEG IF DEBUGGING.
;FOR ANY OTHER VERSION ASSEMBLE AS FOLLOWS:
;.R MACRO
;*TECO_TTY:,DSK:TECO.MAC
;CCL=0 (IF CCL NOT WANTED)
;TEMP=0 (IF TMPCOR UUO NOT WANTED)
;PDP6=1 (IF PDP-6 VERSION WANTED)
;ERRMSG=1 (IF SHORT ERROR MESSAGES WANTED OR
; =3 IF EXTRA LONG ERROR MESSAGES WANTED)
;NORUNS=1 (IF RUN UUO SIMULATION WANTED)
;AUTOFS=-1 (IF DEFAULT = AUTOTYPE AFTER SEARCHES WANTED)
;TYCASW=1 (IF TYPE-OUT CASE FLAGGING DEFAULT VALUE
; TO FLAG UPPER CASE INSTEAD OF LOWER CASE
; CHARS. WANTED)
;TYCASW=-1 (IF TYPE-OUT CASE FLAGGING DEFAULT VALUE
; FOR NO FLAGGING WANTED)
;SRCHSW=1 (IF EXACT MODE WANTED AS THE DEFAULT VALUE
; OF THE PREVAILING SEARCH MODE)
;BUFSIZ=^D256 (IF 256-WORD I/O BUFFERS WANTED. ANY
; OTHER CONSTANT BESIDES 256 MAY BE USED.
; TECO USES STANDARD MONITOR BUFFERING,
; BUT IF THE MONITOR PROVIDES BUFFERS
; LARGER THAN 128 WORDS, BUFSIZ MUST BE
; CHANGED SO THAT SUFFICIENT SPACE IS
; RESERVED.
;LPDL=N (WHERE N>120, IF LARGER PDL WANTED)
;LPF=N (WHERE N>40, IF LARGER Q-REGISTER PDL WANTED)
;EOVAL=N (WHERE 0<N<2, IF EO-CONTROLLED FEATURES ADDED
; SINCE EO=N WAS STANDARD ARE NOT WANTED)
;BUGSW=1 (IF SAVE OF SYMBOL TABLE IS DESIRED)
;^Z
;^Z
;ACCUMULATOR ASSIGNMENTS
FF= 0 ;CONTROL FLAGS
P= 1 ;PUSH DOWN POINTER
;*** A, AA AND B MUST BE CONTIGUOUS AND IN THAT ORDER ***
A= 2
AA= 3 ;TYPE-IN POINTER TO COMMAND BUFFER & SEARCH TABLE INDEX
;*** B AND E MUST BE ADJACENT AND B<11 ***
B= 4 ;COMMAND BUFFER END ADDRESS
E= 5
C= 6
D= 7
F2= 10 ;MORE CONTROL FLAGS
T= 11
;*** TT AND TT1 MUST BE ADJACENT ***
TT= 12
TT1= 13
I= 14
OU= 15
CH= 16 ;CHARACTER AC
PF= 17 ;Q-REGISTER PDL PTR
;CONTROL FLAGS
;RIGHT HALF - AC FF
ALTF== 1 ;ALT-MODE SEEN
ARG2== 2 ;THERE IS A SECOND ARGUMENT
ARG== 4 ;THERE IS AN ARGUMENT
FSRCH== 10 ;REPLACEMENT SEARCH
SLSL== 20 ;@ SEEN
PCHFLG==40 ;N SEARCH
COLONF==100 ;COLON SEEN
SYLF== 200 ;SYLLABLE FLAG
XPLNFL==400 ;HAVE TYPED EXTENSION OF ERROR MESSAGE ALREADY
EMFLAG==1000 ;HAVE TYPED 1ST LINE OF ERROR MESSAGE
FINDR== 2000 ;LEFT ARROW SEARCH
QMFLG== 4000 ;PROSESSING ERROR MESSAGE
SEQUIN==10000 ;OUTPUT: AFTER EOL NEXT 5 CHARS ARE SEQ #
;INPUT: IGNORE CHAR AFTER SEQ# IF IT'S TAB
TRACEF==20000 ;? SEEN
SEQF== 40000 ;SEQUENCE NUMBER SEEN ON INPUT
BELLF== 100000 ;^G SEEN
DDTMF== 200000 ;NEED TO TYI IN DDT MODE
FORM== 400000 ;A FORM FEED TERMINATED THE LAST YANK OR APPEND COMMAND
;LEFT HALF - AC FF
PMATCH==2 ;PREVAILING MATCH MODE
IFN VC,<
TABSRT==4 ;TAB CORRECTION FOR VVAL
>
TMPFLG==40 ;TMPCOR UUO ALLOWED
FINF== 100 ;INPUT CLOSED BY EOF
UREAD== 200 ;INPUT FILE IS OPEN
UWRITE==400 ;OUTPUT FILE IS OPEN
;********* FREE BIT *********
EZTMP== 2000 ;[175] THIS COMMAND IS EZ, NOT EW
FEXTF== 4000 ;FILE EXT EXPECTED (.TYPED).
UBAK== 20000 ;EB IN EFFECT
GKTLKF==40000 ;MESSAGE TYPE OUT IN GRABAK?
TYOF== 100000 ;NEED TO OUTPUT A BUFFER
TYOCTF==200000 ;ALLOW CONTROL CHARS TYPED WITHOUT "^"
CCLFLG==400000 ;TECO COMMAND REQUESTS Y AFTER EB
;CONTROL FLAGS
;RIGHT HALF - AC F2
CTLV== 1 ;^V SEEN INSIDE TEXT
CTLVV== 2 ;DOUBLE ^V SEEN INSIDE TEXT
CTLW== 4 ;^W SEEN INSIDE TEXT
CTLWW== 10 ;DOUBLE ^W SEEN INSIDE TEXT
XMATCH==20 ;EXACT MATCH SEARCH MODE
EMATCH==40 ;TEMPORARILY ACCEPT EITHER UPPER OR LOWER CASE
LINCHR==100 ;TTY LINE HAS LC BIT ON
TYMSGF==200 ;TYPE MESSAGE WITH NO CASE FLAGGING
OCTALF==400 ;OCTAL RADIX
CTLR== 1000 ;^R SEEN AT INPUT TIME
SKIMRF==2000 ;WATCH FOR ^R WHEN SKIMMING
SKIMQF==4000 ;WATCH FOR ^Q WHEN SKIMMING
NOTRAC==10000 ;DISABLE TRACING
TYSPCL==20000 ;TYPE <CR>, ETC INSTEAD OF PRINTER CONTROLS
SKANFS==40000 ;SKANNING FS OR FN
TXTCTL==100000 ;NO CONTROL COMMANDS IN TEXT EXCEPT ^T, ^R
LCASE== 200000 ;CONVERT UPPER CASE TO LOWER CASE BY DEFAULT
UCASE== 400000 ;CONVERT LOWER CASE TO UPPER CASE BY DEFAULT
;LEFT HALF - AC F2
GOING== 1 ;A COMMAND STRING HAS BEEN SEEN
CTLN== 2 ;^N IN SEARCH ARGUMENT
NOALT== 4 ;[137] DON'T CONVERT OLD ALTMODES TO 033
NALTFS==10 ;[174] NULL REPLACEMENT ALTMODE DELIMITED
;[174] F SEARCH
SFDS== 20 ;[214] SUB FILE DIRECTORIES ARE IN EFFECT
LSNINF==40 ;[220] IGNORE CHAR AFTER SEQ# IF IT'S A TAB OR CR
;[220] REPLACES USE OF SEQUIN
;I-O CHANNELS
INCHN== 2
OUTCHN==3
TTY== 4 ;CHANNEL FOR TTY IO
CCLCHN==5 ;CHANNEL FOR THE CCL TMP FILE
ERRCHN==6 ;CHANNEL FOR ERROR MESSAGE FILE
;MISC PARAMETERS
ALT== 033 ;TECO'S ALTMODE
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
STABLN==^D131 ;LENGTH OF SEARCH TABLE
IOEOT== 2000
DVDIR==4 ;[136] DIRECTORY DEVICE CHAR. BIT
DVMTA== 20 ;MTA DEVICE CHARACTERISTIC BIT
DVDTA== 100 ;DTA DEVICE CHARACTERISTIC BIT
DVDSK==200000 ;[136] DSK DEVICE CHARACTERISTIC BIT
CNFTBL==11 ;FOR GETTAB UUO
STATES==17 ;DITTO
SERES5==3400 ;DITTO
JBTPRG==3 ;JOBNAME TABLE
LVDTBL==16 ;LEVEL D PARAMETERS TABLE
STNPRT==12 ;SYSTEM STANDARD PROTECTION WORD
GCTBL== 100
SAVEXT=='SAV' ;PDP-10 SAVE FILE EXTENSION
IFN PDP6,<SAVEXT=='DMP'> ;PDP-6 SAVE FILE EXTENSION
EE1==1B12 ;PRINT UUO ERROR CODE AFTER ?XXX
EE2==2B12 ;PRINT I/O ERROR CODE AFTER ?XXX
EE3==3B12 ;PRINT NOTHING AFTER ?XXX BECAUSE NO CORE FOR ERROR FILE
EO21== 1 ;TURN OFF SPECIAL VERSION 22+ FEATURES IF EO VALUE = 1
RUBSW==0 ;[206] MUST BE ZERO
;OPERATORS
;CHECK EO FLAG: CHKEO EO#,ADDR
;IF EOFLAG > EO#, RETURN AT CALL+1
;OTHERWISE GO TO ADDR
DEFINE CHKEO(E,A)
<1B22+<E>B30,,A>
;TYPE ERROR MSG: ERROR E.XXX
;TYPE MESSAGE CORRESPONDING TO 'XXX'
;THEN GO TO GO
DEFINE ERROR(X)
<1B8+'X'
'X'=<''X''>&777777>
OPDEF TYPR1 [2B8]
EXTERN .JBREL,.JBFF,.JB41,.JBSA,.JBUUO
JOBREN==124
JOBVER==137
LOC JOBVER
EXP VERSION ;VERSION #
LOC JOBREN
EXP REE ;REENTRY ADDRESS
;MACRO TO DEFINE DATA LOCATIONS
DEFINE U(A,B)<
RELOC
A: BLOCK B
RELOC
>
TWOSEG
RELOC 0
RELOC 400000
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
U LOCORE,0 ;START OF DATA AREA
SALL
;PSEUDO RUN UUO IF NEEDED
IFN NORUNS,<
IFN CCL,<
NORUN1: IOWD .-.,INHERE ;MODIFIED FOR LENGTH
0
NORUN2: CALLI 15,11
CALLI 12 ;NOT ENOUGH CORE TO GET COMPIL
IN CCLCHN,NORUN1 ;READ THE FILE
JRST NORBLT ;TO THE ACS
CALLI 12 ;NO GOOD.
INHERE: ;WHERE CODE APPEARS
NORAC: ;WHERE TO READ AC DATA FROM
PHASE 0
NORBLT: BLT NORTOP,.-. ;ADR MODIFIED
CALLI 0
AOS 1,.JBSA ;ADR + 1
JRST (1) ;START COMPIL
NORTOP: XWD INHERE+1,75 ;MOVE COMPIL DOWN
DEPHASE
>>
;STARTUP TIME INITIALIZATION
TECO:
IFN CCL,<
TDZA B,B
MOVNI B,1 ;THE CCL ENTRY
>
RESET ;INITIALIZE ALL IO
SETZM LOCORE ;CLR DATA IN CASE OF ^C,ST
MOVE A,[XWD LOCORE,LOCORE+1]
IFE BUGSW,<BLT A,@.JBREL>
IFN BUGSW,<BLT A,LOWEND-1>
IFN CCL,<MOVEM B,CCLSW>
IFE PDP6,<MOVE A,[PUSHJ P,UUOH]> ;SET UUO TRAP
IFN PDP6,<MOVE A,[JSR UUOH]> ;PDP-6 ASSUMES TRAP SET WITH JSR
MOVEM A,.JB41
MOVE P,[XWD -LPDL,PDL] ;START ONE WORD DOWN
HRRZ A,.JBREL ;.JBFF=.JBREL-202
IFN TEMP,<SUBI A,10> ;SUBTRACT ENOUGH FOR A TMPCOR READ
EXCH A,.JBFF
IFN BUGSW,<MOVEM A,CMDBFR>
ADD A,[677,,-1] ;CBUF=[000700,,FF-1]
MOVEM A,CBUF
MOVEI A,201(A)
IMULI A,5
MOVEM A,BEG ;BEG:=(CBUF+200)*5
MOVEM A,PT ;PT:=(CBUF+200)*5
MOVEM A,Z ;Z:=(CBUF+200)*5
MOVEM A,QRBUF ;QRBUF:=(CBUF+200)*5
GETPPN A, ;GET USER'S PROJ-PROG #
JFCL ;[175] SOMETIMES SKIPS
MOVEM A,USRPPN
SETOM MONITR ;GET MONITOR SERIES NUMBER
MOVE A,[XWD STATES,CNFTBL]
GETTAB A, ;WHICH MONITOR?
JRST TECO2 ;3 SERIES (MONITR=-1)
TLNE A,SERES5
AOS MONITR ;5 SERIES (MONITR=+1)
AOS MONITR ;4 SERIES (MONITR=0)
;FALL THROUGH TO NEXT PAGE
TECO2: MOVE A,[F%FDAE&<-1,,0>!.GTFET] ;[175] GETTAB FTFDAE
GETTAB A, ;[175] NEED TO KNOW IF FILE DAEMON
SETZ A, ;[175] MONITOR FOR EB STUFF
SETZM FDAEM ;[175] ASSUME NOT
TRNE A,F%FDAE&<0,,-1> ;[175] FILE DAEMON MONITOR?
SETOM FDAEM ;[175] YES, SIGN BIT OF .RBPRV CHANGED
SETZM DEFPTH ;[175] NOW DETERMINE JOB'S DEFAULT
MOVE A,[DEFPTH,,DEFPTH+1] ;[175] PATH
BLT A,DEFPTH+10 ;[175] FIRST, ZERO PATH BLOCK
SETOM DEFPTH ;[175] FUNCTION -1 IS READ PATH
MOVE C,USRPPN ;[175] DEFAULT PATH IF NO PATH UUO
MOVE A,[10,,DEFPTH] ;[175] POINT TO ARG BLOCK
PATH. A, ;[175] READ JOB'S DEFAULT PATH
MOVEM C,DEFPPN ;[175] POOR SUBSTITUTE
PJOB A, ;GET JOB #
MOVEM A,JOBN
MOVE C,[%FTSTR] ;[214] FIND OUT IF SFDS ARE USED
GETTAB C, ;[214] ...
JRST .+2 ;[214] ASSUME SO
TRNE C,F%SFD &<0,,-1> ;[214] SFDS HERE?
TLO F2,SFDS ;[214] YES, SET THE FLAG
MOVEI C,3 ;SET CTR
JOBLUP: IDIVI A,12 ;CONVERT JOB# TO DECIMAL ASCII IN LEFT HALF
ADDI AA,20
LSHC AA,-6
SOJG C,JOBLUP
HRRI B,(SIXBIT /TEC/) ;FORM NAME ###TEC
MOVEM B,TMPTEC ;SAVE
HRREI A,TYCASW ;GET WHATEVER IS DEFAULT TYPE-OUT CASE FLAGGING MODE
MOVEM A,TYCASF ;AND MAKE IT CURRENT
HRRZI A,EOVAL ;INITIALIZE EO FLAG
MOVEM A,EOFLAG
HRREI A,ERRMSG-2 ;SET ERROR MESSAGE TYPE INDICATOR
MOVEM A,ERRLEN ;-1=SHORT, 0=MEDIUM, +1=LONG
HRREI A,AUTOFS ;INIT AUTOTYPE-AFTER-SEARCHES FLAG
MOVEM A,AUTOF
U DEFPTH,1
U DEFFLG,1
U DEFPPN,1
U DEFSFD,6
;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.
PUSH P,INITG ;FOR IN LINE CODING POPJ
CRE23: MOVE A,.JBFF ;LATEST VALUE OF FF
IMULI A,5 ;5 CHARACTERS PER MEM WORD
MOVEM A,MEMSIZ ;MEMSIZ:=C(.JBFF)*5
INITG: POPJ P,.+1 ;EXIT OR CONTINUE
MOVE A,CBUF
MOVEI A,100(A)
CAMG A,.JBREL ;[207] IS THE MEMORY REALLY THERE ?
JRST .+6 ;[207] YES; GO BACK TO WORK
PUSH P,17 ;[207] IT IS NOT THERE! GO SNARF A K.
MOVE 17,.JBREL ;[207] FIND OUT HOW MUCH WE NEED .
SUB 17,A ;[207] LEAVE IT IN 17 FOR GRABKQ TO LOOK AT .
PUSHJ P,GRABKQ ;[207] GRAB THE K...QUIETLY.
POP P,17 ;[207] RESTORE AC 17.
MOVEM A,CBUFH ;CBUFH:=CBUF+77
MOVEI A,SYL
MOVEM A,DLIM ;DLIM:=SYL
MOVE A,[XWD 10014,-1]
MOVEM A,NROOM2 ;NROOM2:=XWD 10014,-1
MOVEI FF,0 ;CLEAR FLAG REGISTER
SKIPE SRHMOD ;IF DEFAULT SEARCH MODE IS NOT 0,
TLOA FF,PMATCH ;MAKE EXACT MODE CURRENT
GOE: TRZA FF,777777-TRACEF-QMFLG-FORM-SEQF
GO: TRZ FF,777777-TRACEF-FORM-SEQF
TLZ FF,CCLFLG ;[175] CLEAR "Y" REQUESTED FLAG
TRZ F2,NOTRAC
MOVE P,[XWD -LPDL,PDL] ;INITIALIZE PUSHDOWN LIST
SETZM PDL ;FLAG PDL TOP - NOTE: PDL FLAGS ARE
;0 = TOP OF PDL
;-1= LAST ITEM IS AN ITERATION
;+1= LAST ITEM IS A PARENTHESIS
;>1= LAST ITEM IS A MACRO
SETZM EQM ;[114] CLEAR MACRO LEVEL COUNT
MOVE PF,[XWD -LPF-1,PFL-1]
JRST CLIS
;FROM REE COMMAND DISTRIBUTION IN THE MONITOR
REE: CLRBFO ;STOP TYPEOUT
JRST GO ;GO AND LISTEN FOR INPUT
;THIS PAGE CONTAINS THE COMMAND READER FOR THE CCL SYSTEM
IFN CCL,<
TTYPT: XWD 440700,TTYBFS ;CCL COMMAND BUFFER PTR
TTYPT2: XWD 260700,TTYBFS ;TO INSERT FILE NAME AFTER EW OR EB
U CCLB,3 ;THE HEADER FOR CCL FILE IO
CCLIN:
IFN TEMP,<
MOVE A,[XWD 2,TT] ;SET UP FOR TMPCOR READ & DELETE
HRLI TT,'EDT' ;SET UP READ BLOCK FOR TMPCOR UUO
HRRZ TT1,.JBFF ;[175] GET FIRST FREE
ADDI TT1,46 ;[175] LAST LOC USED IN TMPCOR
CAML TT1,.JBREL ;[175] ENOUGH ROOM?
CORE TT1, ;[175] NO, EXPAND
JFCL ;[175] DOESN'T MATER
HRLZI TT1,-46 ;[175] GET IT ALL
HRR TT1,.JBFF
SOJ TT1, ;MAKE IT AN IOWD
TMPCOR A, ;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"
TLO FF,TMPFLG ;[175] SET TMPCOR FLAG
JRST CCLTM1 ;[175] FINISH PROCESSING COMMAND
CCLTMP: >
;HERE IF TMPCOR FAILED OR FEATURE TEST OFF. READ NNNEDT.TMP FROM DSK:
HLLZ B,TMPTEC ;GET SIXBIT JOB #
HRRI B,(SIXBIT /EDT/) ;REST OF NAME
MOVE T,[-XFILEN,,XFILNM-1] ;[175] PDL INTO LOOKUP BLOCK
PUSH T,[XFILEN] ;[175] FIRST WORD IS CNT OF ARGS
PUSH T,[0] ;[175] LOOK ON DEFAULT PATH
PUSH T,B ;[175] STORE FILENAME
PUSH T,['TMP '] ;[175] EXTENSION
MOVE T,.JBFF ;USE BUFFER SPACE BRIEFLY
INIT CCLCHN,0
SIXBIT /DSK/ ;TO READ THE FILE
EXP CCLB ;INPUT BUFFER
JRST TECO ;IF NO DSK, SAY "*"
INBUF CCLCHN,1 ;DONT ADR CHECK
LOOKUP CCLCHN,XFILNM ;[175] OPEN THE FILE
JRST TECO ;IT WASNT THERE?
INPUT CCLCHN,0
MOVEM T,.JBFF ;GIVE BACK SPACE
IBP CCLB+1 ;SKIP THE LINED S
MOVE AA,CCLB+1 ;[175] SETUP BYTE POINTER TO INPUT
CCLTM1: MOVE T,TTYPT2 ;[175] OUTPUT CHARS
MOVEI C,2 ;INIT CHAR CTR
MOVEI A,"=" ;[175] 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 ;[175] INPUT THE FILE NAME & EXT
CAMN B,A ;[175] FIRST EQUALS SIGN SEEN?
JRST CCLEQL ;[175] YES
CAIE B,15 ;[221] CR?
CAIN B,175 ;[221] OLD ALT?
AOJA C,CCLNUL ;[221] THEN PROCESS
JUMPE B,CCLIL ;[221] THROW AWAY NULLS
IDPB B,T ;[175] ELSE STORE CHAR
AOJA C,CCLIL ;[175] AND LOOP FOR ALL CHARS
;HERE ON THE FIRST "=" IN THE COMMAND STRING
CCLEQL: MOVEI B,ALT ;[175] REPLACE FIRST EQUALS SIGN
IDPB B,T ;[175] WITH <ALT>ER
ADDI C,1 ;[200] COUNT THE ALT
MOVE D,T ;[200] SAVE C & T
MOVE E,C ;[200] INCASE .TE A=B
MOVEI B,"E" ;[175] SINCE WE EXPECT
IDPB B,T ;[175] AN INPUT FILE
MOVEI B,"R" ;[175] SPEC TO FOLLOW
IDPB B,T ;[175] THE FIRST ONE
ADDI C,2 ;[175] COUNT THE CHARS STORED
SETO A, ;[175] PREVENT FINDING LATER EQUALS
TLO FF,CCLFLG ;[175] DO A Y IN ANY CASE
JRST CCLIL ;[175] AND LOOP BACK FOR NEXT CHAR
;HERE ON A NUL (END OF COMMAND). SEE IF IT WAS MAKE OR TECO
CCLNUL: MOVEI TT,"W" ;[200] PREPARE FOR EW COMMAND
CAILE B,15 ;WAS BREAK A CRLF?
JRST CCLDUN ;NO. ALTMODE ASSUMED
TLO FF,CCLFLG ;REQUEST Y AFTER EB
MOVEI TT,"B" ;[200] NOW PREPARE FOR EB
AOJN A,CCLDUN ;[200] CONTINUE UNLESS EB & "=" WAS SEEN
MOVE T,D ;[200] IF .TE A=B, WE NEVER SAW THE "="
MOVE C,E ;[200] IN CASE .MA A=B, THEN .TE<CRLF>
CCLDUN: MOVEI B,ALT
IDPB B,T ;[225] TERMINATING TWO ALT'S
IDPB B,T ;LAST ALT
ADDI C,3 ;[225] COUNT 2ND ALT & ADD 1 TO FOOL TYI0
MOVEI B,"E" ;NOW FILL IN THE EB OR EW
MOVE T,TTYPT ;AT THE BEGINNING OF STRING
MOVEM T,TIB+1 ;ALSO INITIALIZE TO READ THIS
IDPB B,T ;STORE "E"
IDPB TT,T ;[200] AND EITHER W OR B
MOVEM C,TIB+2 ;SET BUFR CTR
IFN TEMP,<TLZE FF,TMPFLG ;TMPCOR UUO IN PROGRESS?
JRST CCLDU2> ;YES, DONT CLOSE DSK
SETZM XNAM ;[175] NOW FLUSH FILE
RENAME CCLCHN,XFILNM ;[175] BY RENAME TO ZERO
JFCL ;[175] PROTECTED?
CCLDU2: RELEAS CCLCHN,
POPJ P,
>
;ROUTINE TO RETURN NON-NULL TTY CHARACTER IN CH.
;CALL PUSHJ PDP,TYI
; RETURN
TYI: TLZE FF,TYOF ;NEED A TYO?
OUTPUT TTY,0 ;YES. DO SO.
TYI0: SOSG TIB+2 ;CHARS IN NORMAL MODE?
JRST TYI1 ;NONE LEFT
TYI2: ILDB CH,TIB+1 ;YES. GET ONE
JUMPE CH,TYI0 ;FLUSH NULLS
TYI3: TRZ FF,DDTMF ;CLR TTCALL REQUEST FLAG
IFN RUBSW,<
SETO A, ;AIM AT THIS TTY
TTCALL 6,A ;GETSTS
TLNN A,4 ;SUPPRESS ECHO?
>
CAIE CH,7 ;BELL?
JRST ALTLIN ;CHECK FOR ALTMODE
JSP A,CONMES ;ECHO AN "^G" TOO
ASCIZ /^G/
MOVEI CH,7 ;GET BACK BELL
POPJ P,
TYI1: TRNE FF,DDTMF ;SHOULD TYI BE TTCALL?
JRST TYIDDT ;YES
INPUT TTY,0 ;NO. ORDINARY.
STATO TTY,20000 ;END OF FILE?
JRST TYI2
PUSHJ P,TTOPEN ;CLEAR EOF THE HARD WAY
JRST TYI0 ;^Z WAS SEEN ALREADY. GET ANOTHER CH
;CONVERT 175 & 176 TO ALTMODE (033) UNLESS TTY NOALT IS ON
ALTLIN: CAIL CH,175 ;OLD ALTMODE?
CAILE CH,176
POPJ P, ;NO
TLNN F2,NOALT ;[137] TEST TTY NOALT BIT
ALTX: MOVEI CH,ALT ; 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
TYIDDT: TLZE FF,TYOF ;CHARACTERS WAITING FOR OUTPUT?
OUTPUT TTY,0 ;YES, FORCE THEM OUT
TTCALL 0,CH ;WAIT FOR A SINGLE CHARACTER
JRST TYI3
TTOPEN: MOVEI T,TTYBFS
EXCH T,.JBFF ;SET .JBFF AND SAVE IT
INIT TTY,100 ;INIT THE CONSOLE
SIXBIT /TTY/
XWD TOB,TIB ;SHOULD BE
JRST .-3 ;I REALLY WANT TTY
INBUF TTY,1
OUTBUF TTY,1 ;KEEP IT SMALL
MOVEM T,.JBFF ;RESTORE .JBFF
IFN CCL,<
SETZM TYIPT ;SIGNAL CCL BUFFER EMPTY
>
POPJ P,
;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.
TYOS: TROA F2,TYSPCL ;TYPE <CR>, ETC INSTEAD OF PRINTER CONTROLS
TYOM: TRZ F2,TYSPCL ;CLR SPECIAL TYPEOUT FLAG
TROA F2,TYMSGF ;SET NO-CASE-FLAGGING FLAG
TYO: TRZ F2,TYMSGF+TYSPCL ;CLR NO-CASE-FLAGGING FLAG & SPECIAL FLAG
PUSH P,CH ;SAVE CHAR IN CASE ^ OR ' NEEDED
TLNE FF,TYOCTF ;ET IN EFFECT?
JRST TYOB ;[120] YES, TYPE ALL CHARACTERS AS IS
PUSHJ P,ALTEO ;CONVERT OLD ALTMODES IF EO=1
CAIGE CH,11
JRST TYO1 ;BELOW TAB
TRZN F2,TYSPCL ;WANT <CR>, ETC INSTEAD OF PRINTER CONTROLS?
JRST TYOJ ;NO
CAIG CH,15 ;IS IT A PRINTER CONTROL?
JRST TYOH ;YES
CAIE CH,ALT ;OR AN ALTMODE?
JRST TYOG ;NO, DO NORMAL THING
MOVEI CH,16 ;ADJUST INDEX FOR ALTMODE
TYOH: MOVEI A,5 ;5 CHAR. CTR
MOVE AA,[POINT 7,TSPTAB-11] ;& PTR TO RIGHT COMBINATION
ADDI AA,(CH)
TYOI: ILDB CH,AA ;TYPE <CR> OR WHATEVER
SOJLE A,TYOB ;LAST CHAR GOES OUT VIA TYOB (TO POP CH)
PUSHJ P,TYOA
JRST TYOI
TYOJ: CAIG CH,15 ;NO, TAB, LF, VT, FF, OR CR?
JRST TYOB ;YES. TYPE IT AND RETURN
CAIN CH,ALT
MOVEI CH,"$" ;YES TYPE DOLLAR SIGN
TYOG: CAIGE CH,40 ;NO. ANY OTHER CONTROL CHARACTER?
JRST TYO1 ;YES.
TYOC: TRNE F2,LINCHR+TYMSGF ;TTY LC ON? OR TYPING A MESSAGE?
JRST TYOB ;YES, NO CASE FLAGGING
MOVE A,TYCASF ;WHAT SHOULD BE FLAGGED?
JUMPL A,TYOB ;NOTHING
JUMPG A,TYOD ;UPPER CASE RANGE
CAIGE CH,140 ;LOWER CASE. IS THIS LC?
JRST TYOB ;NO, SO DON'T FLAG IT
TYOE: MOVEI CH,47 ;YES, FLAG IT WITH '
PUSHJ P,TYOA
MOVE CH,(P) ;GET BACK THE CHARACTER
TRZ CH,40 ;MAKE IT UPPER CASE
TYOB: PUSHJ P,TYOA ;TYPE CH.
POP P,CH ;RESTORE CH
CAIN CH,7 ;IF BELL AND ET IS OFF, WE MUST
TLNE FF,TYOCTF ;FALL INTO TYOA TO GET A DING
POPJ P, ;RETURN
TYOA: TLO FF,TYOF ;MARK WILL NEED TO OUTPUT
SOSG TOB+2 ;OUTPUT SPACE AVAIL?
OUTPUT TTY,0 ;NO. OUTPUT.
IDPB CH,TOB+1
CAILE CH,14 ;FORCE OUTPUT ON LF,FF ETC
POPJ P, ;NO
OUTPUT TTY,0
TLZ FF,TYOF ;NO LONGER NEED TO OUTPUT
POPJ P,
TYO1: PUSH P,CH ;TYPE CONTROL CHARACTER IN FORM "^CH"
MOVEI CH, "^"
PUSHJ P,TYOA ;TYPE ^
POP P,CH
ADDI CH,100 ;CONVERT TO PRINTING CHARACTER
JRST TYOB ;AND TYPE IT.
TYOD: CAIL CH,100 ;IS THIS UPPER CASE?
CAILE CH,137
JRST TYOB ;NO
JRST TYOE ;YES, FLAG IT WITH '
IFN CCL,<U TYIPT,1> ;
U TTYBFS,46 ;100 MODE TTY BFRS
U TIB,3 ;BUFFER HEADER
U TOB,3 ;DITTO
U JOBN,1 ;JOB #
U USRPPN,1 ;USER PROJ-PROG #
U MONITR,1 ;MONITOR LEVEL: 0=3,1=4,2=5
U IBUF,3 ;
U OBF,3 ;
U IBUF1,2*<BUFSIZ+3> ;
U OBUF1,2*<BUFSIZ+3> ;
;PRINT THESE INSTEAD OF PRINTER CONTROLS IF TYSPCL FLAG IS ON
TSPTAB: ASCII /<TAB>/
ASCII /<LF>/
ASCII /<VT>/
ASCII /<FF>/
ASCII /<CR>/
ASCII /<ALT>/
;MESSAGE TYPE-OUT
;CALL JSP A,CONMES
; ASCIZ /MESSAGE/
; RETURN
CONMES: HRLI A,440700 ;A=POINT 7,MESSAGE-ADDR
ILDB CH,A ;GET MSG CHAR
JUMPE CH,1(A) ;RETURN WHEN 0 FOUND
PUSHJ P,TYOM ;TYPE WITH NO CASE FLAGGING
JRST .-3
;ROUTINE TO OUTPUT DECIMAL (OCTAL IF 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 > 0?
MOVEI CH,"-" ;NO. OUTPUT -
PUSHJ P,@LISTF5
MOVMS B ;B:=ABSOLUTE VALUE OF B
DPT1: MOVEI A,12 ;RADIX 10
TRNE F2,OCTALF ;OCTAL RADIX?
MOVEI A,10 ;YES, CHANGE TO RADIX 8
IDIVI B,(A) ;E:=DIGIT
HRLM E,(P) ;PUT DIGIT ON LEFT HALF OF TOP OF PUSH DOWN LIST
JUMPE B,.+2 ;DONE?
PUSHJ P,.-3 ;NO. PUSH THIS DIGIT AND PRINT RETURN ADDRESS.
HLRZ CH,(P) ;YES. CH:=DIGIT
ADDI CH,60 ;CONVERT IT TO ASCII.
JRST @LISTF5 ;PRINT IT
;ROUTINE TO TYPE CARRIAGE RETURN LINE FEED
;CALL PUSHJ P,CRR
; RETURN
CRR: JSP A,CONMES ;OUTPUT CRLF
ASCIZ /
/
POPJ P,
;RETURN NEXT COMMAND CHAR AT CURRENT LEVEL
;CALL: PUSHJ P,SKRCH
; ERROR RETURN IF NO MORE CHARS AT THIS LEVEL
; NORMAL RETURN WITH CHAR IN CH
SKRCH: SKIPG COMCNT ;ANY CHARS LEFT?
POPJ P, ;NO, TAKE ERROR RETURN
PUSHJ P,RCH ;YES, GET NEXT
CPOPJ1: AOS (P) ;SKIP RETURN
POPJ P,
;ROUTINE TO RETURN NEXT CHARACTER FROM COMMAND BUFFER.
;CALL PUSHJ P,RCH
; RETURN ALWAYS WITH CHARACTER IN CH
RCH: SOSGE COMCNT ;DECREMENT COMMAND BUFFER CHARACTER COUNT
;IS COMMAND BUFFER EMPTY?
JRST RCH2 ;YES. POP UP TO HIGHER MACRO LEVEL.
ILDB CH,CPTR ;NO. GET COMMAND CHARACTER IN CH
PUSHJ P,ALTEO ;CONVERT OLD ALTMODES IF EO = 1
TRNE FF,TRACEF ;IN TRACE MODE?
TRNE F2,NOTRAC ;TRACE ENABLED?
POPJ P, ;NO, RETURN
JRST TYO ;YES, TYPE THE COMMAND
;RCH+7 [204]
PUSH P,A ;[204] YES, SAVE A FOR CALLING ROUTINE
POP P,A ;[204] RESTORE THE STATE
POPJ P, ;[204] AND RETURN
RCH2: POP P,CH ;SAVE RETURN FOR POPJ IN CH
POP P,COMCNT ;GET RID OF FLAG
SKIPE EQM ;[114] DON'T ALLOW NEG MACRO COUNT
SOS EQM ;[114] DECREMENT THE MACRO LEVEL
SOSG COMCNT ;IF ANG BRAK ON PDL, ITS A INCOMPLETE MACRO
ERROR E.IAB
POP P,COMCNT ;GET COUNT FROM NEXT MACRO LEVEL
POP P,CPTR ;CURRENT POINTER TOO
POP P,COMAX ;NUMBER OF COMMANDS
PUSH P,CH ;GET RETURN BACK ON PDL.
JRST RCH ;TRY AGAIN.
;GET NEXT CHAR FROM CURRENT COMMAND LEVEL WHERE A CHAR IS
;KNOWN TO BE THERE, AND NO TRACING IS WANTED
GCH: SOS COMCNT ;REDUCE CHAR COUNT
ILDB CH,CPTR ;GET CHAR.
JRST ALTEO ;CONVERT OLD ALTMODES AND RETURN
;SCAN COMMAND STRING FOR CHARACTER IN TT
;IGNORING PAIRS STARTING WITH CHAR. IN TT1 AND ENDING WITH (TT)
;ASSUMED THAT CPTR IS SET
;NON-SKIP RETURN IF (TT) CAN'T BE FOUND
;SKIP RETURN IF FOUND
;CPTR LEFT SET FOR NEXT CHAR. IN COMMAND STRING
SKAN: TRO F2,NOTRAC ;INHIBIT TRACE ACTION WHILE SKANNING
MOVEI C,0 ;CTR FOR <> AND "...' PAIRS
SKAN0: TRZ F2,SKIMQF+SKIMRF+SKANFS ;CLR SKIM FLAGS
PUSHJ P,SKRCH2 ;GET COMMAND CHAR.
CAIN CH,(TT1) ;SECONDARY CHARACTER?
AOJA C,SKAN1 ;YES, COUNT IT
CAIN CH,(TT) ;PRIMARY CHAR?
JRST SKAN10 ;YES!
SKAN1: CHKEO EO21,SKAN0 ;OLD STYLE SKAN IF EO = 1
MOVEI T,SKNTAB ;NO, WATCH OUT FOR TEXT STRINGS
SKAN00: PUSHJ P,DISPAT
JRST SKAN0 ;NOT A TEXT-ARG COMMAND, IGNORE IT
SKAN2: PUSHJ P,SKRCH2 ;GET CHAR AFTER "^"
CAIN CH,"A"
JRST SKAN7 ;^A COMMAND
CAIN CH,"^"
JRST SKAN11 ;^^ COMMAND
JRST SKAN0 ;ORDINARY CTRL-COMMAND, FORGET IT
SKAN3: PUSHJ P,SKRCH2
MOVEI T,SK3TAB ;WHICH E COMMAND?
JRST SKAN00
SKAN4: PUSHJ P,SKRCH2 ;WHAT FOLLOWS @?
MOVEI T,SK4TAB
PUSHJ P,DISPAT
JRST SKAN4 ;MUST BE 1 OF THESE 4
SKAN9: PUSHJ P,SKIM ;IGNORE TO $
JRST SKAN0
SKAN7: MOVEI T,1 ;IGNORE TO ^A
JRST SKAN5
SKAN8: MOVEI T,"!" ;IGNORE TO !
SKAN5: PUSHJ P,SKIM1 ;IGNORE TO CHAR IN T
JRST SKAN0
SKAN6: PUSHJ P,SKRCH2 ;GET SEARCH DELIMITER
SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE
SKAN12: MOVEI T,ALT ;DELIMITER IS ALTMODE
PUSHJ P,SKIMRQ ;SKIP TO DELIMITER & WATCH OUT FOR ^Q,^R
JRST SKAN0
SKAN13: PUSHJ P,SKRCH2 ;GET INSERT DELIMITER
SKIPA T,CH ;IGNORE TO NEXT OCCURRENCE
SKAN14: MOVEI T,ALT ;DELIMITER IS ALTMODE
PUSHJ P,SKIM.R ;SKIP TO DELIMITER & WATCH OUT FOR ^R
JRST SKAN0
SKAN11: PUSHJ P,SKRCH2 ;IGNORE NEXT CHAR.
JRST SKAN0
SKAN16: MOVEI T,SK5TAB ;TABLE FOR @F
JRST SKAN17
SKAN15: MOVEI T,SK1TAB ;TABLE FOR F COMMANDS
SKAN17: TRO F2,SKANFS ;SIGNAL FS OR FN IN PROGRESS
PUSHJ P,SKRCH2 ;GET CHAR AFTER F
JRST SKAN00
SKAN10: SOJGE C,SKAN0 ;IF MATCH JUST ENDS A PAIR, LOOP BACK
TRZ F2,NOTRAC ;ENABLE TRACING
JRST CPOPJ1 ;OTHERWISE, WE HAVE WHAT WE WANT
;SKIM OVER TEXT
;ENTER AT SKIM TO SKIP TO NEXT ALTMODE, GIVING ^R & ^Q NO SPECIAL TREATMENT
;ENTER AT SKIM1 TO SKIP OVER ARBITRARY CHAR IN T, GIVING ^R & ^Q NO SPECIAL TREATMENT
;ENTER AT SKIM.R TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER ^R
;ENTER AT SKIMRQ TO SKIP TO ARBITRARY CHAR IN T, UNLESS IT IS AFTER EITHER ^R OR ^Q
SKIMRQ: TRO F2,SKIMQF ;CK FOR ^Q AND ^R
SKIM.R: TROA F2,SKIMRF ;CK FOR ^R
SKIM: MOVEI T,ALT ;SKIP TO NEXT ALTMODE
SKIM1: PUSHJ P,SKRCH ;GET NEXT TEXT CHAR.
JRST APOPJ ;ERROR RETURN FROM SKAN ROUTINE
CAIN CH,(T) ;CHARACTER WE WANT?
JRST SKIM3 ;YES
CAIN CH,21 ;^Q?
TRNN F2,SKIMQF ;YES, CK FLAG ON?
JRST .+2 ;NO
JRST SKIM2 ;YES
CAIN CH,22 ;^R?
TRNN F2,SKIMRF ;YES, CK FLAG ON?
JRST SKIM1 ;NO, KEEP LOOKING
SKIM2: PUSHJ P,SKRCH ;GOBBLE UP NEXT CHARACTER
JRST APOPJ ;ERROR RETURN FROM SKAN
JRST SKIM1 ;CONTINUE SKIMMING
SKIM3: TRZE F2,SKANFS ;SKIMMING OVER FS OR FN?
JRST SKIM1 ;YES, IGNORE 1ST DELIMITER
POPJ P,
;GET A SINGLE CHARACTER FROM COMMAND STRING
;TAKE ERROR RETURN FROM SKAN IF THERE ARE NO MORE
SKRCH2: PUSHJ P,SKRCH ;GET A COMMAND CHAR.
APOPJ: POP P,A ;ERROR RETURN FROM SKAN IF NO MORE CHARS.
POPJ P,
;SKAN ROUTINE DISPATCH TABLES
SKNTAB: XWD SKAN15,"F"
XWD SKAN14,"I"
XWD SKAN14,11 ;TAB
XWD SKAN12,"_"
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 0,0 ;LIST TERMINATOR
SK3TAB: XWD SKAN9,"B" ;EB
XWD SKAN9,"R" ;ER
XWD SKAN9,"W" ;EW
XWD SKAN9,"Z" ;EZ
XWD 0,0
SK4TAB: XWD SKAN16,"F" ;@F
XWD SKAN13,"I" ;@I
XWD SKAN6,"_" ;@_
SK5TAB: XWD SKAN6,"S" ;@S OR @FS
XWD SKAN6,"N" ;@N OR @FN
XWD 0,0
CLIS1: PUSHJ P,CRR ;TYPE CRLF
CLIS:
IFN CCL,<
SKIPN CCLSW ;NEED CCL COMMAND?
JRST LIS0 ;NO
PUSHJ P,CCLIN ;GET THE CCL COMMAND TO TYI BUFFER
JRST LIS02 ;AND DONT SAY STAR
>
LIS0: PUSHJ P,TTOPEN ;GET TELETYPE
TRNE FF,QMFLG ;1ST CHARACTER IN ALREADY?
JRST LIS01 ;YES
MOVEI CH,"*"
TRZ F2,LINCHR ;CLR TTY LC BIT
SETO A, ;GETLCH ON THIS LINE
TTCALL 6,A
TLNE A,20 ;TTY LC ON?
TRO F2,LINCHR ;YES, SET TTY LC BIT
HRRZ TT1,A ;[137] GET UNIVERSAL I/O INDEX
MOVEI TT,1026 ;[137] CODE FOR ALT TESTING
MOVE A,[XWD 2,TT] ;[137] SET UP FOR TRMOP
TRMOP. A, ;[137] GET ALTMODE INFO FROM MONITOR
LDB A,[POINT 1,F2,29] ;[137] IF THIS FAILS USE LC BIT
SKIPE A ;[137] SHOULD WE CHANGE OLD ALTMODES?
TLOA F2,NOALT ;[137] DON'T CONVERT
TLZ F2,NOALT ;[137] DO CONVERT
PUSHJ P,TYOM ;TYPE *
LIS01: TRON FF,QMFLG ;UNLESS ONE ALREADY IN
PUSHJ P,TYI
CAIE CH,"*" ;1ST CHAR AN ASTERISK?
JRST LIS02 ;NO, CONTINUE NORMALLY
;SAVE PREVIOUS COMMAND STRING IN NAMED Q-REGISTER
LIS03: MOVE C,COMLEN ;LENGTH OF STRING
TLNE F2,NALTFS ;[174] NULL REPLACEMENT ALTMODE DELIMITED
;[174] F SEARCH?
ADDI C,1 ;[174] YES, DONT OMIT LAST ALTMODE
ADDI C,2 ;OMIT LAST ALTMODE
MOVEI B,CMDBFR ;POSITION OF FIRST CHAR. IN BYTES
IFN BUGSW,<MOVE B,CMDBFR>
IMULI B,5
TLNN F2,GOING ;[227] ANY CMD SEEN BEFORE?
SKIPA B,[-1,,-1] ;[227] NO - FLAG NCS ERROR FOR LATER.
PUSHJ P,X3 ;[227] YES - SAVE CMD IN Q-REG BUFFER
MOVEM B,COMSAV ;[227] SAVE FOR LATER
HRRZI CH,"*" ;[227] RESTORE CH (GARBAGED BY X3)
LIS02: SETZM COMCNT ;COMCNT:=0
TLZ F2,NALTFS ;[174] CLEAR FLAG
SETZM SYMS
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVE AA,CBUF
MOVE B,CBUFH
LI1: TRZ FF,ALTF+BELLF+XPLNFL+EMFLAG
LI2: CAILE B,(AA) ;COMMAND BUFFER EXCEEDED?
JRST LI3 ;NO
;TO SEE IF TECO WILL NEED MORE CORE FOR COMMAND
;BUFFER EXPANSION. IF SO, GET IT
MOVE C,Z ;GET THE NUMBER OF CHARACTERS NOW
ADDI C,500 ;WILL WE OVERFLOW IF THIS IS REQUESTED?
CAMG C,MEMSIZ ;WILL THIS OVERFLOW?
JRST .+5 ;NO, FORGET THIS EVER HAPPENED
PUSH P,17 ;WILL OVERFLOW, THEREFORE, SAVE AC#17
MOVE 17,C ;THIS IS THE REQUEST FOR MEMORY
PUSHJ P,GRABKQ ;GET THE NECESSARY CORE
POP P,17 ;RESTORE AC#17
;OK, EXPAND THE COMMAND BUFFER CONFIDENTLY
ADDI B,100 ;YES. EXPAND COMMAND BUFFER 100 WORDS.
MOVE C,Z
IDIVI C,5 ;C:=DATA BUFFER END WORD ADDRESS.
MOVE D,QRBUF
PUSH P,F2 ;KLUDGE TO PROTECT F2 UNTIL AC'S ARE REORDERED
IDIVI D,5 ;D:=Q-REG BUFFER BASE WORD ADDRESS.
POP P,F2 ;RESTORE FLAGS
SUBM C,D ;D:=NO. OF WORDS IN Q-REG BUFFER AND DATA BUFFER.
MOVE CH,(C)
MOVEM CH,100(C) ;MOVE Q-REG AND DATA BUFFERS UP 100 WORDS.
SOS C
SOJGE D,.-3
MOVEI C,500
ADDM C,BEG ;BEG:=C(BEG)+500
ADDM C,PT ;PT:=C(PT)+500
ADDM C,Z ;Z:=C(Z)+500
ADDM C,QRBUF ;QRBUF:=C(QRBUF)+500
MOVE D,Z
LI3: MOVEM B,CBUFH ;NO. RESET HIGH END OF COMMAND BUFFER.
TRZN FF,QMFLG ;1ST CHAR IN ALREADY?
PUSHJ P,TYI ;GET A NON-NULL CHARACTER IN CH
CAIN CH,177 ;RUBOUT?
JRST RUBOUT ;YES
LI3A: AOS A,COMCNT ;NO. INCREMENT COMMAND CHARACTER COUNT
IDPB CH,AA ;STORE CHARACTER IN COMMAND BUFFER.
LI4: CAIE CH,ALT ;ALT-MODE?
JRST LI5 ;NO
TRZN F2,CTLR ;PREVIOUS CHAR. A ^R?
JRST LI7 ;NO
CHKEO EO21,LI7 ;IF EO=1, NEVERMIND ^R
LI9: TRZ FF,BELLF ;ALTMODE CLEARS BELL FLAG
JRST LI2
LI7: TRON FF,ALTF ;YES. SET ALT-MODE FLAG. WAS IT ON?
JRST LI9 ;NO
MOVEM A,COMAX ;SET COMMAND CHARACTER ADDRESS UPPER BOUND
MOVEM A,COMLEN ;SAVE IN CASE OF * COMMAND NEXT
MOVE AA,CBUF ;INIT COMMAND BYTE PTR
MOVEM AA,CPTR
SKIPE CCLSW ;READING CCL CMD?
PUSHJ P,TTOPEN ;YES, INIT TTY
PUSHJ P,CRR ;TYPE CRLF
SETZM CCLSW ;FINISHED WITH CCL READ
JRST CD ;DECODE COMMAND
LI5: CAIN CH,22 ;^R?
JRST CNTRLR ;YES
TRZ F2,CTLR ;NO, CLR FLAG IN CASE PRECEDING CHAR WAS
CAIN CH,25 ;^U?
JRST CNTRLU ;YES
CAIN CH,7 ;BELL?
JRST LI6 ;YES
TRZN FF,BELLF ;NO, PREVIOUS CHAR A BELL?
JRST LI1 ;NO, GET NEXT CHARACTER
CAIE CH," " ;YES, IS THIS A SPACE?
JRST LI2
RETYPE: PUSHJ P,BACKUP ;BACK OFF ^G<SPACE>
SOS D,COMCNT ;MARK CURRENT POSITION
PUSHJ P,BACKLN ;BACK UP TO BEG OF LINE
JRST RETYP3 ;HIT BEG OF COMMAND STRING
RETYP1: SKIPL COMCNT ;[151] SEE IF ANY COMMANDS
PUSHJ P,TYOM ;TYPE A CHAR OF COMMAND LINE
RETYP4: AOS C,COMCNT ;ADVANCE COMMAND CTR
CAIL C,(D) ;BACK IN PLACE?
JRST RETYP2 ;YES
ILDB CH,AA ;NO, GET NEXT CHAR
JRST RETYP1
RETYP2: CAIN CH,ALT ;LOOKING AT AN ALTMODE?
TRO FF,ALTF ;YES, BETTER SET FLAG
JRST LI2
RETYP3: PUSH P,CH ;SAVE 1ST CHAR
PUSHJ P,CRR ;TYPE CR-LF BEFORE COMMAND LINE
POP P,CH ;RETRIEVE 1ST CHARACTER
JUMPE CH,RETYP4 ;DON'T PRINT ^@ IF NULL COMMAND STRING
JRST RETYP1
LI6: TROE FF,BELLF ;YES. SET BELL FLAG. TWO SUCCESSIVE BELLS?
JRST LI8 ;YES, REJECT COMMAND
TRO FF,DDTMF ;GET ANOTHER CHAR WITH TTCALL 0
JRST LI2
LI8: SUBI A,1 ;SAVE COMCNT-1 IN CASE * COMMAND FOLLOWS
MOVEM A,COMLEN
TLO F2,GOING ;SO YOU CAN DO *I AFTER ^G^G
PUSHJ P,CRR ;YES. TYPE A CRLF
JRST GO ;AND CLEAR COMMAND BUFFER.
;BACK UP BYTE POINTER IN AA, LOAD APPROPRIATE CHARACTER IN CH,
;AND ADJUST COMCNT
BACKUP: ADD AA,[7B5] ;BACK UP CHAR PTR
JUMPG AA,.+3 ;OK NOW?
SUBI AA,1 ;NO, NEEDS FURTHER FIXING
HRLI AA,010700
LDB CH,AA ;LOAD CHAR
SOS C,COMCNT ;DECREMENT COMMAND COUNT
POPJ P,
;BACKUP TO BEGINNING OF CURRENT LINE
;CALL: PUSHJ P,BACKLN
; RETURN IF BACKUP WENT TO BEGINNING OF COMMAND STRING
; RETURN IF CR-EOL COMBINATION FOUND
BACKLN: PUSHJ P,BACKUP ;BACK UP ONE CHAR
JUMPLE C,CPOPJ ;RETURN IF NOTHING LEFT
BACKL1: PUSHJ P,CKEOL ;IS THIS AN EOL CHAR?
JRST BACKLN ;NO, KEEP BACKING UP
PUSHJ P,BACKUP ;YES, BACK UP ONE MORE
CAIE CH,15 ;IS THIS A CR?
JRST BACKL1 ;NO, MAYBE ANOTHER EOL?
JRST CPOPJ1 ;YES, TAKE SKIP RETURN
;PROCESS CONTROL-U
CNTRLU: PUSHJ P,TYOM ;ECHO THE ^U
PUSHJ P,BACKLN ;BACK UP TO BEG OF LINE
JUMPLE C,CLIS1 ;IF NOTHING LEFT, RETYPE *
AOS COMCNT ;KEEP CRLF
IBP AA
PUSHJ P,CRR ;CR-LF AFTER ^U
JRST LI1 ;CONTINUE TYPE-IN
;CONTROL-R IN COMMAND MODE PREVENTS AN ALTMODE AFTER IT
;FROM BEING A TERMINATOR
CNTRLR: TRZN F2,CTLR ;^R ON ALREADY?
TRO F2,CTLR ;NO, SET FLAG
JRST LI1
;PROCESS RUBOUTS
RUBOUT: SKIPG COMCNT ;ANYTHING TYPED IN?
JRST CLIS1 ;NO, RETYPE *
IFN RUBSW,<
SETO A, ;GETLCH ON THIS TTY
TTCALL 6,A ;SET TO SUPPRESS ECHOING
TLO A,4
TTCALL 7,A
PUSHJ P,SPLAT ;ACT LIKE THE MONITOR
JRST RUB4
RUB1: SKIPGE COMCNT ;PAST BEGINNING OF COMMAND STRING YET?
JRST RUB3 ;YES
PUSHJ P,TYIDDT ;GET ONE CHARACTER
CAIE CH,177 ;RUBOUT?
JRST RUB2 ;NO
RUB4: >
LDB CH,AA ;RELOAD THE CHAR.
SKIPE COMCNT ;UNLESS AT BEGINNING OF COMMAND STRING,
PUSHJ P,TYOM ;ECHO THE DELETED CHAR.
PUSHJ P,BACKUP ;BACK OVER THE CHAR.
IFE RUBSW,<JRST LI1> ;RESUME TYPE-IN
IFN RUBSW,<
JRST RUB1 ;TRY NEXT INPUT CHAR.
RUB2: PUSH P,CH ;SAVE THIS GOOD GUY
PUSHJ P,SPLAT ;TYPE THE SECOND \
POP P,CH ;GET THAT CHAR. BACK
CAIE CH,25 ;CTRL-U?
PUSHJ P,TYOM ;NO, ECHO IT
PUSHJ P,TTCREE ;RESET TTCALL FOR ECHOING
JRST LI3A ;PROCESS THIS CHAR.
RUB3: PUSHJ P,SPLAT ;SECOND \
PUSHJ P,TTCREE ;RESET TTCALL MODE TO NORMAL
JRST CLIS1 ;START A NEW COMMAND STRING
>
;TYPE BACKSLASH
IFN RUBSW,<
SPLAT: MOVEI CH,"\"
JRST TYOM
>
;RESET TTCALL FOR ECHOING
IFN RUBSW,<
TTCREE: SETO A, ;GETLCH ON THIS TTY
TTCALL 6,A
TLZ A,4 ;TURN OFF NO ECHO BIT
TTCALL 7,A
POPJ P,
>
CD:
RET: TRZ FF,ARG2+ARG+FINDR+PCHFLG+SEQUIN+FSRCH
TLO F2,GOING ;A COMMAND STRING IS IN
CD1: SETZM NUM ;NO ARGUMENT STRING SEEN
SETZM SYL
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"
TRZ F2,OCTALF ;NO, CLEAR OCTAL RADIX FLAG
CAIE A,140 ;140 IS ILLEGAL
CAILE A,172 ;ALSO 173-177 ARE ILLEGAL
MOVEI A,0
CAILE A,137 ;REDUCE LOWER CASE TO UPPER
SUBI A,40
ROT A,-1 ;DIV BY 2
JUMPL A,CD92 ;ODD CHARACTER
HLRZ A,DTB(A) ;GET CODE & ADDR FOR EVEN CHAR.
JRST CD93
CD92: HRRZ A,DTB(A) ;GET CODE & ADDR FOR ODD CHAR.
CD93: TRNN A,300000 ;IS IT A JRST DISPATCH WITH NO ARG PROCESSING?
JRST (A) ;YES, DO IT
MOVE B,NUM ;NO, TAKE CARE OF ARGUMENTS
XCT DLIM ;NUM:=NUM (DLIM OPERATOR) SYL
MOVEM B,NUM
setzm syl ;[167] clear old operand
MOVE C,SARG ;SAVE SECOND ARGUMENT IN C.
TRZ FF,SYLF ;CLR DIGIT STRING BIT
TRZ F2,CTLV+CTLVV+CTLW+CTLWW+EMATCH+TXTCTL
TRZ A,100000 ;CLR PUSHJ DISPATCH BIT
TRZE A,200000 ;JRST OR PUSHJ DISPATCH?
JRST (A)
PUSHJ P,(A)
JRST RET
U DLIM,1 ;
U NUM,1 ;
U SYL,1 ;
U SARG,1 ;
;DIGITS FORM DECIMAL INTEGERS.
CDNUM: TRON FF,SYLF ;DIGIT STRING ALREADY STARTED?
SETZM SYL ;NO, INIT TO ZERO
MOVEI A,12 ;RADIX 10
TRNN F2,OCTALF ;OCTAL FLAG ON?
JRST CDNUM1 ;NO
MOVEI A,10 ;YES, RADIX 8
CAIG CH,"7" ;[202] 8 OR 9 IN OCTAL STRING?
JRST CDNUM1 ;[202] NO, PROCEED
TRZ F2,OCTALF ;[202] YES, CLEAR OCTAL FLAG
ERROR E.OCT;; ;[202] AND COMPLAIN TO THE USER
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: TRO FF,ARG
JRST CD5
ALTMOD: SKIPN COMCNT ;ANY COMMANDS LEFT?
JRST ALTM2 ;[114] NO
MOVE T,CPTR ;IF NEXT COMMAND CHARACTER IS ALT-MODE, GO
ILDB CH,T
CAIE CH,ALT
JRST CD
ALTM1: TRNE FF,TRACEF ;TRACING?
PUSHJ P,CRR ;YES, TYPE CR/LF BEFORE *
JRST GO
ALTM2: SKIPN EQM ;[114] WITHIN A MACRO?
JRST GO ;[114] NO
JRST CD ;[114] MACRO RETURN
;^ MEANS THAT THE NEXT CHARACTER IS A CONTROL CHARACTER.
UAR: PUSHJ P,SKRCH ;GET NEXT COMMAND CHARACTER.
ERROR E.MEU
TRZ CH,140 ;CHANGE IT TO CONTROL CHARACTER
JRST CD9 ;DISPATCH
;IF A COMMAND TAKES TWO NUMERIC ARGUMENTS, COMMA IS USED TO SEPARATE THEM
COMMA: MOVEM B,SARG ;SAVE CURRENT ARGUMENT IN SARG.
TRZE FF,ARG ;WAS THERE A CURRENT ARGUMENT?
TROE FF,ARG2 ;YES. WAS THERE ALREADY A SECOND ARGUMENT?
ERROR E.ARG
JRST CD1 ;YES. CLEAR CURRENT ARGUMENT.
;() MAY BE USED TO OVERRIDE LEFT TO RIGHT OPERATOR SCAN FOR +,-,*,/,& AND #.
OPENP: PUSH P,NUM ;PUSH CURRENT ARGUMENT.
PUSH P,DLIM ;CURRENT OPERATOR
PUSH P,[1] ;SET PAREN FLAG ON PDL
JRST CD1
CLOSEP: POP P,T ;LAST THING ON PDL A LEFT PAREN?
JUMPL T,CLOSE1 ;SOMETHING LIKE (...<...)
SOJN T,CLOSE2 ;MISSING (
MOVEM B,SYL ;YES. SAVE CURRENT ARGUMENT.
POP P,DLIM ;RESTORE OPERATOR
POP P,NUM ;RESTORE ARGUMENT.
JRST CD7
CLOSE1: ERROR E.PAR
CLOSE2: ERROR E.MLP
;^O SETS FLAG FOR OCTAL RADIX INPUT
OCTIN: TRO F2,OCTALF
JRST CD5 ;RETURN WITHOUT MESSING UP ARGUMENTS
;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,COMAX ;[227] CALCULATE WHICH CHARACTER
SUB B,COMCNT ;[227] * WAS.
CAIE B,1 ;[227] WAS * THE FIRST CHAR?
JRST TIMES0 ;[227] NO - GO DO MULTIPLY.
MOVE B,COMSAV ;[227] YES - GET SAVED Q-BFR PTR
CAME B,[-1,,-1] ;[227] IS IT ERROR-FLAGGED?
JRST .+3 ;[227] NO - NO ERROR (YET)
PUSHJ P,GCH ;[227] YES - GET Q-REG NAME
ERROR E.NCS ;[227] AND DO ERROR.
PUSHJ P,QREGVI ;[227] GET Q-REG NAME WITH IQL CHECK
MOVEM B,QTAB-"0"(CH) ;[227] AND SAVE PTR IN THE Q-REG.
JRST CD ;[227]
TIMES0: MOVSI A,(IMUL B,) ;DLIM = IMUL B,SYL
JRST CD3
;DIVIDE (TRUNCATES) TAKES TWO ARGUMENTS
SLASH: MOVSI A,(IDIV B,) ;DLIM = IDIV B,SYL
JRST CD3
;RETURNS THE VALUE OF THE FORM FEED FLAG
FFEED: TRNE 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: TLNN 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.
TRO FF,SEQUIN ;[122] INITIALIZE AS NEW LINE
TRNE FF,ARG2 ;FLAG ANY ARGS BEFORE H
ERROR E.ARG
TROA 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
IFN VC,<
VCMD: MOVE A,VVAL ;LENGTH OF LAST TEXT
JRST VALRET
>
U VVAL,1 ;LENGTH OF LAST TEXT STRING PROCESSED
;N= CAUSES THE VALUE OF N TO BE TYPED OUT.
PRNT: TRNN FF,ARG ;INSIST ON ARG BEFORE =
ERROR E.NAE
MOVE A,CPTR ;SNEAK A LOOK AT NEXT COMMAND CHAR.
ILDB CH,A
CAIE CH,"=" ;ANOTHER = SIGN?
JRST PRNT9 ;NO
TRO F2,OCTALF ;YES, THAT MEANS OCTAL RADIX TYPE-OUT
PUSHJ P,SKRCH ;SWALLOW THE EXTRA =
TRZ F2,OCTALF ;AT END OF MACRO
PRNT9: PUSHJ P,PRNT9S ;PRINT NUMBER
JRST CRR ;CRLF AND RETURN TO CALLER
;TYPE C(B) IN OCTAL
OCTMS: TROA F2,OCTALF ;SET OCTAL RADIX
;TYPE C(B) IN DECIMAL
DECMS: TRZ F2,OCTALF ;DECIMAL RADIX
PRNT9S: MOVEI A,TYO ;OUTPUT ON TTY
PUSHJ P,DPT ;TYPE NUMBER
TRZ F2,OCTALF ;CLR RADIX FLAG
POPJ P,
;CAUSES COMMAND INTERPRETATION TO STOP UNTIL THE USER TYPES A CHARACTER
;ON THE TELETYPE AND THEN HAS THE ASCII VALUE OF THE CHARACTER TYPED IN.
SPTYI: TRO FF,DDTMF
PUSHJ P,TYI ;GET A SINGLE CHAR.
SKIPA A,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
ERROR E.MUU
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: TRZE FF,ARG ;WHICH KIND OF BACKSLASH?
JRST BAKSL1 ;ARG TO MEMORY
MOVE I,PT ;MEMORY TO VALRET
CAML I,Z ;CAN WE READ ANOTHER?
JRST BAKSL3 ;NO
PUSHJ P,GETINC ;CK FOR +,- SIGN
CAIN CH,"+"
JRST BAKSLA ;IGNORE +
CAIE CH,"-"
JRST BAKSL0 ;NO SIGN
TRO FF,ARG ;NEGATION FLAG
BAKSLA: CAML I,Z ;OVERDID IT ?
JRST BAKSL3 ;YES. EXIT
PUSHJ P,GETINC ;NO. GET A CHAR
BAKSL0: CAIG CH,"9" ;DIGIT?
CAIGE CH,"0" ;DIGIT?
SOJA I,BAKSL2 ;NOT A DIGIT. BACKUP AND LEAVE LOOP
SUBI CH,"0" ;CONVERT TO NUMBER
EXCH CH,SYL
IMULI CH,12
ADDM CH,SYL ;SYL:= 10.*SYL+CH
JRST BAKSLA ;LOOP
BAKSL3: MOVE I,Z ;HERE ON OVERFLOW
BAKSL2: TRZE FF,ARG ;MINUS SIGN SEEN?
MOVNS SYL ;YES. NEGATE
MOVEM I,PT ;MOVE POINTER PAST #
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: TRNN 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.
MOVE A,CH ;RETURN CH AS VALUE.
JRST VALRET
;NUI PUTS THE NUMERIC VALUE N IN Q-REGISTER I.
USE: TRNN FF,ARG ;INSIST ON ARG BEFORE U
ERROR E.NAU
;USE+1 1/2 [205]
TLNE B,400000 ;[205] DOES THE ARG LOOK LIKE A TEXT POINTER?
TLNE B,377777 ;[205] (IE., IS IT OUT OF RANGE?)
JRST USEA ;[205] NO, GO STORE IT
ERROR E.AOR
USEA: PUSHJ P,QREGVI ;YES. CH:=Q-REGISTER INDEX.
MOVEM B,QTAB-"0"(CH) ;STORE ARGUMENT IN SELECTED Q-REG.
JRST RET
;QI HAS THE VALUE OF THE LATEST QUANTITY PUT INTO Q-REGISTER I.
QREG: PUSHJ P,QTXTST ;[135] 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.
ERROR E.MIQ
QREGV2: CAIL CH,140 ;LC LETTER?
TRZ CH,40 ;MAKE UC
CAIGE CH,"0" ;DIGIT?
ERROR E.IQN
CAIG CH,"9"
POPJ P, ;YES
CAIL CH,"A" ;LETTER?
CAILE CH,"Z"
ERROR E.IQN
SUBI CH,"A"-"9"-1 ;TRANSLATE LETTERS DOWN BY NUMBER OF
POPJ P, ;CHARACTERS BETWEEN 9 AND A. ONLY 36 Q-REG'S
;%I ADDS 1 TO THE QUANTITY IN Q-REGISTER I AND STANDS FOR THE
; NEW VALUE
PCNT: PUSHJ P,QTXTST ;[135] GET Q-REG & CHECK FOR TEXT
AOS A,QTAB-"0"(CH) ;INCREMENT THE Q REG
JRST VALRET ;RETURN NEW VALUE.
QTXTST: PUSHJ P,QREGVI ;[135] GET Q-REG INDEX
MOVE A,QTAB-"0"(CH) ;[135] GET Q-REG CONTENTS
TLNE A,400000 ;[143] DOES IT CONTAIN TEXT?
TLNE A,377777 ;[143]
POPJ P, ;[135] NO,RETURN
ERROR E.NNQ
;M,NXI COPIES A PORTION OF THE BUFFER INTO Q-REGISTER I.
; IT SETS Q-REGISTER I TO A DUPLICATE OF THE (M+1)TH
; THROUGH NTH CHARACTERS IN THE BUFFER. THE BUFFER IS UNCHANGED.
;NXI INTO Q-REGISTER I IS COPIED THE STRING OF CHARACTERS STARTING
; IMMEDIATELY TO THE RIGHT OF THE POINTER AND PROCEEDING THROUGH
; THE NTH LINE FEED.
X:
IFN VC,<SETZM VVAL> ;CLR STRING LENGTH HOLD
PUSHJ P,GETARG ;C:=FIRST STRING ARGUMENT ADDRESS
;B:=SECOND STRING ARGUMENT ADDRESS.
PUSHJ P,CHK1 ;IS SECOND ARG. ADDR. > FIRST ARG. ADDR.?
EXCH B,C ;YES.
SUB C,B ;[211] C:=LENGTH OF STRING.
MOVE A,C ;[211] STORE LENGTH OF STRING SAVED
ADDI C,3 ;[211] C:=LENGTH OF STRING +3.
; MOVEI A,-3(C) ;STORE LENGTH OF STRING SAVED
IFN VC,<MOVEM A,VVAL>
ADD B,C ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3
PUSHJ P,X3 ;MOVE DATA TO Q-REG BUFR
JRST USEA ;NO, MAKE QTAB ENTRY NORMALLY.
;TRANSFER DATA TO Q-REGISTER BUFR
X3: PUSH P,PT
ADDM C,(P) ;(P):=PT + LENGTH OF STRING + 3.
MOVE D,BEG
MOVEM D,PT ;PT:=BEG
PUSHJ P,NROOM ;INSERT STRING AT BEG
MOVE OU,RREL ;RREL CONTAINS RELOCATION CONSTANT IF
;GARBAGE COL. OCCURRED.
ADDM OU,(P) ;RELOCATE TOP OF STRING POINTER.
CAML B,BEG ;[212] DON'T NEED TO RELOCATE IF *I
ADD B,OU ;B:=FIRST ARG ADDR + LENGTH OF STRING + 3 + RREL
MOVE OU,BEG ;OU:=ADDRESS OF Q-REG BUFFER
ADDM C,BEG ;BEG:=C(BEG)+LENGTH OF STRING + 3
MOVE CH,C ;FIRST CHAR OF BUFFER :=LEAST SIGNIFICANT 7 BITS
PUSHJ P,PUT ;OF LENGTH OF STRING + 3
AOS OU ;SECOND CHAR = MIDDLE 7 BITS OF LENGTH
ROT CH,-7
PUSHJ P,PUT
ROT CH,-7
MOVE I,B ;THIRD CHAR OF BUFFER := MOST SIGNIFICANT 7 BITS
;OF LENGTH OF STRING + 3
AOS OU
X1: PUSHJ P,PUT ;MOVE STRING TO Q-REG BUFFER.
AOS OU
CAIN C,3
JRST X2
PUSHJ P,GETINC
SOJA C,X1
X2: MOVE B,PT ;QTAB ENTRY :=XWD 400000,Q-REG BUFFER
;ADDRESS RELATIVE TO C(QRBUF)
SUB B,QRBUF
TLO B,400000
POP P,PT ;MOVE PT PAST STRING.
POPJ P,
;GI THE TEXT IN Q-REGISTER I IS INSERTED INTO THE BUFFER AT THE
; CURRENT LOCATION OF THE POINTER. THE POINTER IS THEN PUT JUST
; TO THE RIGHT OF THE INSERTION. THE Q-REGISTER IS NOT CHANGED.
QGET:
IFN VC,<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
PUSHJ P,NROOMC ;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE OU,PT
HRRZ I,QTAB-"0"(B)
ADD I,QRBUF
ADDI I,3
QGET1: JUMPE C,RET ;MOVE STRING INTO DATA BUFFER
PUSHJ P,GETINC
PUSHJ P,PUT
AOS OU,PT
SOJA C,QGET1
;GET 21 BIT Q-REGISTER CHARACTER COUNT
GTQCNT: PUSHJ P,GETINC ;LOW ORDER 7 BITS
MOVEM CH,C
PUSHJ P,GETINC ;MIDDLE 7 BITS
ROT CH,7
IORM CH,C
PUSHJ P,GETINC ;HIGH 7 BITS
ROT CH,^D14
IORM CH,C
SUBI C,3 ;LESS 3 WORDS USED TO STORE THIS COUNT
POPJ P,
;INITIALIZE ACCESS OF TEXT FROM A Q-REGISTER
QTEXT: PUSHJ P,QREGVI ;A=QTAB ENTRY, CH=Q-REG INDEX
MOVE A,QTAB-"0"(CH)
TLZE A,400000 ;MAKE SURE IT CONTAINS TEXT
TLZE A,377777
ERROR E.NTQ
ADD A,QRBUF
MOVE I,A ;I=Q-REG BUFFER ADDRESS
POPJ P,
;MI PERFORM NOW THE TEXT IN Q-REGISTER I AS A SERIES OF COMMANDS.
MAC: PUSHJ P,QTEXT ;INIT Q-REG ACCESS
PUSH P,COMAX ;SAVE CURRENT COMMAND STATE
PUSH P,CPTR
PUSH P,COMCNT
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,COMAX ;AND MAX.
SUBI I,1 ;ADJUST TO SUIT BTAB
IDIVI I,5
MOVE OU,BTAB(OU) ;MAKE A BYTE POINTER
HRR OU,I
MOVEM OU,CPTR ;PUT IT IN CPTR
AOS EQM ;[114] 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
ERROR E.MEE
MOVEI T,ECTABL ;INDEX DISPATCH TABLE
PUSHJ P,DISPAT
ERROR E.IEC
;E-COMMAND DISPATCH TABLE
ECTABL: XWD TYOCTL,"T"
XWD OPNRD,"R"
XWD OPNWR,"W"
XWD CLOSEF,"F"
XWD ZERDIR,"Z"
XWD EMTAPE,"M"
XWD EBAKUP,"B"
XWD FINISH,"X"
IFN CCL,<XWD CCLFIN,"G">
XWD OLDMOD,"O"
XWD TYCASE,"U"
XWD ERRSET,"H"
XWD AUTOTY,"S"
XWD COLOIT,"C" ;[231] DISABLE AUTO-COLON SEARCHES
XWD 0,0 ;MARKS END OF LIST
;[214] THIS ROUTINE POINTS TO THE PATH BLOCK IF SUB FILE DIRECTORIES ARE
;[214] IMPLEMENTED, OTHERWISE IT WILL PUT THE PPN IN .RBPPN.
STOMP: TLNN F2,SFDS ;[214] SEE IF SUB FILE DIRECTORIES EXIST
JRST .+3 ;[214] THEY DON'T
PUSH E,[PTHBLK] ;[214] YES, POINT TO THE PATH BLOCK
POPJ P, ;[214]
PUSH E,COMPPN ;[214] USE THE GIVEN PPN OR THE DEFAULT PPN
POPJ P, ;[214]
;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: CAIG CH,172 ;CONVERT LC TO UC
CAIG CH,137
JRST DISP1
TRZ CH,40
DISP1: PUSH P,A ;SAVE AC A WHILE WE USE IT
DISP2: MOVE A,(T) ;GET TABLE ENTRY
TRNN A,777777 ;ANYTHING LEFT?
JRST APOPJ ;NO -- RESTORE AC A & RETURN
SUBI A,(CH) ;COMPARE
MOVSS A
TLNE A,777777
AOJA T,DISP2 ;NOT A MATCH
MOVEM A,-1(P) ;GOT IT -- PUT DISPATCH ADDR ON PDL
JRST APOPJ ;RESTORE AC A & DISPATCH
;EX -- FINISH OUTPUT AND RETURN TO THE TIME-SHARING EXEC.
FINIS1: SETSTS TTY,0 ;RETURN TO NORMAL TTY MODE
OUTPUT TTY,0 ;DUMMY OUTPUT TO LET SCNSER IN ON THE NEW MODE
TRO FF,PCHFLG ;NO FREE FORM FEEDS
MOVSI E,1 ;A LARGE NUMBER OF PAGES
PUSHJ P,PUN1 ;PUNCH THOSE PAGES
JRST CLOSEF ;CLOSE AND RENAME FILES
FINISH: PUSHJ P,FINIS1 ;FINISH UP.
;^Z -- RETURN TO THE MONITOR (SAME AS THE OLD ^G)
DECDMP: RELEAS TTY,0
RELEAS INCHN,0
RELEAS OUTCHN,0
TLZ FF,UREAD+UWRITE+FINF+UBAK ;IN CASE OF A CONTINUE
RESET
EXIT 1,
JRST GO ;IF HE CONTINUES
IFN CCL,<
CCLFIN: PUSHJ P,FINIS1 ;FINISH FILE IO
IFN NORUNS,<
SKIPGE MONITR ;CHECK FOR 4 SERIES MONITOR
JRST NORUN ;3 SERIES - SIMULATE RUN UUO
>
MOVEI A,CCLBLK ;RUN COMPIL
HRLI A,1 ;AT START ADR PLUS ONE
CALLI A,35 ;RUN UUO
JRST DECDMP ;JUST EXIT IF NO RUN.
CCLBLK: SIXBIT /SYS/
SIXBIT /COMPIL/ ;RUN SYS:COMPIL
REPEAT 4,<0>
>
IFN NORUNS,<
IFN CCL,<
NORUN: MOVE 1,[SIXBIT /COMPIL/]
MOVSI 2,SAVEXT ;SIXBIT FOR SAV OR DMP
SETZB 3,4
INIT CCLCHN,17
SIXBIT /SYS/
0
CALLI 12
LOOKUP CCLCHN,1
CALLI 12
CALL 1,[SIXBIT /SETNAM/]
HLRO 15,4
HRLM 15,NORUN1
MOVNS 15
MOVEI 16,73(15)
ADDI 15,INHERE
TRO 15,1777
MOVSI NORTOP,NORAC
BLT NORTOP,NORTOP
HRR NORBLT,16
JRST NORUN2
>>
;ET COMMAND
TYOCTL: POP P,CH ;CLR RET. ADDR. FROM PDL
TRNE FF,ARG ;ARGUMENT?
JRST TYOCT1 ;YES.
TLNE FF,TYOCTF ;NO, FLAG ON?
JRST FFOK ;YES, RETURN -1
JRST BEGIN ;NO, RETURN 0
TYOCT1: TLZ FF,TYOCTF ;CLEAR ET FLAG
JUMPE B,RET ;ARGUMENT NON-ZERO?
TLO FF,TYOCTF ;YES. SET ET FLAG
JRST RET ;RETURN
;EO COMMAND
OLDMOD: POP P,CH ;CLR RET. ADDR. FROM PDL
TRNE FF,ARG ;ARGUMENT?
JRST OLD1 ;YES, SET FLAG
MOVE A,EOFLAG ;NO, RETURN VALUE OF EOFLAG
JRST VALRET
OLD1: CAIG B,0 ;N <= 0?
MOVEI B,EOVAL ;YES, SET TO STANDARD
CAILE B,EOVAL ;N > STANDARD FOR THIS VERSION?
ERROR E.EOA
MOVEM B,EOFLAG ;SET EOFLAG
JRST RET
U EOFLAG,1 ;EDIT OLD FLAG
;EU COMMAND
TYCASE: POP P,CH ;CLR RET. ADDR. FROM PDL
TRNE FF,ARG ;ARGUMENT?
JRST TYCAS1 ;YES
MOVE A,TYCASF ;NO, RETURN VALUE OF TYPE-OUT CASE FLAG
JRST VALRET
TYCAS1: MOVEM B,TYCASF ;SET TYPE-OUT CASE FLAG
JRST RET
U TYCASF,1 ;TYPE-OUT CASE FLAG: 0 = TYPE ' BEFORE LC
;+ = TYPE ' BEFORE UC; - = DON'T TYPE FLAGS
;ES COMMAND
AUTOTY: POP P,CH ;CLR RET ADDR FROM PDL
TRNE FF,ARG ;ARG?
JRST AUTOT1 ;YES
MOVE A,AUTOF ;NO, RETURN VALUE OF FLAG
JRST VALRET
AUTOT1: MOVEI A,12 ;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
;
;EC COMMAND
COLOIT: POP P,CH ;[231] CLR RETURN ADDR.
TRNE FF,ARG ;[231] ARGUMENT?
JRST COLOI1 ;[231] YES - GO PROCESS IT.
MOVE A,COLOFL ;[231] NO - RETURN FLAG VALUE
JRST VALRET ;[231]
COLOI1: CAIE B,0 ;[231] ZERO ARGUMENT?
SETO B, ;[231] NO - MAKE ALL ONES
MOVEM B,COLOFL ;[231] SAVE ARGUMENT
JRST RET ;[231]
U COLOFL,1 ;[231] NON-ZERO IMPLIES NO AUTO-COLON
;[231] ZERO IMPLIES AUTO-COLON.
;^V COMMAND
LOWCAS: TRNE FF,ARG ;ARG SEEN?
JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
TRZ F2,UCASE ;CLEAR ^W FLAG
TRO F2,LCASE ;& SET ^V FLAG
JRST RET
;^W COMMAND
STDCAS: TRNE FF,ARG ;ARG SEEN?
JUMPE B,CLRCAS ;YES, IF 0 CLEAR ALL PREVAILING CASE FLAGS
TRZ F2,LCASE ;CLEAR ^V FLAG
TROA F2,UCASE ;& SET ^W FLAG
CLRCAS: TRZ F2,LCASE+UCASE ;0^V OR 0^W CLEARS BOTH FLAGS
JRST RET
;^X COMMAND
SETMCH: TRNE FF,ARG ;ANY ARGUMENT?
JRST SETMC1 ;YES
TLNE FF,PMATCH ;NO, FORCED EXACT MATCH FLAG ON?
JRST FFOK ;YES, RETURN -1
JRST BEGIN ;NO, RETURN 0
SETMC1: TLZ FF,PMATCH ;CLR ^X FLAG
JUMPE B,RET ;IF ARG = 0, FLAG = 0
TLO FF,PMATCH ;OTHERWISE, SET FLAG
JRST RET
;EH COMMAND -- CHANGE ERROR MESSAGE DEFAULT
ERRSET: POP P,CH ;[144] ADJUST STACK POINTER.
TRNE FF,ARG ;ARG SEEN?
JRST ERRSE1 ;YES, RESET INDICATOR
MOVE A,ERRLEN ;NO, RETURN CURRENT VALUE OF FLAG
ADDI A,2 ;CONVERT TO EXTERNAL VALUE
JRST VALRET
ERRSE1: JUMPG B,.+2 ;TRANSLATE AS FOLLOWS:
MOVEI B,ERRMSG ;-N,0 IS SET TO STANDARD (ERRMSG)
SUBI B,2 ;1 BECOMES -1 = SHORT MESSAGE
MOVEM B,ERRLEN ;2 BECOMES 0 = MEDIUM
JRST RET ;3 BECOMES +1 = LONG
;ER PREPARE TO READ FILE
OPNRD: TLZ FF,FINF+UREAD ;NOT EOF & CLOSE PREVIOUS INPUT
RELEAS INCHN,0 ;[175] RELEASE INPUT BEVICE
SETZM SWITC ;[175] NO FILE SWITCHES TYPED YET
PUSHJ P,FILSPC ;GET FILE SPEC
PUSHJ P,RDFIL ;[175] LOOKUP FILE, IF POSSIBLE
PUSHJ P,TYPFFI ;[175] FOUND ON LIBRARY
MOVE E,SWITC ;[175] PICKUP USER'S SWITCHES
TLC E,GENLSN!SUPLSN ;[175] SEE IF BOTH ARE SET
TLCN E,GENLSN!SUPLSN ;[175] ARE THEY?
ERROR E.COS;; ;[175] YES, CONTRADICTORY SWITCHES
MOVEM E,INSWIT ;STORE SETTING FOR INPUT
TRZ FF,SEQF ;CLR SEQUENCE NUMBER FLAG
TLZE FF,CCLFLG ;[175] YANK REQUESTED?
PUSHJ P,YANK ;[175] 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
;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 ;[175] ASCII MODE
MOVEI E,IBUF
MOVEM E,OPNBUF ;[175]
MOVE E,OPNDEV ;[175] PICKUP INPUT DEVICE
MOVEM E,INDEV ;[175] SAVE FOR ERRORS
MOVE E,OPNCHR ;[175] DEVCHR WORD, TOO
MOVEM E,INCHR ;[175] ERROR PROCESSOR NEEDS IT
OPEN INCHN,OPNBLK ;[175] OPEN INPUT FILE
ERROR E.IDV
MOVEI T,IBUF1 ;[175] GET INPUT BUFFERS
EXCH T,.JBFF ;[175]
INBUF INCHN,2 ;[175]
MOVEM T,.JBFF ;[175]
MOVE A,[XNAM,,INNAM] ;[175] COPY INPUT FILE NAME
BLT A,INEXT ;[175] FOR ERROR MESSAGES
TXNN E,DV.DIR ;[175] LOOKUP UUO NEEDED?
JRST RDFIL2 ;[175] NO, DON'T DO ONE
TLNE E,DVDTA ;[136] IS IT DECTAPE?
JRST RDFIL1 ;[136] YES, DO SHORT LOOKUP
LOOKUP INCHN,XFILNM ;EXTENDED LOOKUP
JRST LKUPER ;ERROR
TLO FF,UREAD ;[175] INPUT FILE NOW OPEN
MOVEI E,INCHN ;[175] INPUT CHANNEL
MOVEM E,PTHBLK ;[175] PUT INTO PATH BLOCK
MOVE E,[PTHLEN,,PTHBLK] ;[175] DO PATH UUO
PATH. E, ;[175] TO DETERMINE WHERE FILE WAS FOUND
JRST CPOPJ1 ;[175] PROBABLY A TTY: OR TSK:
MOVE E,[PTHPPN,,INPPN] ;[175] COPY PATH TO FILE
BLT E,INSFD+5 ;[175] FOR ERROR MESSAGE PROCESSOR
PUSHJ P,CHKPTH ;[175] WAS IT FOUND WHERE SAID IT WAS?
POPJ P, ;[175] NO, NON-SKIP RETURN
JRST CPOPJ1 ;[175] YES, ALL IS WELL
RDFIL1: LOOKUP INCHN,SFILNM ;[175] SHORT LOOKUP
JRST LKUPER ;LOOKUP FAILURE
RDFIL2: TLO FF,UREAD ;[175] INPUT FILE NOW OPEN
AOS (P) ;[175] DECTAPES DON'T HAVE LIB'S
POPJ P, ;[175] RETURN
EBAKUP: TLNE FF,UBAK ;[175] IS EB ALREADY IN PROGRESS?
ERROR E.EBO;; ;[175] YES, NEW ONE ILLEGAL TILL EF
TLZ FF,UBAK!UREAD!FINF ;[175] INPUT FILE CLOSED
RELEAS INCHN, ;[175] (AS SOON AS WE CLOSE IT)
PUSHJ P,CLOSEF ;[175] CLOSE OUTPUT FILE IF ANY
SETZM SWITC ;[175] NO I/O SWITCHES TYPED YET
PUSHJ P,FILSPC ;[175] PARSE USER'S FILE SPEC
MOVE E,SWITC ;[175] GET SWITCHES USER TYPED
TLC E,GENLSN!SUPLSN ;[175] CHECK FOR CONFLICTING SWITCHES
TLCN E,GENLSN!SUPLSN ;[175] DID HE GIVE BOTH?
ERROR E.COS;; ;[175] YES, ERROR
MOVEM E,INSWIT ;[175] NO, STORE BOTH AS INPUT...
MOVEM E,OUTSWT ;[175] AND AS OUTPUT SWITCHES
;EBAKUP +14 1/2 [203]
MOVE E,[<"00000">B34+1] ;[203] SETUP INITIAL LSN
MOVEM E,LSNCTR ;[203] FOR OUTPUT FILE
SKIPE E,OPNCHR ;[175] GET CHARACTERISTICS OF HIS DEVICE
TXNE E,DV.DSK!DV.DTA ;[175] IF DEVICE EXISTS BUT ISN'T RIGHT
CAIA ;[175] DOESN'T EXIST (GET BETTER MESSAGE
;[175] WHEN OPEN FAILS) OR IS OK
ERROR E.EBD;; ;[175] ILLEGAL EB DEVICE
HLRZ A,XEXT ;[175] GET PROPOSED EXTENSION
TLC E,-1-<(DV.TTA)> ;[175] CONTRARY TO POPULAR BELIEF,
TLCE E,-1-<(DV.TTA)> ;[175] NUL: DOESN'T PROHIBIT UFD/SFD!
TXNN E,DV.DSK ;[175] IS EB DEVICE A DISK?
JRST EBAKU0 ;[175] NO, DIRECTORY NAMES LEGAL
CAIE A,'SFD' ;[175] CAN'T DO EB TO DIRECTORIES,
CAIN A,'UFD' ;[175] SINCE RENAMES WOULD FAIL AT EF
ERROR E.EBF;; ;[175] ILLEGAL EB FILE
EBAKU0: CAIN A,'BAK' ;[175] IS IT BAK?
ERROR E.EBF;; ;[175] CAN'T DO EB TO BAK FILES
CAIE A,'TMP' ;[175] USER'S EXTENSION .TMP?
JRST EBAKU1 ;[175] NO, FILENAME IS OK TO USE
MOVE A,XNAM ;[175] CAN'T ALLOW NNNTEC.TMP,
CAMN A,TMPTEC ;[175] SINCE THAT'S OUR TEMP OUTPUT FILE
ERROR E.EBF;; ;[175] IT WAS NNNTEC.TMP, ILLEGAL FILE
EBAKU1: PUSHJ P,RDFIL ;[175] OPEN DEVICE & LOOKUP FILE
JRST FAKERW ;[175] ON LIB:, CAN'T DO EB, DO ER/EW
SETZM PTHBLK ;[175] CLEAR RETURNED JUNK
SETZM PTHFLG ;[175] IN CASE MONITOR LOOKS AT IT
MOVE E,OPNCHR ;[175] GET DEVCHR OF EB DEVICE
MOVEM E,EBCHR ;[175] STORE FOR BAKCLS
SETZM OPNSTS ;[175] ASCII MODE FOR OPNOU
MOVE E,[XNAM,,EBNAM] ;[175] SAVE EB FILE & EXT FOR BAKCLS
BLT E,EBEXT ;[175] ..
MOVE E,[PTHPPN,,EBPPN] ;[175] SAVE EB PATH TOO
BLT E,EBSFD+4 ;[175] ..
MOVE E,OPNCHR ;[175] GET EB DEVICE
TXNN E,DV.DSK ;[175] IS IT A DSK: ?
JRST EBAKU4 ;[175] 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] ;[175] PICKUP FILE PROTECTION
MOVEM A,EBPROT ;[175] SAVE FOR BAKCLS
HRLI A,.ACREN ;[175] CHECK NEEDED RENAME ACCESS
MOVE AA,PTHPPN ;[175] FILE'S PPN IN LOC + 1
MOVE B,USRPPN ;[175] USER'S IN LOC + 2
MOVEI E,A ;[175] POINT TO 3 CONTIGUOUS ACS
CHKACC E, ;[175] SEE IF WE CAN RENAME IT
SETZ E, ;[175] DON'T KNOW, ASSUME OK
JUMPE E,EBAKU3 ;[175] 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 ;[175] SET LH=-1 AS FLAG FOR BAKCLS
;[175] THAT 2 RENAMES WILL BE NEEDED
HRLI A,.ACCPR ;[175] CHECK .ACCPR TO SEE IF WE OWN IT
MOVEI E,A ;[175] POINT TO THE ARG BLOCK
CHKACC E, ;[175] CHECK IF WE CAN CHANGE PROTECTION
SETZ E, ;[175] PATH UUO BUT NO CHKACC?
JUMPE E,EBAKU2 ;[175] OK, NOW CHECK WRITE ACCESS
ERROR E.EBP;; ;[175] EB FILE IS TOO PROTECTED
EBAKU2: HRLI A,.ACWRI ;[175] WE OWN IT, BUT CAN WE WRITE IT?
MOVEI E,A ;[175] (MIGHT BE <555>)
CHKACC E, ;[175] ASK FILSER
SETZ E, ;[175] NEVER BOMB USER HERE
JUMPE E,EBAKU3 ;[175] OK, GO EDIT IT
ERROR E.EBP;; ;[175] PROTECTED FILE
;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 ;[175] GET REAL INPUT FILE UNIT
MOVEM E,DCBLK ;[175] STORE FOR DSKCHR
MOVE E,[DCLEN,,DCBLK] ;[175] DO DSKCHR TO GET STR
DSKCHR E, ;[175] THAT FILE WAS FOUND ON
JRST EBAKU4 ;[175] FAILED, USE WHAT WE HAVE
MOVE E,DCSNM ;[175] OK, PICKUP STR NAME
MOVEM E,OPNDEV ;[175] STORE IN NEW OPEN BLOCK
MOVX E,UU.PHS ;[175] USE PHYSICAL ONLY OPEN
MOVEM E,OPNSTS ;[175] SINCE WE HAVE PHYSICAL STR NAME
;FALL THROUGH TO NEXT PAGE
;ENTER HERE IF GOING TO A DECTAPE.
EBAKU4: MOVE E,[OPNBLK,,EBSTS] ;[175] SAVE STS & DEV FOR BAKCLS
BLT E,EBDEV ;[175] ..
PUSHJ P,OPNOU ;[175] OPEN EB DEVICE
MOVE E,[-XFILEN+1,,XFILNM] ;[175] PDL TO LOOKUP BLOCK
PUSHJ P,STOMP ;[214] PUT THE RIGHT THING IN .RBPPN
PUSH E,TMPTEC ;[175] FILE NAME IS NNNTEC
PUSH E,['TMP '] ;[175] EXTENSION IS TMP (WIPE DATES)
MOVX E,<777>B8 ;[175] CLEAR ALL DATES FOR ENTER
ANDM E,XPRV ;[175] BUT KEEP ORIGINAL PROTECTION
MOVX E,<100>B8 ;[175] GET LOWEST NON-ZERO PROTECTION
SKIPN XPRV ;[175] IF EDITING A <000> FILE,
MOVEM E,XPRV ;[175] DO ENTER WITH <100> SO WON'T
;[175] GET SYSTEM DEFAULT PROTECTION
SETZM XVER ;[175] EDITING CHANGES FILE VERSIONS!
MOVE E,XSIZ ;[175] NOW SETUP OUTPUT ESTIMATE
ADDI E,777 ;[175] ROUND UP INPUT + 2 RIBS + 1
LSH E,-7 ;[175] CONVERT TO BLOCKS
MOVEM E,XEST ;[175] STORE FOR OUTPUT ENTER
SETZM XALC ;[175] NO NEED FOR CONTIGUITY
SETZM XPOS ;[175] CERTAINLY NO SPECIFIC PLACE!
PUSHJ P,WTFIL ;[175] DO ENTER ON .TMP FILE
TLO FF,UWRITE+UBAK ;[175] IT ALL WORKED! TURN ON FLAGS
EBAKU5: TLZE FF,CCLFLG ;[175] CALLED FROM TECO COMMAND?
PUSHJ P,YANK ;[175] YES, DO A Y
POPJ P, ;[175] 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 ;[175] TELL WHAT WE'RE DOING
PUSHJ P,FILALT ;[175] PUT OUTPUT FILE EXACTLY WHERE
SETZM OPNSTS ;[175] THE USER SPECIFIED. ITS KNOWN
PUSHJ P,OPNOU ;[175] NOT TO EXIST, SINCE A LOOKUP
PUSHJ P,WTFIL ;[175] FOUND IT ONLY ON LIB
TLO FF,UWRITE ;[175] EW SUCCESSFULLY INITIATED
PJRST EBAKU5 ;[175] DO A Y IF FROM A TECO COMMAND
U TMPTEC,1 ;SAVE FOR ###TEC. FILE NAME
U FDAEM,1 ;[175] NON-ZERO MEANS FTFDAE ON IN MON.
U EBSTS,1 ;[175] SAVED MODE FOR EB DEVICE
EBOPN==EBSTS ;[175] ALTERNATE NAME
U EBDEV,1 ;[175] DEVICE FOR EB
U EBBUF,1 ;[175] BUFFER ADDR (NOT USED)
U EBCHR,1 ;[175] EB DEVICE DEVCHR
U EBPTH,2 ;[175] PATH BLOCK HEADER (NOT USED)
U EBPPN,1 ;[175] PPN THAT EB FILE CAME FROM
U EBSFD,5 ;[175] SFD'S IN EB FILE'S PATH
U EBNAM,1 ;[175] EB FILE NAME
U EBEXT,1 ;[175] EB EXTENSION
U EBPROT,1 ;[175] LH=-1 IF EDITING OWNER'S <2XX>
;[175] FILE, RH=ORIGINAL FILE'S PROT
;INPUT FILE LOOKUP ERROR
LKUPER: RELEAS INCHN,0
TLZ FF,UREAD+FINF ;[175] LET GO OF INPUT DEVICE
EE1+ERROR E.FNF
;TYPE OUTPUT ERROR
ENTERR: RELEAS OUTCHN,0
TLZ FF,UWRITE+UBAK ;LET GO OF OUTPUT DEVICE & EB FLAG
LDB E,[POINT 15,XEXT,35] ;[175] ERROR CODE
CAIE E,ERPRT% ;[175] MAYBE DTA FULL?
JRST ENTER2 ;[175] NO
MOVE A,OUCHR ;[175] YES
TXNE A,DV.DTA ;[175] IF DTA ITS FULL, ELSE ENTER ERROR
ERROR E.FUL
ENTER2: EE1+ERROR E.ENT
;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)
ZERDIR: TLOA FF,EZTMP ;[175] FLAG EZ COMMAND, NOT EW
OPNWR: TLZ FF,EZTMP ;[175] THIS IS A REAL EW COMMAND
TLNE FF,UBAK ;[175] EB IN PROGRESS?
ERROR E.EBO;; ;[175] YES, EW IS A NO-NO
PUSHJ P,CLOSEF ;[175] GIVE HIM A FREE EF ON OLD FILE
SETZM SWITC ;[175] NO I/O SWITCHES TYPED YET
PUSHJ P,FILSPC ;[175] PARSE NEW FILE SPEC, SET UP X???
MOVE E,SWITC ;[175] GET SWITCHES HE TYPED
TLC E,GENLSN+SUPLSN ;[175] CHECK FOR BOTH BEING ON
TLCN E,GENLSN+SUPLSN ;[175] WITH TRIED & TRUE TLC, TLCN TRICK
ERROR E.COS;; ;[175] CONFLICTING OUTPUT SWITCHES
MOVEM E,OUTSWT ;[175] OK, STORE WHAT HE TYPED
MOVE E,[<"00000">B34+1] ;[175] SETUP INITIAL LSN
MOVEM E,LSNCTR ;[175] FOR OUTPUT FILE
SETZM OPNSTS ;[175] ASCII MODE
PUSHJ P,OPNOU ;[175] OPEN OUTPUT DEVICE, SETUP BUFFERS
TLZN FF,EZTMP ;[175] WAS THIS AN EZ COMMAND?
JRST OPNWR0 ;[175] NO, CONTINUE
UTPCLR OUTCHN, ;[175] YES, ZERO DIRECTORY
MTREW. OUTCHN, ;[175] AND REWIND THE "DECTAPE"
MTWAT. OUTCHN, ;[175] WAIT FOR IT IN CASE MTA
OPNWR0: MOVEI E,OUTCHN ;[230] LOAD E WITH THE OUTPUT CHANNEL
DEVNAM E, ;[230] FIND OUT THE "REAL" DEVICE NAME
JFCL ;[230] WELL, WE LOSE.
CAME E,[SIXBIT/NUL/] ;[230] IS IT NUL:?
JRST OPNWRA ;[230] NO - CONTINUE.
JSP A,CONMES ;[230] YES - MAKE SURE USER KNOWS.
ASCIZ \%Output is to NUL:
\
OPNWRA: MOVE E,OPNCHR ;[175] DEVCHR OF DEVICE WE JUST OPENED
TXNN E,DV.DIR ;[175] A DIRECTORY DEVICE?
JRST OPNWR3 ;[175] NO, CAN'T SUPERSEDE EXISTING FILE
TLC E,-1-<(DV.TTA)> ;[175] CAN NEVER SUPERCEDE
TLCN E,-1-<(DV.TTA)> ;[175] ON DEVICE NUL:
JRST OPNWR3 ;[175] YUP, IT'S NUL:. DON'T CHECK.
TXNE E,DV.DTA ;[175] IF A DECTAPE..
JRST OPNWR1 ;[175] MUST GO DO SHORT LOOKUP
LOOKUP OUTCHN,XFILNM ;[175] SEE IF HE'S GOING TO SUPERSEDE
JRST OPNWR3 ;[175] NOT A CHANCE
MOVEI E,OUTCHN ;[175] MAYBE, SEE IF THE FILE
MOVEM E,PTHBLK ;[175] IS REALLY WHERE HE SAID IT WAS
MOVE E,[PTHLEN,,PTHBLK] ;[175] OR ON SOME LIB
PATH. E, ;[175] BY DOING A PATH UUO & COMPARING
JRST OPNWR3 ;[175] ?? OH WELL, MESSAGE NOT CRITICAL
PUSHJ P,CHKPTH ;[175] COMPARE FOUND WITH SOUGHT
JRST OPNWR3 ;[175] FOUND IN A LIB, IGNORE IT
JRST OPNWR2 ;[175] WILL SUPERSEDE, WARN USER
;HERE IF WRITING TO A DECTAPE
OPNWR1: LOOKUP OUTCHN,SFILNM ;[175] DO SHORT LOOKUP
JRST OPNWR3 ;[175] NOT THERE
OPNWR2: JSP A,CONMES ;[175] TYPE FATEFUL MESSAGE
ASCIZ \%Superseding existing file
\
OPNWR3: CLOSE OUTCHN, ;[175] WE DON'T WANT UPDATE MODE (!!)
PUSHJ P,FILALT ;[175] RE-SET UP THE ENTER BLOCK
PUSHJ P,WTFIL ;[175] DO ENTER ON OUTPUT FILE
TLO FF,UWRITE ;[175] OUTPUT FILE NOW OPEN
POPJ P, ;[175] DONE
;SUBROUTINE TO OPEN THE OUTPUT DEVICE AND SETUP THE OUTPUT BUFFERS
;USES E,T
OPNOU: MOVSI E,OBF ;[175] SETUP ADDR OF OUTPUT HEADER
MOVEM E,OPNBUF ;[175] IN OPEN BLOCK
OPEN OUTCHN,OPNBLK ;[175] FIND THE DEVICE
ERROR E.ODV;; ;[175] NONE SUCH OR IN USE
MOVE E,OPNDEV ;[175] GET DEVICE WE JUST OPENED
MOVEM E,OUDEV ;[175] SAVE FOR ERRORS
MOVE E,OPNCHR ;[175] NEED DEVCHR, TOO
MOVEM E,OUCHR ;[175] (SEE ENTERR)
MOVEI T,OBUF1 ;[175] NOW SET UP BUFFERS
EXCH T,.JBFF ;[175] TWO OF THEM,
OUTBUF OUTCHN,2 ;[175] IN OUR SPECIFIED PLACE
MOVEM T,.JBFF ;[175] THEN RESTORE REAL .JBFF
POPJ P, ;[175] DONE
;SUBROUTINE TO ENTER OUTPUT FILE. DOES SHORT ENTER IF DTA. USES E.
WTFIL: MOVE E,[XNAM,,OUNAM] ;[175] SAVE FILENAME & EXTENSION
BLT E,OUEXT ;[175] FOR PRETTY ERROR MESSAGES
MOVE E,OPNCHR ;[175] SHORT ENTER IF DTA
TXNE E,DV.DTA ;[175] IS IT?
JRST WTFIL1 ;[175] YES
ENTER OUTCHN,XFILNM ;[175] NO, DO EXTENDED ENTER
JRST ENTERR ;[175] WARN OF FAILURE
MOVEI E,OUTCHN ;[175] DETERMINE PATH TO FILE CREATED
MOVEM E,PTHBLK ;[175] BY DOING PATH UUO ON CHANNEL
MOVE E,[10,,PTHBLK] ;[175] POINT TO PATH BLOCK
PATH. E, ;[175] READ THE PATH TO THE FILE
POPJ P, ;[175] NOT A DIRECTORY DEVICE
MOVE E,[PTHPPN,,OUPPN] ;[175] NOW SAVE PATH AWAY
BLT E,OUPPN+5 ;[175] IN CASE OF OUTPUT ERRORS
POPJ P, ;[175] SUCCESS
;HERE IF DTA
WTFIL1: ENTER OUTCHN,SFILNM ;[175] SHORT ENTER FOR DTA
JRST ENTERR ;[175] FULL?
POPJ P, ;[175] 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
;EF FINISHES OUTPUT ON THE CURRENT OUTPUT FILE WITHOUT
; SELECTING A NEW OUTPUT FILE.
CLOSEF: TLNN FF,UWRITE ;[155]
POPJ P,
CLOSE OUTCHN, ;[175] CLOSE OUTPUT COMPLETELY
STATZ OUTCHN,740000
JRST OUTERR
TLZ FF,UWRITE ;[175] CLEAR NOW IN CASE ERROR IN BAKCLS
TLNE FF,UBAK ;[155] EB IN PROGRESS?
PUSHJ P,BAKCLS ;[175] YES
RELEAS OUTCHN,0
TLZ FF,UBAK ;[175] CLEAR WRITE AND EB FLAGS
POPJ P,
;EM EXECUTE MTAPE UUO.
EMTAPE: TLNN FF,UREAD
ERROR E.EMD
PUSHJ P,CHK2
CAIGE B,1
ERROR E.EMA
WAIT INCHN, ;[175] WAIT FOR BUFFERS TO FILL
MTAPE INCHN,0(B)
HRRZ A,IBUF ;[175] GET ADDR OF FIRST BUFFER
MOVE E,A ;[175] COPY TO TEMP AC
MOVX T,BF.IOU ;[175] GET "BUFFER IN USE" BIT
EMTAP1: ANDCAM T,0(E) ;[175] CLEAR IT IN CURRENT BUFFER
HRRZ E,0(E) ;[175] PICKUP ADDRESS OF NEXT
CAME E,A ;[175] DONE WITH ALL BUFFERS IN RING?
JRST EMTAP1 ;[175] NO, LOOP
SETOM IBUF+2 ;[175] INSURE NEXT IN GETS NEW RECORD
MTWAT. INCHN, ;[175] MAKE SURE SPACING COMPLETES
POPJ P, ;[175] 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: TLZ FF,UREAD+FINF ;[175] AN EB EF WIPES INPUT CHANNEL, TOO
RELEAS INCHN, ;[175] GET RID OF OLD DEVICE
MOVE E,[EBOPN,,OPNBLK] ;[175] RETRIEVE EB DEVICE
BLT E,OPNDEV ;[175] FROM EB SAVE AREA
SETZM OPNBUF ;[175] NO BUFFERS NEEDED FOR RENAMES
OPEN INCHN,OPNBLK ;[175] RE-GRAB DEVICE
ERROR E.IRN;; ;[175] IT WENT AWAY??
SETZM XFILNM ;[175] SETUP LOOKUP BLOCK
MOVE E,[XFILNM,,XFILNM+1] ;[175] TO DELETE OLD BAK FILE
BLT E,XFILNM+XFILEN-1 ;[175] FIRST, BLT TO ZERO
MOVE E,[-XFILEN,,XFILNM-1] ;[175] SET UP PDL TO XFILNM
PUSH E,[XFILEN-1] ;[175] SETUP LENGTH OF BLOCK
PUSHJ P,STOMP ;[214] PUT THE RIGHT THING IN .RBPPN
PUSH E,EBNAM ;[175] SET .RBNAM TO ORIG FILE NAME
PUSH E,['BAK '] ;[175] EXTENSION IS BAK
MOVE E,EBCHR ;[175] GET EB DEV CHARACTERISTICS
TXNE E,DV.DTA ;[175] IS IT A DECTAPE?
JRST BKCLS2 ;[175] YES, GO DO DTA'ISH THINGS
SETZM PTHBLK ;[175] NO, CLEAR OUT PATH BLOCK
SETZM PTHFLG ;[175] SINCE MONITOR LOOKS AT FLAGS
MOVE E,[EBPPN,,PTHPPN] ;[175] RESTORE PATH FROM EB SAVE
BLT E,PTHBLK+PTHLEN-2 ;[175] EBPPN IS ONLY 5 WORDS
SETZM PTHBLK+PTHLEN-1 ;[175] PTHBLK HAS XTRA 0 ON END
HRRZ B,EBPROT ;[175] SETUP AC B TO BE PROTECTION THAT
ANDCMI B,300 ;[175] WE WILL GIVE .BAK FILE IF NONE
SKIPN FDAEM ;[175] NOW EXISTS
ANDCMI B,400 ;[175] (I.E <0XX> OR <4XX> IF FDAEM)
LOOKUP INCHN,XFILNM ;[175] FIND OLD .BAK FILE
JRST BKCLS3 ;[175] NONE THERE, GO MAKE ONE
LDB B,[POINT 9,XPRV,8] ;[175] MAKE NEW .BAK HAVE SAME
;[175] PROTECTION AS OLD ONE DID
SETZM XNAM ;[175] DELETE OLD .BAK FILE
RENAME INCHN,XFILNM ;[175] BY RENAMING TO 0 . . .
EE1+ERROR E.BAK;; ;[175] TOO PROTECTED TO GET RID OF
JRST BKCLS3 ;[175] OK, GO RENAME SOURCE TO BAK
;HERE IF OLD BAK FILE SOUGHT ON A DECTAPE. USE SHORT LOOKUP/RENAME
BKCLS2: LOOKUP INCHN,SFILNM ;[175] LOOK FOR THE FILE
JRST BKCLS3 ;[175] NONE, DON'T SWEAT IT
SETZM XNAM ;[175] DELETE BY RENAMING TO ZERO
RENAME INCHN,SFILNM ;[175] ..
EE1+ERROR E.BAK;; ;[175] HOW CAN IT FAIL ON MY DTA??
;HERE TO RENAME THE OLD SOURCE FILE TO FILE.BAK
BKCLS3: MOVE E,[-XFILEN+1,,XFILNM] ;[200] RESET THINGS TO EB FILE
PUSHJ P,STOMP ;[214] LAST LOOKUP MIGHT HAVE WIPED PPN
PUSH E,EBNAM ;[175] WE WIPED XNAM
PUSH E,EBEXT ;[175] EXTENSION DEFINITELY ISN'T BAK
MOVE E,EBCHR ;[175] GET ORIGINAL EB DEVICE DEVCHR
TXNE E,DV.DTA ;[175] DECTAPE?
JRST BKCLS5 ;[175] YES, DO SHORT LOOKUP/RENAME
SETZM PTHBLK ;[175] NO, MAKE SURE PTHBLK SETUP RIGHT
SETZM PTHFLG ;[175] MONITOR RETURNS STUFF ON LOOKUP
LOOKUP INCHN,XFILNM ;[175] FIND ORIGINAL SOURCE FILE
EE1+ERROR E.ILR;; ;[175] I'M EXTREMELY OFFENDED
SKIPL EBPROT ;[175] NEED TO LOWER PROTECTION?
JRST BKCLS4 ;[175] NO, JUST RENAME IT TO .BAK
MOVX E,<300>B8 ;[175] CLEAR THESE BITS
ANDCAM E,XPRV ;[175] TO MAKE PROTECTION REASONABLE
RENAME INCHN,XFILNM ;[175] DOWN GOES THE PROTECTION
EE1+ERROR E.IRB;; ;[175] FILE DAEMON WON'T LET US?
SETZM PTHBLK ;[233] After rename to change prot.,
SETZM PTHFLG ;[233] non-default path will be lost
LOOKUP INCHN,XFILNM ;[233] so get it again
EE1+ERROR E.ILR;; ;[233]
BKCLS4: MOVE A,XEXT ;[175] SAVE DATES FOR ERROR RECOVERY
MOVSI E,'BAK' ;[175] NEW FILE NAME IS FILE.BAK
HLLM E,XEXT ;[175] KEEP SAME DATES ETC.
DPB B,[POINT 9,XPRV,8] ;[175] STORE BAK FILE PROTECTION
RENAME INCHN,XFILNM ;[175] MAKE OLD SOURCE INTO BAK
CAIA ;[175] TRY TO RECOVER
JRST BKCLS6 ;[175] 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] ;[175] PICKUP RENAME ERROR CODE
CAIE E,ERPRT% ;[175] PROTECTION FAILURE?
EE1+ERROR E.IRB;; ;[175] NO, STOP NOW
MOVEM A,XEXT ;[175] YES, RESTORE DATES WIPED BY ERROR
LOOKUP INCHN,XFILNM ;[175] LOOKUP OLD SOURCE AGAIN
EE1+ERROR E.ILR;; ;[175] GONE??
MOVSI E,'BAK' ;[175] NEW EXTENSION
HLLM E,XEXT ;[175] CHANGE ONLY EXTENSION
RENAME INCHN,XFILNM ;[175] TRY IT AGAIN
EE1+ERROR E.IRB;; ;[175] SOME OTHER ERROR?
JRST BKCLS6 ;[175] WON, GO MAKE .TMP NEW SOURCE
;HERE TO MAKE FILE.SRC BE FILE.BAK IF ON A DTA
BKCLS5: LOOKUP INCHN,SFILNM ;[175] FIND OLD SOURCE FILE
EE1+ERROR E.ILR;; ;[175] HOW CAN THIS BE?
MOVSI E,'BAK' ;[175] NEW EXTENSION IS .BAK
HLLM E,XEXT ;[175] KEEP DATES ETC.
RENAME INCHN,SFILNM ;[175] CHANGE NAME TO FILE.BAK
EE1+ERROR E.IRB;; ;[175] JUST NOT MY LUCKY DAY
;FALL THROUGH TO NEXT PAGE
;HERE TO FIND OUTPUT NNNTEC.TMP FILE, AND RENAME IT TO NEW SOURCE FILE.
BKCLS6: RELEAS INCHN, ;[175] MAKE SURE INPUT DEVICE FINISHED
SETZM XFILNM ;[175] CAN'T BE TOO CAREFUL
MOVE E,[XFILNM,,XFILNM+1] ;[175] SO BLT LOOKUP BLOCK TO 0
BLT E,XFILNM+XFILEN-1 ;[175] ..
MOVE E,[-XFILEN,,XFILNM-1] ;[175] SETUP PDL TO LOOKUP BLOCK
PUSH E,[XFILEN-1] ;[175] RESET LENGTH WORD
PUSHJ P,STOMP ;[214] RESET .RBPPN
PUSH E,TMPTEC ;[175] SET .RBNAM TO NNNTEC
PUSH E,['TMP '] ;[175] EXTENSION IS TMP
MOVE E,EBCHR ;[175] DEVCHR OF EB DEVICE
TXNE E,DV.DTA ;[175] DECTAPE?
JRST BKCLS8 ;[175] YES, DO SHORT LOOKUPS
SETZM PTHBLK ;[175] ZAP BITS MONITOR RETURNS
SETZM PTHFLG ;[175] ON LOOKUPS OR RENAMES
LOOKUP OUTCHN,XFILNM ;[175] FIND THE .TMP FILE
EE1+ERROR E.OLR;; ;[175] WENT AWAY??
SKIPL EBPROT ;[175] NEED TO LOWER PROTECTION?
JRST BKCLS7 ;[175] NO, GO CHANGE NAME
SKIPN FDAEM ;[175] FILE DAEMON MONITOR?
SKIPA A,[POINT 3,XPRV,2] ;[175] NO, OWNER FIELD 3 BITS
MOVE A,[POINT 2,XPRV,2] ;[175] YES, ONLY 2 BITS
SETZ E, ;[175] LOWEST POSSIBLE PROTECTION
DPB E,A ;[175] STORE IN OWNER FIELD
RENAME OUTCHN,XFILNM ;[175] LOWER PROTECTION OF FILE
EE1+ERROR E.RNO;; ;[175] CANT?
SETZM PTHBLK ;[233] After rename to change prot.,
SETZM PTHFLG ;[233] non-default path will be lost
LOOKUP OUTCHN,XFILNM ;[233] so get it again
EE1+ERROR E.OLR;; ;[233]
BKCLS7: MOVE E,EBNAM ;[175] GET SOURCE FILE NAME
MOVEM E,XNAM ;[175] STORE FOR RENAME
MOVE E,EBEXT ;[175] GET SOURCE EXTENSION
HLLM E,XEXT ;[175] STORE WITHOUT TOUCHING DATES
MOVE E,EBPROT ;[175] MAKE PROTECTION SAME AS OLD
DPB E,[POINT 9,XPRV,8] ;[175] ..
RENAME OUTCHN,XFILNM ;[175] TURN TMP FILE INTO NEW SOURCE
EE1+ERROR E.RNO;; ;[175] FILE DAEMON DOESN'T KNOW US
POPJ P, ;[175] ALL DONE
;HERE TO RENAME TMP FILE TO NEW SOURCE FILE ON A DTA
BKCLS8: LOOKUP OUTCHN,SFILNM ;[175] DO SHORT LOOKUP TO FIND FILE
EE1+ERROR E.OLR;; ;[175] GONE!
MOVE E,EBNAM ;[175] GET SOURCE FILE NAME
MOVEM E,XNAM ;[175] STORE FOR RENAME
MOVE E,EBEXT ;[175] PICKUP EB EXTENSION
HLLM E,XEXT ;[175] STORE WITHOUT TOUCHING DATES
RENAME OUTCHN,SFILNM ;[175] LAST RENAME OF THE JOB
EE1+ERROR E.RNO;; ;[175] HOW CAN WE LOSE NOW?
POPJ P, ;[175] DONE
;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 ;[175] GET DEVICE USER TYPED
MOVSI E,'DSK' ;[175] BLANK DEFAULTS TO DSK:
MOVEM E,CPATH ;[175] STORE IN OUR PATH BLOCK
MOVE E,[CPTLEN,,CPATH] ;[175] DO A PATH UUO ON IT
PATH. E, ;[175] TO SEE IF USER MEANT HIS PPN
JFCL ;[175] PROBABLY MTA: OR TSK:
MOVE E,CFLG ;[175] PICKUP FLAGS WORD
TXNN E,PT.IPP ;[175] IS THIS AN ERSATZ DEVICE?
JRST CMPDSK ;[175] 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] ;[175] COPY SFD'S ONLY
BLT E,CPATH+CPTLEN-1 ;[175] ..
JRST CMPPTH ;[175] 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 ;[175] IS DEFAULT PATH OK?
JRST CMPPTH ;[175] YES, GO COMPARE WITH FOUND
MOVE E,[COMPPN,,CPPN] ;[175] NO, GET WHAT USER SAID
BLT E,CPATH+CPTLEN-1 ;[175] ONLY PPN & SFD'S
CMPPTH: SETZ A, ;[175] SETUP TO LOOP OVER PATH
CMPLUP: MOVE E,CPPN(A) ;[175] GET NEXT WORD OF PATH
CAME E,PTHPPN(A) ;[175] MATCH WHERE IT WAS FOUND?
POPJ P, ;[175] NO, IN A LIBRARY
SKIPE E ;[175] DONE IF ZERO
AOJA A,CMPLUP ;[175] ELSE COMPARE MORE SFD'S
AOS (P) ;[175] PATHS WERE THE SAME
POPJ P, ;[175] 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: JSP A,CONMES ;[175] TYPE FIRST PART
ASCIZ \%File found in [\ ;[175]
MOVEI C,PTHBLK ;[175] POINT TO PATH BLOCK
PUSHJ P,TYPATH ;[175] TYPE IT
JSP A,CONMES ;[175] NOW FINISH MESSAGE
ASCIZ \]
\
POPJ P,
;ROUTINE TO TYPE A PATH IN THE PATH BLOCK POINTED TO BY AC C.
;USES AC'S B,CH,TT
TYPATH: HLRZ B,2(C) ;[175] GET PROJECT
PUSHJ P,OCTMS ;[175] TYPE IT
MOVEI CH,"," ;[175] SEPARATOR
PUSHJ P,TYOM ;[175] TYPE
HRRZ B,2(C) ;[175] PROGRAMMER
PUSHJ P,OCTMS ;[175] PUT IT OUT IN OCTAL
TYPTH1: SKIPN TT,3(C) ;[175] MORE SFD'S?
POPJ P, ;[175] NO
MOVEI CH,"," ;[175] YES, END LAST ONE
PUSHJ P,TYOM ;[175] WITH A COMMA
PUSHJ P,SIXBMS ;[175] TYPE THIS ONE
AOJA C,TYPTH1 ;[175] LOOP
;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:
;ENTER AT FILALT TO COPY COM??? AREA TO X???? AREA.
;USES AC'S A,B,E,CH
FILSPC: TLZ FF,FEXTF ;[175] INITIALIZE FILE SCANNING FLAGS
SETZM COMZR ;[175] ZERO AREA THAT WE USE
MOVE A,[COMZR,,COMZR+1] ;[175] INCLUDES COM???, X????
BLT A,COMEZR ;[175] ..
;BACK HERE TO PARSE A NEW FIELD OF THE FILE SPECIFICATION
NEWFLD: PUSHJ P,FILWRD ;[175] ACCUMULATE SIXBIT INTO AC E
CAIN CH,":" ;[175] WAS TERMINATOR A COLON?
JRST FILDEV ;[175] YES, GO PROCESS DEVICE
CAIN CH,"." ;[175] A PERIOD?
JRST FILNAM ;[175] YES, STORE FILENAME & FLAG EXT.
PUSHJ P,STRFLD ;[175] ALL OTHER TERMINATORS START A
;[175] FIELD, SO STORE END OF LAST ONE
CAIN CH,"[" ;[175] PATH DESIGNATOR?
JRST FILPTH ;[175] YES, GO READ IN PATH
CAIN CH,"/" ;[175] A SWITCH?
JRST FILSWT ;[175] YES, GO READ IT
CAIE CH,ALT ;[175] ONLY OTHER DELIMITER AN ALT
ERROR E.IFN;; ;[175] NO, SO ILLEGAL CHARACTER
;HERE WHEN FILESPEC FINISHED (ALTMODE SEEN). COPY COM??? TO X??? & POPJ.
FILALT: SETZM XFILNM ;[175] ZERO LOOKUP BLOCK AGAIN
MOVE E,[XFILNM,,XFILNM+1] ;[175] INCASE ENTRY AT FILALT
BLT E,XFILNM+XFILEN-1 ;[175] BUT NOT TOO FAR
SKIPN E,COMDEV ;[175] PICKUP USER DEVICE IF ANY
MOVSI E,'DSK' ;[175] NONE, SO USE DSK:
MOVEM E,OPNDEV ;[175] STORE FOR OPEN
DEVCHR E, ;[175] ALSO NEED CHARACTERISTICS
MOVEM E,OPNCHR ;[175] SO WE CAN TELL DECTAPES FROM DSK:
TXNE E,DV.TTY ;[175] IS IT A TTY?
TXNN E,DV.TTA ;[175] YES, CONTROLLING A JOB (OURS)?
CAIA ;[175] NO TO EITHER
ERROR E.TTY;; ;[175] ILLEGAL TTY I/O DEVICE
MOVE A,[-XFILEN,,XFILNM-1] ;[175] SETUP PDL INTO LOOKUP BLK
PUSH A,[XFILEN-1] ;[175] FIRST WORD IS LENGTH
SKIPG COMPPN ;[175] DID USER SPECIFY A PATH?
TDZA E,E ;[175] NO, USE A ZERO FOR DEFAULT
MOVEI E,PTHBLK ;[175] YES, POINT TO PATH BLOCK
TLNN F2,SFDS ;[214] SEE IF SFDS ARE USED
MOVE E,COMPPN ;[214] IF NOT, THEN USE A PPN.
PUSH A,E ;[175] STORE PATH POINTER OR ZERO OR PPN
PUSH A,COMNAM ;[175] STORE FILE NAME
PUSH A,COMEXT ;[175] EXTENSION
SETZM PTHBLK ;[175] SETUP PTHBLK FROM COMPPN
SETZM PTHFLG ;[175] ZERO 1ST 2 WORDS FOR MONITOR
MOVE A,[COMPPN,,PTHPPN] ;[175] COPY REST FROM COMMAND
BLT A,PTHBLK+PTHLEN-2 ;[175] ..
SETZM PTHBLK+PTHLEN-1 ;[175] MAKE SURE IT TERMINATES WITH A 0
POPJ P,
;HERE WHEN ":" TYPED. STORE THE DEVICE NAME.
FILDEV: SKIPE E ;[175] USER TYPE A DEVICE?
TLNE FF,FEXTF ;[175] MAYBE, REALLY AN EXTENSION?
ERROR E.NDV;; ;[175] NO OR YES, NULL DEVICE ILLEGAL
MOVEM E,COMDEV ;[175] YES, STORE IT
JRST NEWFLD ;[175] 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: TLOE FF,FEXTF ;[175] SET EXTENSION FLAG
ERROR E.DEX;; ;[175] DOUBLE EXTENSION ILLEGAL
JUMPE E,NEWFLD ;[175] MAYBE NO FILENAME (FOO[,].BAR)
SKIPE COMNAM ;[175] THERE IS, DUPLICATE?
ERROR E.DFN;; ;[175] YES, ERROR
MOVEM E,COMNAM ;[175] NO, STORE THE FILE NAME
JRST NEWFLD ;[175] READY FOR THE NEXT FIELD
;HERE WHEN "/" OR "[" OR <ALT> TYPED. STORE FILE OR EXT. FIRST
STRFLD: TLZE FF,FEXTF ;[175] WAITING FOR AN EXTENSION?
JRST STREXT ;[175] YES, GO STORE IT
JUMPE E,CPOPJ ;[175] DON'T STORE IF NOTHING THERE
SKIPE COMNAM ;[175] FILE NAME ALREADY SEEN?
ERROR E.DFN;; ;[175] YES, ERROR
MOVEM E,COMNAM ;[175] NO, STORE THE FILE NAME
POPJ P, ;[175] RETURN
;HERE IF WE SHOULD STORE AN EXTENSION
STREXT: JUMPE E,CPOPJ ;[175] DON'T STORE IF NOT TYPED
SKIPE COMEXT ;[175] DOUBLE EXTENSION?
ERROR E.DEX;; ;[175] YES, ILLEGAL
HLLZM E,COMEXT ;[175] NO, STORE EXTENSION
POPJ P, ;[175] DONE
;HERE WHEN "[" TYPED. READ IN A PATH SPECIFICATION.
FILPTH: SKIPE COMPPN ;[175] ONLY ONE PER CUSTOMER
ERROR E.DDI;; ;[175] DOUBLE DIRECTORY ILLEGAL
PUSHJ P,FILOCT ;[175] READ THE PROJECT
CAIN CH,"-" ;[175] [-] MEANS DEFAULT PATH
JUMPE E,FILDFP ;[175] BUT [123-] DOESN'T
CAIN CH,"," ;[175] ONLY LEGAL TERMINATOR IS ","
TDNE E,[-1,,400000] ;[175] AND PROJECT MUST BE .LE. 377777
ERROR E.IPJ;; ;[175] ILLEGAL PPN
SKIPN E ;[175] [, ???
HLRZ E,USRPPN ;[175] YES, USE LOGGED-IN PROJECT
MOVSM E,COMPPN ;[175] STORE FOR RETURN
PUSHJ P,FILOCT ;[175] GET PROGRAMMER
TLNE E,-1 ;[175] ONLY HALF WORD ALLOWED
ERROR E.IPG;; ;[175] ERROR
SKIPN E ;[175] [FOO,]??
HRRZ E,USRPPN ;[175] YES, USE LOGGED IN PROGRAMMER
HRRM E,COMPPN ;[175] STORE ANSWER
CAIN CH,ALT ;[175] ALLOW X:Y.Z[,<ALT>
JRST FILALT ;[175]
CAIN CH,"]" ;[175] END OF SPEC?
JRST NEWFLD ;[175] YES, GO READ MORE
CAIE CH,"," ;[175] LAST CHANCE
ERROR E.IFN;; ;[175] ILLEGAL CHARACTER
;HERE TO COLLECT SFD'S FROM THE COMMAND STRING
MOVE B,[XWD -5,COMSFD] ;[175] MAX SFD'S ALLOWED
FILSFD: PUSHJ P,FILWRD ;[175] PARSE SFD NAME
SKIPN E ;[175] MUST BE ONE
ERROR E.NSF;; ;[175] NULL SFD ILLEGAL
MOVEM E,(B) ;[175] OK, STORE IT
CAIN CH,ALT ;[175] END OF IT ALL?
JRST FILALT ;[175] FINISH UP
CAIN CH,"]" ;[175] NO, END OF PATH?
JRST NEWFLD ;[175] YES, LOOK FOR SWITCHES ETC
CAIE CH,"," ;[175] MORE SFD'S?
ERROR E.IFN;; ;[175] NO, JUNK
AOBJN B,FILSFD ;[175] GO AFTER MORE SFD'S
ERROR E.SFD;; ;[175] SPEC NESTED TOO DEEPLY
;HERE ON "[-". SET COMPPN TO -1 TO INDICATE DEFAULT PATH.
FILDFP: SETOM COMPPN ;[175] DEFAULT PATH
PUSHJ P,FILCHR ;[175] NEXT CHARACTER
CAIN CH,ALT ;[175] ALLOW IT TO END HERE
JRST FILALT ;[175] FINISH UP
CAIE CH,"]" ;[175] ELSE MUST FINISH RIGHT
ERROR E.IFN;; ;[175] DON'T LIKE IT
JRST NEWFLD ;[175] GO GET MORE
;HERE ON A "/". READ IN THE SWITCH.
FILSWT: PUSHJ P,FILWRD ;[175] READ THE SWITCH NAME
MOVEM E,SWITHL ;[175] STORE FOR ERROR MSGS
MOVEI B,SWITAB ;[175] POINT TO SWITCH TABLE
FILSWL: SKIPN (B) ;[175] DONE?
ERROR E.UIS;; ;[175] UNKNOWN I/O SWITCH
CAME E,(B) ;[175] MATCH?
AOJA B,FILSWL ;[175] NO, TRY NEXT
SUBI B,SWITAB ;[175] CONVERT SWITCH TO OFFSET
MOVNS B ;[175] NEED NEGATIVE FOR LSH
MOVSI E,(1B0) ;[175] 1B0 IS 1ST SWITCH, 1B1 IS SECOND
LSH E,(B) ;[175] CONVERT TO RIGHT BIT
IORM E,SWITC ;[175] STORE FOR RETURN
CAIN CH,"/" ;[175] ANOTHER SWITCH COMING?
JRST FILSWT ;[175] YES, PROCESS IT
CAIN CH,ALT ;[175] END OF IT ALL?
JRST FILALT ;[175] YES, GO FINISH UP
ERROR E.IFN;; ;[175] NOTHING ELSE LEGAL ANYMORE
;FILE SELECTION COMMAND SWITCH TABLE
SWITAB: SIXBIT /GENLSN/ ;GENERATE LINE SEQ#'S ON OUTPUT
SIXBIT /SUPLSN/ ;SUPPRESS LSN (INPUT OR OUTPUT)
0
U INSWIT,1 ;INPUT SWITCHES
U OUTSWT,1 ;OUTPUT SWITCHES
U LSNCTR,1 ;LSN GENERATION CTR
;SWITCH BITS -- LEFT HALF
GENLSN==1B18
SUPLSN==1B19
;HERE TO READ AN ALFAMERIC WORD INTO E IN SIXBIT. USES A.
FILWRD: SETZ E, ;[175] INITIALIZE ACCUMULATOR AC
MOVE A,[POINT 6,E] ;[175] SETUP TO STORE IN IT
FILWRL: PUSHJ P,FILCHR ;[175] GET NEXT CHAR
CAIL CH,"A" ;[175] A LETTER?
CAILE CH,"Z" ;[175] MAYBE, IS IT?
CAIA ;[175] NO, COULD BE A DIGIT
JRST FILWR1 ;[175] IT IS A LETTER. STORE IT.
CAIL CH,"0" ;[175] DIGIT?
CAILE CH,"9" ;[175] IS IT?
POPJ P, ;[175] NOPE, END OF WORD
FILWR1: SUBI CH,"A"-'A' ;[175] CONVERT TO SIXBIT
TLNE A,770000 ;[175] AC E FULL YET?
IDPB CH,A ;[175] NO, STORE THE CHARACTER
JRST FILWRL ;[175] LOOP FOR ENTIRE WORD
;HERE TO READ AN OCTAL NUMBER INTO E.
FILOCT: SETZ E, ;[175] INITIALIZE ANSWER
FILOCL: PUSHJ P,FILCHR ;[175] GET NEXT DIGIT
CAIL CH,"0" ;[175] A DIGIT?
CAILE CH,"7" ;[175] (OCTAL, THAT IS)
POPJ P, ;[175] NO, END OF OCTAL NUMBER
LSH E,3 ;[175] YES, MAKE ROOM
ADDI E,-"0"(CH) ;[175] ADD IN NEXT DIGIT
JRST FILOCL ;[175] LOOP FOR ENTIRE NUMBER
;GET A CHAR FOR FILEPSPECIFICATION
;IGNORE SPACE, TAB, LF, VT, FF, CR; CONVERT LC TO UC
FILCHR: PUSHJ P,SKRCH
ERROR E.UFS
CAIL CH,141
CAILE CH,172
JRST .+2
TRZ CH,40
CAIN CH,40
JRST FILCHR
CAIL CH,11
CAILE CH,15
POPJ P,
JRST FILCHR
;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:
YANK1: MOVE OU,BEG
MOVEM OU,PT ;PT:=BEG
TLZ F2,LSNINF ;[220] CLEAR THE CLEARING FLAG
YANK2: TLNE FF,FINF ;[140] IF WE FINISHED ALREADY
JRST YANK51 ;[140] THEN GET OUT
TRZ FF,FORM ;RESET THE YANK,APPEND FORM FEED FLAG
TLNN FF,UREAD ;ERROR IF INPUT NOT SPECIFIED
ERROR E.NFI
;MAINTAIN AT LEAST A MINIMUM SIZE BUFFER OF 3000
;CHARACTERS AT ALL TIMES, WHEN TECO ASKS FOR INPUT FROM
;ANYTHING BUT THE CONSOLE.
MOVE C,PT ;GET .
MOVEM C,Z ;TELL NROOM IT'S AN EXPAND
SUBM OU,C ;BUT EXPAND WITH REAL Z IN MIND
ADDI C,^D3000 ;NEED 3000 ABOVE Z
PUSHJ P,NROOM
YANK6: ADD OU,RREL ;RELOCATE IN CASE GARBAGE COLLECTION DONE
MOVE TT,MEMSIZ ;TOP OF BUFFER
MOVE CH,TT
SUB TT,OU
IDIVI TT,3
SUBM CH,TT
MOVEM TT,M23 ;M23 HAS 2/3 PT
SUBI CH,200
MOVEM CH,M23PL ;M23PL HAS 200 BELOW TOP
YANK4: CAMGE OU,M23 ;2/3 FULL YET?
JRST YANK3 ;NO, KEEP GOING
CAMG OU,M23PL ;YES, GETTING NEAR TOP?
CAIN CH,12 ;NO. LINE FEED?
JRST YANK51 ;YES. THAT'S ALL.
;NO. GET MORE.
YANK3: SOSLE IBUF+2 ;IS DEVICE BUFFER EMPTY?
JRST YANK5 ;NO.
INPUT INCHN,0 ;YES. FILL IT.
STATZ INCHN,740000 ;ERROR?
JRST INERR ;YES.
STATO INCHN,20000 ;NO. END OF FILE?
JRST YANK5 ;NO.
TLO FF,FINF
JRST YANK51 ;CLEAR BUFFER AND RETURN.
YANK5: ILDB CH,IBUF+1 ;CH:=NEXT CHARACTER.
TLZN F2,LSNINF ;[220] WAS THE LAST THING A SUPPRESSED LSN?
JRST YANK52 ;NO
CAIE CH,15 ;[150] YES, IGNORE THE NEXT CHARACTER
CAIN CH,11 ;[150] IF IT'S A CR (FOR SOS) OR A TAB
JRST YANK3 ; IGNORE IT
YANK52: JUMPE CH,YANK3 ;IF NULL, IGNORE IT.
MOVE T,@IBUF+1
TRNE T,1 ;SEQUENCE NUMBER?
JRST YNKSEQ ;YES
YANK50: PUSHJ P,PUT ;NO. PUT CHARACTER IN DATA BUFFER.
CAIE CH,14 ;FORM FEED?
AOJA OU,YANK4 ;NO. UPDATE DATA BUFFER PTR AND CHECK FOR OVERFLOW.
TRO FF,FORM ;YANK AND/OR APPEND TERMINATED ON A LFORM FEED
YANK51: MOVEM OU,Z ;YES. SET END OF DATA BUFFER AND RETURN
POPJ P,
YNKSEQ: MOVE T,INSWIT ;SUPPRESS SEQ# FLAG ON?
TLNE T,SUPLSN
JRST YNKSEZ ;YES, STRIP THEM OFF AS IN DAYS OF YORE
TRON FF,SEQF ;SET SEQ FILE AND [121]
;JRST IF ALREADY SEEN [121]
TLNE T,GENLSN ;DOES USER WANT LSN'S? [121]
JRST YANK50 ;IF SO DON'T BOTHER HIM [121]
;HERE IF NO LSN SWITCH AND SEQUENCED FILE
; TELL USER WHAT'S ABOUT TO HAPPEN [121]
MOVE T,CH ;SAVE THE CHARACTER [121]
JSP A,CONMES ;OUTPUT THE MESSAGE [121]
ASCIZ /%LINE NUMBER DETECTED IN INPUT FILE
/
MOVE CH,T ;RESTORE CHARACTER [121]
JRST YANK50 ; [121]
YNKSEZ: MOVEI T,4 ;CTR FOR REST OF SEQ #
IBP IBUF+1 ;MOVE PTR OVER THIS CHAR
SOS IBUF+2 ;& CTR TOO
SOJG T,.-2
TLO F2,LSNINF ;[220] IGNORE NEXT CHAR IF TAB
TRO FF,SEQUIN ;IGNORE NEXT CHAR IF IT IS A TAB
JRST YANK3
INERR: GETSTS INCHN,B ;SAVE ERROR FLAGS
RELEAS INCHN,0
TLZ FF,UREAD
EE2+ERROR E.INP
;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
;^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: TRZ FF,ARG ;NO ARGUMENT WANTED
PUSHJ P,TAB2 ;INSERT TAB
IFN VC,<TLO FF,TABSRT> ;ADJUST VVAL
;ITEXT$ INSERT, AT THE CURRENT POINTER LOCATION, THE TEXT FOLLOWING
; THE I UP TO BUT NOT INCLUDING THE FIRST ALT. MODE. THE
; POINTER IS PUT TO THE RIGHT OF THE INSERTED MATERIAL.
INSERT: TRNE FF,ARG ;IS THERE AN ARGUMENT?
JRST INS1A ;YES. NI COMMAND.
MOVEI CH,ALT ;NORMAL TERMINATOR
TRZN FF,SLSL ;DID @ PRECEED I?
JRST INSERA ;NO, TERMINATOR = ALTMODE
PUSHJ P,SKRCH ;YES. CH:=USER SELECTED TERMINATOR.
ERROR E.UIN
INSERA: MOVEI B,(CH) ;B=INSERTION TERMINATOR.
PUSH P,CPTR ;SAVE CURRENT POSITION IN CMD STRING
PUSH P,COMCNT
MOVEI C,0 ;COUNT # CHARACTERS TO INSERT IN C AND
;MOVE CPTR TO END OF STRING.
INSER0: PUSHJ P,SKRCH ;GET NEXT CHARACTER
ERROR E.UIN
CAIN CH,(B) ;IS IT THE TERMINATOR?
JRST INSER2 ;YES, END OF 1ST PASS
CHKEO EO21,INSER1 ;IF EO=1, CTRL-CHARS ARE JUST TEXT
MOVEI T,IN1TAB ;CK FOR ^V, ^W, ^R, ^T, ^^
TRNE F2,TXTCTL ;^T FLAG ON?
MOVEI T,IN2TAB ;YES, USE RESTRICTED TABLE
PUSHJ P,DISP1
TRNN F2,TXTCTL ;IF ^T ON, ALL OTHER CTL-CHARS LEGAL TEXT
PUSHJ P,CKNCC ;CHECK FOR OTHER CTRL-CHARS (THEY ARE ILLEGAL)
INSER1: AOJA C,INSER0 ;COUNT TEXT CHARACTERS
INSER2: MOVEM C,VVAL ;SAVE LENGTH OF STRING
IFN VC,<
TLZE FF,TABSRT ;TAB INSERTED?
AOS VVAL ;YES, COUNT IT
>
TRZ F2,TXTCTL ;REFRESH ^T FLAG
TRNE FF,FSRCH ;DOING FS OR FN?
JRST SERCHJ ;YES
POP P,COMCNT ;RESET TO BEGINNING OF INSERT TEXT
POP P,CPTR
PUSHJ P,NROOM ;YES. MOVE FROM PT THROUGH Z UP C POSITIONS.
;MOVE INSERTION INTO DATA BUFFER
INS1B: MOVE OU,PT
INS1C: PUSHJ P,GCH ;CH:=CHARACTER FROM COMMAND STRING.
INS1F: CAIN CH,(B) ;IS IT THE TERMINATOR?
POPJ P, ;YES. DON'T STORE IT.
CHKEO EO21,INS1D ;IF EO=1, THERE ARE NO CTL-CHAR. COMMANDS
MOVEI T,INSTAB ;CK FOR CONTROL CHARACTERS
TRNE F2,TXTCTL ;^T FLAG ON?
MOVEI T,INTTAB ;YES, ONLY ^T AND ^R ARE SPECIAL
PUSHJ P,DISP1
INS1E: PUSHJ P,CASE ;CONVERT UC TO LC IF FLAGS WARRANT
INS1D: PUSHJ P,PUT ;NO. STORE CHARACTER IN DATA BUFFER TO RIGHT OF PT.
AOS PT ;PT:=PT+1
JRST INS1B ;LOOP
;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (COUNT PASS)
IN1TAB: XWD INSER0,26 ;^V
XWD INSER0,27 ;^W
XWD INSER0,36 ;^^
IN2TAB: XWD INSER4,24 ;^T
XWD INSER3,22 ;^R
XWD 0,0 ;END OF LIST
;GET CHARACTER AFTER ^R
INSER3: PUSHJ P,SKRCH ;DON'T COUNT ^R & DON'T DO CHECKS ON CHAR AFTER IT
ERROR E.UIN
JRST INSER1
;CHANGE NO-CONTROL-COMMANDS FLAG
INSER4: TRC F2,TXTCTL
JRST INSER0 ;DON'T COUNT ^T
;DISPATCH TABLE FOR INSERT STRING CONTROL CHARACTERS (INSERT PASS)
INSTAB: XWD INSLOW,26 ;^V
XWD INSSTD,27 ;^W
XWD INSSPC,36 ;^^
INTTAB: XWD INSMAC,24 ;^T
XWD INSIGR,22 ;^R
XWD 0,0 ;END OF LIST
;^V CAUSES THE NEXT CHARACTER TO BE CONVERTED TO LOWER CASE (IF UPPER CASE)
;^V^V SETS LOWER CASE MODE UNTIL THE END OF THE TEXT STRING (OR FURTHER NOTICE)
INSLOW: PUSHJ P,C.V ;SET ^V FLAGS
JRST INS1C ;CONTINUE TO NEXT CHAR.
;^W CAUSES NEXT CHAR. TO BE TAKEN AS IS (STANDARD MODE)
;^W^W SETS STANDARD MODE UNTIL END OF TEXT STRING (OR FURTHER NOTICE)
INSSTD: PUSHJ P,C.W ;SET ^W FLAGS
JRST INS1C ;CONTINUE TO NEXT CHAR.
;^R CAUSES NEXT CHAR. TO BE TAKEN AS TEXT
;EVEN IF IT IS A CONTROL CHAR. OR THE TEXT TERMINATOR
INSIGR: PUSHJ P,GCH ;GET NEXT CHAR.
JRST INS1E ;TREAT AS TEXT
;^^ -- IF NEXT CHAR IS @,[,\,],^, OR _, CONVERT IT TO LC RANGE
INSSPC: PUSHJ P,GCH ;GET NEXT CHAR
PUSHJ P,CVTSPC ;CONVERT IF WARRANTED
JRST INS1F
;CHANGE NO-CONTROL-COMMANDS MODE
INSMAC: TRC F2,TXTCTL ;COMPLEMENT ^T FLAG
JRST INS1C ;GO ON TO NEXT CHAR
;SET ^V FLAGS
C.V: TRON F2,CTLV ;SET ^V FLAG -- WAS IT ON BEFORE?
POPJ P, ;NO
TRZ F2,CTLV+CTLWW ;YES, SET ^V^V FLAG & CLR OTHERS
TRO F2,CTLVV
POPJ P,
;SET ^W FLAGS
C.W: TRON F2,CTLW ;SET ^W FLAG -- WAS IT ON BEFORE?
POPJ P, ;NO
TRZ F2,CTLW+CTLVV ;YES, SET ^W^W FLAG & CLR OTHERS
TRO F2,CTLWW
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: TRNE F2,LCASE ;PREVAILING LOWER CASE?
TRO CH,40 ;YES, CONVERT TO LOWER
TRNE F2,UCASE ;PREVAILING UPPER CASE?
TRZ CH,40 ;YES, CONVERT TO UPPER
TRNE F2,CTLVV ;DOUBLE ^V ON?
TRO CH,40 ;YES, CONVERT TO LC
TRNE F2,CTLWW ;DOUBLE ^W ON?
TRZ CH,40 ;YES, CONVERT TO UC
TRZE F2,CTLV ;SINGLE ^V ON?
TRO CH,40 ;YES, CONVERT TO LC
TRZE F2,CTLW ;SINGLE ^W ON?
TRZ CH,40 ;YES, CONVERT TO UC
CASE3: TRZ F2,CTLV+CTLW ;CLR IN CASE NO CONVERSION
POPJ P,
;CONVERT @, [, \, ], ^, AND _ TO THE EQUIVALENT LC CHARACTER
CVTSPC: CAIL CH,"["
CAILE CH,"_"
CAIN CH,"@"
TRO CH,40 ;CONVERT TO LOWER CASE RANGE
POPJ P,
;CHECK FOR NON-CONTROL CHARACTERS
;IF CH<10, OR 15<CH<33, OR 33<CH<40, CH IS AN ILLEGAL CTRL-CHAR
CKNCC: CAIGE CH,40
CAIG CH,15
CAIGE CH,10
CAIN CH,33
POPJ P, ;IT IS 10-15 OR 33 OR 40+
MOVEI B,(CH) ;SAVE CHAR FOR ERROR MSG ROUTINE
ERROR E.ICT
;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
ERROR E.NAI
CAIE CH,ALT ;IT HAD BETTER BE AN ALTMODE
ERROR E.NAI
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.
BAKSL1: MOVE T,[XWD 700,STAB-1]
MOVEI C,0 ;COUNT # DIGITS IN C.
MOVEI A,BAKSL4 ;SET DPT TO RETURN TO BAKSL4
PUSHJ P,DPT ;CONVERT C(B) TO ASCII AND STORE STRING IN STAB.
MOVE B,[XWD 700,STAB-1]
PUSHJ P,NROOMC ;MOVE FROM PT THROUGH Z UP C POSITIONS.
BAKSL5: 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,BAKSL5 ;DECREMENT THE CHAR CTR
JRST RET
BAKSL4: IDPB CH,T ;STORE DIGIT IN STAB
AOJA C,CPOPJ ;C:=C+1. RETURNS TO DPT CALL + 1 ON COMPLETION.
;@ COMMAND MODIFIER
ATSIGN: TROA FF,SLSL ;SET @ SEEN FLAG
;COLON COMMAND MODIFIER
COLON: TRO FF,COLONF ;SET : SEEN FLAG
JRST RET
;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:
TYPE4: MOVEI D,TYO ;D:=ADDRESS OF OUTPUT ROUTINE.
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
HLL TT,BTAB(TT1) ;..
LDB CH,TT ;COPIED TO SPEED IT UP
ADDI I,1 ;..
PUSHJ P,(D) ;OUTPUT IT
JRST TYPE3 ;LOOP
TYPE5: MOVEI A,PPA ;IF TYPING OR I,JP DON'T APPEND FF.
MOVEI CH,14 ;IF PUNCHING, APPEND FF.
CAIE A,(D) ;D=PPA?
POPJ P, ;NO
TRNN FF,PCHFLG ;IS THIS AN "N" SEARCH?
CPPA: JRST PPA ;NO, APPEND A FORM FEED
TRNN FF,FORM ;DID LAST Y,A TERMINATE ON A FORM FEED?
POPJ P, ;NO,DO NOT APPEND ONE
;YES, FALL INTO PPA: TO APPEND FF
PPA: TLNN FF,UWRITE ;ERROR IF NO OUTPUT FILE
ERROR E.NFO
PPA05: SOSLE OBF+2 ;YES. IS OUTPUT BUFFER FULL?
JRST PPA11 ;NO.
OUTPUT OUTCHN,0 ;YES. WRITE IT
STATZ OUTCHN,740000 ;ERROR?
JRST OUTERR ;YES.
MOVE A,OUCHR ;[175]
TXNE A,DV.MTA ;[175]
STATO OUTCHN,IOEOT ;A MAG TAPE AND AFTER EOT?
SKIPA ;NO
JRST OUTERR
PPA11: MOVE A,OUTSWT ;GET OUTPUT SWITCHES
TRNE FF,SEQF ;SEQUENCED FILE?
JRST PPA02 ;YES
TLNE A,GENLSN ;NO, OUTPUT GENLSN ON?
JRST PPA02 ;YES, GENERATE LSN
TRZ FF,SEQUIN ;CLR SO AS NOT TO SCREW YANK
PPA01: IDPB CH,OBF+1 ;CH TO OUTPUT BUFFER.
POPJ P, ;RETURN
OUTERR: GETSTS OUTCHN,B ;SAVE ERROR FLAGS
RELEAS OUTCHN,0 ;CLOSE FILE AND RELEASE OUTPUT DEVICE.
TLZ FF,UWRITE+UBAK ;CLEAR OUTPUT FILE OPEN INDICATOR.
EE2+ERROR E.OUT
PPA02: TRNN FF,SEQUIN ;WAS LAST CHAR AN EOL OR BEG OF BUFR?
JRST PPA03 ;NO
MOVE AA,OUTSWT ;[176] GET OUTPUT SWITCHES
TLNE AA,SUPLSN ;[176] SUPPRES SEQ # ?
JRST PPA06 ;[176] YES
MOVE A,OBF+2 ;ROOM FOR SEQ# IN OUTPUT BUFR?
CAIG A,14 ;[217] PAGE MARKS ARE A LITTLE BIGGER
JRST PPA05 ;NO, OUTPUT & COME BACK
PPA07: LDB A,[POINT 6,OBF+1,5] ;GET CURRENT BYTE POSITION IN OUT BUFR
CAIG A,1 ;AT END OF WORD?
JRST PPA06 ;YES
IBP OBF+1 ;NO, PAD OUT WORD WITH NULLS
SOS OBF+2
JRST PPA07 ;TRY AGAIN
PPA06: TRZ FF,SEQUIN ;[176] MOVED DOWN FROM PPA07-1
TRNE FF,SEQF ;[176] REMOVE PPA06 LABEL
;[176] GENERATE NEW LSN OR OUTPUT EXISTING LSN?
JRST PPA04 ;OUTPUT EXISTING LSN
CAIN CH,14 ;[217] HANDLE A FORM-FEED?
JRST PPA14 ;[217] 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
PPA06A: AOS OBF+1 ;& OUTPUT THE 5 DIGITS + BIT 35
MOVEM A,@OBF+1
MOVEI A,11 ;FOLLOWED BY TAB
IDPB A,OBF+1
MOVE A,OBF+2 ;ADJUST BUFR CTR
SUBI A,6
MOVEM A,OBF+2
PPA03: PUSHJ P,CKEOL ;IS THIS CHAR AN EOL?
JRST PPA01 ;NO
TRO FF,SEQUIN ;YES, SET EOL FLAG
CAIE CH,14 ;[217] A FORM FEED?
JRST PPA01 ;[217] NO, SO JUST OUTPUT
TLNE AA,SUPLSN ;[217] SUPPRESSING LSN'S?
JRST PPA01 ;[217] YES
MOVEI A,15 ;[217] NO, INSERT CRLF
IDPB A,OBF+1 ;[217] BEFORE A PAGE MARK
MOVEI A,12 ;[217] SO IT WILL BE RECOGNIZED
IDPB A,OBF+1 ;[217]
SOS OBF+2 ;[217] AND UPDATE
SOS OBF+2 ;[217] THE COUNTER
JRST PPA14 ;[217] 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 ;[141]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] ;[150] GET 5 SPACES
PPA08X: CAIE CH," " ;[150] SPACE?
JRST PPA08B ;NO, INSERT 5 SPACES [115]
SOSGE LSNCTR ;HAVE WE SEEN 5 SPACES [115]
JRST PPA08C ;IF SO CHECK FOR TAB [115]
PUSHJ P,GETINC ;[141]GET NEXT CHARACTER
JRST PPA08X ;[150] 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 ;[150] PICK IT UP AND
CAIE CH,15 ;[150] TEST FOR CR (FOR SOS) OR
CAIN CH,11 ;[150] TAB TO BE OUTPUT WITH SPACES
JRST PPA09 ;[150] OUTPUT 5 SPACES + CHAR IN CH
; JRST PPA08B ;[150] MUST BE USER'S SPACES!
; HERE IF NOT 5 SPACES FOLLOWED BY TAB OR CR. THIS IMPLIES
; THAT ANY SPACES SEEN WERE USER'S TEXT.
PPA08B: SUBI I,5 ;[150] BACK UP TO FIRST CHARACTER
ADD I,LSNCTR ;[150] AND OUTPUT IT WITH BLANK LSN
PUSHJ P,GETINC ;[141] GET PROPER CHARACTER
MOVE AA,OUTSWT ;GET SWITCHES [115]
TLNE AA,SUPLSN ;SUPPRESS SEQ# [115]
JRST PPA01 ;[141] YES
TRO A,1 ;NO, SET BIT 35 [115]
JRST PPA06A ;OUTPUT SEQ# WITH A TAB [115]
PPA09: MOVE AA,OUTSWT ;GET SWITCHES
TLNE AA,SUPLSN ;SUPPRESS SEQ#'S?
JRST PPA13 ;YES
TRO A,1 ;SET BIT 35
AOS OBF+1 ;& OUTPUT SEQ #
MOVEM A,@OBF+1
MOVE A,OBF+2 ;& ADJUST BUFR CTR
SUBI A,5
MOVEM A,OBF+2
JRST PPA03 ; CONTINUE
PPA13: CAIE CH,15 ;[150] ELIMINATE CR (FOR SOS)
CAIN CH,11 ;IS TERMINATOR A TAB?
AOSA OBF+2 ;[176] YES, FIX POINTER AND
JRST PPA01 ;NO, OUTPUT IT
POPJ P, ;[176] OMIT IT
;
; HERE TO INSERT A SOS STYLE PAGE MARK.
;
PPA14: MOVE A,[BYTE(7) 40,40,40,40,40] ;[217] FIVE SPACES
TRO A,1 ;[217] AND THE BIT ON
AOS OBF+1 ;[217] OUTPUT IT
MOVEM A,@OBF+1 ;[217]
MOVE A,[BYTE(7) 15,14,0,0,0] ;[217] AND CR,FF
AOS OBF+1 ;[217] INCREMENT THE POINTER
MOVEM A,@OBF+1 ;[217] AND DEPOSIT
MOVE A,OBF+2 ;[217] ADJUST BUFR CTR
SUBI A,12 ;[217]
MOVEM A,OBF+2 ;[217]
TRO FF,SEQUIN ;[217] SET THE EOL FLAG
MOVE A,[<"00000">B34+1] ;[217] RESET THE LSN'S
MOVEM A,LSNCTR
POPJ P, ;[] AND RETURN
;PW OUTPUT THE ENTIRE BUFFER, FOLLOWED BY A FORM FEED CHARACTER.
; TO THE SELECTED OUTPUT DEVICE. BUFFER IS UNCHANGED AND POINTER
; IS UNMOVED.
;P IS IDENTICAL TO PWY.
;NP IS IDENTICAL TO PP...P (P PERFORMED N TIMES).
;I,JP OUTPUTS (I+1)TH THROUGH JTH CHARACTERS OF BUFFER. NO FORM
; FEED IS PUT AT THE END. BUFFER UNCHANGED; POINTER UNMOVED.
PUNCHA: MOVEI D,CPPA ;SELECT PPA FOR OUTPUT INDIRECTLY IN CASE I,JP.
TRNE FF,ARG2 ;I,JP?
JRST TYPE0 ;YES. GET STRING ARGUMENTS AND OUTPUT.
MOVE E,B ;NO. E:=N
MOVE B,CPTR
ILDB T,B ;T:=COMMAND CHARACTER FOLLOWING P.
TRZ T,40 ;FILTER L.C.
JUMPL E,CPOPJ ;IF N<0, IGNORE P.
CHKEO EO21,PUN1 ;OLD STYLE P ALWAYS GIVES FORM FEED
CAIE T,"W" ;PW ALWAYS GIVES FORM FEED
TRO 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?
TLNN 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
TRZ 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 ;[173] NO; IF SEQUENCED FILE, START PAGE WITH SEQ#
;[173] EDIT 173 OBSOLECES PUNCH1
TRNE 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: TLNE FF,UREAD ;ANY INPUT FILE?
TLNE 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 IF N>0: MOVE POINTER TO THE RIGHT, STOPPING WHEN IT HAS
; PASSED OVER N LINE FEEDS.
; IF N<0: MOVE POINTER TO THE LEFT; STOP WHEN IT HAS PASSED
; OVER N+1 EOL'S AND THEN MOVE IT TO THE RIGHT OF
; THE LAST EOL PASSED OVER.
;L SAME AS 1L.
LINE: TRNE FF,ARG2 ;ERROR IF THERE ARE 2 ARGS
ERROR E.TAL
PUSHJ P,GETARG ;NO. C:=FIRST STRING ARGUMENT ADDRESS,
;B:=SECOND STRING ARGUMENT ADDRESS.
XOR B,C
XORM B,PT
JRST RET
;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: TROE 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
;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
MOVM C,B
MOVNS C ;C:=-ABS(B)
ADD B,PT ;B:=PT+B
PUSHJ P,CHK ;STILL IN DATA BUFFER?
CAMGE B,PT ;YES. IS N NEGATIVE?
MOVEM B,PT ;YES. MOVE PT BACK FOR DELETION.
PUSHJ P,NROOM ;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
JRST RET
;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
ERROR E.POP
POPJ P,
;ROUTINE TO PUT STRING ARGUMENT ADDRESSES WITHIN DATA BUFFER
;BOUNDS AND CHECK ORDER RELATION.
;CALL MOVE C,FIRST STRING ARGUMENT ADDRESS
; MOVE B,SECOND STRING ARGUMENT ADDRESS
; PUSHJ P,CHK1
; RETURN
CHK1: CAMLE C,B ;[172] C>B? (CHECK FIRST!)
ERROR E.SAL
CAMGE C,BEG ;[172] C:=MAX(C(C),BEG)
MOVE C,BEG ;[172]
CAMLE C,Z ;[172] C:=MIN(C(C),Z)
MOVE C,Z ;[172]
CAMGE B,BEG ;[172] B:=MAX(C(B),BEG)
MOVE B,BEG ;[172]
CAMLE B,Z ;[172] B:=MIN(C(B),Z)
MOVE B,Z ;[172]
CAMN C,BEG ;[173] YES; BEG OF BUFFER?
JRST CHK1.5 ;[173] YES
MOVE TT,C ;[173] NO; BEG OF LINE?
SUBI TT,1 ;[173] GET PREV CHAR
IDIVI TT,5 ;[173] RIGHT HALF OF PTR
HLL TT,BTAB(TT1) ;[173] LEFT HALF OF PTR
LDB CH,TT ;[173]
PUSHJ P,CKEOL ;[173] PREV CHAR = EOL?
POPJ P, ;[173] NO; RETURN
CHK1.5: TRO FF,SEQUIN ;[173] YES; SET FLAG
POPJ P, ;[172] RETURN (CHANGE COMMENT)
;_ SEARCH
LARR: TROA FF,FINDR ;FINDR:=1 FOR LEFT ARROW SEARCH
;N SEARCH
SERCHP: TRO FF,PCHFLG ;PCHFLG:=1 FOR N SEARCH
;S SEARCH
SERCH: SKIPLE E,B ;E=SEARCH COUNT
JRST SERCHA ;POSITIVE ARGUMENT
TRNE FF,ARG ;ILLEGAL 0 OR - SRH ARG
ERROR E.ISA
SERCHA: MOVEI CH,ALT ;USE ALT-MODE DELIMITER IF NO @ SEEN
TRZN FF,SLSL ;@ SEEN?
JRST SERCHB ;NO, TERMINATOR = ALTMODE
PUSHJ P,SKRCH ;YES. CH:=USER SPECIFIED DELIMITER.
ERROR E.USR
SERCHB: MOVEM CH,B ;B:=SEARCH STRING DELIMITER
MOVEM CH,ARGTRM ;SAVE TERMINATOR FOR FS INSERTION
SETZM STAB ;CLEAR SEARCH MATRIX
MOVE A,[XWD STAB,STAB+1]
BLT A,STAB+STABLN-1
PUSHJ P,SKRCH ;LOOK AHEAD 1 CHAR
ERROR E.USR
CAIE CH,(B) ;IS IT THE DELIMITER?
JRST SERCHT ;NO, AN ARGUMENT IS GIVEN
SKIPN SRHCTR ;YES, USE PREVIOUS SEARCH STRING
ERROR E.SNA
JRST SERCH0
U ARGTRM,1 ;FS, FN 2ND ARG TERMINATOR
;MOVE NEW STRING TO STORAGE
SERCHT: TRZ F2,XMATCH ;[215]
SETZM SRHCTR ;CLR STRING CTR
MOVE AA,[POINT 7,SRHARG] ;INIT STORAGE PTR
JRST SERCHD ;1ST CHAR ALREADY IN
SERCHC: PUSHJ P,SKRCH ;GET NEXT CHAR OF CMD STRING
ERROR E.USR
SERCHD: CHKEO EO21,SERCHE ;IF EO=1, ^R IS JUST TEXT
CAIE CH,22 ;^R?
SERCHE: CAIN CH,21 ;^Q?
JRST SERCHG ;YES, NEXT CHAR IS TEXT
CAIN CH,(B) ;THE DELIMITER?
JRST SERCH0 ;YES
CAIN CH,24 ;^T?
JRST SERCHU ;YES
TRNE F2,TXTCTL ;^T FLAG ON?
JRST SERCHF ;YES, ^V AND ^W ARE JUST TEXT
CAIE CH,26 ;^V?
CAIN CH,27 ;^W?
TRO F2,XMATCH ;YES, SET EXACT MATCH FLAG
SERCHF: AOS A,SRHCTR ;BUMP STRING CTR
CAILE A,^D80 ;STILL FIT IN STORE?
ERROR E.STC
IDPB CH,AA ;STORE CHARACTER
JRST SERCHC ;& GO BACK FOR MORE
SERCHG: AOS A,SRHCTR ;COUNT THE ^R (^Q)
CAILE A,^D80 ;[216] STILL FIT IN STORE?
ERROR E.STC ;[216] NO
IDPB CH,AA ;& STORE IT
PUSHJ P,SKRCH ;GET NEXT CHAR
ERROR E.USR
JRST SERCHF ;STORE IT AS TEXT
SERCHU: TRC F2,TXTCTL ;COMPLEMENT CONTROL CMD DISABLING SWITCH
JRST SERCHF
;SET UP SEARCH MATRIX
SERCH0: TRZ F2,TXTCTL ;REFRESH ^T FLAG
SETZM SCESQB ;CLR ^E[...] NEST CTR
MOVE B,SRHCTR ;INIT STRING CTR
MOVE AA,[POINT 7,SRHARG] ;& POINTER
MOVSI D,400000 ;INIT MATRIX BIT PTR
SERCH2: ILDB CH,AA ;CH:=NEXT SEARCH STRING CHARACTER.
SKIPN SCESQB ;GATHERING DATA FOR ^E[...]?
JRST .+3 ;NO
SOJL B,CNTREE ;YES, ERRORS GO TO ?ICE
JRST .+2
SOJL B,SERCHI ;END OF STRING?
MOVEI T,S2TABL ;CK FOR CTL CHAR IN STRING
TRNE F2,TXTCTL ;^T FLAG ON?
MOVEI T,S3TABL ;YES, USE RESTRICTED TABLE
PUSHJ P,DISP1
CHKEO EO21,SRCH2B ;IF EO=1, FORCE EXACT MODE
TRNN F2,TXTCTL ;IF ^T FLAG ON, ALL ^CHARS ARE LEGAL
PUSHJ P,CKNCC ;CK FOR OTHER CTRL-CHARS (THEY ARE ILLEGAL)
SRCH2E: TRNE F2,EMATCH ;IGNORE XMATCH FLAG?
JRST SRCH2F ;YES, FORCE ACCEPT-EITHER SEARCH
TRNN F2,XMATCH ;NO, XMATCH ON?
TLNE FF,PMATCH ;NO, PREVAILING EXACT MATCH FLAG ON?
JRST SRCH2B ;EMATCH=0 & XMATCH OR PMATCH =1 IMPLIES EXACT MODE
SRCH2F: CAIL CH,141 ;ACCEPT-EITHER SEARCH MODE
CAILE CH,172 ;IS IT LOWER CASE ALPHA?
SKIPA ;NO
TRZ CH,40 ;YES, MAKE IT UPPER CASE
CAIL CH,"A" ;IS IT UPPER CASE ALPHA?
CAILE CH,"Z"
JRST SERCH4 ;NO
XORM D,STAB+40(CH) ;ENABLE MATCH ON CORRESP. LC CHAR.
JRST SERCH4
SRCH2B: PUSHJ P,CASE ;EXACT MODE SEARCH -- ADJUST CASE
SERCH4: XORM D,STAB(CH) ;MARK CHARACTER TO MATCH
SERCH5: SKIPE SCESQB ;GATHERING DATA FOR A ^E[...]?
POPJ P, ;YES
TLZN F2,CTLN ;DOES ^N PRECEDE THIS CHAR POSITION?
JRST SERCH6 ;NO
ANDCAM D,STAB+BEGPAG ;YES, CLEAR ALL FAKE BITS
ANDCAM D,STAB+ENDPAG
ANDCAM D,STAB+SPCTAB
SERCH6: LSH D,-1 ;MOVE TO NEXT CHAR. POSITION IN MATRIX
SETZM SCESQB ;(BASE IS 0)
JUMPN D,SERCH2 ;36 CHARS SEEN YET? IF NOT CONTINUE.
JUMPE B,SERCHI ;TOO MUCH IF STILL ANOTHER CHAR WAITING
ERROR E.STL
;SCAN INSERT ARGUMENT IF F-SEARCH
SERCHI: TRNN FF,FSRCH ;F-SEARCHING?
JRST SERCH1 ;NO
TRZ F2,TXTCTL ;REFRESH ^T FLAG
MOVE CH,ARGTRM ;GET TERMINATOR TO WATCH FOR
JRST INSERA ;SCAN INSERT ARGUMENT
SERCHJ: POP P,COMBAK ;SAVE COMCNT & CPTR FOR THE INSERTION
POP P,CPTBAK
;THEN FALL INTO SERCH1
;START SEARCHING
SERCH1: MOVE AA,D ;END OF SEARCH MARKER
MOVE I,PT ;START SEARCHING AT PT
S1: TRNE FF,ARG ;IS THERE AN ARGUMENT?
JUMPLE E,FND ;YES. SEEN STRING N TIMES?
MOVE TT,I ;NO, FORM BYTE PTR WHICH WILL BE
SUBI TT,1 ;INCREMENTED BEFORE USE
IDIVI TT,5
HLL TT,BTAB(TT1)
CAMG I,BEG ;AT BEG OF BUFR?
SKIPL STAB+BEGPAG ;& 1ST SERCH CHAR = BEG OF BUFR CHAR?
JRST S3 ;NO
MOVSI D,200000 ;YES, START SEARCH AT 2ND SEARCH CHAR
MOVE TT1,TT ;SET DYNAMIC PTR = STATIC PTR
SETOM BCOUNT ;FLAG 1ST IS BEGPAG [117]
JRST S4B ;ENTER SEARCH LOOP
S3: MOVSI D,400000 ;START SEEKING MATCH FOR 1ST CHAR
MOVE TT1,TT ;SET DYNAMIC PTR=STATIC PTR
JRST S4A
S4: TDNE D,STAB+SPCTAB ;IS SPACE/TAB STRING BIT SET?
JRST SPTB ;YES
S4D: ADDI I,1 ;[223] LOOK AT NEXT LOC, XCEPT 1ST TIME THRU
S4C: LSH D,-1 ;ADVANCE TO NEXT CHAR POSITION
S4B: CAMN D,AA ;END OF SEARCH TABLE?
JRST FND ;YES.
S4A: ILDB CH,TT1 ;NO, GET NEXT CHAR
TDNE D,STAB(CH) ;IS IT A MATCH?
JRST S4 ;YES, GO TO NEXT TABLE ENTRY.
AOSN BCOUNT ;IF WE FAILED WITH BEGPAG [117]
JRST S3 ; THEN TRY AGAIN WITH 1ST CHAR [117]
CAML I,Z ;[213] REACHED TOP OF BUFFER?
JRST NOFND ;[213] YES.
AOS I,PT ;NO MATCH. PT:=PT+1
IBP TT ;MOVE STATIC BYTE PTR
JRST S3 ;KEEP LOOKING
FND: CAMLE I,Z ;REACH TOP OF BUFFER?
JRST NOFND ;YES. SEARCH FAILED.
SETOM SFINDF ;NO. SFINDF:=-1
MOVE A,I
SUB A,PT ;COMPUTE LENGTH OF SEARCH ARG
MOVEM I,PT ;MOVE PT PAST THE STRING
SOJG E,S1 ;FIND IT N TIMES?
TRNN FF,FSRCH ;F-SEARCH?
JRST FND3 ;NO
MOVE C,VVAL ;YES, GET INSERT SIZE
SUBI C,(A) ;INSERT MINUS DELETE
MOVNS A ;SET PT TO BEGINNING OF STRING FOUND
ADDM A,PT
CAIE C,0 ;[201] SKIP FOR SAME LENGTH STRINGS
PUSHJ P,NROOM ;STRETCH OR SCRUNCH THE HOLE
MOVE B,ARGTRM ;GET TERMINATOR TO LOOK FOR
MOVE A,COMBAK ;RESET COMCNT & CPTR TO BEGINNING
MOVEM A,COMCNT ; OF INSERT ARGUMENT
MOVE A,CPTBAK
MOVEM A,CPTR
PUSHJ P,INS1B ;INSERT THE 2ND ARG
PUSHJ P,ZEROTT ;DO AUTO-TYPE IF REQUIRED
MOVE CH,ARGTRM
SKIPN VVAL ;IS THERE A NON-NULL INSERT?
CAIE CH,ALT ;ALTMODE TERMINATOR?
JRST FND2 ;NO
TLO F2,NALTFS ;[174] SET NULL REPLACEMENT ALTMODE
;[174] DELIMITED F SEARCH FLAG
JRST ALTM1 ;YES, FS<STRING>$$ TERMINATES EXECUTION
FND3:
IFN VC,<MOVEM A,VVAL> ;SAVE LENGTH OF STRING
PUSHJ P,ZEROTT ;AUTOTYPE
FND2: TRZN FF,COLONF ;COLON MODIFIER?
SKIPGE (P) ;[210] NO, BUT IS THIS AN ITERATION?
JRST [ SKIPN COLOFL ;[231] IS AUTO-COLON DISABLED?
JRST FFOK ;[231] NO - TREAT LIKE COLON SEARCH
JRST RET ;[231] YES - JUST RETURN
] ;[231]
JRST RET ;[210] NIETHER
FFOK: MOVNI A,1 ;YES. RETURN VALUE OF -1
JRST VALRET
U COMBAK,1 ;STORE FOR COMCNT DURING FS, FN
U CPTBAK,1 ;DITTO CPTR
;AUTOTYPE AFTER SUCCESSFUL SEARCHES
; IF AUTOF IS NON-ZERO
; INCLUDE POINTER MARKER = ASCII CHAR IN AUTOF IF AUTOF > 0
ZEROTT: TRNE FF,COLONF ;NO AUTOTYPE ON COLON SEARCHES
POPJ P,
SKIPL -1(P) ;IN AN ITERATION?
SKIPN AUTOF ;AUTOTYPE WANTED?
POPJ P,
TRO 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
TRZ FF,ARG
POPJ P,
NOFND: TDNN D,STAB+ENDPAG ;ENDPAG GOOD FOR A MATCH HERE?
JRST NOFND3 ;NO
LSH D,-1 ;YES, BUT ONLY IF THIS IS LAST SRH CHAR
CAMN D,AA
JRST FND ;ENDPAG MATCHES!
NOFND3: MOVE I,BEG ;SEARCH FAILED
MOVEM I,PT ;PT=BEG
SETZM SFINDF ;SFINDF=0
TRNE FF,PCHFLG+FINDR ;S SEARCH?
JRST NOFND1 ;NO.
BEGIN1: TRZN FF,COLONF ;YES. COLON MODIFIER?
JRST NOFND2 ;NO
BEGIN2: TRZ FF,PCHFLG+FINDR ;YES.
JRST BEGIN ;RETURN VALUE OF 0
NOFND1: MOVEM E,SRHCNT ;YES. SAVE SEARCH COUNT
MOVEM AA,SRHAA ;& SAVE END OF MATRIX MARKER
MOVEI B,1 ;PUNCH 1 PAGE ONLY
TRNE FF,PCHFLG ;N SEARCH?
PUSHJ P,PUNCHA ;YES. PUNCH THIS BUFFER AND REFILL IT.
TLNN FF,UREAD ;ANY INPUT FILE?
JRST BEGIN1 ;NO
TLNE FF,FINF ;MORE DATA?
TRNE FF,FORM
JRST NOFND4 ;YES
MOVE E,BEG ;EOF & NO FORM SEEN
CAMN E,Z ;CHECK BUFFER CONTENTS
JRST BEGIN1 ;NO MORE DATA
NOFND4: TRNE FF,FINDR ;LEFT ARROW SEARCH?
PUSHJ P,YANK1 ;YES. FILL BUFFER.
MOVE E,SRHCNT ;RESTORE SEARCH COUNT.
MOVE D,SRHAA ;RESTORE END OF STRING MARKER
JRST SERCH1 ;RESUME SEARCH
NOFND2: SKIPGE (P) ;IN AN ITERATION?
JRST BEGIN2 ;YES. RETURN VALUE OF 0
ERROR E.SRH
U SRHCNT,1 ;SEARCH COUNT STORE
U SRHAA,1 ;END OF SEARCH MATRIX MARKER
SRHMOD: EXP SRCHSW ;DEFAULT SEARCH MODE
;CNTR S MATCHES ANY SEPARATOR CHARACTER (I.E., ANY CHARACTER NOT
;A LETTER, NUMBER, PERIOD, DOLLAR SIGN OR PER CENT SYMBOL)
CNTRS: MOVE T,[-STABLN+3,,1] ;SET ALL CURRENT BITS EXCEPT NULL & SPCTAB
PUSHJ P,SETSTB ; & ENDPAG, BUT DO INCLUDE BEGPAG
XORM D,STAB+"." ;NOW, SCRATCH ALL SYMBOL CHARS
XORM D,STAB+"%"
XORM D,STAB+"$"
MOVE T,[-^D10,,"0"] ;DIGITS
PUSHJ P,SETSTB
CNTLEA: MOVE T,[-^D26,,"A"] ;UC CHARS (ENTRY FOR ^EA)
PUSHJ P,SETSTB
CNTLEV: MOVE T,[-^D26,,141] ;LC CHARS (ENTRY FOR ^EV)
JRST CNTRXX
;CNTR X MATCHES ANY ARBITRARY CHARACTER
CNTRX: MOVE T,[-STABLN+4,,1] ;WANT TO ACCEPT ANYTHING AS A MATCH
CNTRXX: PUSHJ P,SETSTB ; EXCEPT NULL & SPCTAB & BEGPAG & ENDPAG
JRST SERCH5
;CNTR N REVERSES THE SENSE OF THE SEARCH FOR THE NEXT CHARACTER
CNTRN: MOVE T,[-STABLN+4,,1] ;STAB CTR & PTR
PUSHJ P,SETSTB ;SET CURRENT POSITION BIT FOR ALL CHARS
TLO F2,CTLN ;SET ^N FLAG
JRST SERCH2
;SET STAB BITS AS INDICATED BY T & D
SETSTB: XORM D,STAB(T)
AOBJN T,.-1
POPJ P,
;DISPATCH TABLE FOR 2ND SCAN OF SEARCH STRING
S2TABL: XWD CNTRE,05 ;^E
XWD CNTRX,30 ;^X
XWD CNTRN,16 ;^N
XWD CNTRS,23 ;^S
XWD CNTRV,26 ;^V
XWD CNTRW,27 ;^W
XWD CNTRL,34 ;^\
XWD CNTRU,36 ;^^
S3TABL: XWD CNTRT,24 ;^T
XWD CNTRQ,21 ;^Q
XWD CNTRR,22 ;^R
XWD CNTR33,ALT ;ALTMODE
XWD 0,0 ;END OF LIST
;^E COMMANDS
CNTRE: CHKEO EO21,SERCH4 ;IF EO=1, ^E IS JUST TEXT
ILDB CH,AA ;GET CHAR. AFTER ^E
SOJL B,CNTREE ;NONE THERE
MOVEI T,S4TABL ;GO TO PROPER ^E COMMAND
PUSHJ P,DISPAT ; TO SET SPECIFIED CHARACTER BITS
CNTREE: ERROR E.ICE
;DISPATCH TABLE FOR ^E COMMANDS
S4TABL: XWD CNTLEA,"A" ;^EA ACCEPT ANY ALPHA
XWD CNTLEV,"V" ;^EV ACCEPT ANY L.C. ALPHA
XWD CNTLEW,"W" ;^EW ACCEPT ANY U.C. ALPHA
XWD CNTLED,"D" ;^ED ACCEPT ANY DIGIT
XWD CNTLEL,"L" ;^EL ACCEPT ANY E-O-L CHAR.
XWD CNTLES,"S" ;^ES ACCEPT A STRING OF SPACES OR TABS
XWD CNTLEN,74 ;^E<NNN> ACCEPT ASCII <NNN>
XWD CNTLEB,133 ;^E[A,B,C] ACCEPT A OR B OR C
XWD 0,0 ;END OF LIST
U SCESQB,1 ;SEARCH FOR ^E[...] NESTING COUNTER
;^EW
CNTLEW: MOVE T,[-^D26,,"A"] ;UPPER CASE ALPHABETIC CHARS.
JRST CNTRXX
;^ED
CNTLED: MOVE T,[-^D10,,"0"] ;DIGITS
JRST CNTRXX
;^EL
CNTLEL: MOVE I,Z ;IS LAST CHAR IN BUFR AN EOL?
CAMG I,BEG
JRST CNTLE3 ;NO
SUBI I,1
PUSHJ P,GET
CAIL CH,12
CAILE CH,14
CNTLE3: XORM D,STAB+ENDPAG ;NO, ENDPAG IS GOOD FOR A MATCH
MOVE T,[-3,,12] ;LF, VT, FF
JRST CNTRXX
;^ES
CNTLES: XORM D,STAB+40 ;SPACE
XORM D,STAB+11 ;TAB
XORM D,STAB+SPCTAB ;& SPACE/TAB STRING BIT
JRST SERCH5
;SKIP OVER A STRING OF SPACES AND/OR TABS WHILE SEARCHING
SPTB: CAIE CH,40 ;[223] HAVE ALREADY MATCHED
CAIN CH,11 ;[223] ON OTHER THAN SP/TAB?
JRST SPTB1 ;[223] NO, LOOK FOR SP/TABS
JRST S4D ;[223] YES, NEXT SEARCH POSITION
SPTB1: ADDI I,1 ;[223] ADVANCE TO NEXT BUFFER LOCATION
CAML I,Z ;END-OF BUFFER?
JRST S4C ;YES, NO MORE SPACE/TABS
MOVEM TT1,ERR1 ;SAVE CURRENT BYTE PTR (USING ERR1 AS TMP)
ILDB CH,TT1 ;LOOK AT NEXT CHAR
CAIE CH,40 ;IS IT A SPACE?
CAIN CH,11 ;OR TAB?
JRST SPTB1 ;[223] YES, KEEP SKIPPING
MOVE TT1,ERR1 ;NO, END OF SPACE/TAB STRING
JRST S4C ; RESTORE BYTE-POINTER & CONTINUE SEARCH
;^E[A,B,C,...]
CNTLEB: AOS SCESQB ;BUMP ^E[...] NEST CTR
CNTLE0: PUSHJ P,SERCH2 ;GET CHAR FROM OR-STRING
ILDB CH,AA ;GET SEPARATOR
SOJL B,CNTREE
CAIN CH,"," ;MORE TO GO?
JRST CNTLE0 ;COMMA IMPLIES YES
CAIE CH,"]" ;END OF OR-STRING?
ERROR E.ICE
SOS SCESQB ;DECREMENT ^E[...] NEST CTR
JRST SERCH5 ;YES
;^E<NNN> (NNN IS OCTAL FOR A SINGLE ASCII CHAR)
CNTLEN: MOVEI A,0 ;CLR NUMBER ACCUMULATOR
CNTLE1: ILDB CH,AA ;GET A DIGIT
SOJL B,CNTREE ;SHOULDN'T RUN OUT
CAIN CH,76 ;RIGHT ANGLE-BRACKET?
JRST CNTLE2 ;YES, END OF NUMBER
CAIL CH,"0" ;IS IT A DIGIT?
CAILE CH,"7"
ERROR E.ICE
LSH A,3 ;YES, SCALE UP THE PREVIOUS VALUE
ADDI A,-60(CH) ;AND ADD IN THE NEW DIGIT
JRST CNTLE1 ;TRY FOR MORE
CNTLE2: ANDI A,177 ;EXTRACT AN ASCII CHAR.
XORM D,STAB(A) ;AND SET THE CORRESP. BIT
JRST SERCH5
;^R IS SAME AS ^Q (PROVIDED EO NOT = 1)
;EXCEPT IT DOESN'T CAUSE RUBOUT PROBLEMS
CNTRR: CHKEO EO21,SERCH4 ;IF EO=1, ^R IS JUST TEXT
;^Q CAUSES NEXT CHAR TO BE TAKEN AS TEXT EVEN IF IT IS
;A CTRL CHAR. OR THE TERMINATOR
CNTRQ: ILDB CH,AA ;GET NEXT CHAR
SOJA B,SRCH2E ;& PROCESS AS ORDINARY TEXT
;^V CAUSES NEXT CHAR TO BE TAKEN AS LOWER CASE
;^V^V SETS LOWER CASE MODE UNTIL FURTHER NOTICE
CNTRV: CHKEO EO21,SERCH4 ;IF EO=1, ^V IS JUST TEXT
PUSHJ P,C.V ;SET ^V FLAGS
JRST SERCH2
;^W CAUSES NEXT CHAR TO BE TAKEN WITHOUT CONVERSION
;^W^W SETS STANDARD CASE MODE UNTIL FURTHER NOTICE
CNTRW: CHKEO EO21,SERCH4 ;IF EO=1, ^W IS JUST TEXT
PUSHJ P,C.W ;SET ^W FLAGS
JRST SERCH2
;FIRST ^\ CHANGES MATCH MODE TO ACCEPT EITHER UC OR LC
;SECOND ONE TURNS ACCEPT EITHER FLAG OFF
CNTRL: CHKEO EO21,SERCH4 ;IF EO=1, ^\ IS JUST TEXT
TRC F2,EMATCH ;COMPLEMENT ACCEPT EITHER FLAG
JRST SERCH2
;IF SEARCHING FOR ALTMODE, AND IF EO=1, 033 & 175 ARE MATCHES
CNTR33: CHKEO EO21,.+2 ;EO=1?
JRST SERCH4 ;NO, ACCEPT 033 ONLY
XORM D,STAB+175 ;YES, MARK 175 AS ACCEPTABLE MATCH
JRST SERCH4 ;& 033
;^^ CAUSES IMMEDIATELY FOLLOWING @,[,\,],^,_ TO BE CONVERTED TO LC RANGE
CNTRU: CHKEO EO21,SERCH4 ;IF EO=1, ^^ IS TEXT
ILDB CH,AA ;GET NEXT CHAR
PUSHJ P,CVTSPC ;CONVERT TO LC IF @, ETC
SOJGE B,SRCH2E ;[222] CONTINUE UNLESS NO CHAR
ERROR E.MCO ;[222] FOR US TO LOWER CASEIFY
;^T DISABLES ALL CNTRL COMMANDS EXCEPT ^Q,^R,^T AND ALLOWS ALL OTHER
;CNTRL CHARS AS TEXT. THE NEXT ^T TURNS THE ^T SWITCH BACK OFF.
CNTRT: CHKEO EO21,SERCH4 ;IF EO=1, ^T IS TEXT
TRC F2,TXTCTL
JRST SERCH2
;F SEARCHES
FCMD: PUSHJ P,SKRCH ;GET CHAR AFTER F
ERROR E.MEF
TRO FF,FSRCH ;SET F-SEARCH FLAG
TRZ CH,40 ;UPPER OR LOWER CASE [114]
CAIN CH,"S" ;FS?
JRST SERCH ;YES
CAIN CH,"N" ;FN?
JRST SERCHP ;YES
ERROR E.IFC
;<> ITERATION BRACKETS. COMMAND INTERPRETATION IS SENT
; BACK TO THE < WHEN THE > IS ENCOUNTERED.
LSSTH: PUSH P,ITERCT ;SAVE ITERATION COUNT
PUSH P,COMAX ;[161] KEEP MAX. FOR GARBAGE COLLECTION
PUSH P,CPTR ;SAVE COMMAND STATE
PUSH P,COMCNT
SETOM ITERCT ;ITERCT:=-1
PUSH P,ITERCT ;-1 FLAGS ITERATION ON PDL
TRZN FF,ARG ;IS THERE AN ARGUMENT?
JRST RET ;NO
JUMPLE B,INCMA1 ;IF ARG NOT > 0, SKIP OVER <>
MOVEM B,ITERCT ;YES. ITERCT:=ARGUMENT
JRST RET
GRTH: SKIPGE A,(P) ;IS THERE A LEFT ANGLE BRACKET?
JRST GRTH2 ;YES. OTHERWISE ITS A MISSING < OR
SOJE A,GRTH9 ;SOMETHING LIKE <...(...>
ERROR E.MLA
GRTH2: SOSN ITERCT ;ITERCT:=ITERCT-1. DONE?
JRST INCMA2 ;YES
MOVE A,-2(P) ;NO. RESTORE COMMAND STATE TO START OF ITERATION.
MOVEM A,CPTR
MOVE A,-1(P)
MOVEM A,COMCNT
TRNE FF,TRACEF ;TRACING?
PUSHJ P,CRR ;YES. OUTPUT CRLF
JRST RET
GRTH9: ERROR E.MRP
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 <...>
ERROR E.SNI
TRNN FF,ARG ;YES. IF NO ARG,
MOVE B,SFINDF ;USE LAST SEARCH SWITCH (0 OR -1).
JUMPL B,CD ;IF ARG <0, JUST RET + EXECUTE LOOP
INCMA1: MOVEI TT,">" ;SKAN FOR >
MOVEI TT1,"<" ;IGNORE <...> STRINGS
PUSHJ P,SKAN
ERROR E.MRA
INCMA2: SUB P,[XWD 3,3] ;[161] POP OUT A LEVEL
POP P,COMAX ;[161]
POP P,ITERCT
JRST RET
;!TAG! TAG DEFINITION. THE TAG IS A NAME FOR THE LOCATION IT
; APPEARS IN IN A MACRO, ITERATION OR COMMAND STRING.
EXCLAM: PUSHJ P,SKRCH ;LOOK FOR NEXT !
ERROR E.UTG
CAIE CH,"!"
JRST EXCLAM
JRST RET
;OTAG$ GO TO THE TAG NAMED TAG. THE TAG MUST APPEAR IN THE
; CURRENT MACRO OR COMMAND STRING.
OG: MOVE A,CPTR
MOVE AA,A
IDIVI AA,17
CAMN A,SYMS(B)
JRST OGFND
SKIPN SYMS(B)
JRST OGNF
CAMN A,SYMS+1(B)
ES1: AOJA B,OGFND
SKIPN SYMS+1(B)
ES2: AOJA B,OGNF
CAMN A,SYMS+2(B)
AOJA B,ES1
SKIPN SYMS+2(B)
ADDI B,2
OGNF: PUSH P,CPTR
PUSH P,B
MOVEI D,STAB
OGW: CAIG D,STAB+STABLN-2 ;[156] IS THE TAG TOO LONG?
JRST OG1 ;[156] NO, CONTINUE
ERROR E.TTL
OG1: PUSHJ P,SKRCH ;GET NEXT COMMAND CHAR
ERROR E.MEO
MOVEM CH,(D) ;STAB ... _ TAG
CAIE CH,ALT
AOJA D,OGW
MOVEI A,"!" ;TAG TERMINATOR
MOVEM A,(D)
SETZM 1(D)
MOVE B,COMCNT ;MAKE PTR TO START OF THIS COMMAND LEVEL
SUB B,COMAX
IDIVI B,5
ADD B,CPTR
JUMPE E,OG7 ;NO REMAINDER
SOS B
MOVMS E
JRST .(E)
IBP B
IBP B
IBP B
IBP B
OG7: MOVEM B,CPTR
MOVE B,COMAX ;GET # OF CMD CHARS AT THIS LEVEL
MOVEM B,COMCNT
OG2: MOVEI TT,"!" ;SKAN FOR !
MOVEI TT1,-1 ;NO SECONDARY CHAR.
PUSHJ P,SKAN
ERROR E.TAG
TRO F2,NOTRAC ;DON'T TYPE EVERY TAG WHILE TRACING
MOVEI E,STAB ;INIT SEARCH STRING TO 1ST CHAR AFTER !
OG5: SKIPN (E) ;OVER STRING?
JRST OG3 ;YES
PUSHJ P,SKRCH ;NO. GET A CHAR
ERROR E.TAG
CAMN CH,(E) ;MATCH ?
AOJA E,OG5 ;YES. MOVE ON.
CAIN CH,"!" ;NO, ARE WE AT END OF A TAG?
JRST OG2 ;YES, LOOK FOR ANOTHER
MOVEI E,"!" ;NO, SKIP TO NEXT !
OG6: PUSHJ P,SKRCH ;GET NEXT CHAR OF TAG
ERROR E.UTG
CAIE CH,(E) ;!?
JRST OG6 ;NO, KEEP GOING
JRST OG2 ;YES, LOOK FOR ANOTHER TAG
OG3: TRZ F2,NOTRAC ;RE-ENABLE TRACING
POP P,A ;GET INDEX TO SYMBOL TABLE
POP P,SYMS(A) ;SAVE POSITION OF THIS O COMMAND
MOVE B,COMCNT ;SAVE COMCNT FOR THIS TAG
MOVEM B,CNTS(A)
MOVE B,CPTR ;SAVE TAG POSITION IN COMMAND STRING
MOVEM B,VALS(A)
JRST RET
OGFND: MOVE A,VALS(B)
MOVEM A,CPTR
MOVE A,CNTS(B)
MOVEM A,COMCNT
JRST RET
;N"G HAS NO EFFECT IF N IS GREATER THAT 0. OTHERWISE,
; SEND COMMAND INTERPRETATION TO NEXT MATCHING '.
; THE " AND ' MATCH SIMILAR TO ( AND ).
;N"L SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"N SEND COMMAND TO MATCHING ' UNLESS N NOT = 0.
;N"E SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"F SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"U SEND COMMAND TO MATCHING ' UNLESS N=0.
;N"T SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"S SEND COMMAND TO MATCHING ' UNLESS N<0.
;N"C SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS A LETTER, NUMBER, PERIOD (.), DOLLAR SIGN ($),
; OR PER CENT (%).
;N"A SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS ALPHABETIC.
;N"D SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS A DIGIT.
;N"V SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS LOWER CASE ALPHABETIC.
;N"W SEND COMMAND TO MATCHING ' UNLESS THE VALUE OF N AS AN ASCII
; CHARACTER IS UPPER CASE ALPHABETIC.
DQUOTE: TRNN FF,ARG ;ERROR IF NO ARG BEFORE "
ERROR E.NAQ
PUSHJ P,SKRCH ;GET CHAR AFTER "
ERROR E.MEQ
MOVEI T,DQTABL ;INDEX DISPATCH TABLE
PUSHJ P,DISPAT ;DISPATCH FOR CHAR. AFTER "
ERROR E.IQC
;" COMMAND DISPATCH TABLE
DQTABL: XWD DQ.G,"G"
XWD DQ.L,"L"
XWD DQ.N,"N"
XWD DQ.E,"E"
XWD DQ.C,"C"
XWD DQ.L,"T"
XWD DQ.E,"F"
XWD DQ.L,"S"
XWD DQ.E,"U"
XWD DQ.A,"A"
XWD DQ.D,"D"
XWD DQ.V,"V"
XWD DQ.W,"W"
XWD 0,0 ;END OF LIST
;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
ERROR E.MAP
JRST RET
;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
;ERROR MESSAGE PRINTOUT
ERRP: TRO FF,QMFLG ;ERROR PROCEDURE IN PROGRESS
;ERRP+1/2 [164]
MOVE B,.JBREL ;[164] SAVE CURRENT CORE
MOVEM B,RELSAV ;[164]
HRLZ B,.JBUUO ;GET ERROR CODE
CLRBFI ;CLEAR TTY
PUSHJ P,TTOPEN
MOVEI CH,"?" ;TYPE ?
PUSHJ P,TYOM
HLLZ TT,B ;PRINT CODE
PUSHJ P,SIXBMS
LDB D,[POINT 4,.JBUUO,12] ;GET SPECIAL TYPEOUT FLAG
JUMPE D,ERRP04 ;NO SPECIAL ERROR EXTENSION
CAIN D,3 ;FLAG=EE3?
JRST ERRP05 ;YES
MOVEI CH,"-" ;NO, TYPE EXTENSION (MONITOR ERROR CODE)
PUSHJ P,TYOM
LDB B,[POINT 15,XEXT,35] ;[175] GET UUO ERROR FLAG
SOJLE D,ERRP03 ;1 IMPLIES IT IS A UUO ERROR
HRRZI B,740000 ;GET I-O ERROR FLAGS
AND B,ARGSTO
ERRP03: PUSHJ P,OCTMS ;TYPE ERROR CODE IN OCTAL
ERRP04: MOVE B,ERRLEN ;HOW MUCH MESSAGE WANTED?
JUMPGE B,ERRP02 ;AT LEAST 1ST FULL LINE
PUSHJ P,CRR ;HE WANTS ONLY ?XXX, SO END LINE
JRST ERRP5 ;BETTER SEE IF HE WANTS MORE
ERRP02: MOVEI CH,11 ;1ST LINE OF MESSAGE AUTOMATIC
PUSHJ P,TYOM ;TYPE TAB
ERRP0: INIT ERRCHN,0 ;INIT INPUT FROM SYS:
SIXBIT /SYS/
XWD 0,ERRHDR
JRST NOERRS ;CAN'T
MOVE B,RELSAV ;[177] SETUP FOR GRABJR CALL BELOW
MOVE TT,Z ;GET ACTUAL FIRST FREE LOC
IDIVI TT,5
ADDI TT,2
MOVEI T,<BUFSIZ+3>*2(TT) ;ROOM FOR 2 DISK BUFFERS?
CAML T,.JBFF
PUSHJ P,GRABJR ;NO, GET 1K CORE
EXCH TT,.JBFF ;GET INPUT BUFFER
INBUF ERRCHN,2
MOVEM TT,.JBFF
MOVSI A,(SIXBIT /ERR/)
MOVEM A,TECERR+1 ;SET UP FILE EXTENSION
SETZM TECERR+2
SETZM TECERR+3
HRL A,JOBN ;GET JOBNUMBER
HRRI A,JBTPRG ;& JOBNAME TABLE ADDRESS
GETTAB A, ;GET JOBNAME
JRST ERRP01 ;CAN'T
MOVEM A,TECERR ;SET FILE NAME
LOOKUP ERRCHN,TECERR ;LOOKUP JOBNAME.ERR
JRST ERRP01 ;NOT THERE, SO USE TECO.ERR
JRST ERRP1 ;FOUND
ERRP01: MOVE A,[SIXBIT /TECO/]
MOVEM A,TECERR
LOOKUP ERRCHN,TECERR ;FIND TECO.ERR
JRST NOERRS ;NOT ON SYS:
ERRP1: PUSHJ P,ERRCHR ;GET A CHAR. FROM TECO.ERR
CAIE CH,"?" ;LOOK FOR START OF A MESSAGE
JRST ERRP1 ;NO, TRY NEXT
SETZ T, ;YES, INIT RESULT ACCUMULATOR
HRRZ D,.JBUUO ;GET ERROR CODE AGAIN
ERRP2: PUSHJ P,ERRCHR ;GET NEXT CHAR
CAIN CH,11 ;TAB?
JRST ERRP3 ;YES
LSH T,6 ;SCALE PREV. RESULT UP ONE CHAR
ADDI T,-40(CH) ;ADD NEW SIXBIT CHAR TO PREVIOUS RESULT
JRST ERRP2
ERRP3: CAME D,T ;IS THIS CODE EQUAL TO THE ERROR CODE?
JRST ERRP1 ;NO, KEEP GOING
PUSHJ P,ERRPRN ;YES, PRINT EVERYTHING UP TO THE LF
TRO FF,EMFLAG ;NOTE THAT THE 1ST LINE HAS BEEN TYPED
JRST ERRP5
NOERRS: TRO FF,XPLNFL+EMFLAG ;CANT DO /
JSP A,CONMES ;PRINT BAD NEWS
ASCIZ /
?EEE Unable to Read Error Message File
/
ERRP5: MOVE A,COMAX
SUB A,COMCNT
MOVEM A,ERR1 ;ERR1:=COMAX-COMCNT
MOVE A,CPTR
MOVEM A,ERR2 ;ERR2:=CPTR
MOVE A,ERRLEN ;DOES HE WANT THE WHOLE THING AUTOMATICALLY?
TRNN FF,XPLNFL ;[162] IF SO, CAN WE GIVE IT TO HIM?
JUMPG A,XPLAIN ;YES
ERRP6: TLZN FF,CCLFLG ;GET HERE FROM A "TECO" COMMAND?
JRST ERRP6A ;NO
LDB CH,[POINT 15,XEXT,35] ;[175] CHECK FOR ?FNF-00
JUMPN CH,ERRP6A ;IT'S NOT
HRRZ CH,.JBUUO ;MAYBE
CAIE CH,(SIXBIT /FNF/) ;[232]
JRST ERRP6A ;[232] NO
CLOSE OUTCHN,CL.RST ;[232] YES - DON'T SUPERCEDE OLD FILE.
JRST DECDMP ;YES, POP UP TO MONITOR
ERRP6A: MOVEI CH,"*" ;TYPE * FOR NEXT COMMAND
PUSHJ P,TYOM
TRO FF,DDTMF
PUSHJ P,TYI ;GET A CHARACTER NOW
CAIN CH,"?" ;QUESTION MARK?
JRST ERRTYP ;YES, TYPE BAD COMMAND
TRNE FF,XPLNFL ;EXPLANATION TYPED YET?
JRST ERRP7 ;YES, CAN'T DO THAT AGAIN
CAIE CH,"/" ;NO, IS IT A SLASH?
JRST ERRP7 ;NO
TRNN FF,EMFLAG ;YES, 1ST LINE DONE YET?
JRST ERRP0 ;NO
JRST XPLAIN ;OK, TYPE MORE EXPLANATION OF ERROR
ERRP7: RELEAS ERRCHN,
TRNN FF,XPLNFL+EMFLAG ;MED OR LONG MSG TYPED? [125]
JRST GOE ;NO, SKIP CORE CONTRACTN[125]
MOVE B,RELSAV ;GO BACK TO CORE WE HAD BEFORE
CORE B,
JFCL ;REDUCTION WON'T FAIL
JRST GOE ;GET REST OF COMMAND
U TECERR,4 ;LOOKUP SPECS FOR TECO.ERR
U ERRHDR,3 ;RING HEADER FOR TECO.ERR
U RELSAV,1 ;STORE FOR .JBREL
U ARGSTO,1 ;STORE FOR ARGUMENT (IF ANY)
ERRPRN: PUSHJ P,ERRCHR ;GET A CHAR FROM ERR. FILE
ERRPR2: CAIE CH,16 ;^N?
JRST ERRPR3 ;NO, SKIP
PUSHJ P,ERRCHR ;GET 1ST DIGIT AFTER ^N
MOVEI T,-60(CH)
IMULI T,^D10 ;PUT IT IN TEN'S PLACE
PUSHJ P,ERRCHR ;GET 2ND DIGIT
ADDI T,-60(CH)
ROT T,-1 ;DIVIDE TOTAL BY 2 & SAVE BIT 35
HLRZ CH,ETABL(T) ;GET LEFT SIDE ADDR IN CASE EVEN
TLNE T,400000 ;EVEN OR ODD?
HRRZ CH,ETABL(T) ;ODD, GET ADDR FROM RIGHT SIDE
JRST (CH) ;TYPE SPECIAL INFORMATION
ERRPR3: PUSHJ P,TYOM ;PRINT NORMAL CHARS.
CAIE CH,12 ;LF?
JRST ERRPRN ;NO
POPJ P,
;GET A CHARACTER FROM SYS:TECO.ERR
ERRCHR: SOSG ERRHDR+2 ;ANY CHARS. IN BUFFER?
JRST ERRCH2 ;NO
ERRCH1: ILDB CH,ERRHDR+1 ;YES, GET NEXT
JUMPE CH,ERRCHR ;IGNORE NULLS
POPJ P,
ERRCH2: IN ERRCHN,0 ;GET NEXT BUFFER
JRST ERRCH1 ;OK, NOW GET A CHAR.
ERRCH3: POP P,A ;UNABLE TO READ TECO.ERR
JRST NOERRS
;GET 1K CORE FOR ERROR MESSAGE FILE READ-IN
GRABJR: ADDI B,^D1024 ;ADD 1K
CORE B,
JRST ERRCH3 ;CAN'T GET IT
POPJ P,
;CAN'T PRINT ERROR FILE BECAUSE OF NO CORE
ERRP05: TRO FF,XPLNFL+EMFLAG
JSP A,CONMES
ASCIZ / Storage Capacity Exceeded
/
JRST ERRP5
;ROUTINE TO TYPE C(TT) IN SIXBIT
;CALL MOVE TT,[SIXBIT /MESSAGE/]
; PUSHJ P,SIXBMS
; RETURN
SIXBMS: SKIPN CH,TT ;ALL SPACES?
JRST SIXBM2 ;YES
MOVNI B,6
MOVE E,[POINT 6,TT]
ILDB CH,E
JUMPE CH,CPOPJ
SIXBM2: ADDI CH,40
PUSHJ P,TYOM
AOJL B,.-4
POPJ P,
ERRTYP: MOVE AA,ERR2 ;VALUE OF CPTR WHEN LAST ERROR OCCURRED.
MOVEI B,12
SUBI AA,2 ;BACK POINTER UP 10 CHARACTERS.
ILDB CH,AA ;GET CHARACTER
CAMG B,ERR1 ;WAS IT IN THE COMMAND BUFFER?
PUSHJ P,TYOM ;YES. TYPE IT.
CAME AA,ERR2 ;HAVE WE REACHED THE BAD COMMAND?
SOJA B,.-4 ;NO. DO IT AGAIN.
;ERRTYP+10 [166] SR#17205
ERRTY1: JSP A,CONMES ;PRINT A ? TO MARK END
ASCIZ /?
/
JRST ERRP6A
XPLA2: PUSHJ P,ERRPR2 ;PRINT UP TO LF
XPLAIN: PUSHJ P,ERRCHR ;IS NEXT CHAR A "?" OR ^A,^B, ... ^H?
CAIN CH,"?"
JRST XPLA1 ;YES
CAILE CH,10
JRST XPLA2 ;NO, KEEP GOING
XPLA1: TRO FF,XPLNFL ;SET FLAG THAT XPLANATION IS TYPED
JRST ERRP6 ;YES, STOP HERE
U ERR1,1 ;
U ERR2,1 ;
U COMLEN,1 ;LENGTH OF BASIC COMMAND STRING
;DISPATCH TABLE FOR SPECIAL INFORMATION TYPEOUT
;BASED ON CHARACTER AFTER CONTROL-N
ETABL: XWD ECOMCH,EOUTFL ;00 01
XWD EFILEN,EERNUM ;02 03
XWD EDEVNM,EPROJN ;04 05
XWD EARG1,EPROTC ;06 07
XWD EEBFN,EINFIL ;08 09
XWD EEBFIL,EIOFLG ;10 11
XWD ESTAB,ESKIP ;12 13
XWD EISKIP,EFILSP ;14 15
XWD EEOVAL,EESRCH ;16 17
XWD EECTRL,EESWIT ;18 19
XWD EEBPTH,EINFSP ;20 21
XWD EOUFSP,EPATH ;22 23
;SPECIAL INFORMATION TYPEOUT ROUTINES
EECTRL: SKIPA CH,ARGSTO ;GET BAD CHAR FROM TEXT STRING
ECOMCH: LDB CH,CPTR ;GET LAST COMMAND STRING CHAR.
PUSHJ P,TYOS
JRST ERRPRN
EOUTFL: MOVEI TT1,OUNAM ;[175] AIM AT OUTPUT FILENAME
EOUTF2: PUSHJ P,EFILE ;[175] TYPE THE FILE
JRST ERRPRN ;[175] CONTINUE WITH MESSAGE
;HERE TO TYPE A FILENAME.EXTENSION
EFILE: MOVE TT,(TT1) ;[175] PICK UP FILE NAME
PUSHJ P,SIXBMS ;PRINT FILENAME
HLLZ TT,1(TT1)
JUMPE TT,CPOPJ ;[175] SKIP REST IF NO EXTENSION
MOVEI CH,"."
PUSHJ P,TYOM
PUSHJ P,SIXBMS ;PRINT EXTENSION
POPJ P, ;[175]
EFILEN: MOVEI TT1,XNAM ;[175] GET FILENAME REF'D BY UUO
JRST EOUTF2
EERNUM: LDB B,[POINT 15,XEXT,35] ;[175] GET 2-DIGIT ERROR CODE
EERNU1: PUSHJ P,OCTMS ;TYPE IT
JRST ERRPRN
EDEVNM: MOVE TT,OPNDEV ;[175] GET DEVICE NAME
EDEVN1: PUSHJ P,SIXBMS ;[175] PRINT THE DEVICE NAME
JRST ERRPRN ;[175] BACK FOR MORE OF MESSAGE
EPROJN: SKIPE PTHPPN ;[175] LOOKUP/ENTER ON DEFAULT PATH?
SKIPA C,[PTHBLK] ;[175] NO, GET PATH WE USED
MOVEI C,DEFPTH ;[175] YES, POINT TO DEFAULT PATH
PUSHJ P,TYPATH ;[175] TYPE THE PATH
JRST ERRPRN ;[175] AND CONTINUE WITH TYPEOUT
EESWIT: MOVE TT,SWITHL ;GET I/O SWITCH NAME
JRST EDEVN1 ;[175] TYPE IT & RETURN
EARG1: MOVE B,ARGSTO ;GET ARG BACK
EARG1A: PUSHJ P,DECMS ;PRINT IT
JRST ERRPRN
EPROTC: LDB B,[POINT 9,XPRV,8] ;[175] GET FILE PROTECTION
JRST EERNU1
EEBFN: MOVE TT,EBNAM ;[175] EB FILENAME
JRST EDEVN1 ;[175] PRINT IT WITHOUT EXTENSION
EINFIL: MOVEI TT1,INNAM ;[175] AIM AT INPUT FILENAME
JRST EOUTF2
EEBFIL: MOVEI TT1,EBNAM ;[175] AIM AT EB ORIGINAL FILENAME
JRST EOUTF2
EIOFLG: HRRZI B,740000 ;RETRIEVE I/O ERROR FLAGS
AND B,ARGSTO
JRST EERNU1
ESTAB: MOVEI TT,STAB ;INDEX STAB WHERE TAG RESIDES
ESTAB1: MOVE CH,(TT)
JUMPE CH,ERRPRN ;THAT'S ALL
PUSHJ P,TYOS
AOJA TT,ESTAB1
EISKIP: LDB TT,[POINT 4,ARGSTO,21] ;GET I/O ERROR FLAGS
SKIPA
ESKIP: LDB TT,[POINT 15,XEXT,35] ;[175]
ESKIP2: PUSHJ P,ERRCHR ;LOOK FOR ^A
CAIN CH,2 ;^B ENCOUNTERED?
JRST ERRPRN ;YES, PRINT DEFAULT MESSAGE
CAIE CH,1
JRST ESKIP2 ;NOT ^A
PUSHJ P,ERRCHR ;GET 1ST DIGIT AFTER ^A
MOVEI T,-60(CH)
LSH T,3 ;MULT BY 8
PUSHJ P,ERRCHR ;GET NEXT DIGIT
ADDI T,-60(CH)
CAME TT,T ;THIS THE NUMBER WE WANT?
JRST ESKIP2 ;NO
JRST ERRPRN ;YES, NOW START PRINTING
EEOVAL: MOVEI B,EOVAL ;GET MAXIMUM EOFLAG FOR THIS VERSION
JRST EARG1A
EESRCH: MOVE TT,[POINT 7,SRHARG] ;GET PTR TO SEARCH STRING
MOVE B,SRHCTR ;& STRING CTR
EESRH2: ILDB CH,TT ;GET STRING CHAR
PUSHJ P,TYOS ;TYPE IT
SOJE B,ERRPRN ;WATCH STRING CTR
JRST EESRH2 ;NOT FINISHED YET
EFILSP: MOVEI TT1,XNAM ;[175] POINT TO FILE NAME
MOVEI C,PTHBLK ;[175] AND DEVICE, CHR'S, PATH
JRST EFLSUB ;[175] JOIN COMMON ROUTINE
EPATH: SKIPA C,[PTHBLK] ;[200] POINT TO PTHBLK
EEBPTH: MOVEI C,EBPTH ;[175] POINT TO EB PATH
JRST EDSPTH ;[175] GO DISPLAY IT
EINFSP: MOVEI TT1,INNAM ;[175] SETUP INPUT FILE NAME
MOVEI C,INPTH ;[175] AND INPUT PATH
JRST EFLSUB ;[175] MERGE WITH COMMON CODE
EOUFSP: MOVEI TT1,OUNAM ;[175] OUTPUT FILE NAME
MOVEI C,OUPTH ;[175] OUTPUT PATH
; JRST EFLSUB ;[175] COMMON CODE
;HERE TO PRINT DEV:FILE.EXT[PATH]
EFLSUB: MOVE TT,-3(C) ;[175] GET DEVICE NAME
PUSHJ P,SIXBMS ;[175] TYPE IT
MOVEI CH,":" ;[175] SEPERATOR
PUSHJ P,TYOM ;[175] TYPE IT
PUSHJ P,EFILE ;[175] TYPE THE FILE.EXT
;HERE TO TYPE PATH C POINTS TO IF FROM A DISK.
EDSPTH: MOVE E,-1(C) ;[175] GET DEVCHR WORD
TXNN E,DV.DSK ;[175] A DISK?
JRST ERRPRN ;[175] NO, DONE
SKIPE 2(C) ;[175] THIS PATH BLOCK SET UP?
JRST EDSPT1 ;[175] YES, PROCEED
MOVE E,-3(C) ;[175] NO, PICKUP DEVICE
MOVEM E,0(C) ;[175] STORE IN PATH BLOCK
MOVSI E,10 ;[200] ASSUME 10 WORDS LONG
HRRI E,0(C) ;[175] NOW SET UP FOR PATH UUO
PATH. E, ;[175] FIND OUT DEVICE'S PATH
JRST ERRPRN ;[175] NOT A DISK, FORGET IT
EDSPT1: MOVEI CH,"[" ;[175] ANNOUNCE THE PATH
PUSHJ P,TYOM ;[175] OUT IT GOES
PUSHJ P,TYPATH ;[175] TYPE IT
MOVEI CH,"]" ;[175] ANNOUNCE END OF PATH
PUSHJ P,TYOM ;[175] TYPE IT
JRST ERRPRN ;[175] LOOP BACK FOR MORE OF THE MESSAGE
;UUO HANDLER
UUOH:
IFN PDP6,<0> ;PDP-6 JSR ENTRY
MOVEM B,ARGSTO ;SAVE POSSIBLE ARG
LDB B,[POINT 9,.JBUUO,8] ;GET UUO TYPE
CAIL B,20 ;CHKEO?
JRST CEO ;YES
CAIN B,1 ;ERROR UUO?
JRST ERRP ;YES
UUOERR: MOVEM B,PTHPPN ;[175]
HRRZ B,(P) ;ADDRESS OF ILLEGAL UUO
SUBI B,1
ERROR E.UUO
U LISTF5,1 ;OUTPUT DISPATCH
;CHKEO EO#,ADDR
;IF EOFLAG > EO#, RETURN AT CALL+1 (FEATURE IS LEFT ON)
;OTHERWISE GO TO ADDR (FEATURE IS TURNED OFF)
CEO: PUSH P,A ;SAVE AC
LDB B,[POINT 8,.JBUUO,12] ;GET EO TEST VALUE
MOVE A,EOFLAG ;GET LAST SETTING OF EOFLAG
CAIG A,(B) ;EOFLAG > TEST VALUE?
JRST CEO1 ;NO
CEO2: POP P,A ;RESTORE AC A
MOVE B,ARGSTO ;RESTORE AC B
IFE PDP6,<POPJ P,> ;RETURN
IFN PDP6,<JRST @UUOH>
CEO1: HRRZ A,.JBUUO ;GET DISPATCH ADDR
HRRM A,-1(P) ;PUT ON PDL AS RET. ADDR.
JRST CEO2
;COMMAND TO COMPLEMENT TRACE MODE. "?" AS A COMMAND
QUESTN: TRCN FF,TRACEF ;COMPLEMENT TRACE FLAG
JRST RET
PUSHJ P,CRR ;TYPE CR/LF AFTER TRACE MODE EXIT
JRST RET
COMMEN: PUSHJ P,SKRCH ;GET A COMMENT CHAR
ERROR E.UCA
CAIN CH,1 ;^A
JRST RET ;DONE
TRNN FF,TRACEF ;OMIT DOUBLE TYPE-OUT WHEN TRACING
PUSHJ P,TYOM ;TYPE IT
JRST COMMEN
;OLD ^G EXIT COMMAND AND ILLEGAL COMMANDS
BELDMP: CHKEO EO21,DECDMP ;IF EO=1, DO ^Z, OTHERWISE ^G IS ILLEGAL
ERRA: ERROR E.ILL
;ROUTINE TO RETURN STRING OPERATION STRING ARGUMENTS.
;ARGUMENTS ARE CHARACTER ADDRESSES IN THE DATA BUFFER.
;TRANSFORMS M,N OR N, WHERE THE LATTER SPECIFIES A NUMBER OF LINES,
;TO ARGUMENTS.
;CALL PUSHJ P,GETARG
; RETURN WITH FIRST ARGUMENT ADDRESS IN C, SECOND IN B.
;IF THE EO VALUE HAS BEEN SET TO 1, THE ONLY EOL CHAR IS LINE FEED.
;IF EO > 1, THE EOL CHARS ARE LF, VT, AND FF (& END OF BUFFER IF
;LAST CHAR IN BUFR IS NOT AN EOL)
GETARG: TRNE 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,
;ROUTINE TO RETURN IN CH THE CHARACTER TO THE RIGHT OF THE POINTER
;AND INCREMENT THE POINTER.
;CALL MOVE I,POINTER (AS A CHARACTER ADDRESS)
; PUSHJ P,GETINC
; RETURN WITH CHARACTER IN CH AND POINTER TO CHARACTER IN IN.
GETINC: PUSHJ P,GET
AOJA I,CPOPJ
GET: MOVE TT,I
IDIVI TT,5
HLL TT,BTAB(TT1)
LDB CH,TT
POPJ P,
PUT: MOVE TT,OU
IDIVI TT,5
HLL TT,BTAB(TT1)
DPB CH,TT
POPJ P,
;CHARACTER TRANSLATION BYTE POINTER TABLE
;TRANSLATES 1 CHARACTER POSITION TO THE RIGHT OF A CHARACTER ADDRESS POINTER
BTAB: XWD 350700,0
XWD 260700,0
XWD 170700,0
XWD 100700,0
XWD 10700,0
;CHECK IF CH = EOL CHARACTER
;CALL: PUSHJ P,CKEOL
; RETURN IF CH NOT = EOL
; RETURN IF CH IS EOL CHAR
CKEOL: CAIN CH,12 ;LINE FEED?
JRST CPOPJ1 ;YES, IT IS AN EOL!
CHKEO EO21,CPOPJ ;IF EO=1, LF IS ONLY POSSIBLE EOL
CAIE CH,13 ;VERTICAL TAB?
CAIN CH,14 ;FORM FEED?
AOS (P) ;YES, SKIP RETURN
POPJ P, ;NO
NROOMC:
IFN VC,<MOVEM C,VVAL> ;SAVE LENGTH OF STRING
NROOM: MOVEM 17,AC2+15 ;SAVE 17
MOVEI 17,NROOM9 ;ANTICIPATE GARBAGE COLLECTION
MOVEM 17,GCRET ;THIS THE EXIT DISPATCH
SETZM CRREL
SETZM RREL
MOVE 17,PT
CAMN 17,Z ;PT=Z? I.E., DATA BUFFER EXPANSION?
JRST NROOM1 ;YES.
NROOM0: MOVE 17,[XWD 2,AC2] ;NO. SAVE ACS 2 THROUGH 16.
BLT 17,AC2+14
JUMPL C,NROOM6 ;DELETION?
SETOM GCFLG ;NO.
;MOVE STRING STORAGE UP C CHARACTERS STARTING AT PT.
NROOM9: MOVE 17,Z
ADD 17,C
CAML 17,MEMSIZ ;WILL REQUEST OVERFLOW MEMORY?
JRST GC ;YES. GARBAGE COLLECT.
;MOVE FROM PT THROUGH Z UP C POSITIONS
MOVE 14,C ;NO.
IDIVI 14,5 ;AC14:=Q(REQ/5), AC15:=REM(REQ/5)
IMULI 15,7 ;AC15:=(REM(REQ/5))*7
MOVN 13,15 ;AC13:=-(REM(REQ/5))*7
MOVEI 15,-43(15) ;AC15:=(REM(REQ/5))*7-43
MOVE 11,PT
IDIVI 11,5 ;AC11:=Q(PT/5), AC12:=REM(PT/5)
MOVNI 16,-5(12)
IMULI 16,7 ;AC16:=-(REM(PT/5)-5)*7
DPB 16,[XWD 300600,NROOM2] ;SET SIZE FIELD OF LAST PARTIAL WORD POINTER.
ADDI 14,1(11) ;AC14:=Q(REQ/5)+Q(PT/5)+1
MOVE 16,Z
IDIVI 16,5 ;AC16:=Q(Z/5)
MOVEI B,1(16)
SUB B,11 ;B:=Q(Z/5)+1-Q(PT/5)=NO. OF WORDS TO MOVE.
;PUT MOVE ROUTINE IN FAST ACS
HRLI 11,200000+B+A*40 ;AC11:=MOVE A,[Q(PT/5)](B)
HRLOI 12,241000+A*40 ;AC12:=ROT A,-1
HRLI 13,245000+A*40 ;AC13:=ROTC A,-(REM(REQ/5))*7
HRLI 14,202000+B+AA*40 ;AC14:=MOVEM AA,[Q(PT/5)+1](B)
HRLI 15,245000+A*40 ;AC15:=ROTC A,(REM(REQ/5))*7-43
MOVE 17,[JRST,NROOM7] ;AC16:=SOJGE B,11
MOVE 16,.+1 ;AC17:=JRST NROOM7
SOJGE B,11 ;B:=B-1. DONE?
NROOM7: ROTC A,43(13) ;YES. STORE LAST PARTIAL WORD.
DPB A,NROOM2
ADDM C,Z ;Z:=Z+REQ
NROOM5: MOVE 17,[XWD 2,AC2] ;RESTORE ACS AND RETURN.
MOVSS 17
BLT 17,17
POPJ P,
U NROOM2,1 ;POINTER TO LAST PARTIAL WORD ON UPWARD MOVE.
;A CALL FOR A BUFFER EXPANSION, WHERE PT=Z. IF
;THERE IS NOT ENOUGH ROOM, PERFORM THE GARBAGE COLLECTION ROUTINE
;IF THERE IS STILL NO ROOM, GET THE NECESSARY CORE FROM THE
;MONITOR TO SATISFY THIS REQUEST
NROOM1: ADD 17,C ;TOTAL SPACE REQUIREMENT
CAMG 17,MEMSIZ ;IS THERE ENOUGH?
JRST .+4 ;YES, THEREFORE, UPDATE Z AND EXIT
MOVEI 17,GCRETA ;EXIT DISPATCH FOR THE
MOVEM 17,GCRET ;GARBAGE COLLECTION ROUTINE
JRST NROOM0 ;GO DO THE GARBAGE COLLECTION
ADDM C,Z ;UPDATE Z, SIZE IS OK
MOVE 17,AC2+15 ;RESTORE AC#17
POPJ P, ;EXIT OUT
;NOT ENOUGH ROOM FOR THE EXPANSION, GARBAGE COLLECTION HAS BEEN
;PERFORMED, IF NEED BE, GRAB A K FROM THE MONITOR (OR MORE)
GCRETA: MOVE 17,Z ;GET TOTAL SO FAR
ADD 17,C ;ADD IN THE REQUEST
CAML 17,MEMSIZ ;STILL IN NEED OF CORE?
PUSHJ P,GRABAK ;YES, GET THE REQUIRED CORE FROM THE MONITOR
ADDM C,Z ;UPDATE Z AND EXIT
JRST NROOM5 ;RESTORE ALL AC'S AND RETURN TO SEQUENCE
U GCRET,1 ;GC EXIT DISPATCH
;MOVE FROM PT+ABS(C) THROUGH Z DOWN ABS(C) POSITIONS
NROOM6: MOVE 14,PT ;INITIALIZE PARTIAL WORD POINTER.
IDIVI 14,5 ;AC14:=Q(PT/5), AC15:=REM(PT/5)
MOVEM 14,B ;B:=Q(PT/5)
HRRZM 14,NROOM4
IMULI 15,7
DPB 15,[XWD 300600,NROOM4] ;SIZE:=(REM(PT/5))*7
MOVNI 15,-44(15)
DPB 15,[XWD 360600,NROOM4] ;POSITION:=44-(REM(PT/5))*7
MOVE 11,Z
IDIVI 11,5 ;AC11:=Q(Z/5)+1, AC12:=REM(Z/5)
ADDI 11,1
MOVE 13,C
IDIVI 13,5
ADDI 13,-1(11) ;AC13:=Q(Z/5)-Q(REQ/5)
MOVNM 14,12 ;AC12:=(REM(REQ/5))*7
IMULI 12,7
MOVNI 15,-43(12) ;AC15:=43-(REM(REQ/5))*7
SUBI B,1(13) ;B:=Q(PT/5)+Q(REQ/5)-Q(Z/5)-1:=# WORDS TO MOVE
NROOM8: HRLI 11,200000+B+AA*40 ;AC11:=MOVE AA,[Q(Z/5)+1](B)
HRLI 12,245000+A*40 ;AC12:=ROTC A,(REM(REQ/5))*7
HRLI 13,202000+B+A*40 ;AC13:=MOVEM A,[Q(Z/5)-Q(REQ/5)](B)
MOVE 14,[ADDM A,@13] ;AC14:=ADDM A,@13
HRLI 15,245000+A*40 ;AC15:=ROTC A,43-(REM(REQ/5))*7
MOVE 17,[JRST NROOM3] ;AC16:=AOJLE B,11
ADDM C,Z ;AC17:=JRST NROOM3
LDB C,NROOM4
MOVE A,@11 ;Z:=C(Z)-REQ
ROT A,-1 ;A:=Q(PT/5)+Q(REQ/5) RIGHT JUSTIFIED.
MOVE 16,.+1
AOJLE B,11 ;B:=B+1. DONE?
NROOM3: DPB C,NROOM4 ;YES. DEPOSIT PARTIAL WORD.
JRST NROOM5
U NROOM4,1 ;PARTIAL WORD POINTER FOR DOWNWARD MOVE
GC: AOSE GCFLG ;FIRST ATTEMPT?
JRST PRENR9 ;TRY TO EXPAND MEMORY
SETOM GCPTR ;YES. GCPTR:=-1
SETZM SYMS ;CLEAR SYMS,VALS AND CNTS TABLES
MOVE T,[XWD SYMS,SYMS+1]
BLT T,SYMEND-1
MOVEI T,CPTR ;COMMAND BUFFER
PUSHJ P,GCMA
MOVEI T,(P)
PUSHJ P,GCMA ;NO. GARBAGE COLLECT ALL BYTE POINTERS ON IT.
CAILE T,PDL+1
SOJA T,.-2
HRRZ T,AC2+PF-2 ;GARBAGE COLLECT Q-REG PUSHDOWN LIST.
CAIL T,PFL
PUSHJ P,GCM
CAILE T,PFL
SOJA T,.-2
MOVE T,[XWD -44,QTAB] ;GARBAGE COLLECT Q-REGISTERS.
PUSHJ P,GCM
AOBJN T,.-1
MOVE I,BEG ;MAKE SURE STUFF BEFORE BEG
SUB I,QRBUF ;IS COLLECTED
MOVEI T,0 ;MARK THIS AS LAST COLLECTION
PUSHJ P,GCM3 ;STORE IT ON TH GC LIST
;COMPACT QREG STRING STORAGE AREA
;
MOVE I,QRBUF ;I: NEXT FREE ADDR. TO USE
;FIND STRING WITH LOWEST ADDRESS IN AREA
GCS1A: MOVSI TT,200000 ;TT>MAX. NO. CHARACTERS IN WORLD
MOVE OU,GCPTR ;GO BACKWARDS THROUGH GCTAB
GCS1: HRRZ A,GCTAB(OU) ;GET ADDR OF STRING FOUND ABOVE
ADD A,QRBUF
CAMGE A,I ;PTR ABOVE AREA ALREADY DONE?
JRST GCS2 ;NO, NOT INTERESTED
CAMGE A,TT ;THIS LOWEST PTR IN GC AREA?
MOVE TT,A ;YES, REMEMBER IT
GCS2: SOJGE OU,GCS1
CAMN TT,[1B1] ;ANYTHING IN GCTAB? [116]
JRST GCS4A ;NO, DON'T SAVE INFINITY[116]
;HAVE FOUND A STRING, MOVE IT AND EVERYTHING AFTER IT DOWN TO
;LOWEST FREE ADDRESS.
MOVE F2,TT ;HIGHEST CHARACTER.
IDIVI F2,5 ;LENGTH OF STRING
IDIVI I,5 ;WORDS TO OFFSET
SKIPE B ;FRACTIONATED WORD?
AOS I ;YES, ROUND UP
MOVS OU,F2 ;SET UP SOURCE FOR BLT
MOVE T,F2
SUB T,I ;COMPUTE DISTANCE OF MOVE
JUMPLE T,GCS4A ;ANYTHING TO GET?
HRR OU,I ;SETUP DEST FOR BLT
MOVE B,Z ;GET TOP OF BUFR FOR BLT
HRRZ F2,(P) ;SEE WHO CALLED NROOM
CAIN F2,YANK6 ;WAS IT APPEND?
MOVE B,AC2+OU-2 ;YES, MUST USE THE REAL Z FOR THE BLT
IDIVI B,5 ;SETUP FINAL DEST FOR BLT
SUB B,T ;IE FINAL SOURCE MINUS DISTANCE
BLT OU,(B) ;MOVE STUFF DOWN
MOVNS OU,T ;GET NEG DISTANCE
IMULI OU,5 ;IN TERMS OF CHARACTERS
ADDM OU,BEG ;BEG:=C(BEG)-5*NREG
ADDM OU,PT ;PT:=C(PT)-5*NREG
ADDM OU,Z ;Z:=C(Z)-5*NREG
ADDM OU,RREL ;RREL:=C(RREL)-5*NREG
MOVE CH,GCPTR ;UPDATE INSERTER
GCS3: HRRZI TT1,GCTAB(CH) ;GET STRING ADDR
HRRZ A,(TT1)
ADD A,QRBUF
CAMGE A,TT
JRST GCS4
ADDM OU,(TT1) ;RELOCATE PTR
HLRZ A,(TT1) ;GET ADDR WHERE STRING WAS LIVING
JUMPE A,GCS4 ;NO PTR TO BEG
CAIN A,CPTR ;IN COMMAND BUFFER?
ADDM T,CRREL ;YES. UPDATE COMMAND POINTER RELOCATION
SKIPL (A) ;Q-REG?
ADDM T,(A) ;NO
SKIPGE (A) ;Q-REG?
ADDM OU,(A) ;YES. RELOCATE BASE POINTER.
GCS4: SOJGE CH,GCS3 ;DONE?
ADD TT,OU ;YES. IN:=C(TT)-5*NREG
GCS4A: CAML TT,BEG ;LAST COLLECTION?
JRST @GCRET ;YES, RETURN
MOVE I,TT
PUSH P,C
PUSHJ P,GTQCNT
ADD I,C
POP P,C
JRST GCS1A
;MARK ACTIVE QREG STRING
; T: ADDRESS OF QREG STRING PTR
GCM: MOVE I,(T)
TLZE I,400000 ;DOES Q-REG CONTAIN TEXT?
TLZE I,377777
POPJ P, ;NO
ADD I,QRBUF ;YES. ENTER POINTER IN GCTAB
GCM2: CAML I,BEG ;REGION BEFORE TEXT BUFFER?
POPJ P, ;NO. FORGET IT.
SUB I,QRBUF ;YES. IN:=# CHARACTERS TO RETREIVE.
; IN Q-REG BUFFER AREA?
JUMPL I,CPOPJ ;NO. FORGET IT.
GCM3: AOS TT,GCPTR ;YES. TO BE GRABBED.
CAIL TT,GCTBL ;AM I WINNING?
ERROR E.GCE ;NO. VERY BAD.
HRL I,T ;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS
MOVEM I,GCTAB(TT) ;SAVE DATA
POPJ P, ;DONE THIS POINTER
;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMA: HLRZ TT,(T) ;LEFT HALF OF PTR
TRC TT,700 ;DOES T POINT TO A TEXT BYTE POINTER?
TRNE TT,7700
POPJ P, ;NO
MOVE I,-1(T) ;MAYBE. GET WORD BEFORE POINTER. (MAX)
SUB I,1(T) ;MAX-CT
LSH TT,-14 ;BYTE POSITION
IDIVI TT,7 ;NO. OF CHARACTERS
MOVEI TT1,4-3+1 ;2
SUB TT1,TT ;2-NO. OF CHARACTERS
HRRZ TT,(T) ;POINTER WORD ADDRESS (UNRELOCATED)
IMULI TT,5 ;5*ADDRESS
ADD TT,TT1
SUBM TT,I ;5*ADDRESS-NO. CHARS+2+CT-MAX
JRST GCM2
;**********AUTOMATIC MEMORY EXPANSION*********
;MEMORY WILL BE EXPANDED UNDER ONE OF THESE CONDITIONS.
; 1.AN INTERNAL BUFFER EXPANSION CANNOT BE PERFORMED,
; TO DO SO WOULD OVERFLOW THE PRESENT MEMORY
; CAPACITY. THE INTERNAL OPERATIONS WHICH DESCOVER
; THE NEED FOR EXPANSION ARE:
; A.COMMAND BUFFER EXPANDING
; B.THE Q-REG GET (GI)
; C.THE Q-REG LOAD (NXI)
; D.ANY OF THE INSERTS
; E.COMMAND ACCEPTANCE ROUTINE
; 2.THE DATA BUFFER WILL BE MAINTAINED AT A MINIMUM
; NUMBER OF 5000 CHARACTERS BEFORE NEW DATA IS LOADED
; FROM AN INPUT DEVICE OTHER THAN THE CONSOLE. Q-REG
; USAGE SHORTENS THE NUMBER OF AVAILABLE CHARACTERS
; DIRECTLY, AND NORMAL TECO COMMANDS ARE GREATLY IMPARED
; OTHERWISE.
;SAVE THE ACCUMULATORS
GRABAK: TLOA FF,GKTLKF ;TALKATIVE GRAB
GRABKQ: TLZ FF,GKTLKF ;GRAB A K QUIETLY
MOVEM CH,SAV16 ;TO SAVE THE ACCUMULATORS
MOVEI CH,SAVE ;WHILE WE SCOOT ALL OVER THE
BLT CH,SAV16-1 ;THE PLACE
;COUNT THE NUMBER OF BLOCKS NEEDED TO FILL THE REQUEST
MOVEI F2,^D1024 ;1 BLOCK OF CORE
MOVEI B,1 ;WE WILL NEED AT LEAST ONE BLOCK
ADDM F2,.JBFF ;UP THE FIRST FREE COUNT
PUSHJ P,CRE23 ;COMPUTE A NEW MEMSIZ AND 2/3 VALUE
CAML 17,MEMSIZ ;WILL THIS BE ENOUGH CORE?
AOJA B,.-3 ;NO, COMPUTE ANOTHER BLOCK
;NUMBER OF BLOCKS HAVE BEEN FOUND
;OBTAIN THE NEEDED CORE FROM THE MONITOR
MOVE B,.JBFF ;TO HELP OUT THE MONITOR
CORE B, ;MAKE THE CALL TO THE MONITOR
JRST NOTANY ;NO CORE (OR NOT ENOUGH) AVAILABLE
TLNN FF,GKTLKF ;MESSAGE DESIRABLE?
JRST EXITZ ;NO
MOVEI CH,"["
PUSHJ P,TYOM
MOVE B,.JBREL ;SIZE OF CORE NOW
ADDI B,1
ASH B,-12
PUSHJ P,DECMS ;PRINT
JSP A,CONMES
ASCIZ /K Core]
/
;RESTORE THE AC'S AND EXIT FROM THIS COR GET ROUTINE
EXITZ: MOVSI CH,SAVE ;FROM TO
BLT CH,CH ;ALL AC'S AS THEY WERE
POPJ P, ;AND EXIT
;NO CORE AVAILABLE (OR NOT ENOUGH)
NOTANY: HLRZ A,.JBSA ;GET LAST FIGURE OF CORE BOUND
MOVEM A,.JBFF ;AND STORE IT
PUSHJ P,CRE23 ;COMPUTE THE MEMSIZE VALUES AGAIN
MOVSI CH,SAVE ;RESTORE THE ACCUMULATORS
BLT CH,CH ;& INFORM THE OUTSIDE WORLD THAT THEY LOSE
EE3+ERROR E.COR
;THIS IS AN AUXILARY SPOT FOR ENTRANCE FROM GC2
;GET THE REQUIRED CORE TO SAVE THE JOB IF POSSIBLE
PRENR9: PUSHJ P,GRABAK ;GET THE REQUIRED CORE
JRST NROOM9 ;GO TRY THE INSERT AGAIN
U BEG,1 ;
U PT,1 ;
U Z,1 ;
U QRBUF,1 ;
;*** DO NOT SEPARATE ***
U COMAX,1 ;TOTAL # OF CHARS AT CUR. CMD. LEVEL
U CPTR,1 ;EXECUTION-TIME CMD STRING PTR
U COMCNT,1 ;# OF CHARS REMAINING TO BE EXECUTED AT THIS LEVEL
;*** DO NOT SEPARATE ***
U CBUFH,1 ;
U CBUF,1 ;
U MEMSIZ,1 ;
IFN CCL,<U CCLSW,1>
U GCPTR,1 ;
U CRREL,1 ;
U GCFLG,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 ;
; [227] ADD A NEW GLOBAL FOR *I COMMAND.
U COMSAV,1 ;[227] SAVED Q-REG VALUE FOR *I
;COMMAND DISPATCH TABLE
DEFINE DSP (C1,A1,C2,A2)<
XWD <<C1>B20+A1>,<<C2>B20+A2>>
;CODES INDICATE TYPE OF DISPATCH
JR==0 ;FOR SIMPLE JRST DISPATCH
HR==1 ;FOR DISPATCH TO A COMMAND PERFORMED BY A SUBROUTINE
MV==2 ;FOR JRST DISPATCH AFTER PROCESSING PRECEDING NUMERIC ARGUMENTS
DTB: DSP(JR,ERRA,JR,COMMEN) ;^@ ^A
DSP(JR,ERRA,JR,ERRA) ;^B ^C
DSP(JR,ERRA,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 [142]
DSP(HR,TYO,JR,CD5) ;FF CR [142]
DSP(JR,EOF,JR,OCTIN) ;^N ^O
DSP(JR,ERRA,JR,ERRA) ;^P ^Q
DSP(JR,ERRA,JR,ERRA) ;^R ^S
DSP(JR,SPTYI,JR,ERRA) ;^T ^U
DSP(MV,LOWCAS,MV,STDCAS) ;^V ^W
DSP(MV,SETMCH,JR,ERRA) ;^X ^Y
DSP(JR,DECDMP,JR,ALTMOD) ;^Z ^[
DSP(JR,ERRA,JR,ERRA) ;^BKSLH ^]
DSP(JR,CNTRUP,JR,ERRA) ;^^ ^LFTARR
DSP(MV,PLUS,JR,EXCLAM) ;SPACE !
DSP(MV,DQUOTE,MV,COR) ;" #
DSP(JR,ERRA,JR,PCNT) ;$ %
DSP(MV,CAND,JR,CD) ;& '
DSP(JR,OPENP,MV,CLOSEP) ;( )
DSP(MV,TIMES,MV,PLUS) ;* +
DSP(MV,COMMA,MV,MINUS) ;, -
DSP(JR,PNT,MV,SLASH) ;. /
DSP(JR,CDNUM,JR,CDNUM) ;0 1
DSP(JR,CDNUM,JR,CDNUM) ;2 3
DSP(JR,CDNUM,JR,CDNUM) ;4 5
DSP(JR,CDNUM,JR,CDNUM) ;6 7
DSP(JR,CDNUM,JR,CDNUM) ;8 9
DSP(MV,COLON,MV,SEMICL) ;: ;
DSP(MV,LSSTH,HR,PRNT) ;< =
DSP(JR,GRTH,JR,QUESTN) ;> ?
DSP(MV,ATSIGN,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,LINE,JR,MAC) ;L M
DSP(MV,SERCHP,JR,OG) ;N O
DSP(HR,PUNCHA,JR,QREG) ;P Q
DSP(MV,REVERS,MV,SERCH) ;R S
DSP(HR,TYPE,MV,USE) ;T U
DSP(JR,ERRA,JR,ERRA) ;V W
DSP(MV,X,HR,YANK) ;X Y
DSP(JR,END1,MV,OPENB) ;Z [
DSP(MV,BAKSL,MV,CLOSEB) ;BKSLH ]
DSP(JR,UAR,MV,LARR) ;^ LFTARR
U ERRLEN,1 ;TYPE OF ERROR MESSAGES WANTED BY DEFAULT
U AC2,16 ;SAVE AC2-AC17 IN NROOM ROUTINE
U STAB,STABLN ;SEARCH MATRIX
COMZR==STAB ;[175] BEGINNING OF AREA TO ZERO
;[175] WHEN ENTERING COMMAND SCANNER
COMDEV=STAB ;[175] DEVICE USER TYPED
COMNAM=COMDEV+1 ;[175] FILENAME " "
COMEXT=COMNAM+1 ;[175] EXTENSION " "
COMPPN=COMEXT+1 ;[175] PPN " "
COMSFD=COMPPN+1 ;[175] SFD'S " "
SWITC=COMSFD+5 ;[175] SWITCHES " "
SWITHL=SWITC+1 ;[175] LAST SWITCH TYPED, IN SIXBIT
OPNBLK==<OPNSTS=SWITHL+1> ;[175] STATUS TO DO OPEN WITH
OPNDEV=OPNSTS+1 ;[175] DEVICE TO OPEN
OPNBUF=OPNDEV+1 ;[175] BUFFER ADDRESS
OPNCHR=OPNBUF+1 ;[175] DEVCHR OF DEVICE IN OPNDEV
PTHBLK=OPNCHR+1 ;[175] 1ST WORD OF PATH BLOCK
PTHFLG=PTHBLK+1 ;[175] SCAN SWITCH & OTHER FLAGS
PTHPPN=PTHFLG+1 ;[175] PROJ-PROG PAIR
PTHSFD=PTHPPN+1 ;[175] FIRST SFD
PTHLEN=PTHSFD+5-PTHBLK+1 ;[175] LENGTH OF PATH BLOCK
XFILNM==PTHBLK+PTHLEN ;[175] EXTENDED OPEN BLOCK
XCNT=XFILNM+.RBCNT ;[175] COUNT OF ARGS FOLLOWING
XPPN=XFILNM+.RBPPN ;[175] POINTER TO PATH BLOCK
XNAM=XFILNM+.RBNAM ;[175] FILE NAME
XEXT=XFILNM+.RBEXT ;[175] EXTENSION
XPRV=XFILNM+.RBPRV ;[175] PROT. & DATES
XSIZ=XFILNM+.RBSIZ ;[175] FILE SIZE (WORDS)
XVER=XFILNM+.RBVER ;[175] VERSION
XSPL=XFILNM+.RBSPL ;[175] SPOOLING NAME
XEST=XFILNM+.RBEST ;[175] ESTIMATED SIZE
XALC=XFILNM+.RBALC ;[175] BLOCKS ALLOCATED TO FILE
XPOS=XFILNM+.RBPOS ;[175] POSITION OF FILE ON DISK
XNCA=XFILNM+.RBNCA ;[175] NON-PRIVED CUST. ARG.
XDEV=XFILNM+.RBDEV ;[175] UNIT OF STR THAT FILE CAME FROM
XFILEN=XDEV-XFILNM+1 ;[175] LENGTH OF LOOKUP BLOCK
SFILNM==XNAM ;[175] ALTERNATE NAME FOR DTA LOOKUPS
CPATH=XFILNM+XFILEN ;[175] SECOND PATH BLOCK FOR CHKPTH
CFLG=CPATH+1 ;[175] SCAN SWITCH
CPPN=CFLG+1 ;[175] PPN
CSFD=CPPN+1 ;[175] 1ST SFD
CPTLEN=CSFD+5-CPATH+1 ;[175] LENGTH OF PATH BLOCK
DCBLK=CPATH+CPTLEN ;[175] DSKCHR BLOCK FOR EB OPEN
DCSNM=DCBLK+.DCSNM ;[175] STRUCTURE NAME FILE IS ON
DCLEN==DCSNM-DCBLK+1 ;[175] LENGTH OF DSKCHR BLOCK
COMEZR==DCBLK+DCLEN-1 ;[175] 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 SERCH1 [ED#117]
U SYMS,22 ;LIS+4(0),OG3+1,GC+3(0)
U VALS,22 ;LIS+4(0),OG3+3,GC+3(0)
U CNTS,22 ;LIS+4(0),OG3+2,GC+3(0)
U SYMEND,0 ;
U EQM,1 ;LEVEL OF MACRO NESTING [ED#114]
U SRHCTR,1 ;# OF CHARS IN SEARCH ARGUMENT (MUST PRECEDE SRHARG)
U SRHARG,^D16 ;STORE FOR SEARCH ARGUMENT
U PFL,LPF ;
U GCTAB,GCTBL ;GCS3+4,GCM2+13
U QTAB,44 ;Q-REGISTER TABLE
;USEA+1,PCNT+1
U PDL,LPDL ;
U SAVE,16 ;AC STORAGE FOR GC
U SAV16,1 ;
IFE BUGSW,<U CMDBFR,0> ;COMMAND BUFFER
IFN BUGSW, <U CMDBFR,1
U LOWEND,0>
LIT ;SO PATCH SPACE IS AT TOP OF HI-SEG
PATCH: END TECO
Reference in New Issue View Git Blame Copy Permalink