Trailing-Edge
-
PDP-10 Archives
-
bb-d549g-sb
-
teco.mac
There are 5 other files named teco.mac in the archive. Click here to see a list.
TITLE TECO VERSION 24
SUBTTL TEXT EDITOR AND CORRECTOR RC CLEMENTS/PMH/CAM/EAR/DML/JNG/BGS/DCE
EDIT==202
VERSION==XWD 2400,EDIT
;COPYRIGHT 1970,1971,1972,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
SEARCH UUOSYM,MACTEN ;[175]
F%FDAE==3,,1B30 ;[175] 8/8/76, NOT YET IN UUOSYM
IFDEF .TEXT,<.TEXT "/SYMSEG:HIGH"> ;[175] STORE SYMBOLS IN
;[175] HI SEG IF DEBUGGING
; . . . 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
;[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
;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
;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
;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
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
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)
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
JUMPE B,CCLNUL ;[175] QUIT ON END OF STRING
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: LDB B,T ;[175] RETRIEVE LAST CHAR
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
DPB B,T ;TERMINATING TWO ALT'S
IDPB B,T ;LAST ALT
ADDI C,2 ;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
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
TLNE F2,GOING ;ANY CMD STRG SEEN YET? IF NOT, * IS ILLEGAL
JRST LIS03 ;OK
PUSHJ P,CRR ;MUST PUT CR/LF BEFORE ?NCS
;LIS01+6 1/2 [166] SPR#17205
PUSHJ P,TYI ;[166] FIND NEXT CHARACTER TYPED
MOVE A,TIB+1 ;[166] PICK UP ITS POINTER
MOVEM A,CPTR ;[166] STORE FOR ERROR MESSAGE
ERROR E.NCS
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
PUSHJ P,X3 ;TRANSFER STRING TO Q-REG
PUSHJ P,TYI ;GET Q-REG NAME FOR * COMMAND
;LIS03+5 1/2 INSERT [170] SPR#17404
MOVE A,TIB+1 ;[170] GET POINTER TO CURRENT CHARACTED
MOVEM A,CPTR ;[170] STORE FOR POSSIBLE ERROR MESSAGE
PUSHJ P,QREGV2 ;STORE 400000 IN QTAB
MOVEM B,QTAB-"0"(CH)
TRZ FF,QMFLG ;NEXT INPUT CHAR NOT IN
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
RUBSW==0
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
;cd93+4 1/2 insert [167] spr#18215
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+XMATCH+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: 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
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.
SUBI C,-3(B) ;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.
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 0,0 ;MARKS END OF LIST
;MISCELLANEOUS CHARACTER DISPATCHER
;CALL: MOVE CH,CHARCATER
; MOVEI T,TABLE ADDR
; PUSHJ P,DISPAT
; NOT FOUND RETURN
;ENTER AT DISP1 TO AVOID CONVERTING LC TO UC
DISPAT: 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
;^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
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
PUSH E,[PTHBLK] ;[175] SETUP .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: 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
PUSH E,[PTHBLK] ;[175] SET .RBPPN TO EXTENDED PATH
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
PUSH E,[PTHBLK] ;[175] 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?
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
PUSH E,[PTHBLK] ;[175] 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?
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
PUSH A,E ;[175] STORE PATH POINTER OR ZERO
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
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.
TRZN FF,SEQUIN ;WAS LAST THING A SUPPRESSED SEQ #?
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
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,12
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
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
JRST PPA01
;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
;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: 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 SRHCTR ;COUNT THE ^R (^Q)
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: CAML I,Z ;NO. REACHED TOP OF BUFFER?
JRST NOFND ;YES.
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
ADDI I,1 ;LOOK AT NEXT LOC, XCEPT 1ST TIME THRU
S4C: LSH D,-1 ;ADVANCE TO NEXT CHAR POSITION
S4B: CAMN D,AA ;END OF SEARCH TABLE?
JRST FND ;YES.
S4A: ILDB CH,TT1 ;NO, GET NEXT CHAR
TDNE D,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]
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?
JRST RET ;NO
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: ADDI I,1 ;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 SPTB ;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
SOJA B,SRCH2E
;^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
CAIN CH,(SIXBIT /FNF/)
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: TLNN F2,GOING ;[166] ANY COMMAND SEEN YET?
JRST ERRTY1 ;[166] NO, SKIP THE FOLLOWING
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
MOVE I,QRBUF
GCS1A: MOVSI TT,200000 ;TT>MAX. NO. CHARACTERS IN WORLD
MOVE OU,GCPTR ;GO BACKWARDS THROUGH GCTAB
GCS1: HRRZ A,GCTAB(OU) ;RELOCATE
ADD A,QRBUF
CAMGE A,I
JRST GCS2
CAMGE A,TT ;SET TT TO HIGHEST CHARACTER POSITION
MOVE TT,A
GCS2: SOJGE OU,GCS1
CAMN TT,[1B1] ;ANYTHING IN GCTAB? [116]
JRST GCS4A ;NO, DON'T SAVE INFINITY[116]
MOVE F2,TT ;HIGHEST CHARACTER.
IDIVI I,5 ;C(QRBUF)/5
IDIVI F2,5 ;HIGH CHAR/5
AOS I ;C(QRBUF)/5+1
MOVS OU,F2
MOVE T,F2
SUB T,I ;HIGH CHAR/5-C(QRBUF)/5+1
JUMPLE T,GCS4A ;ANYTHING TO GET?
HRR OU,I ;XWD HIGH CH/5,C(QRBUF)/5+1=NREG
MOVE B,Z ;GET TOP OF BUFR FOR BLT
HRRZ F2,(P) ;SEE WHO CALLED NROOM
CAIN F2,YANK6 ;WAS IT APPEND?
MOVE B,AC2+OU-2 ;YES, MUST USE THE REAL Z FOR THE BLT
IDIVI B,5
SUB B,T ;Z/5-NREG
BLT OU,(B) ;MOVE STUFF DOWN
MOVNS OU,T
IMULI OU,5 ;OUT:=-5*NREG
ADDM OU,BEG ;BEG:=C(BEG)-5*NREG
ADDM OU,PT ;PT:=C(PT)-5*NREG
ADDM OU,Z ;Z:=C(Z)-5*NREG
ADDM OU,RREL ;RREL:=C(RREL)-5*NREG
MOVE CH,GCPTR ;UPDATE INSERTER
GCS3: HRRZI TT1,GCTAB(CH)
HRRZ A,(TT1)
ADD A,QRBUF
CAMGE A,TT
JRST GCS4
ADDM OU,(TT1)
HLRZ A,(TT1)
JUMPE A,GCS4 ;NO PTR TO BEG
CAIN A,CPTR ;IN COMMAND BUFFER?
ADDM T,CRREL ;YES. UPDATE COMMAND POINTER RELOCATION
SKIPL (A) ;Q-REG?
ADDM T,(A) ;NO
SKIPGE (A) ;Q-REG?
ADDM OU,(A) ;YES. RELOCATE BASE POINTER.
GCS4: SOJGE CH,GCS3 ;DONE?
ADD TT,OU ;YES. IN:=C(TT)-5*NREG
GCS4A: CAML TT,BEG ;LAST COLLECTION?
JRST @GCRET ;YES, RETURN
MOVE I,TT
PUSH P,C
PUSHJ P,GTQCNT
ADD I,C
POP P,C
JRST GCS1A
GCM: MOVE I,(T)
TLZE I,400000 ;DOES Q-REG CONTAIN TEXT?
TLZE I,377777
POPJ P, ;NO
ADD I,QRBUF ;YES. ENTER POINTER IN GCTAB
GCM2: CAML I,BEG ;REGION BEFORE TEXT BUFFER?
POPJ P, ;NO. FORGET IT.
SUB I,QRBUF ;YES. IN:=# CHARACTERS TO RETREIVE.
; IN Q-REG BUFFER AREA?
JUMPL I,CPOPJ ;NO. FORGET IT.
GCM3: AOS TT,GCPTR ;YES. TO BE GRABBED.
CAIL TT,GCTBL ;AM I WINNING?
ERROR E.GCE
HRL I,T ;XWD ADDRESS OF BYTE POINTER,NO. CHARACTERS
MOVEM I,GCTAB(TT) ;SAVE DATA
POPJ P, ;DONE THIS POINTER
;IF T POINTS TO AN ASCII BYTE POINTER, IN:=CHARACTER ADDRESS OF TOP
;OF STRING - NO. OF CHARACTERS.
GCMA: HLRZ TT,(T) ;LEFT HALF OF PTR
TRC TT,700 ;DOES T POINT TO A TEXT BYTE POINTER?
TRNE TT,7700
POPJ P, ;NO
MOVE I,-1(T) ;MAYBE. GET WORD BEFORE POINTER. (MAX)
SUB I,1(T) ;MAX-CT
LSH TT,-14 ;BYTE POSITION
IDIVI TT,7 ;NO. OF CHARACTERS
MOVEI TT1,4-3+1 ;2
SUB TT1,TT ;2-NO. OF CHARACTERS
HRRZ TT,(T) ;POINTER WORD ADDRESS (UNRELOCATED)
IMULI TT,5 ;5*ADDRESS
ADD TT,TT1
SUBM TT,I ;5*ADDRESS-NO. CHARS+2+CT-MAX
JRST GCM2
;**********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 ;
;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