eric@tekadg.UUCP (eric) (12/13/84)
Well, since everyone wanted to see my teco source, I guess I will go right ahead
and puke it out here. On my system, a 4.1BSD (it claims), when I want to
create teco, I type
compat macro -xs:3 teco
compat macro -xs:3 tecoio
compat linkr teco tecoio
mv teco.out teco
and when I am ready to teco something, I type
compat teco ARGS
All I am going to put out here are teco.m11, tecoio.m11, and some miscellaneous
(random formatting program) input which makes a (vain) attempt to document teco.
From my use of it, it seems a lot like the first teco I laid hands on on a
DEC10 about eight years ago, i.e., it doesn't know what ey means.
Anyway, part 1 will be teco.m11, part 2 will be tecoio.m11, and part 3 will be
some dorkuments. I haven't figured out what to feed all of them to in order to
make them readable and a question to the originator resulted in a "Oh, it
shouldn't be hard to modify it so ms will format it." Right. Here is teco.m11!
--------------------------------------------------------------------------------
.TITLE TECO TECO-11
.NLIST TTM
.SBTTL TECO-11
; PDP-11 TECO
; A BRUTE FORCE TRANSLATION BY HANK MAURER
; ( 1-JUNE-1973 THROUGH 4-JUNE-1973 )
; (WITH I/O ARRANGEMENTS BY BOB HARTMAN)
; (AT FORD OF COLOGNE, WEST GERMANY)
; [SLIGHT MODIFICATIONS BY MARK BRAMHALL OF DEC]
; [FOR CORE EXPANSION AND HIGH/LOW SEGS]
; <PDP-10 COMPATIBILITY, ETC. BY ANTON CHERNOFF>
; OF OS-8 TECO WHICH COMES FROM A PROGRAM
; ORIGINALLY WRITTEN BY RUSSELL HAMM, WAY BACK WHEN
; MODIFIED FOR OS/8 BY THE O.M.S.I. CREW
; SPEEDED UP, SHORTENED AND MADE PDP-10
; COMPATIBLE BY RICHARD LARY OF DEC
; WITH ASSISTANCE FROM MARIO DENOBILI OF THE P?S
VERSON = 11. ;VERSION NUMBER
.RADIX 10
.IRP N,<\VERSON>
.RADIX 8
.LIST
.IDENT /V'N/
.NLIST
.ENDM
.SBTTL INTERNAL GLOBALS
; ENTRY POINT AND VERSION NUMBER
.GLOBL TECO, VERSON
; READ/WRITE (R5 OFFSET) AREA SIZE
.GLOBL RWSIZE
; SPECIAL ACCESS TO LINE-FINDING ROUTINE
.GLOBL .VVV.V
; SPECIAL ACCESS FOR CCL USAGE
.GLOBL DOCCL
;special access for yank (ccl usage)
.globl yank
;special access for exit
.globl .eeex
; VARIOUS GLOBAL OFFSETS ARE DEFINED LATER...
.SBTTL EXPLAINING THINGS...
; ASSEMBLY PARAMETER
;
; IF THE SYMBOL "ERRTXT" IS DEFINED AS NON-ZERO, THEN ALL ERROR
; CALLS (INCLUDING THOSE FROM 'TECOIO') PASS AN ASCIZ
; STRING TO EXPLAIN THE ERROR. IF THE SYMBOL "ERRTXT" IS
; DEFINED AS ZERO, THEN NO ASCIZ STRINGS NEED BE PASSED
; AND NO EXPLANATIONS ARE EVER GIVEN.
;
; THE DEFAULT IS FOR "ERRTXT" TO BE DEFINED AS NON-ZERO.
.IIF NDF ERRTXT ERRTXT=1 ;DO THE DEFAULT
; READ/WRITE AREAS USED BY TECO
;
; THERE ARE FOUR DIFFERENT READ/WRITE AREAS:
;
; 1) THE MAIN READ/WRITE AREA (TECO'S CRITICAL DATA)
;
; LENGTH: DEFINED (FOR 'TECOIO') BY THE TECO DEFINED
; GLOBAL "RWSIZE". THIS IS THIS AREA'S SIZE
; IN BYTES.
; WHERE: 'TECOIO' DETERMINES WHERE THIS AREA IS AND
; POINTS TO IT BY SETTING R5 TO POINT TO ITS START.
; SETUP: THIS WHOLE AREA MUST BE CLEARED TO ALL ZEROS
; EXCEPT FOR THE FOLLOWING ITEMS:
; TECOSP (SEE AREA #2)
; TECOPD, PDL, SCHBUF (SEE AREA #3)
; TXSTOR, QRSTOR, ZMAX, QMAX, CURFRE
; (SEE AREA #4)
; [NOTE: THE ABOVE ITEMS ARE DEFINED BY TECO AS
; GLOBAL OFFSET VALUES FROM R5.]
;
; 2) THE SP STACK AREA (FOR TECO AND 'TECOIO' USAGE)
;
; LENGTH: WHATEVER SEEMS REASONABLE (200(8) BYTES SEEMS
; A GOOD GUESS).
; WHERE: 'TECOIO' INITIALLY SETS THE STACK POINTER (SP)
; TO POINT TO THE END OF THIS AREA +2. IN ADDITION,
; 'TECOIO' SETS "TECOSP" TO ALSO POINT TO THE END
; OF THIS AREA +2 (I.E. SP STACK RESET VALUE).
; SETUP: NONE NEEDED.
;
; 3) THE PUSH-DOWN LIST AND SEARCH BUFFER
;
; LENGTH: WHATEVER SEEMS REASONABLE (100(8) BYTES FOR
; THE PUSH-DOWN LIST AND ANOTHER 100(8) BYTES FOR
; THE SEARCH BUFFER SEEM GOODLY NUMBERS).
; NOTE THAT THESE TWO AREAS ARE COMBINED INTO ONE
; AREA. TECO DEPENDS ON THE FACT THAT THIS IS
; TRUE! FURTHERMORE, THE PUSH-DOWN LIST MUST BE
; THE LOWER IN ADDRESS SPACE OF THESE TWO COMBINED
; AREAS.
; 'TECOIO' MUST GLOBALIZE THE SEARCH BUFFER'S
; LENGTH VIA THE SYMBOL "SCHSIZ".
.GLOBL SCHSIZ
; WHERE: 'TECOIO' POINTS TO THIS AREA BY SETTING:
; "TECOPD" AND "PDL" TO POINT TO THE AREA'S
; START (PUSH-DOWN LIST).
; "SCHBUF" TO POINT INTO THE MIDDLE OF THE
; AREA (SEARCH BUFFER START).
; SETUP: THE BYTE POINTED TO BY "SCHBUF" MUST BE SETUP
; TO BE -1. ALL OTHER BYTES NEED NOT BE SET UP.
;
; 4) THE TEXT AND Q-REGISTER DATA AREA
;
; LENGTH: 'TECOIO' INITIALLY DEFINES THE LENGTH OF THIS
; AREA, BUT THIS AREA'S SIZE IS CAPABLE OF BEING
; EXPANDED (IF YOUR ENVIORNMENT ALLOWS IT). THE
; AREA'S LENGTH IS REFLECTED BY THE SUM OF "ZMAX"
; PLUS "QMAX" PLUS "CURFRE". THE AREA IS ORGANIZED
; SUCH THAT TEXT STORAGE COMES FIRST (LOWEST IN
; ADDRESS SPACE), THE Q-REGISTER STORAGE COMES
; NEXT, AND THE FREE SPACE (IF ANY) COMES LAST.
; "ZMAX", "QMAX", AND "CURFRE" REFLECT THE SIZES
; OF THESE AREAS RESPECTIVELY.
; WHERE: 'TECOIO' SETS UP TWO POINTERS TO THIS AREA:
; "TXSTOR" POINTS TO AREA'S START
; (TEXT START).
; "QRSTOR" POINTS TO AREA'S MIDDLE
; (Q-REGISTER START).
; NOTE THAT TECO MAY SHUFFLE THE TEXT AND Q-REGISTER
; AREAS WITHIN THIS WHOLE AREA THUS CHANGING "QRSTOR"
; AS WELL AS THE MAXIMUMS.
; ONE OF THE 'TECOIO' SUBROUTINE CALLS IS FOR
; EXPANDING THIS AREA. WHEN 'TECOIO' EXPANDS THE
; AREA (BY ADDING TO ITS END), 'TECOIO' MUST UPDATE
; (BY ADDING TO) "CURFRE" TO REFLECT THE ADDITION.
; SETUP: NONE NEEDED.
; DOCUMENTATION OF 'TECOIO' SUBROUTINES
;
; NOTE THAT, UNLESS A REGISTER IS SPECIFICALLY MENTIONED AS
; OUTPUT FROM A SUBROUTINE, IT MUST BE PRESERVED!
.GLOBL LISTEN ;JSR PC,LISTEN
; IN: R0 = 0 MEANS DELIMITERS ARE: ALTMODE, RUBOUT, CTRL/U, CTRL/G
; R0 <> 0 MEANS ANYTHING IS A DELIMITER (SINGLE CHARACTER MODE)
;
; OUT: R0 = RETURNED CHARACTER (001 <= CHARACTER <= 177)
;
; NOTE: IT IS THE RESPONSIBILITY OF 'LISTEN' TO APPEND A LINE
; FEED TO A CARRIAGE RETURN (IF THE SYSTEM DOESN'T)
; IT IS ALSO THE RESPONSIBILITY OF 'LISTEN' TO ECHO
; THE TYPED CHARACTERS (IF THE SYSTEM DOESN'T)
.GLOBL TYPE ;JSR PC,TYPE
; IN: R0 = CHARACTER TO OUTPUT TO TERMINAL
;
; NOTE: ANY CHARACTER CONVERSIONS (TAB'S, ETC.) ARE TO BE DONE BY
; 'TYPE' (IF THE SYSTEM DOESN'T)
.GLOBL PRINT ;JSR PC,PRINT
; IN: R3 = POINTER TO STRING OF CHARACTERS TO PRINT
; R4 = NUMBER OF CHARACTERS TO PRINT (0 <= R4 <= 32767.)
;
; NOTE: JUST LIKE 'TYPE', 'PRINT' IS RESPONSIBLE FOR ANY CHARACTER
; CONVERSIONS (IF SYSTEM DOESN'T DO IT FOR YOU)
.GLOBL XITNOW ;JSR PC,XITNOW
; NOTE: IF 'TECOIO' CONDITIONED THE TERMINAL NON-NORMALLY FOR
; TECO, THEN THIS IS THE TIME TO UNCONDITION IT. SHOULD
; INPUT AND/OR OUTPUT BE REQUESTED AGAIN BY TECO (ONLY
; HAPPENS IN CASE OF AN I/O ERROR), YOU MUST DETECT THE
; FACT THAT YOU UNCONDITIONED THE TERMINAL AND RE-CONDITION
; IT.
.GLOBL TEXIT ;JMP TEXIT
; NOTE: THIS IS THE WAY TECO EXITS TO THE OPERATING SYSTEM
.GLOBL GEXIT ;JMP GEXIT
; NOTE: THIS IS THE WAY TECO EXITS TO THE OPERATING SYSTEM TO
; "GO"
.GLOBL NOCTLO ;JSR PC,NOCTLO
; NOTE: 'NOCTLO' CANCELS ANY CTRL/O EFFECT CURRENTLY IN PROGRESS
.GLOBL SIZER ;JSR PC,SIZER
; IN: R1 = AMOUNT TO EXPAND THE TEXT & Q-REG AREA
;
; OUT: IF AREA CAN (AND HAS BEEN) EXPANDED THE AMOUNT DESIRED,
; THEN EXIT WITH THE CARRY CLEAR AND "CURFRE" UPDATED. IF
; THE AREA CANNOT BE EXPANDED THAT AMOUNT, THEN EXIT WITH
; THE CARRY SET AND "CURFRE" UNTOUCHED.
.GLOBL SWITCH ;JSR PC,SWITCH
; OUT: R0 = VALUE OF process number
.GLOBL EIOFF ;JSR PC,EIOFF
; NOTE: TURNS OFF EI FILE (DONE IN ERROR ROUTINE)
.GLOBL GETFLS ;JSR PC,GETFLS
; IN: R0 = POINTER TO A "DEV:[P,PN]FILE.EXT" STRING
; R1 = 0 FOR ER CALL
; < 0 FOR EB CALL
; > 0 FOR EW CALL
; = 256. for EI call
; R4 = LENGTH OF "DEV:[P,PN]FILE.EXT" STRING
;
; OUT: IF NO ERROR THEN CARRY BIT IS CLEAR.
; SEE ERROR NOTES IF ERROR.
.GLOBL GETBUF ;JSR PC,GETBUF
; IN: R0 = POINTER TO BUFFER START
; R1 = MAXIMUM SIZE OF BUFFER
;
; OUT: IF NO ERROR THEN CARRY BIT IS CLEAR AND
; R1 = ACTUAL NUMBER OF CHARACTERS TRANSFERED INTO BUFFER
; R2 = -1 IF BUFFER ENDED WITH A FORM FEED
; = 0 IF BUFFER DIDN'T END WITH A FORM FEED
; IF END-OF-FILE, THEN "EOFLAG" IS SET TO -1 AND
; BOTH R1 AND R2 ARE RETURN AS ZERO (THIS IS NOT AN ERROR).
; SEE ERROR NOTES IF ERROR.
;
; NOTE: BUFFER IS FILLED UNTIL:
; 1) FORM FEED FOUND (R2=-1) (THE FORM FEED IS NOT PUT IN BUFFER)
; 2) LESS THAN 128 CHARACTERS ARE FREE IN BUFFER AND
; LINE FEED FOUND OR END OF FILE FOUND (R2=0)
; 3) BUFFER IS FULL (R2=0)
.GLOBL PUTBUF ;JSR PC,PUTBUF
; IN: R0 = POINTER TO BUFFER START
; R1 = NUMBER OF CHARACTERS TO OUTPUT
; R2 = -1 MEANS END BUFFER WITH FORM FEED
; = 0 MEANS DON'T ADD FORM FEED TO BUFFER
;
; OUT: IF NO ERROR THEN CARRY BIT IS CLEAR.
; SEE ERROR NOTES IF ERROR.
.GLOBL CLSFIL ;JSR PC,CLSFIL
; NOTE: CLOSES OUTPUT FILE AND DOES THE EB RENAMING IF NEEDED.
;
; IF NO ERROR THEN CARRY BIT IS CLEAR.
; SEE ERROR NOTES IF ERROR.
.GLOBL CLOSIN ;JSR PC,CLOSIN
; NOTE: CLOSES THE INPUT FILE
.GLOBL DELOUT ;JSR PC,DELOUT
; NOTE: DELETES THE OUTPUT FILE.
;ERROR NOTES:
; ON ERROR EXITS SET:
; CARRY BIT ON (I.E. "BCS" BRANCHES)
; R0 = RAD50 OF ERROR CODE
; R2 = POINTER TO ASCIZ TEXT OF ERROR (OR 0 FOR NO TEXT)
; SPECIAL (CHECKED FOR BY TECO) ERROR CODES ARE:
.GLOBL NI ;NO INPUT FILE CURRENTLY OPEN
.GLOBL NO ;NO OUTPUT FILE CURRENTLY OPEN
; THE VALUE OF "NI" AND "NO" AS RETURNED IN R0
; MUST BE GLOBALIZED BY 'TECOIO'.
; THE ASCIZ ERROR MESSAGE TEXT ON AN ERROR RETURN FROM "GETFLS"
; MAY OPTIONALLY CONTAIN A BYTE OF -2 TO SIGNAL PRINTING THE
; FAILING FILE NAME STRING AT THAT POINT. E.G.
; .ASCIZ "FILE '"<-2>"' IS ILLEGAL"
.globl run,norun ;fix for unix problems
.SBTTL GENERAL PDP-11 DEFINITIONS
; GENERAL REGISTERS
R0 = %0
R1 = %1
R2 = %2
R3 = %3
R4 = %4
R5 = %5
SP = %6
PC = %7
.SBTTL CHARACTER DEFINITIONS
NULL = 000 ;ASCII NULL
BELL = 007 ;ASCII BELL (CONTROL/G)
BS = 010 ;ASCII BACKSPACE
TAB = 011 ;ASCII HORIZONTAL TAB
LF = 012 ;ASCII LINE FEED
VT = 013 ;ASCII VERTICAL TAB
FF = 014 ;ASCII FORM FEED
CR = 015 ;ASCII CARRIAGE RETURN
ALTMOD = 033 ;ASCII ESCAPE (ALSO CALLED ALTMODE)
SPACE = 040 ;ASCII SPACE
LAB = '< ;ASCII LEFT ANGLE BRACKET
RAB = '> ;ASCII RIGHT ANGLE BRACKET
VBAR = 174 ;ASCII VERTICAL BAR
RUBOUT = 177 ;ASCII RUBOUT (ALSO CALLED DEL)
.SBTTL COMMAND Q-REG VALUE
QSTKRG = <'Z-'A+1>+<'9-'0+1>+1
CMDQRG = QSTKRG+1
.SBTTL MACROS
.MACRO SORT TABLE,ENTRY
JSR R4,SORT'ENTRY
.WORD TABLE-2
.ENDM SORT
.MACRO PUSH ARGS
JSR R4,PUSH
.IRP ARG,<ARGS>
.WORD ARG
.ENDM
.WORD -1
.ENDM PUSH
.MACRO POP ARGS
JSR R4,POP
.IRP ARG,<ARGS>
.WORD ARG
.ENDM
.WORD -1
.ENDM POP
.MACRO SKPSET CHR
JSR R4,SKPSET
.WORD CHR
.ENDM SKPSET
.MACRO TSTNXT CHR
JSR R4,TSTNXT
.WORD CHR
.ENDM TSTNXT
.MACRO SIZE AREA
JSR R4,SIZE
.IF IDN <AREA>,<TEXT>
.WORD ZMAX
.MEXIT
.ENDC
.IF IDN <AREA>,<QREGS>
.WORD QMAX
.MEXIT
.ENDC
.ERROR ; AREA IS ILLEGAL IN SIZE CALL
.ENDM SIZE
.MACRO OFFSET LABEL,AMT
LABEL = $$$$$$
.GLOBL LABEL
.LIST
LABEL = LABEL
.NLIST
.IF NB <AMT>
$$$$$$ = AMT*2+$$$$$$
.IFF
$$$$$$ = 1*2+$$$$$$
.ENDC
.ENDM OFFSET
.MACRO .TABLE KIND
.'KIND:
.MACRO .ENTRY CHR,DSP
.IF B <DSP>
.WORD ''CHR, KIND''CHR
.IFF
.WORD ''CHR, DSP
.ENDC
.ENDM .ENTRY
.ENDM .TABLE
.MACRO CMDCHR VAL
.IRP NUM,<\<VAL+1000>>
$$'NUM:
.PSECT TECOCH
. = VAL*2+TECOCH
.NLIST
.SBTTL COMMAND CHARACTER VAL
.WORD $$'NUM
.LIST
.ENDM
.PSECT TECORO
.ENDM CMDCHR
.MACRO MESSAG TEXT
.PSECT TECOER
.NLIST
$$$$$$ = .
.ASCIZ TEXT
.LIST
.PSECT TECORO
.ENDM MESSAG
.MACRO ERROR NUM,TEXT
.IF NDF $E$'NUM
$E$'NUM:
.ENDC
$$$$$$ = .-$E$'NUM
.IF GE $$$$$$-400
JMP $E$'NUM
.MEXIT
.ENDC
.IF NE $$$$$$
BR $E$'NUM
.MEXIT
.ENDC
.IF NE ERRTXT
$$$$$$ = 0
.IRPC CHR,<NUM>
$$$$$$ = $$$$$$*40+<''CHR-<'A-1>>
.ENDM
.IF EQ $$$$$$&077740-<'N-<'A-1>*40+'A-<'A-1>*40+0>
JSR R4,ERRORA
$$$$$$ = 1.
.IRPC CHR,<NUM>
.IF EQ $$$$$$-3.
.BYTE ''CHR-<'A-1>
.ENDC
$$$$$$ = $$$$$$+1.
.ENDM
.NCHR $$$$$$,<TEXT>
.IF EQ $$$$$$-17.
.IRPC CHR,<TEXT>
.IF EQ $$$$$$-2.
.BYTE ''CHR
.ENDC
$$$$$$ = $$$$$$-1.
.ENDM
.MEXIT
.ENDC
.IF EQ $$$$$$-24.
.IRPC CHR,<TEXT>
.IF EQ $$$$$$-6.
.BYTE ''CHR-100
.ENDC
$$$$$$ = $$$$$$-1.
.ENDM
.MEXIT
.ENDC
.ERROR ; NUM ERROR IN ILLEGAL FORMAT!!
.BYTE '?
.MEXIT
.ENDC
.IF EQ $$$$$$&076037-<'I-<'A-1>*40+0*40+'C-<'A-1>>
JSR R4,ERRORC
$$$$$$ = 1.
.IRPC CHR,<NUM>
.IF EQ $$$$$$-2.
.BYTE ''CHR-<'A-1>*5
.ENDC
$$$$$$ = $$$$$$+1.
.ENDM
.NCHR $$$$$$,<TEXT>
.IF EQ $$$$$$-21.
.IRPC CHR,<TEXT>
.IF EQ $$$$$$-12.
.BYTE ''CHR
.ENDC
$$$$$$ = $$$$$$-1.
.ENDM
.MEXIT
.ENDC
.IF EQ $$$$$$-30.
.IRPC CHR,<TEXT>
.IF EQ $$$$$$-18.
.BYTE ''CHR-100
.ENDC
$$$$$$ = $$$$$$-1.
.ENDM
.MEXIT
.ENDC
.ERROR ; NUM ERROR IN ILLEGAL FORMAT!!
.BYTE '?
.MEXIT
.ENDC
.ENDC
JSR R4,ERRMSG
.RAD50 /NUM/
.IF NE ERRTXT
MESSAG <TEXT>
.WORD $$$$$$
.ENDC
.ENDM ERROR
.SBTTL INITIALIZE THE .PSECTS'S, ETC.
; THIS ORDERS THE .PSECT'S (USE /SQ IF NEEDED...)
.PSECT TECORO,SHR
.PSECT TECOCH,SHR
.PSECT TECOER,SHR
; THIS INITIALLY LOADS THE COMMAND CHARACTER TABLE
.PSECT TECOCH
TECOCH:
.REPT '_+1+5 ;additional 5 for high characters
.NLIST
.WORD ERROR
.LIST
.ENDR
; NOW BACK TO THE MAIN .PSECT
.PSECT TECORO
.SBTTL DEFINE THE OFFSETS FROM R5
$$$$$$ = 0;OFFSETS START AT ZERO...
CLRSRT = $$$$$$;START OF EACH COMMAND CLEAR AREA
OFFSET SCANP ;COMMAND LINE EXECUTION POINTER
OFFSET NFLG ;NUMBER FLAG
OFFSET N ;NUMBER
OFFSET M ; ARGUMENTS
OFFSET OFLG ;OPERATOR FLAG
OFFSET CFLG ;COMMA FLAG
OFFSET MPDL ;MACRO FLAG (SAVED "PDL")
OFFSET ITRST ;ITERATION START
OFFSET CLNF ;COLON FLAG
OFFSET TFGTMP ;BACKUP FOR "TFLG"
OFFSET QFLG ;QUOTED STRING FLAG
OFFSET SCHAR ;LAST SORTED CHARACTER
OFFSET OSCANP ;BACKUP FOR "SCANP"
OFFSET QCMND ;COMMAND LINE OR MACRO Q REG NUMBER
OFFSET QUOTE ;QUOTE CHARACTER (NORMALLY 33)
OFFSET QNMBR ;CURRENT Q REG NUMBER
OFFSET QLENGT ;COMMAND LINE LENGTH
OFFSET CNDN ;COUNTER FOR " NESTING
OFFSET NP ;VALUE OF CURRENT NUMBER
OFFSET NACC ;EXPRESSION ACCULMULATOR
OFFSET PST ;CHARACTER POSITION AT SEARCH START
OFFSET ITRCNT ;ITERATION COUNT
OFFSET NOPR ;ARITHMETIC OPERATOR
OFFSET TEMP ;GENERAL TEMPORARY READ/WRITE WORD
OFFSET TFLG ;TRACE FLAG
OFFSET REPFLG ;REPLACE FLAG
CLREND = $$$$$$;END OF EACH COMMAND CLEAR AREA
OFFSET FFFLAG ;FORM FEED FLAG
OFFSET P ;CURRENT TEXT POINTER (.)
OFFSET QBASE ;COMMAND LINE Q REG BASE OFFSET
OFFSET NMRBAS ;RADIX
OFFSET ERRPOS ;ERROR POSITION
OFFSET PDL ;PUSH-DOWN LIST POINTER
OFFSET LSCHSZ ;-(LENGTH) OF LAST SKIPPED QUOTED STRING
OFFSET EDFLAG ;EDIT LEVEL FLAG
OFFSET XFLAG ;SEARCH CASE FLAG (0-ANY, ELSE-EXACT)
OFFSET EHELP ;EDIT HELP LEVEL
OFFSET ESFLAG ;EDIT SEARCH FLAG
OFFSET EVFLAG ;EDIT VERIFY FLAG
OFFSET ETYPE ;EDIT TYPEOUT FLAG
OFFSET EIFLAG ;INSTRUCTION FILE FLAG (=0 FOR TERMINAL I/O)
OFFSET EOFLAG ;END-OF-FILE FLAG
OFFSET OFLAG ;EDIT OPEN PROTECT CODE
OFFSET ROFLAG ;NON-ZERO IF RUBOUT OR CTRL/U (FOR SCOPE)
OFFSET ABEND ;ABORT EXECUTION FLAG
OFFSET TXSTOR ;TEXT BUFFER BIAS
OFFSET ZZ ;TEXT BUFFER SIZE IN USE
OFFSET ZMAX ;TEXT BUFFER SIZE
OFFSET QRSTOR ;Q REG BUFFER BIAS
OFFSET QZ ;Q REG BUFFER SIZE IN USE
OFFSET QMAX ;Q REG BUFFER SIZE
OFFSET CURFRE ;CURRENT FREE SPACE IN BYTES
OFFSET QARRAY,<<<'Z-'A+1>+<'9-'0+1>>*2>;Q REGISTER ARRAY
OFFSET QSTK 2 ;Q REGISTER STACK Q REGISTER!
OFFSET QPNTR ;COMMAND Q REGISTER OFFSET
OFFSET QLCMD ;SIZE OF LAST COMMAND
OFFSET TECOSP ;SP STACK RESET VALUE
OFFSET TECOPD ;PDL RESET VALUE
OFFSET SCHBUF ;SEARCH BUFFER POINTER
RWSIZE = $$$$$$ ;SIZE OF AREA IN BYTES
.SBTTL SCAN
.CMD.R: DEC QZ(R5) ;REMOVE LAST CHARACTER
DEC QPNTR(R5) ; ENTERED INTO COMMAND
MOV QZ(R5),R3 ;GET POINTER TO END+1
ADD QRSTOR(R5),R3 ; AND MAKE IT ABSOLUTE
MOV QPNTR(R5),R4 ;NOW GET SIZE OF THE COMMAND
RTS PC ;AND EXIT
.ENABL LSB
CMDCHR <'?> ;"?" IS THE TRACE FLIP/FLOP
COM TFLG(R5) ;SO FILP THE FLOP
2$: RTS PC ;AND EXIT
3$: CMP (SP),#.CMD.C ;END OF COMMAND; MAIN CALL?
BNE 4$ ;NOPE, SO MUST BE AN ERROR
ABORT: CMP MPDL(R5),PDL(R5) ;YES, IN MACRO?
BNE 4$ ;NO (OR UNTERMINATED MACRO)
POP <SCANP,ITRST,MPDL,QCMND>;YES, RESTORE ALL ITEMS
MOV QCMND(R5),R0 ;GET COMMAND Q REG NUMBER
JSR PC,SETCMD ;AND (RE)SET COMMAND
SCAN: MOV (R5),R0 ;GET CURRENT COMMAND POINTER
CMP R0,QLENGT(R5) ;END OF THIS COMMAND?
BHIS 3$ ;YES, CHECK FOR A MACRO
ADD QBASE(R5),R0 ;NO, ADD BASE OF COMMAND Q REG
ADD QRSTOR(R5),R0 ;AND MAKE ABSOLUTE POINTER
MOVB (R0),R0 ;GET NEXT CHARACTER
INC (R5) ;THEN BUMP POINTER ONE AHEAD
TST TFLG(R5) ;TRACING?
BEQ 2$ ;NOPE
JMP TYPE ;YES, SO ANNOUNCE CHARACTER
4$: TST (SP)+ ;PURGE THE RETURN ADDRESS
TST MPDL(R5) ;WITHIN MACRO?
BEQ .CMD.D ;NO, BACK TO MAIN EDIT LEVEL
ERROR UTM,<"UNTERMINATED MACRO">;YES, MUST BE UNTERMINATED
.DSABL LSB
.SBTTL COMMAND INPUT
.ENABL LSB
.CMDSP: CMP TEMP(R5),#BELL ;PRECEEDED BY A BELL?
BNE 13$ ;NO, SO NORMAL
JSR PC,.CMD.R ;REMOVE 1ST BELL AND GET POINTER, COUNT
BEQ TECO ;NOTHING, SO RESTART US
REPRI: JSR PC,CRLF ;SOMETHING, SO RETURN CARRIAGE
10$: DEC R4 ;ONE LESS IN COUNT NOW
BMI 11$ ;ONLY ONE LINE WAS IN COMMAND
CMPB -(R3),#LF ;BACKED UP TO A LINE FEED?
BNE 10$ ;NO, KEEP GOING
INC R3 ;YES, SO CORRECT POINTER
br 12$
11$: mov #'*,r0 ;print prompt
jsr pc,type
12$: COM R4 ;NEGATE AND DECREMENT COUNT
ADD QPNTR(R5),R4 ;FORM THE POSITIVE PRINT COUNT
JSR PC,PRINT ;PRINT THE LINE
JMP .CMD.W ;AND CONTINUE
.CMDBL: MOV #100000,ERRPOS(R5) ;FLAG THIS AS A BELL
CMP R0,TEMP(R5) ;2ND BELL?
BEQ .+6 ;BRANCH AROUND JUMP
JMP .CMD.Z
JSR PC,.CMD.R ;REMOVE 1ST BELL AND GET COUNT
ctrlc: MOV R4,QLCMD(R5) ;NOW SAVE THE COUNT AS LAST COMMAND COUNT
BR TECO ;AND RESTART US
.CMDQM: MOV ERRPOS(R5),R4 ;GET ERROR POSITION
BLE 13$ ;IF NONE, THEN NORMAL CHARACTER
JSR PC,CRLF ;RESTORE CARRIAGE
MOV QBASE(R5),R3 ;GET BASE OF LAST COMMAND
ADD QRSTOR(R5),R3 ;NOW MAKE POINTER ABSOLUTE
JSR PC,PRINT ;AND PRINT THE ERRING LINE
MOV #'?,R0 ;END LINE WITH
JSR PC,TYPE ; A "?"
bit #200,etype(r5) ;error condition?
beq teco ;no--RESTART US
jsr pc,crlf ;print crlf and die
jmp texit
13$: BR .CMD.Y
.CMDST: TST QPNTR(R5) ;WAS THIS THE 1ST THING TYPED?
BNE 16$ ;NOPE, SO NORMAL
JSR PC,LISTEN ;YES, SO GET NEXT AS Q REG NAME
JSR PC,.CMD.S ;AND VALIDATE IT AND SUM IT
MOV QLCMD(R5),R0 ;GET LAST COMMAND'S SIZE
ADD R0,QZ(R5) ;INCREASE Q REG AREA SIZE BY THAT
MOV R0,QPNTR(R5) ;AND PLACE IT IN COMMAND Q REG
JSR PC,QADJ ;NOW ADJUST SELECTED REG TO THAT SIZE
MOV R2,R3 ;SAVE OFFSET TO SELECTED Q REG
MOV #CMDQRG,R0 ;NOW SET TO SUM THE
JSR PC,QSUMX ; COMMAND Q REG
ADD QRSTOR(R5),R3 ;ABS POINTER TO SELECTED Q REG
ADD QRSTOR(R5),R2 ;ABS POINTER TO COMMAND Q REG
MOV (R1),R1 ;GET SIZE OF DATA TO MOVE
BEQ TECO ;MOVE NOTHING?
15$: MOVB (R2)+,(R3)+ ;MOVE THE DATA
DEC R1 ;MORE?
BGT 15$ ;YEP...
BR TECO ;NOPE...GET NEXT COMMAND
16$: CMP #BELL,TEMP(R5) ;NOT AFTER BELL?
BNE .CMD.Y ;THEN NORMAL CHARACTER "*"
JSR PC,CRLF ;DO CRLF
mov #'*,r0 ;print the "prompt"
jsr pc,type
JSR PC,.CMD.R ;DELETE BELL,GET COUNT
SUB R4,R3 ;SUB SIZE FROM END POINTER
JSR PC,PRINT ;WHICH IS IN FORMAT TO PRINT
BR .CMD.W ;CLEAN UP AND CONTINUE
.DSABL LSB
.ENABL LSB
TECO: MOV TECOSP(R5),SP ;SET UP OUR SP STACK
JSR PC,NOCTLO ;NO CONTROL/O PLEASE
JSR PC,CRLF ;RESTORE CARRIAGE
MOV TECOPD(R5),PDL(R5) ;NOW SET UP THE PUSH-DOWN LIST
.CMD.D: CMP SP,TECOSP(R5) ;IS SP STACK OK?
BNE 90$ ;NOPE
CMP PDL(R5),TECOPD(R5) ;WAS LAST COMMAND UNTERMINATED?
BNE 90$ ;YEP, GO GIVE ERROR
JSR PC,NORUN ;entering command mode
MOV #CMDQRG,R0 ;INDICATE THE COMMAND Q REG
JSR PC,QREFR0 ;REFERENCE IT
JSR PC,QADJ ; AND ADJUST TO 0 SIZE
MOV R5,R1 ;GET OFFSET POINTER
ADD #CLREND,R1 ;AND INDEX TO CLEAR AREA (+2)
MOV #CLREND-CLRSRT/2,R2 ;LOAD A COUNT OF HOW MANY TO CLEAR
22$: CLR -(R1) ;NOW CLEAR OUR VARIABLES
DEC R2 ;MORE?
BGT 22$ ;YEP...
JSR PC,IREST ;RESTORE QUOTE TO 33 (ALTMODE)
MOV EVFLAG(R5),r4 ;EDIT VERIFY?
BEQ 21$ ;NO
CLR NFLG(R5) ;YES
jsr pc,.sch.v ;call special entry to verify
$24$: CLR N(R5)
21$: TST EIFLAG(R5) ;EI FILE?
BNE .CMD.W ;THEN DONT PRINT CHARACTER
MOV #'*,R0 ;SET UP TO ANNOUNCE US
bic #10200,etype(r5) ;clear interupt bit
JSR PC,NOCTLO ;NO CONTROL/O PLEASE
$23$: clr abend(R5) ;dont abort print
JSR PC,TYPE ;AND TYPE A CHARACTER
.CMD.W: CLR TEMP(R5) ;AVOID DOUBLE CHARACTER INDICATIONS
.CMD.X: MOV ERRPOS(R5),R0 ;SELECT INPUT MODE
JSR PC,LISTEN ;AND GET A CHARACTER
TST EIFLAG(R5) ;NOT FROM FILE
BEQ 1$ ;THEN ALLOW ALL IMMEDIATE CHARS
CMP #ALTMOD,R0 ;ALTMODE IS ONLY SPECIAL
bne .cmd.y ;stuff all characters but
jmp .cmdam
1$: tst abend(r5) ;do we restart?
beq .+6
jmp ctrlc
SORT ..CMD ;SORT OUT SPECIAL CHARACTERS
.CMD.Y: CLR ERRPOS(R5) ;NO ERROR POSITION IF STORING
.CMD.Z: CLR QLCMD(R5) ;NO LAST COMMAND IF STORING ANYTHING
MOV #.CMD.X,-(SP) ;SET THRETURN ADDRESS
MOV R0,TEMP(R5) ;SAVE CHARACTER ABOUT TO BE STORED
.CMDAX: MOV QZ(R5),R1 ;GET OUR CURRENT SIZE
MOV QMAX(R5),R2 ;AND OUR MAXIMUM SIZE
DEC R2 ;ADJUSTED FOR NEW CHARACTER
CMP R1,R2 ;CAN WE DO THIS?
BHIS 91$ ;NO, GO GIVE ERROR
INC QZ(R5) ;INDICATE 1 MORE IN COMMAND
INC QPNTR(R5) ; Q REGISTER
ADD QRSTOR(R5),R1 ;GET POSITION TO STORE IN
MOVB R0,(R1) ;AND STORE CHARACTER
SUB QRSTOR(R5),R1 ;BACK TO RELATIVE AGAIN
ADD #100.,R1 ;FUDGE BY 100. MORE CHARACTERS
SIZE QREGS ;GET ROOM FOR THOSE CHARACTERS
BCS 31$ ;ALL IS STILL O.K.
MOV #BELL,R0 ;IF NOT, THEN RING THE BELL
JMP TYPE ;FOR A WARNING, THEN CONTINUE
31$: RTS PC
90$: ERROR UTC,<"UNTERMINATED COMMAND">
91$: ERROR MEM,<"MEMORY OVERFLOW">
.DSABL LSB
.ENABL LSB
.CMDBS: tst qpntr(r5) ;nothing on line?
beq .cmdro ;then do -1lt!
MOV #$23$,-(SP)
BIT #2,ETYPE(R5) ;TTY MODE?
BEQ 30$
MOV #32$,(SP) ;SET RETURN ADDRESS FROM RUBBING OUT
30$: INC ROFLAG(R5) ;IF IT ALL VANISHES, DO NOT WATCH
TST QPNTR(R5) ;ANYTHING LEFT TO REMOVE?
bne .+6
jmp teco ;none left so restart us.
JSR PC,.CMD.R ;REMOVE A CHARACTER AND GET POINTER
MOVB (R3),R0 ;PUT CHAR IN R0
RTS PC ;NOW EXIT
32$: CMPB #SPACE,R0 ;ARE WE DELETING A PRINTING CHARACTER
BLE 33$ ;
CMPB #LF,R0 ;IF a line feed then reprint previous
beq 34$
mov r3,-(sp) ;save registers
mov r4,-(sp)
mov #Delst2,r3 ;print bs bs bs space space space vt
mov #7,r4
jsr pc,print
mov (sp)+,r4 ;restore registers
mov (sp)+,r3
jmp REPRI
33$: bit #10,etype(R5) ;local echo?
bne .cmd.w
Mov #Delstr,r3 ;print bs space bs
Mov #3,r4
Jsr Pc,print
Br .cmd.w ;and continue
34$: mov #213,r0 ;print 2 vts
jsr pc,type
jsr pc,type
jmp repri
.CMDCU: JSR PC,30$ ;REMOVE 1 CHARACTER FROM BUFFER
CMP R0,#LF ;LINE FEED JUST REMOVED?
BNE .CMDCU ;NOPE, KEEP REMOVING
INC QZ(R5) ;YEP, SO PUT IT
INC QPNTR(R5) ; BACK IN COMMAND
JSR PC,CRLF ;RESTORE CARRIAGE
JMP .CMD.W ;AND CONTINUE
.CMDRO: JSR PC,CRLF ;GOTO NEW LINE
MOV #-1,R0 ;DO -1LT
1$: JSR PC,.VVV.V ;"-1L"
mov evflag(R5),r4 ;are we in autoverify mode?
bne 2$
dec r4 ;make negative to do 0tt
2$: jsr pc,.sch.v
JMP $24$
.CMDLF: TST QPNTR(R5) ;FIRST THING TYPED?
beq .+6
jmp .cmd.y ;no--treat normally
MOV #1,R0 ;DO "1LT"
BR 1$
.DSABL LSB
.SBTTL INTERPRETER
.ENABL LSB
.CMDAM: CMP R0,TEMP(R5) ;2ND ALTMODE?
beq .+6
jmp .CMD.Y ;NOPE, SO NORMAL CHARACTER
jsr pc,run ;now we are running!
JSR PC,.CMDAX ;YES, SO STORE THE FINAL ALTMODE
MOV QPNTR(R5),QLCMD(R5) ; AND SAVE COMMAND AS LAST
tst eiflag(r5) ;shall we restore carriage?
bne 39$ ;not if we are ei-ing!
JSR PC,CRLF ; AND RESTORE CARRIAGE
39$: MOV #CMDQRG,R0 ;SET UP TO REFERENCE
JSR PC,SETCMD ; THE COMMAND REGISTER
40$: JSR PC,SCAN ;SCAN THE COMMAND
.CMD.C: JSR PC,UPPERC ; AND FORCE UPPER CASE
CMPB #173,R0
BHI 42$
SUB #'[-'@,r0 ;put into acceptable range
42$: MOV R0,R1 ;COPY THE CHARACTER
CLR R0 ;LEAVE R0 (THE AC...) CLEAR
ASL R1 ;WE NEED A WORD INDEX
TST ABEND(R5) ;MAKE SURE NOT ABORTED
BNE 45$
JSR PC,@TECOCH(R1) ;DISPTACH TO COMMAND
TST NFLG(R5) ;NUMBER?
BMI 40$ ;YES, SO JUST CONTINUE
CLR N(R5) ;NO, SO CLEAR THE ARGUMENT
CLR NFLG(R5) ;AND RESET NUMBER FLAG
BR 40$ ;AND CONTINUE
CMDCHR <'^> ;^ MEANS NEXT IS CONTROL/CHARACTER
TST (SP)+ ;POP THE RETURN ADDRESS
JSR PC,SCNUPP ;AND GET NEXT FORCING UPPER CASE
BIC #-77-1,R0 ;BUT MAKE IT A CONTROL/CHARACTER
BR 42$ ;AND CONTINUE WITH IT
45$: CLR ABEND(R5)
ERROR XAB,<"EXECUTION ABORTED">
.DSABL LSB
DELSTR: .Byte bs+200,space,bs+200
DELST2: .Byte bs+200,bs+200,bs+200,space,space,space,213
.even
CMDCHR <'L> ;"L" IS THE LINE MOVER
JSR PC,GETN ;GET THE NUMBER OF LINES
.VVV.V: MOV TXSTOR(R5),R2 ;GET TEXT POINTER BIAS
MOV P(R5),R1 ;GET THE CURRENT .
ADD R2,R1 ;AND MAKE THAT ABSOLUTE
MOV #LF,R3 ;SPEED UP THE COMPARES
TST R0 ;WHICH DIRECTION
BLE 15$ ;<=0 IS BACKWARDS
ADD ZZ(R5),R2 ;>0 IS FORWARDS; SO GET END OF TEXT
11$: CMP R1,R2 ;PAST END OF TEXT YET?
BHIS 13$ ;YES, SO STOP THE MOVE
CMPB R3,(R1)+ ;NOPE, IS THIS A LINE FEED?
BNE 11$ ;NO, KEEP MOVING
DEC R0 ;YES, MORE TO GO?
BGT 11$ ;KEEP GOING
13$: SUB TXSTOR(R5),R1 ;GET THE NEW .
MOV R1,P(R5) ;AND STORE IT
RTS PC ;THEN EXIT
15$: CMP R1,R2 ;TOO LOW?
BLOS 13$ ;YES, SO QUIT
CMPB R3,-(R1) ;NO, IS IT LINE FEED?
BNE 15$ ;NOPE, KEEP GOING
INC R0 ;YEP, MORE?
BLE 15$ ;STILL ARE MORE TO GO
INC R1 ;DONE, CORRECT .
BR 13$ ;AND GO SET NEW .
.ENABL LSB
CMDCHR <LAB> ;"<" STARTS AN ITERATION
MOV (R5),R4 ;in case we need it
.CSMI: PUSH <ITRST,ITRCNT> ;SAVE ITERATION START AND COUNT
MOV (R5),ITRST(R5) ;AND SET ITERATION START
TST NFLG(R5) ; NO NUMBER?
BEQ 1$
CLR NFLG(R5) ; USING UP THE NUMBER
TST N(R5) ;DONT ITERATE?
BLE .SCH.I
1$: MOV N(R5),ITRCNT(R5) ;SET THE NEW ITERATION COUNT
RTS PC ;NOW EXIT
CMDCHR <RAB> ;">" ENDS AN ITERATION
TST ITRCNT(R5) ;FOREVER REPEAT?
BEQ 3$
DEC ITRCNT(R5) ;GO AROUND AGAIN?
BEQ .CSMO ;YES, SO END US
3$: TST ITRST(R5) ;ERROR IF NOT IN LOOP
BEQ 90$
MOV ITRST(R5),(R5) ;RESET SCAN POINTER
BR 5$
CMDCHR <ALTMOD> ;ALTMODES COME HERE
TSTNXT ALTMOD ;ESC-ESC (ABORT MACRO) COMMAND?
BCC 5$ ;NO
2$: tst itrst(r5) ;get out of any iterations
beq 10$ ;not in one
pop <itrcnt,itrst> ;pop count and start of next loop
br 2$
10$: MOV #.CMD.C,(SP) ;FAKE DIFFERENT RETURN ADDRESS
JMP ABORT ;AND ABORT MACRO
CMDCHR <''> ;END OF CONDITIONALS COME HERE
5$: CLR NFLG(R5) ;USE UP ANY NUMBER
JMP IREST ;AND RESTORE NORMAL QUOTE
90$: ERROR BNI,<<RAB>" NOT IN ITERATION">
.fffla: ;"F<" command
mov itrst(r5),(r5) ;move to beginning of whatever
clr nflg(r5) ;snarf any number
rts pc ;done!
.fffra: ;"F>" command
clr nflg(r5) ;snarf any number
tst itrst(r5) ;not in iteration?
beq 2$ ;then same as "$$" command (almost)
tst itrcnt(R5) ;forever loop?
beq .fffla
dec itrcnt(r5) ;decrement counter
bne .fffla ;loop back if not zero
mov itrst(R5),r4 ;else go to end of loop
br .sch.i
CMDCHR <';> ;";" IS SPECIAL ITERATION END
MOV ITRST(R5),R4 ;GET ITERATION START POINTER
BEQ 91$ ;IF ANY...
INC NFLG(R5) ;ARGUMENT?
BNE 92$ ;NO--ILLEGAL NOW
TST N(R5) ;SUCCESSFUL?
BMI 5$ ;YES, SO JUST CONTINUE
.SCH.I: MOV R4,-(SP) ;SAVE ITERATION START POINT
SKPSET '> ;GO TO MATCHING >
JSR PC,ENTRCE ;RE-ENABLE TRACE IF NEEDED
MOV (SP)+,R4 ;RESTORE ITERATION START
CMP R4,ITRST(R5) ;MATCH THIS START?
BEQ .CSMO ;YES, SO EXIT
MOV #.SCH.I,-(SP) ;NO, SO POP LEVEL AND CONTINUE
.CSMO: POP <ITRCNT,ITRST> ;POP THE COUNT AND START
BR 5$ ;GO RESET QUOTE CHARACTER
91$: ERROR SNI,<"; NOT IN ITERATION">
92$: ERROR NAS,<"NO ARG BEFORE ;">
.DSABL LSB
CMDCHR <'M> ;"M" IS THE MACRO COMMAND
JSR PC,QREF ;REFERENCE A Q REGISTER
PUSH <QCMND,MPDL,ITRST,SCANP>;NOW PUSH ALL OLD DATA
CLR (R5) ;START MACRO OFF AT RELATIVE 0
CLR ITRST(R5) ;NOT INTO ANY ITERATION YET
MOV PDL(R5),MPDL(R5) ;SAVE PDL AT MACRO'S START
MOV QNMBR(R5),R0 ;THIS IS THE Q REG WITH THE MACRO IN IT
JMP SETCMD ;GO OFF AND START THE MACRO
.ENABL LSB
CMDCHR <'=> ;"=" IS THE NUMBER PRINTER
MOV NMRBAS(R5),-(SP) ;SAVE BASE
INC NFLG(R5) ;ANY NUMBER?
BNE 90$ ;HE'S IN ERROR IF NOT
CLR NMRBAS(R5) ;ASSUME RADIX 10
TSTNXT '= ;IS IT REALLY "=="?
ADC NMRBAS(R5) ;C=1 IF SO, SET RADIX=OCTAL
JSR R4,ZEROD ;THIS DOES THE REAL WORK
.WORD TYPE ;OUTPUT TO TERMINAL
MOV (SP)+,NMRBAS(R5) ;RESTORE BASE
TST CLNF(R5) ;COLON NUMBER OUT?
BEQ CRLF ;NO
CLR CLNF(R5) ;YES--SNARF COLON
RTS PC ;NO CRLF
CRLF: bit #4,etype(R5) ;if rt mode then we need to send cr
beq 1$
mov #cr,r0
jsr pc,type
1$: MOV #LF,R0 ; TYPE ONLY
JMP TYPE ; LINE FEED
90$: ERROR NAE,<"NO ARG BEFORE =">
.DSABL LSB
.ENABL LSB
CMDCHR <'\> ;"\" IS NUMBER INSERTER/GETTER
INC NFLG(R5) ;WAS THERE AN ARGUMENT?
BNE 2$ ;NO, SO GET A NUMBER FROM TEXT
JSR R4,ZEROD ;YES, SO INSERT IT INTO TEXT
.WORD .BSL.I
1$: RTS PC ;AND EXIT
2$: JSR PC,NCOM ;SET UP NUMBER PROCESSOR
JSR PC,GETXTP ;GET CHAR FROM TEXT
BCC 1$ ;NOTHING THERE
SUB #'-,R0 ;MINUS SIGN?
BNE 3$ ;NOPE
JSR PC,@'-*2+TECOCH ;YES, SO DO THE MINUS OPERATOR
BR 4$ ;AND CONTINUE
3$: CMP R0,#'+-'- ;PLUS SIGN?
BNE 5$ ;NOPE
4$: INC P(R5) ;BUMP .
5$: JSR PC,GETXTP ;GET CHARACTER FROM TEXT
BCC 1$ ;EXIT IF NO MORE
JSR PC,NUMER ;CHECK FOR NUMERIC
BCC 1$ ;NOT A NUMBER
TST NMRBAS(R5) ;DECIMAL?
BEQ 6$
CMPB #'8,R0 ;OCTAL--8 AND 9 AREN'T NUMBERS
BLOS 1$
6$: MOV R0,R1 ;MOVE DIGIT OVER TO HERE
JSR PC,.BSL.N ;NUMBER, SO USE IT
BR 4$ ;AND CONTINUE
CMDCHR <'!> ;"!" IS THE COMMENT DELIMITER
CMP (R0)+,(R0)+ ;MAKE R0 = 4 (SKIP 2 WORDS)
CMDCHR <'A-100> ;CTRL/A IS THE TEXT PRINTER
MOV R0,R2 ;SAVE DETERMINATION
CLR NFLG(R5) ;USE UP ANY NUMBER
MOV R1,R4 ;GET CHARACTER (*2) THAT CALLED US
ASR R4 ;NOW MAKE NORMAL CHARACTER
10$: JSR PC,SCAN ;SCAN TEXT
CMP R0,R4 ;END?
BEQ 1$ ;YES, SO EXIT
ADD R2,PC ;CHECK DETERMINATION
JSR PC,TYPE ;CTRL/A CHARS GET TYPED
BR 10$ ;AND LOOP
.DSABL LSB
.ENABL LSB
CMDCHR <'"> ;'"' IS THE CONDITIONAL
INC NFLG(R5) ;ANY ARGUMENT?
BNE 90$ ;THERE HAD BETTER BE
SORT ..CND,C ;AND SPECIAL SORT
ERROR ICC,<'ILLEGAL " CHARACTER'>
90$: ERROR NAQ,<'NO ARG BEFORE "'> ;NO
.CNDC: ADD #RAD50-NUMER,R2 ;"C" IS A-Z,0-9,.,$
.CNDD: ADD #NUMER-ALPHA,R2 ;"D" IS 0-9
.CNDA: ADD #ALPHA-ALPHAN,R2 ;"A" IS A-Z
.CNDR: ADD #ALPHAN,R2 ;"R" IS A-Z,0-9
MOV R3,R0 ;SET UP TEST CHARACTER
JSR PC,(R2) ;AND GO CHECK IT
BCS 4$ ;CARRY SET IS SUCCESS
BR 2$ ;ELSE FAILURE
.CNDN: TST R3 ;SET CC'S
BNE 4$ ;"N" IS OK IF <>
BR 2$ ;ELSE NOT OK
.CNDG: NEG R3 ;"G" IS OK IF >
BVS 2$ ;TRAP -32768. CASE
.CNDS: ;"S" IS SUCCESSFUL (-1)
.CNDT: ;"T" IS TRUE (-1)
.CNDL: TST R3 ;SET CC'S
BPL 2$ ;"L" IS NO GOOD IF >=
BR 4$ ;ELSE OK
.CNDF: ;"F" IS FALSE (0)
.CNDU: ;"U" IS UNSUCCESSFUL (0)
.CNDE: TST R3 ;SET CC'S
BEQ 4$ ;"E" IS OK IF =
BR 2$
.fffvb: clr nflg(R5) ;"F<vbar>" command
2$: MOV #-1,CNDN(R5) ;INTO 1 LEVEL OF CONDITIONAL SKIP
3$: jsr pc,notrce ;disable trace
10$: jsr pc,scnupp ;get next character
11$: mov r0,schar(r5) ;save as sorted character
cmp #VBAR,r0 ;else clause?
beq 5$
cmp #'',r0 ;end of conditional?
beq 6$
cmp #'^,r0 ;uparrow is special case
bne 12$
jsr pc,scnupp ;get next character
bic #-77-1,r0 ;as a control character
br 11$ ;and try again
12$: mov #10$,-(sp) ;stack a return address
sort ..csm ;sort on skip characters
rts pc ;non specials ignored (br 10$)
5$: jsr pc,entrce ;enable trace
cmp #-1,cndn(R5) ;match our level?
bne 3$ ;no--continue scanning
br 4$ ;yes--done
6$: jsr pc,entrce ;enable trace
inc cndn(R5) ;match our level?
bne 3$ ;no--continue scanning
4$: JMP IREST ;YES, RESTORE QUOTE AND EXIT
.DSABL LSB
cmdchr <VBAR-27.> ;"VBAR" is conditional else clause
.fffq: ;F' goes here too
clr nflg(R5) ;snarf any number
mov #-1,cndn(R5) ;into one level of conditional skip
3$: skpset '' ;search for end of conditional
jsr pc,entrce ;enable tracing
inc cndn(r5) ;same level?
bne 3$
rts pc ;yes--finished
CMDCHR <'O>
MOV (R5),-(SP) ;SAVE CURRENT POINTER
CLR NFLG(R5) ;USE UP ANY NUMBER
CLR QFLG(R5) ;AND USE ALTMODE AS QUOTE
JSR PC,QSKP ;SKIP THE QUOTED STRING
MOV ITRST(R5),(R5) ;START SEARCH AT ITERATION START
1$: SKPSET '! ;SKIP UNTIL A !
JSR PC,ENTRCE ;REENABLE TRACE
MOV (SP),R4 ;GET BACK THE TAG'S START
ADD QBASE(R5),R4 ;AND ADDIN Q REG OFFSET
ADD QRSTOR(R5),R4 ;THEN MAKE ABSOLUTE
2$: JSR PC,SCAN ;SCAN THE FOUND TAG
CMP R0,#'! ;END OF TAG?
BEQ 4$ ;YES
CMPB R0,(R4)+ ;NO, MATCH?
BEQ 2$ ;CONTINUE UNTIL END IF MATCH
3$: JSR PC,SCAN ;SCAN FOR TAG'S END IF NO MATCH
CMP R0,#'! ;END OF TAG?
BNE 3$ ;NOT YET...
BR 1$ ;YES, SO FIND NEXT TAG
4$: CMPB (R4)+,#ALTMOD ;BOTH ENDS MATCH?
BNE 1$ ;NOPE, SO FIND NEXT TAG
TST (SP)+ ;YES, SO DUMP SAVED TAG POINTER
RTS PC ;AND EXIT
CMDCHR <':> ;":" IS THE SEARCH MODIFIER
MOV #-1,CLNF(R5) ;SET COLON FLAG
TSTNXT ': ;DOUBLE COLON?
SBC CLNF(R5) ;YES MEANS FLAG=-2
RTS PC ;AND EXIT
CMDCHR <'[> ;PUSH INTO QUEUE STACK
JSR PC,QREF ;REFERENCE QUEUE REGISTER
MOV QNMBR(R5),-(SP) ;SAVE Q REGISTER NUMBER
MOV (R1),R4 ;SAVE LENGTH
MOV #QSTKRG,R0 ;LOOK UP QUEUE STACK REGISTER
JSR PC,QREFR0 ;REFERENCE IT TO GET SIZE
MOV R4,R0 ;SIZE OF NEW ENTRY
ADD #4,R0 ;ADD 4 BYTES FOR HEADER STUFF
ADD (R1),R0 ;+ OLD SIZE
MOV (R1),-(SP) ;SAVE OLD SIZE ON STACK
JSR PC,QADJ ;ADJUST SIZE
ADD QRSTOR(R5),R2 ;MAKE POINTER TO IT ABSOLUTE
MOV R2,R3 ;COPY
ADD (R1),R2 ;POINT TO END
MOV (SP)+,R1 ;OLD LENGTH
BEQ 2$ ;ZERO
ADD R1,R3 ;POINT TO END OF OLD
1$: MOVB -(R3),-(R2) ;MOVE OVER TO GIVE ROOM
DEC R1
BNE 1$
2$: MOV R2,R4
MOV (SP)+,R0 ;NAME OF QUEUE REGISTER
JSR PC,QSUMX ;GET STUFF ABOUT IT
ADD QRSTOR(R5),R2 ;MAKE POINTER ABSOLUTE
MOV (R1),R0 ;LENGTH OF IT
BEQ 4$ ;ZERO--SKIP MOVING
ADD R0,R2 ;POINT TO END OF DATA
3$: MOVB -(R2),-(R4)
DEC R0
BNE 3$
4$: ADD #4,R1 ;POINT TO END OF LENGTH/VALUE
.REPT 4
MOVB -(R1),-(R4) ;MOVE IT
.ENDR
RTS PC ;DONE
CMDCHR <']> ;POP QUEUE REGISTER STACK
MOV #QSTKRG,R0 ;SEE WHAT IS THERE
JSR PC,QSUMX
TST (R1) ;ANY LENGTH?
BNE 2$
TST CLNF(R5) ;CANNOT POP
BGE 1$ ;AND NO COLON!
INC (R5) ;THROW OUT Q NUMBER
7$: CLR CLNF(R5)
JMP NCOM ;RETURN NUMERIC RESULT
2$: ADD QRSTOR(R5),R2 ;ABS ADDRESS
CLR R0 ;FETCH LENGTH OF ENTRY
BISB (R2)+,R0
SWAB R0
BISB (R2)+,R0
SWAB R0
MOV R0,R3 ;SAVE LENGTH
JSR PC,QREF ;GET QREG ARGUMENT
MOV R3,R0 ;SIZE REGISTER
JSR PC,QADJX
MOV R1,R3 ;SAVE STATISTICS IN R3,4
MOV R2,R4
ADD QRSTOR(R5),R4 ;CORRECT POINTER
MOV #QSTKRG,R0 ;FETCH QSTACK AGAIN
JSR PC,QREFR0
ADD QRSTOR(R5),R2 ;MAKE ADDR ABSOLUTE
MOV R2,-(SP) ;SAVE THAT ADDRESS
ADD #2,R2 ;POINT BEYOND SIZE
MOVB (R2)+,2(R3) ;GET VALUE INTO PLACE
MOVB (R2)+,3(R3)
MOV (R3),R0 ;LENGTH OF ENTRY (QREG)
BEQ 4$ ;NONE--SKIP MOVE
3$: MOVB (R2)+,(R4)+ ;MOVE THE BYTES
DEC R0
BNE 3$
4$: MOV (SP)+,R4 ;GET START OF QREG STACK
MOV (R1),R0 ;ORIGINAL LENGTH
SUB (R3),R0 ;LESS SIZE OF JUST POPPED
SUB #4,R0 ;LESS A HEADER
MOV R0,R1
BEQ 6$ ;NOTHING LEFT?
5$: MOVB (R2)+,(R4)+ ;MOVE STUFF OVER
DEC R1
BNE 5$
6$: JSR PC,QADJ ;ADJUST Q STACK SIZE
TST CLNF(R5) ;CHECK COLON
BGE 8$ ;NONE
DEC R0 ;RETURN A -1
BR 7$
8$: RTS PC ;RETURN NOTHING
1$: ERROR CPQ,<%CANT POP INTO Q-REGISTER%>
.ENABL LSB
CMDCHR <'U-100> ;CTRL/U IS Q REG TEXT INSERT
CLR -(SP) ;PUSH A ZERO
JSR PC,QREF ;REFERENCE THE Q REG
JSR PC,COLCHK ;CHECK FOR COLON TYPE
JSR PC,QSKP ;NOW SKIP THE QUOTED STRING
INC NFLG(R5) ;IS THERE ANUMBER
BEQ 1$
MOV (R5),R0 ;GET SCAN POINTER
DEC R0 ;LESS 1 FOR QUOTE CHAR
SUB OSCANP(R5),R0 ;NOW HAVE LENGTH
ADD (SP),R0 ;CORRECT LENGTH IF APPEND
JSR PC,QADJX ;ADJUST Q REG TO ITS NEW SIZE
MOV OSCANP(R5),R0 ;GET INSERT STRING START
ADD QBASE(R5),R0 ;AND ADD IN OFFSET
ADD QRSTOR(R5),R0 ;NOW MAKE IT ABSOLUTE
BR 15$ ;AND GO INSERT IT IN Q REG
1$: JSR PC,NULSTR ;MAKE SURE STRING IS ZERO LENGTH
MOV (SP),R0 ;ORIGINAL SIZE (IF APPEND)
INC R0 ;SPACE FOR NEW CHARACTER
JSR PC,QADJX ;ADJUST QREG SIZE
ADD (SP)+,R2 ;POINT TO POSITION TO INSERT
ADD QRSTOR(R5),R2 ;ABSOLUTE IT
BICB #200,N(R5) ;GET RID OF PARITY BIT
MOVB N(R5),(R2) ;STUFF IT IN
RTS PC
CMDCHR <'U> ;"U" IS Q REG NUMBER SETTER
JSR PC,QREF ;REFERENCE THE Q REG
INC NFLG(R5) ;ANY NUMBER?
BNE 90$ ;THERE MUST BE
TST (R1)+ ;SKIP THE SIZE
MOV N(R5),(R1) ;AND SET THE NUMBER
MOV CFLG(R5),NFLG(R5) ;MOVE M TO N (IF ANY)
CLR CFLG(R5)
MOV M(R5),N(R5)
RTS PC ;THEN EXIT
90$: ERROR NAU,<"NO ARG BEFORE U"> ;NOPE
CMDCHR <'X> ;"X" IS Q REG TEXT INSERT
CLR -(SP) ;PUSH A ZERO (SIZE IF APPEND)
JSR PC,QREF ;REFERENCE THE Q REG
JSR PC,COLCHK ;CHECK FOR COLON (APPEND)
JSR PC,NLINES ;GET NUMBER OF CHARACTERS
ADD (SP),R0 ;MAKE BIGGER IF APPEND
JSR PC,QADJX ;ADJUST Q REG TO ITS NEW SIZE
MOV M(R5),R0 ;GET START OF TEXT
ADD TXSTOR(R5),R0 ;AND MAKE IT ABSOLUTE
15$: ADD QRSTOR(R5),R2 ;MAKE POINTER TO Q REG ABSOLUTE
ADD (SP),R2 ;POINT PAST CURRENT DATA (APPEND)
MOV (R1),R1 ;NOW GET SIZE OF Q REG
SUB (SP)+,R1 ;LESS ORIGINAL SIZE
BEQ 21$ ;NO SIZE IS FAST EXIT
20$: MOVB (R0)+,(R2)+ ;ELSE MOVE BYTES INTO Q REG
DEC R1 ;MORE?
BGT 20$ ;YEP
21$: JMP IREST ;RESTORE THE ALTMODE AS QUOTE
.DSABL LSB
COLCHK: TST CLNF(R5) ;COLON?
BEQ 1$ ;DONE IF NOT
CLR CLNF(R5) ;SNARF IT UP
MOV (R1),2(SP) ;STASH AWAY ORIGINAL QREG SIZE
1$: RTS PC
.ENABL LSB
CMDCHR <'F> ;"F" IS PREFIX FOR SPECIAL SEARCHES
SORT ..FFF,S ;AND SORT ON IT
ERROR IFC,<"ILLEGAL F CHARACTER">
.FFFS: MOV #-1,REPFLG(R5) ;SET REPLACE FLAG
CMDCHR <'S> ;"S" IS SEARCH
SRCHJN: JSR PC,SEARCH ;SEARCH FOR THE STRING
1$: CLR CFLG(R5)
TST REPFLG(R5) ;REPLACEMENT?
BEQ 3$ ;NOPE
MOVB R1,-(SP) ;YES, SO SAVE SUCCESS/FAILURE FLAG
JSR PC,QSKP ;AND SKIP THE 2ND STRING
MOVB (SP)+,R1 ;RESTORE SUCCESS/FAILURE FLAG
BEQ 2$ ;NO REPLACEMENT IF FAILURE
MOV PST(R5),R0 ;GET START OF FOUND STRING
SUB P(R5),R0 ;AND NOW ITS -(LENGTH)
MOV PST(R5),P(R5) ;THEN UPDATE .
JSR PC,.SCH.R ;DO REPLACEMENT
MOV #-1,R1 ;RESTORE SUCCESS FLAG
2$: CLR REPFLG(R5) ;CLEAR REPLACE FLAG
3$: MOVB R1,R0 ;GET REAL NUMBER IN R0
JSR PC,NCOM ;INIT THE NUMBER PROCESSOR
TST CLNF(R5) ;WAS THERE A ":" THERE?
BMI 10$ ;YES, SO JUST RETURN FLAG
CLR CLNF(R5) ;ELSE SET FLAG TO FALSE
MOV ITRST(R5),R4 ;IN AN ITERATION?
BNE 11$ ;GO CHECK FOR FOLLOWING SEMICOLON
CLR NFLG(R5) ;USE UP THE NUMBER
TST N(R5) ;SUCCESSFUL?
BPL 5$ ;NOPE
MOV ESFLAG(R5),R4 ;YES, GET EDIT SEARCH FLAG
BEQ 10$ ;=0, SO EXIT
cmp mpdl(R5),pdl(r5) ;are we in a macro?
beq 10$ ;then no verify!
JMP .SCH.V ;ELSE GO PRINT SOMETHING
5$: ERROR SRH,<%SEARCH FAILURE FOR "%<-1>%"%>
9$: DEC (R5) ;MOVE BACK BEFORE SEMICOLON
10$: CLR CLNF(R5) ;CLEAR COLON FLAG
JMP IREST ;RESTORE QUOTE AND EXIT
11$: TSTNXT <';> ;SEE IF THERE IS
BCS 9$ ;YES--TREAT AS : SEARCH
CLR NFLG(R5) ;GET RID OF NUMBER
TST N(R5) ;SEARCH SUCCESSFUL?
BMI 10$ ;YES--CONTINUE NORMALLY
JSR PC,NOCTLO ;RESET CONTROL-O
MOV #12$,R3 ;STRING TO PRINT
MOV #13$-12$,R4 ;LENGTH OF STRING
JSR PC,PRINT
MOV ITRST(R5),R4 ;GO TO IT!
JMP .SCH.I ;AND LEAVE ITERATION LOOP
12$: .ASCII /%SEARCH FAIL IN ITER/<LF>
13$:
.EVEN
.FFFN: CLR R0 ;INSURE "N" TYPE SEARCH
MOV #-1,REPFLG(R5) ;AND DO A REPLACE
BR 17$ ;NOW JOIN UP
CMDCHR <'_> ;"_" IS DESTRUCTIVE SEARCH
;**********kludge ahead--WARNING!!!!!
MOV #32,R0 ;SET TO SKIP BUFFER DUMP
CMDCHR <'N> ;"N" IS THE PAGING SEARCH
17$: CLR CFLG(R5) ;MAKE INTO 1 ARGUMENT
MOV R0,TEMP(R5) ;SAVE DETERMINATION
JSR PC,SEARCH ;AND SEARCH
$18$: BMI 1$ ;SUCCESS(-1) OR BACKWARDS FAIL(177400)
19$: MOV R2,-(SP) ;SAVE THE SEARCH COUNTER
ADD TEMP(R5),PC ;CHECK DETERMINATION
20$: MOV TXSTOR(R5),R0 ;GET BUFFER START
MOV ZZ(R5),R1 ; AND ITS LENGTH
MOV FFFLAG(R5),R2 ; AND FORM FEED FLAG
JSR PC,PUTBUF ;PUT OUT THE BUFFER
BCC .+6
JMP IOERR ;ERROR FROM 'TECOIO'
CLR ZZ(R5) ;MAKE BUFFER EMPTY
$21$: JSR PC,@'Y*2+TECOCH ;NOW YANK IN A PAGE OF TEXT
MOV (SP)+,R2 ;RESTORE SEARCH COUNTER
TST ZZ(R5) ;ANYTHING WORTH SEARCHING FOR?
BNE $22$ ;YES, SO SEARCH SOME MORE
TST FFFLAG(R5) ;NOPE, IS THIS IS TRUE NULL PAGE?
BNE 19$ ;DON'T BOTHER TO SEARCH NULL
CLR R1 ;IF REAL END, THEN SIGNAL
JMP 1$ ; FAILURE, AND QUIT
.DSABL LSB
$22$: MOV #$18$,-(SP) ;CONTINUE SEARCHING
MOV XFLAG(R5),-(SP) ;THIS IS CALL TO ENTRY POINT
JMP .SURCH ;WILL RETURN TO 18$
.FFFR: JSR PC,QSKP ;SKIP THE INSERT STRING
MOV LSCHSZ(R5),R0 ;GET -(LENGTH) OF LAST FOUND STRING
JSR PC,.FFF.R ;AND BACK UP . TO THERE
MOV LSCHSZ(R5),R0 ;GET -(LENGTH) AGAIN
BR .SCH.R ;AND DO THE INSERT
CMDCHR <'G> ;"G" IS GET Q REG INTO TEXT
JSR PC,QREF ;REFERENCE THE Q REG
CLR NFLG(R5) ;USE UP ANY NUMBER
TST CLNF(R5) ;TO DISPLAY?
BNE 1$
MOV R2,-(SP) ;SAVE OFFSET TO Q REG
MOV (R1),R0 ;AND GET Q REG'S SIZE
MOV R0,-(SP) ;SAVE INSERT LENGTH
COM (SP) ;MAKE IT -(LENGTH)-1
BR .GGG.I ;NOW REALLY INSERT IT
1$: CLR CLNF(R5) ;GET RID OF COLLON
MOV (R1),R4 ;LENGTH
MOV QRSTOR(R5),R3 ;BASE ADDRESS
ADD R2,R3 ;OFFSET TO STRING
JMP PRINT ;PRINT IT AND RETURN
.FFFC: MOV #-1,REPFLG(R5) ;FC COMMAND
.FFFB: TST CFLG(R5) ;FB COMMAND, COMMA?
BMI 1$
MOV P(R5),M(R5) ;SAVE START IN "M"
JSR PC,@'L*2+TECOCH ;MOVE "N" LINES
MOV P(R5),N(R5) ;FINAL POSITION
MOV M(R5),P(R5) ;RESTORE POSITION
MOV N(R5),R0 ;COMPUTE LENGTH
SUB M(R5),R0
BLE 2$ ;NEGATIVE OR ZERO--NO PROBLEM
DEC N(R5) ;ONE LESS
1$: MOV N(R5),R0 ;COMPUTE LENGTH
SUB M(R5),R0
2$: MOV #1,R1 ;SEARCH DIRECTION
TST R0 ;DIRECTION?
BGE 3$
NEG R0 ;NEG SEARCH->POSITIVE DISTANCE
NEG R1 ;NEG SEARCH FLAG
3$: INC R0 ;MUST ADD ONE
MOV R1,N(R5) ;DIRECT ION TO SEARCH
MOV R0,R1
MOV M(R5),R0 ;START POSITION
MOV R1,M(R5) ;DISTANCE TO SEARCH
MOV #-1,CFLG(R5) ;SAY COMMA EXISTS
MOV #-1,NFLG(R5) ;SAY WE HAVE NUMBER
JSR PC,BZCHK ;IN RANGE?
MOV R0,P(R5) ;SET POINTER TO START
JMP SRCHJN ;AND START SEARCHING!
.ENABL LSB
CMDCHR <'I> ;"I" IS INSERT TEXT
INC NFLG(R5) ;NUMBER TO INSERT?
BNE 1$ ;NOPE
JSR PC,QSKP ;SCAN PAST STRING (BETTER BE 0LEN)
JSR PC,NULSTR ; CHECK FOR ZERO LENGTH
MOV N(R5),R0 ;YES, SO GET THE NUMBER
.BSL.I: BIC #-177-1,R0 ;MAKE INTO A VALID CHARACTER
MOV R0,-(SP) ;AND SAVE IT
MOV #1,R0 ;ADJUST TEXT UP BY
JSR PC,ADJ ; 1 CHARACTER
MOV P(R5),R1 ;GET .
ADD TXSTOR(R5),R1 ;MAKE ABSOLUTE
MOVB (SP)+,(R1) ;AND STORE NEW CHARACTER
INC P(R5) ;BUMP .
RTS PC ;AND EXIT
CMDCHR <'I-100> ;TAB IS SPECIAL FORM OF "I"
CLR QFLG(R5) ;INSURE NO QUOTE SPECIALS
DEC (R5) ;AND INCLUDE THE TAB IN TEXT
1$: JSR PC,QSKP ;SKIP THE QUOTED STRING
CLR R0 ;AND INDICATE NO BIAS
.SCH.R: MOV OSCANP(R5),R3 ;GET STRING START
MOV R3,-(SP) ;AND SAVE START
ADD QBASE(R5),(SP) ;START NOW REAL
SUB (R5),R3 ;NOW HAVE -(LENGTH)-1
SUB R3,R0 ;NOW HAVE (LENGTH)+1+(BIAS)
DEC R0 ;NOW HAVE (LENGTH)+(BIAS)
MOV R3,-(SP) ;SAVE INSERT -(LENGTH)-1
.GGG.I: JSR PC,ADJ ;ADJUST TEXT BUFFER SIZE
MOV (SP)+,R3 ;RESTORE INSERT -(LENGTH)-1
MOV R3,LSCHSZ(R5) ;SAVE TEXTUAL LENGTH
INC LSCHSZ(R5) ; AS -(LENGTH)
MOV (SP)+,R2 ; AND START
ADD QRSTOR(R5),R2 ;MAKE THE START ABSOLUTE
MOV P(R5),R1 ;GET .
ADD TXSTOR(R5),R1 ;AND MAKE . ABSOLUTE ALSO
BR 20$ ;ENTER INSERT LOOP
10$: MOVB (R2)+,(R1)+ ;INSERT A BYTE
20$: INC R3 ;DONE?
BLT 10$ ;NOPE
SUB TXSTOR(R5),R1 ;MAKE NEW . RELATIVE
MOV R1,P(R5) ;AND SET THE NEW .
JMP IREST ;RESTORE QUOTE AS ALTMODE AND EXIT
.DSABL LSB
NULSTR: MOV (R5),R3 ;END OF STRING
SUB OSCANP(R5),R3 ;LENGTH+1
DEC R3
BNE 1$ ;LENGTH NOT ZERO IS BAD
RTS PC
1$: ERROR IIA,<"ILLEGAL INSERT ARG">
.ENABL LSB
CMDCHR <'P> ;"P" IS PAGE WRITER
.SBTTL COMMAND CHARACTER "PW
TSTNXT 'W ;REALLY "PW"?
ROR -(SP) ;SAVE THE DETERMINATION
TST CFLG(R5) ;M,N??
BMI 30$ ;YES
JSR PC,GETN ;NOPE, GET A NUMBER
MOV R0,R4 ;AND SAVE IT
5$: MOV TXSTOR(R5),R0 ;WRITE FROM HERE
MOV ZZ(R5),R1 ; AND WRITE THIS MUCH
BEQ 10$ ; (UNLESS THAT IS ZERO...)
MOV FFFLAG(R5),R2 ; AND WRITE WITH OPTIONAL FORM FEED
TST (SP) ;"P" OR "PW" COMMAND?
BPL 6$ ;IF "P", THEN FORM FEED IS OPTIONAL
MOV #-1,R2 ;IF "PW", THEN ALWAYS A FORM FEED
6$: JSR PC,PUTBUF ;DUMP THE BUFFER
IO.ERR: BCS IOERR ;ERROR FROM 'TECOIO'
10$: TST (SP) ;"PW"?
BMI 22$ ;YES, SO NO YANK
JSR PC,YANK ;SIMULATE FORCED YANK (NO ERRORS)
22$: DEC R4 ;AGAIN?
BGT 5$ ;YES
25$: TST (SP)+ ;DUMP "PW" DETERMINATION
RTS PC ;NO, EXIT
30$: JSR PC,NLINES ;MAKE M,N INTO CHARACTERS
MOV R0,R1 ;COUNT GOES HERE
MOV M(R5),R0 ;START FROM HERE
ADD TXSTOR(R5),R0 ; MAKE IT ABSOLUTE
CLR R2 ;NEVER A FORM FEED
JSR PC,PUTBUF ;AND PUT IT
BCC 25$ ;EXIT IF NO ERROR
IOERR: ;I/O ERRORS COME HERE
.IF NE ERRTXT
MOV R2,-(SP) ;SAVE TEXT POINTER IF ANY
.ENDC
JMP ERRMIO ;AND CALL ERROR PROCESSOR
.DSABL LSB
.ENABL LSB
CMDCHR <'A> ;"A" IS APPEND
INC NFLG(R5) ;UNLESS THERE IS A NUMBER
BNE 10$ ;AND THERE IS NOT
MOV N(R5),R0 ;GET THE NUMBER
ADD P(R5),R0 ;INDEXED BY .
CMP R0,ZZ(R5) ;ARE WE IN RANGE?
BHIS 2$ ;NO--THEN RETURN -1
ADD TXSTOR(R5),R0 ;THEN MAKE IT ABSOLUTE
MOVB (R0),R0 ;AND GET THE CHARACTER
1$: JMP NCOM ;AND COMPUTE AS IF NUMBER
2$: MOV #-1,R0
BR 1$
CMDCHR <'Y> ;"Y" IS YANK IN A BUFFER
CLR NFLG(R5) ;USE UP A NUMBER
BIT #2,EDFLAG(R5) ;CHECK TURNED OFF?
BNE YANK
TST ZZ(R5) ;ANYTHING IN BUFFER?
BEQ YANK ;NO--OK
.GLOBL OBTOP ;PEEK INTO TINAIO
TST OBTOP ;OUTPUT FILE OPEN?
BEQ YANK ;NOT OPENED--YANK OK
ERROR YCA,</Y COMMAND ABORTED/>
YANK: CLR P(R5) ;AND ERASE THE
CLR ZZ(R5) ; OLD BUFFER
10$: MOV ZZ(R5),R0 ;GET END OF CURRENT BUFFER
MOV R0,R1 ;SAVE VALUE
ADD #1024.,R1 ;INCREASE SIZE BY A KAY
SIZE TEXT
BCS 15$ ;SUCCESSFULL--EVERYTHING IS OK
SUB #1024.-128.,R1 ;LAST DITCH EFFORT
SIZE TEXT
BCC 12$ ;IF THIS FAILS--QUIT
15$: mov zmax(r5),r1 ;get max size
DEC R1 ;LESS 1 FOR SAFETY
SUB R0,R1 ;FIND REAL ROOM LEFT
Cmp R1,#5000. ;More than 5k chars ?
Ble 20$
Mov #5000.,R1 ;If so, only use 5000 of them.
20$: ADD TXSTOR(R5),R0 ;MAKE POINTER ABSOLUTE
JSR PC,GETBUF ;GET GET SOME DATA
BCS IOERR ;ERROR
ADD R1,ZZ(R5) ;INCREASE DATA SIZE IN BUFFER
MOV R2,FFFLAG(R5) ;AND SAVE FORM FEED FLAG
BNE 12$ ;IF FORM FEED FOUND, THEN EXIT
TST EOFLAG(R5) ;ELSE WAS END-OF-FILE FOUND?
bne 12$ ;if so then quit
bit #4.,edflag(r5) ;shall we continue?
beq 10$ ;yes--lets!
12$: RTS PC ;NOW EXIT
.DSABL LSB
ioerrx: br ioerr
.ENABL LSB
CMDCHR <'E> ;"E" IS SPECIAL COMMANDS
MOV NFLG(R5),R2 ;SAVE THE NUMBER FLAG
CLR NFLG(R5) ;NO NUMBER
SORT ..EEE,S ;AND SORT
ERROR IEC,<"ILLEGAL E CHARACTER">
.eeesh: mov #'R-256.,r0 ;r0 will get =-256 for E!
br .eeew
.EEEI: MOV #256.+'R,R0 ;R0 WILL GET =256 FOR EI
.EEEB: ;R0 GETS <0 FOR EB
.EEER: ;R0 GETS =0 FOR ER
.EEEW: SUB #'R,R0 ;R0 GETS >0 FOR EW
MOV R0,-(SP) ;SAVE DETERMINATION
JSR PC,QSKP ;AND SKIP QUOTED STRING
MOV OSCANP(R5),R0 ;GET STRING START
MOV R0,R4 ;SAVE START
SUB (R5),R4 ;FIND -(LENGTH)-1
COM R4 ;NOW HAVE LENGTH
ADD QBASE(R5),R0 ;ADD OFFSET TO START
ADD QRSTOR(R5),R0 ;AND MAKE ABSOLUTE
MOV (SP)+,R1 ;RESTORE DETERMINATION
DOCCL: MOV R0,TEMP(R5) ;THEN SAVE START FOR ERRORS
JSR PC,GETFLS ;AND DO THE CORRECT THING
5$: bit #-1,clnf(r5) ;colon set?
beq 6$ ;no
mov #0,r0 ;shift in carry
rol r0
dec r0 ;-1 is success, 0 is failure
clr clnf(r5) ;no colon anymore
jmp ncom ;numeric result
6$: BCS IOERRx ;ERROR
JMP IREST ;RESTORE QUOTE AND EXIT
.EEEX: MOV #TEXIT,-(SP) ;EXIT FROM TECO SOON
BR 7$ ;AFTER FINISHING UP
.EEEG: MOV #GEXIT,-(SP) ;EXIT FROM TECO SOON
7$: BR 15$ ;NOW FINISH UP
.EEEQ: JMP TEXIT ;QUIT
.EEEK: JMP DELOUT ;DELETE OUTPUT FILE
10$: MOV ZMAX(R5),R1 ;GET BUFFER SIZE
DEC R1 ;LESS 1 FOR SAFETY
JSR PC,GETBUF ;NOW DO THE INPUT
BCC 12$ ;ALL OK
CMP R0,#NI ;NO INPUT?
11$: BNE IOERRX ;NO, REAL ERROR
.EEEF: JSR PC,CLSFIL ;CLOSE THE OUTPUT FILE
BR 5$ ;AND ERROR CHECK
12$: MOV R2,FFFLAG(R5) ;SAVE FORM FEED FLAG
MOV R1,ZZ(R5) ;AND DATA SIZE
BNE 15$ ;CONTINUE IF GET SOMETHING
TST R2 ;NULL TYPE PAGE?
BEQ .EEEF ;NOPE, TRUE END OF FILE
15$: MOV TXSTOR(R5),R0 ;FROM BEGINNING
MOV ZZ(R5),R1 ; TO END
MOV FFFLAG(R5),R2 ; WITH OPTIONAL FORM FEED
JSR PC,PUTBUF ;WRITE BUFFER
BCC 10$ ;AROUND AGAIN
CMP R0,#NO ;NO OUTPUT?
BNE 11$ ;NO, REAL ERROR
TST ZZ(R5) ;NO OUTPUT IS ERROR IF NONEMPTY BUFFER
BNE 11$
clr p(r5) ;in case of failing ex
RTS PC ;EMPTY BUFFER, SO QUIT
.EEEC: JSR PC,15$ ;PAGE OUT THE REST OF THE FILE
CLR ZZ(R5) ;NOW CLEAR TEXT BUFFER
CLR FFFLAG(R5) ;AND SAY NO FORM FEED IN BUFFER
JSR PC,CLOSIN ;CLOSE INPUT FILE (IF ANY)
RTS PC ;NOW EXIT
.DSABL LSB
.SCH.V: JSR PC,IREST ;RESTORE QUOTE CHARACTER
MOV R4,R0 ;AND LOAD TYPEOUT FLAG
.ENABL LSB
BR 1$
CMDCHR <'V> ;"V" IS VERIFY (1-NTNT)
JSR PC,GETN ;GET NUMBER
DEC R0 ;SHRINK IT
SWAB R0
CLRB R0
1$: INC R0 ;NASTY TRICK
MOV R0,-(SP) ;SAVE ARGUMENT
SWAB R0 ;GET BACK COUNT (UPPER BYTE)
BIC #177400,R0 ;CLEAN IT UP
NEG R0 ;WANT MINUS OF IT
MOV R0,N(R5) ;BECOMES AN ARGUMENT!
DEC NFLG(R5) ;SAY NUMBER IS THERE
JSR PC,10$ ;CALL "T" ROUTINE
MOV (SP),R0 ;LOOK AT CHARACTER
BIC #177400,R0 ;STRIP AWAY THE GRUNGE
BEQ 2$ ;NO CHARACTER
DEC R0
BEQ 2$ ;NO CHARACTER
CMP R0,#SPACE ;USE A LINE FEED?
BHIS 3$ ;NO-USE GIVEN CHARACTER
MOV #LF+200,R0 ;USE LINEFEED (that doesnt convert!)
3$: JSR PC,TYPE ;TYPE IT OUT
2$: DEC NFLG(R5) ;SAY WE HAVE AN ARGUMENT
CLR CFLG(R5) ;ONLY ONE
MOV (SP)+,R0 ;GET ARGUMENT
SWAB R0
BIC #177400,R0
INC R0 ;CORRECT FOR FORWARD PRINT
MOV R0,N(R5)
CLR R0
10$: ;PRINT STUFF OUT
.DSABL LSB
CMDCHR <'T> ;"T" IS THE PRINTER
JSR PC,NLINES ;FIND NUMBER OF CHARACTERS
1$: MOV M(R5),R3 ;GET STARTING POINT
ADD TXSTOR(R5),R3 ;AND MAKE ABSOLUTE
MOV R0,R4 ;MOVE COUNT INTO HERE
JMP PRINT ;AND PRINT IT
CMDCHR <'O-100> ;CTRL/O MEANS OCTAL RADIX
INC NMRBAS(R5) ;SET RADIX TO OCTAL
RTS PC ;FINISHED!
CMDCHR <'D-100> ;CTRL/D MEANS DECIMAL RADIX
CLR NMRBAS(R5)
RTS PC
ERROR: ERROR ILL,<"ILLEGAL COMMAND"> ;ILLEGAL COMMANDS COME HERE
.ENABL LSB
CMDCHR <'Q-100>
MOV P(R5),-(SP) ;CONVERT LINE TO CHAR ARG
JSR PC,@'L*2+TECOCH
MOV P(R5),R0 ;GET POSITION OF LINE
MOV (SP)+,P(R5) ;RESTORE POINTER
SUB P(R5),R0 ;GET OFFSET
BR 2$
CMDCHR <'N-100> ;CTRL/N IS EOF FLAG
MOV EOFLAG(R5),R0 ;GET END-OF-FILE FLAG
2$: BR 3$ ;AND COMPUTE AS A NUMBER
CMDCHR <'S-100> ;CTRL/S IS -(LENGTH) OF LAST STRING
MOV LSCHSZ(R5),R0 ;GET -(LENGTH) OF LAST
BR 3$ ;AND COMPUTE AS A NUMBER
CMDCHR <'F-100> ;CTRL/F IS process VALUE
JSR PC,SWITCH ;GET SWITCH REGISTER
BR 3$ ;AND COMPUTE AS A NUMBER
CMDCHR <'H> ;"H" MEANS ALL (0,Z)
CLR N(R5) ;SIMULATE THE "B" (OR 0)
JSR PC,1$ ;NOW SIMULATE THE COMMA
CMDCHR <'Z> ;"Z" MEANS END OF TEXT
MOV ZZ(R5),R0 ;GET END OF TEXT VALUE
BR 3$ ;AND COMPUTE AS A NUMBER
CMDCHR <'Y-100> ;SAME AS .+^S,.
MOV LSCHSZ(R5),N(R5)
ADD P(R5),N(R5)
JSR PC,1$ ;MAKE FIRST ARGUMENT
CMDCHR <'.> ;"." IS CURRENT POSITION
MOV P(R5),R0 ;GET .
BR 3$ ;AND COMPUTE AS A NUMBER
CMDCHR <',> ;"," IS THE M,N SEPARATOR
INC NFLG(R5) ;WAS THERE A "M"?
BNE 90$ ;THERE SHOULD HAVE BEEN
1$: MOV N(R5),M(R5) ;SAVE "M"
CLR N(R5) ;NOW CLEAR "N" AGAIN
MOV #-1,CFLG(R5) ;AND INDICATE A COMMA
CMDCHR <NULL> ;IGNORE NULLS
CMDCHR <LF> ;IGNORE LINE FEED
CMDCHR <VT> ;IGNORE VERTICAL TAB
CMDCHR <FF> ;IGNORE FORM FEED
CMDCHR <CR> ;IGNORE CARRIAGE RETURN
CMDCHR <SPACE> ;IGNORE SPACE(S)
RTS PC ;NOW RETURN
90$: ERROR NAC,<"NO ARG BEFORE ,"> ;NO
CMDCHR <'T-100> ;CTRL/T MEANS VALUE OF NEXT INPUT CHARACTER
INC NFLG(R5) ;ANY ARGUMENT?
BEQ 11$ ;THEN PRINT VALUE OF IT
jsr pc,norun ;disable all funny characters
MOV SP,R0 ;SINGLE CHARACTER MODE
JSR PC,LISTEN ;GET A CHARACTER
MOV R0,-(SP) ;SAVE CHAR
MOV (SP)+,R0 ;RESTORE AND CONTINUE
jsr pc,run ;accept funny characters again
BR 3$ ;AND COMPUTE AS A NUMBER
11$: MOV N(R5),R0 ;GET ARG
BIC #177400,R0 ;GET RID OF GRUNGE
JMP TYPE ;TYPE IT OUT AND RETURN
CMDCHR <'^-100> ;CTRL/^ MEANS VALUE OF NEXT CHARACTER
JSR PC,SCAN ;GET NEXT CHARACTER
3$: BR 12$ ;AND COMPUTE AS A NUMBER
CMDCHR <'V-100> ;CTRL/V MEANS VERSION NUMBER
MOV #VERSON,R0 ;GET VERSION NUMBER
BR 12$ ;AND COMPUTE AS A NUMBER
CMDCHR <'Z-100> ;CTRL/Z MEANS SIZE OF Q REGS
MOV QZ(R5),R0 ;GET SIZE OF Q REGS
12$: BR NCOM ;AND COMPUTE AS A NUMBER
CMDCHR <'E-100> ;CTRL/E MEANS FORM FEED FLAG
MOV FFFLAG(R5),R0 ;GET FORM FEED FLAG VALUE
BR NCOM ;AND COMPUTE AS A NUMBER
CMDCHR <'Q> ;"Q" IS VALUE IN Q REGISTER
JSR PC,QREF ;REFERENCE Q REG AS SPECIFIED
inc nflg(r5) ;are we getting single char value?
beq 10$
TST CLNF(R5) ;COLON MODE?
BEQ 4$ ;NO--REGULAR Q FETCH
CLR CLNF(R5) ;SNARF COLON
MOV (R1),R0 ;GET VALUE(LENGTH OF Q REG STRING
BR NCOM ;A NUMERIC RESULT
10$: cmp n(r5),(r1) ;is length too long?
bhis 13$
add qrstor(r5),r2 ;get byte
add n(r5),r2 ;point to it
movb (r2),r0 ;get it
br ncom
13$: dec r0 ;return "not found"
br ncom
CMDCHR <'%> ;"%" IS ADD TO Q REG VALUE
JSR PC,QREF ;REFERENCE Q REG AS SPECIFIED
JSR PC,GETN ;GET THE NUMBER ALSO
4$: TST (R1)+ ;SKIP THE OFFSET WORD
ADD (R1),R0 ;AND ADD FOR A NEW VALUE
MOV R0,(R1) ;THEN STORE IT AWAY
BR NCOM ;AND COMPUTE AS A NUMBER
.DSABL LSB
.ENABL LSB
CMDCHR <'&> ;"&" IS LOGICAL 'AND'
MOV #OP$AND-OP$OR,R0 ;SET FOR 'AND'
CMDCHR <'#> ;"#" IS LOGICAL OR
ADD #OP$OR-OP$DIV,R0 ;SET FOR 'OR'
CMDCHR <'/> ;"/" IS DIVISION
ADD #OP$DIV-OP$MUL,R0 ;SET FOR DIVIDE
CMDCHR <'*> ;"*" IS MULTIPLICATION
ADD #OP$MUL-OP$SUB,R0 ;SET FOR MULTIPLY
CMDCHR <'-> ;"-" IS SUBTRACTION
TST (R0)+ ;SET FOR SUBTRACT
CMDCHR <'+> ;"+" IS ADDITION
9$: MOV R0,NOPR(R5) ;SAVE THE OPERATOR DISPTACH
MOV N(R5),NACC(R5) ;SAVE CURRENT NUMBER IN ACCULMULATOR
CLR NP(R5) ;NO DIGITS FOUND NOW
MOV #-1,OFLG(R5) ;INDICATE OPERATOR PENDING
CLR NFLG(R5) ;BUT NO NUMBER PENDING
RTS PC ;AND RETURN
CMDCHR <'(> ;"(" IS START OF NEW EXPRESSION
TST OFLG(R5) ;OPERATOR PENDING?
BNE 10$ ;YES
JSR PC,NCOM ;NO, INITIALIZE US
10$: PUSH <NACC,NOPR> ;SAVE ACCULMULATOR
BR 9$ ;THEN SET UP AS IF "+"
.DSABL LSB
.ENABL LSB
CMDCHR <')> ;")" IS END OF EXPRESSION
TST NFLG(R5) ;ANYTHING BEFORE THIS?
BPL 90$ ;BADNESS IF NOT
POP <NOPR,NACC> ;RESTORE OPERATOR
MOV N(R5),R0 ;GET VALUE INSIDE PARENS
BR 20$ ;AND TREAT AS A NUMBER
90$: ERROR NAP,<"NO ARG BEFORE )">
CMDCHR <'8>
CMDCHR <'9>
TST NMRBAS(R5)
BEQ 1$ ;DECIMAL O.K.
ERROR ILN,<%ILLEGAL NUMBER%>
CMDCHR <'0> ;THE DIGITS
CMDCHR <'1>
CMDCHR <'2>
CMDCHR <'3>
CMDCHR <'4>
CMDCHR <'5>
CMDCHR <'6>
CMDCHR <'7>
1$: ASR R1 ;FORM NON-WORD-INDEX FROM CHARACTER
.BSL.N: SUB #'0,R1 ;AND MAKE INTO BINARY DIGIT
INC NFLG(R5) ;ANY DIGIT BEFORE THIS?
BNE 31$ ;NO, SO INITIALIZE US
MOV NP(R5),R0 ;YES, SO GET OLD NUMBER
ASL R0 ;TIMES 2
ASL R0 ;TIMES 4 NOW
TST NMRBAS(R5) ;RADIX?
BNE 21$ ;OCTAL
ADD NP(R5),R0 ;DECIMAL
21$: ASL R0 ;TIMES 8. OR 10. BY NOW
ADD R1,R0 ;AND ADD IN NEW DIGIT
MOV R0,NP(R5) ;SAVE THE NUMBER
20$: ADD NOPR(R5),PC ;DISPATCH ON OPERATOR
BR 23$ ;+
OP$SUB: NEG R0 ;-
23$: ADD NACC(R5),R0 ;FORM RESULT
30$: MOV R0,N(R5) ;SAVE THE RESULT
MOV #-1,NFLG(R5) ;AND INDICATE A NUMBER
CLR OFLG(R5) ;BUT NO OPERATOR
RTS PC ;THEN EXIT
31$: MOV R1,R0 ;COPY FIRST DIGIT
MOV R1,NP(R5) ;SAVE IT IN NUMBER ACCUMULATOR
BR 32$ ;ENTER PROCESSING
CMDCHR <'B> ;"B" IS ZERO
NCOM: CLR NP(R5) ;USUALLY WE SET NP TO 0
32$: TST OFLG(R5) ;OPERATOR?
BNE 20$ ;YES
CLR NACC(R5) ;NO, SO INITIALIZE US
CLR NOPR(R5)
BR 30$ ;AND CONTINUE
OP$AND: MOV NACC(R5),R1 ;GET MASK
COM R1 ;MAKE INTO AN 'AND' MASK
BIC R1,R0 ;AND DO THE 'AND'
BR 30$
OP$OR: BIS NACC(R5),R0 ;DO THE 'OR'
BR 30$
OP$MUL: CLR R1 ;CLEAR THE HIGH ORDER
MOV #16.+1,R2 ;NUMBER OF BITS(+1) IN A WORD
40$: CLC ;CLEAR THE DUMB CARRY
ROR R1 ;SHIFT HIGH ORDER INTO
ROR R0 ; LOW ORDER
BCC 41$ ;NO NEED TO ADD HERE...
ADD NACC(R5),R1 ;ADD INTO HIGH ORDER
41$: DEC R2 ;MORE?
BGT 40$ ;YES
BR 30$ ;NO
OP$DIV: MOV R0,R2 ;SET THE DIVISOR
MOV NACC(R5),R0 ;AND THE DIVIDEND
MOV #30$,-(SP) ;STACK RETURN ADDRESS
.DSABL LSB
DIVD: CLR R1 ;CLEAR THE REMAINDER
MOV #16.,R3 ;NUMBER OF BITS IN A WORD
51$: ASL R0 ;SHIFT THE DIVIDEND
ROL R1 ; INTO THE REMAINDER
CMP R2,R1 ;CAN WE SUBTRACT?
BHI 52$ ;NOPE
SUB R2,R1 ;YEP
INC R0 ;AND COUNT IN ANSWER
52$: DEC R3 ;MORE?
BGT 51$ ;YES
RTS PC ;NO, EXIT
CMDCHR <'_-100> ;THE COMPLEMENT OPERATOR (UNARY)
TST NFLG(R5) ;IS THERE A NUMBER?
BPL 90$ ;THERE SHOULD HAVE BEEN
COM N(R5) ;DO A COMPLEMENT
RTS PC ;AND LEAVE
90$: ERROR NAB,<"NO ARG BEFORE "<'_-100>>
.ENABL LSB
CMDCHR <'X-100>
MOV #XFLAG,R0
MOV NFLG(R5),R2 ;"^X" IS CASE MATCH FLAG
CLR NFLG(R5)
BR 1$
.EEEV: MOV #EVFLAG,R0 ;"EV" IS EDIT VERIFY FLAG
BR 1$
.EEED: MOV #EDFLAG,R0 ;"ED" IS EDIT LEVEL
BR 1$
.EEET: MOV #ETYPE,R0 ;"ET" IS EDIT TYPEOUT
BR 1$ ;GO TO COMMON CODE
.EEEH: MOV #EHELP,R0 ;"EH" IS EDIT HELP
BR 1$ ;GO TO COMMON CODE
.EEEO: MOV #OFLAG,R0 ;"EO" IS EDIT OUTPUT PROTECT
BR 1$
.EEES: MOV #ESFLAG,R0 ;"ES" IS EDIT SEARCH
1$: ADD R5,R0 ;MAKE POINTER ABSOLUTE
tst cflg(r5) ;two arguments?
bmi 3$
INC R2 ;ARGUMENT?
BEQ 2$ ;YES
MOV (R0),R0 ;NO, RETURN VALUE
BR NCOM ;AND COMPUTE AS A NUMBER
2$: TST CFLG(R5) ;COMMA PRESENT?
BMI 3$
MOV N(R5),(R0) ;SET THE NEW VALUE
RTS PC ;AND EXIT
3$: CLR CFLG(R5) ;M CLEARS BITS, N SETS THEM
BIC M(R5),(R0)
BIS N(R5),(R0)
RTS PC
.DSABL LSB
.ENABL LSB
CMDCHR <'J> ;"J" IS MOVE POINTER
CLR NFLG(R5) ;USE UP THE NUMBER
MOV N(R5),R0 ;NOW GET THE NUMBER
BR 2$ ;AND GO SET .
CMDCHR <'R> ;"R" IS MOVE POINTER CHARACTERS
JSR PC,GETN ;GET THE NUMBER OF CHARACTERS
NEG R0 ;THIS IS THE REVERSE MOVE
BR .FFF.R ;GO JOIN COMMON CODE
CMDCHR <'C> ;"C" IS MOVE POINTER CHARACTERS
JSR PC,GETN ;GET THE NUMBER OF CHARACTERS
.FFF.R: ADD P(R5),R0 ;CALCULATE NEW .
2$: JSR PC,BZCHK ;CHECK FOR VALIDITY
MOV R0,P(R5) ;SET NEW .
RTS PC ;AND EXIT
CMDCHR <'D> ;"D" IS DELETE CHARACTERS
TST CFLG(R5) ;IS FORM M,ND ?
BMI 10$ ;YES, SO PRETEND IT IS M,NK
JSR PC,GETN ;GET THE NUMBER OF CHARACTERS
MOV R0,R1 ;AND SAVE THAT NUMBER
BPL 20$ ;>0 IS FORWARD DELETE
JSR PC,.FFF.R ;<0 IS BACKWARD (-ND = -NC ND)
MOV R1,R0 ;RESTORE THE DELETE COUNT
BR ADJ ;NOW DELETE
CMDCHR <'K> ;"K" IS THE LINE DELETER
10$: JSR PC,NLINES ;GET THE NUMBER OF LINES
MOV M(R5),P(R5) ;STARTING FROM HERE
20$: NEG R0 ;DELETE THIS MANY (<0 IS DELETE)
;BR ADJ ;NOW DO IT
.DSABL LSB
.SBTTL ADJUST TEXT AREA ROUTINE
.SBTTL R0 = 0 MEANS NO ADJUSTMENT
.SBTTL R0 < 0 MEANS SHRINK AREA BY ABS(R0)
.SBTTL R0 > 0 MEANS ENLARGE AREA BY R0
.SBTTL (R0,R1,R2,R3 ARE CLOBBERED)
.ENABL LSB
ADJ: MOV P(R5),R2 ;GET .
MOV ZZ(R5),R3 ;AND GET END OF TEXT
MOV R0,R1 ;COPY THE CHANGE AMOUNT
BMI 5$ ;<0 MEANS SHRINK AREA
BEQ 4$ ;=0 MEANS NO CHANGE
ADD R3,R1 ;NOW HAVE NEW SIZE
SIZE TEXT ;CHECK OUT THE SIZE
BCC 90$ ;WE CAN'T DO IT
MOV R1,ZZ(R5) ;UPDATE THE BUFFER SIZE
MOV TXSTOR(R5),R0 ;GET ABSOLUTE POINTER BIAS
ADD R0,R1 ;MAKE NEW ZZ ABSOLUTE
ADD R0,R2 ;MAKE . ABSOLUTE
ADD R0,R3 ;MAKE OLD ZZ ABSOLUTE
MOVB (R2),R0 ;SAVE CHARACTER AT .
CLRB (R2) ;THEN FLAG THAT SPOT
BR 3$ ;AND ENTER MOVE LOOP
2$: MOVB -(R3),-(R1) ;MOVE A BYTE UP FROM END
BNE 2$ ;CANNOT BE END OF NON-ZERO
3$: CMP R3,R2 ;REACHED . YET?
BHI 2$ ;NOPE, SO CONTINUE
MOVB R0,(R1) ;YES, RESTORE CHARACTER AT .
4$: RTS PC ;AND EXIT
90$: ERROR MEM,<"MEMORY OVERFLOW"> ;SORRY...
5$: NEG R1 ;MAKE SHIRNK COUNT POSITIVE
MOV R1,R0 ;AND SAVE IT
ADD R2,R1 ;NOW HAVE END OF DELETE
CMP R1,R3 ;IS DELETE TOO BIG?
BHI 91$ ;YEP
SUB R0,ZZ(R5) ;SET NEW DATA SIZE
MOV TXSTOR(R5),R0 ;GET BUFFER BIAS
ADD R0,R1 ;MAKE END OF DELETE ABSOLUTE
ADD R0,R2 ;MAKE . ABSOLUTE
ADD R0,R3 ;MAKE END OF BUFFER ABSOLUTE
CLRB (R3) ;AND FLAG END OF BUFFER
BR 9$ ;NOW ENTER BYTE MOVE LOOP
8$: MOVB (R1)+,(R2)+ ;MOVE A BYTE DOWN
BNE 8$ ;CANNOT BE END IF NON-ZERO
9$: CMP R1,R3 ;END OF BUFFER REACHED?
BLO 8$ ;NOT YET
RTS PC ;NOW EXIT
91$: ERROR DTB,<"DELETE TOO BIG">
.DSABL LSB
.SBTTL SORT
.SBTTL INVOKED VIA "SORT" MACRO
.SBTTL R0 = CHARACTER TO SORT (GOES INTO "SCHAR")
.SBTTL (R1 IS CLOBBERED)
.ENABL LSB
SORTC: MOV N(R5),R3 ;GET ARGUMENT
SORTJ: CLR R2 ;SET UP FOR THE "ADD" CHAIN
SORTS: JSR PC,SCNUPP ;GET CHARACTER TO SORT ON
SORT: MOV (R4)+,R1 ;GET TABLE ADDRESS (-2)
MOV R0,SCHAR(R5) ;SAVE TO BE SORTED CHARACTER
1$: TST (R1)+ ;SKIP THE DISPATCH ADDRESS
CMP R0,(R1)+ ;GET A MATCH?
BHI 1$ ;NO, KEEP GOING
BLO 2$ ;NO, TOO AR
MOV (R1),R4 ;YES, CHANGE RETURN ADDRESS
2$: RTS R4 ;AND EXIT
.SBTTL SKIP OVER COMMAND
.SBTTL INVOKED VIA "SKPSET" MACRO
.SBTTL (R0,R1,R2,R3,"TEMP" ARE CLOBBERED)
SKPSET: MOV (R4)+,TEMP(R5) ;SAVE SPECIAL CHARACTER
JSR PC,NOTRCE ;DISABLE TRACE
10$: JSR PC,SCNUPP ;GET NEXT CHARACTER
11$: MOV R0,SCHAR(R5) ;SAVE AS SORTED CHARACTER
CMP R0,TEMP(R5) ;IS IT THE SPECIAL CHARACTER?
BEQ 2$ ;YES, SO EXIT
MOV #10$,-(SP) ;STACK A RETURN ADDRESS
SORT ..CSM ;SORT ON SPECIAL SKIPPERS
RTS PC ;NON-SPECIALS ARE IGNORED
.CSMDQ: DEC CNDN(R5) ;INTO ONE MORE CONDITIONAL
.CSMD: JMP SCAN ;IGNORE NEXT CHARACTER
.CSMU: JSR PC,SCAN ;IGNORE NEXT CHARACTER
BR .CSMQ ;AND 1 QUOTED STRING
.CSMF: sort ..csmf,s ;sort on F commands
rts pc ;nothing special
.CSM2Q: JSR PC,QSKP ;IGNORE 1 QUOTED STRING
.CSMQ: JSR PC,QSKP ;IGNORE 1 QUOTED STRING
IREST: MOV #ALTMOD,R0 ;SET TO RESTORE QUOTE AS ALTMODE
BR 20$ ;GO DO IT
QCHK: TST QFLG(R5) ;QUOTE FLAG?
BEQ 21$ ;NOPE
JSR PC,SCAN ;YES, SO GET THE QUOTE CHARACTER
20$: MOV R0,QUOTE(R5) ;AND SET QUOTE CHARACTER
CLR QFLG(R5) ;NOW CLEAR THE QUOTE FLAG
21$: RTS PC ;AND EXIT
.CSMY: MOV #.CSMQ,-(SP) ;IGNORE A STRING QUOTED ON
BR 20$ ;THIS CHARACTER
.CSME: SORT ..CSME,S ;IS IT EB, ER, EW ?
RTS PC ;NO
CMDCHR <'@> ;"@" IS QUOTE FLAG SETTER
.CSMA: MOV #-1,QFLG(R5) ;@ FOUND; SET QUOTE FLAG
RTS PC ;EXIT
.CSMUA: JSR PC,SCNUPP ;GET CHARACTER AFTER ^
BIC #-77-1,R0 ; THEN FORCE CONTROL CHARACTER
TST (SP)+ ;JUNK THE RETURN ADDRESS
BR 11$
.DSABL LSB
.SBTTL ERROR MESSAGE PROCESSOR
.IF NE ERRTXT
.ENABL LSB
ERRORA: MOVB (R4)+,R0 ;GET 3RD RAD50 CHARACTER
ADD (PC)+,R0 ;NOW FORM "NA?"
.RAD50 /NA /
MESSAG <"NO ARG BEFORE "<-3>>
MOV #$$$$$$,-(SP) ;STACK MESSAGE POINTER
BR 1$ ;AND GO TO COMMON PROCESSING
ERRORC: MOVB (R4)+,R0 ;GET 2ND RAD50 CHARACTER
ASL R0 ;MAKE INTO
ASL R0 ; REAL
ASL R0 ; 2ND CHARACTER
ADD (PC)+,R0 ;NOW FORM "I?C"
.RAD50 /I C/
MESSAG <"ILLEGAL "<-3>" CHARACTER">
MOV #$$$$$$,-(SP) ;STACK MESSAGE POINTER
1$: MOVB (R4)+,R4 ;GET LAST/MIDDLE CHARACTER
BR ERRMIO ;AND GO TO COMMON PROCESSING
.DSABL LSB
.ENDC
ERRMSG:
MOV (R4)+,R0 ;GET RAD50 OF ERROR CODE
.IF NE ERRTXT
MOV (R4)+,-(SP) ;SAVE THE TEXT POINTER
MOV (PC),R4 ;SET R4 = 012702
.ENDC
ERRMIO: MOV #50,R2 ;SET TO DIVIDE BY 50
CLR -(SP) ;FLAG END OF CHARACTERS
1$: JSR PC,DIVD ;DIVIDE BY 50
MOV R1,-(SP) ; AND SAVE REMAINDER
TST R0 ; ANY ANSWER LEFT?
BNE 1$ ; LOOP IF SO...
JSR PC,NOCTLO ;CANCEL ANY ^O IF EFFECT
JSR PC,CRLF ;RESTORE CARRIAGE
MOV #'?-<'A-1>,R0 ;NOW PRINT A "?"
2$: ADD #'A-1,R0 ;MAKE A CHARACTER
CMP R0,#'Z ;REALLY ALPHABETIC?
BLOS 3$ ;YES, SO TYPE IT
ADD #'0-36-<'A-1>,R0 ;NO, SO CONVERT TO NUMERIC
3$: JSR PC,TYPE ; AND TYPE IT
MOV (SP)+,R0 ;GET NEXT
BNE 2$ ; IF ANY...
MOV (R5),ERRPOS(R5) ;SAVE ERRING "SCANP"
MOV EHELP(R5),R3 ;GET EDIT HELP LEVEL
.IF NE ERRTXT
BIC #^C3,R3 ;WANT ONLY LS 2 BITS
DEC R3 ;LESS 1
BEQ 9$ ;IF "EH"=1 THEN ONLY RAD50
MOV (SP)+,R1 ;GET THE STRING POINTER
BEQ 9$ ;IF ANY...
MOV #TAB,R0 ;START WITH A TAB
4$: JSR PC,TYPE
5$: MOVB (R1)+,R0 ;GET STRING CHARACTER
BGT 4$ ; IF MORE...
BEQ 9$ ; OR THE REAL END
MOV SCHBUF(R5),R2 ;GUESS AT PRINT SEARCH BUFFER FIRST
CMPB R0,#-2 ;WHICH TYPE OF SPECIAL WAS IT??
BGT 7$ ;IF -1 (-1.GT.-2) THEN ALL SET UP
BEQ 6$ ;IF -2 (-2.EQ.-2) THEN SET POINTER
MOVB R4,R0 ;IF -3 (-3.LT.-2) THEN SET CHARACTER
BR 4$ ;AND PRINT IT, THEN JUST CONTINUE
6$: MOV TEMP(R5),R2 ;THIS IS THE SAVED FILENAME POINTER
7$: DEC R4 ;MORE TO PRINT IN STRING?
BMI 5$ ;NOPE, SO QUIT NOW
MOVB (R2)+,R0 ;YEP, SO FETCH NEXT CHARACTER
BPL 8$ ;AND PRINT IT
CMPB R0,#-1 ;IF SPECIAL, THEN THE END?
BEQ 5$ ;QUIT BEFORE PRINTING END CHARACTER
BIC #-177-1,R0 ;ELSE TRIM OFF SPECIAL BIT(S)
8$: JSR PC,TYPE ;AND PRINT CHARACTER AS NORMAL
BR 7$ ;AROUND AGAIN FOR GOODNESS
.ENDC
9$: BIT #4,EHELP(R5) ;TEST TRACE BIT
BEQ 10$ ;IF CLEAR, DONT TRACE
JSR PC,EIOFF ;TURN OFF EI
JMP .CMDQM ;NOW DO THE ?
10$: JSR PC,EIOFF ;TURN OFF EI
bit #200,etype(r5) ;abort on error?
bne 11$
JMP TECO ;RESTART TECO
11$: jsr pc,crlf ;print crlf
jmp texit ;quit!!
.DSABL LSB
.SBTTL Q REGISTER REFERENCE
.SBTTL RETURNS: R0 = 0
.SBTTL R1 = POINTER TO Q REG SIZE
.SBTTL R2 = OFFSET TO BASE OF Q REG
.SBTTL "QNMBR" SET AS SPECIFIED
.ENABL LSB
QREF: JSR PC,SCNUPP ;GET NEXT CHARACTER
.CMD.S: JSR PC,ALPHAN ;MUST BE ALPHANUMERIC
BCC 90$ ; BUT IT IS NOT
CMP R0,#'A ;IS IT ALPHA?
BLO 2$ ;NOPE, IT IS NUMERIC
ADD #13-'A-<1-'0>,R0 ;YEP, RANGE IS 13-44
2$: ADD #1-'0,R0 ;RANGE IS 1-12
QREFR0: MOV R0,QNMBR(R5) ;SAVE THE Q REG NUMBER
.SBTTL GET SUM OF Q REGISTER IN "QNMBR" (QSUMY)
QSUMY: MOV QNMBR(R5),R0 ;GET THE Q REG NUMBER
.SBTTL GET SUM OF Q REGISTER IN R0 (QSUMX)
QSUMX: MOV #QARRAY,R1 ;GET OFFSET TO Q REG ARRAY
ADD R5,R1 ;NOW FIND IT FOR REAL
CLR R2 ;START OFFSET OF REG AT 0
BR 12$ ;AND ENTER COUNTING LOOP
11$: ADD (R1)+,R2 ;SUM THE TOTAL OFFSE
TST (R1)+ ;AND SKIP THE VALUE SPOT
12$: DEC R0 ;MORE TO GO?
BGT 11$ ;YES
RTS PC ;NO, EXIT
90$: ERROR IQN,<"ILLEGAL Q REG NAME">;BAD Q REG NUMBER
.DSABL LSB
.SBTTL Q REGISTER SIZE ADJUST ROUTINE
.SBTTL R0 = NEW SIZE OF Q REGISTER IN "QNMBR"
.SBTTL RETURNS: R0 = 0
.SBTTL R1 = POINTER TO NEW Q REG SIZE
.SBTTL R2 = OFFSET TO THIS Q REG
.SBTTL (R3,R4 ARE CLOBBERED)
.ENABL LSB
QADJX: CMP QNMBR(R5),QCMND(R5) ;ABOUT TO CLOBBER COMMAND?
BEQ 90$ ;YES, BOOT HIM
QADJ: MOV R0,R3 ;COPY THE NEW Q REG SIZE
JSR PC,QSUMY ;AND SUM CURRENT Q REG OFFSET
MOV QZ(R5),R0 ;GET END OF ALL Q REGS
MOV R1,R4 ;COPY Q REG SIZE POINTER
MOV R3,R1 ;AND GET WORKING COPY OF NEW SIZE
ADD (R4),R2 ;POINTER TO CURRENT END OF Q REG
SUB (R4),R1 ;SIZE CHANGE (NEW-OLD)
BLO 25$ ;NEW < OLD
BEQ QSUMY ;NEW = OLD
ADD R0,R1 ;NEW > OLD; GET NEW QZ
SIZE QREGS ;CHECK OUT THE SIZE
BCC 91$ ;WE CAN'T DO IT
MOV R3,(R4) ;SET NEW Q REG SIZE
MOV R1,QZ(R5) ;SET NEW TOTAL Q REG SIZE
MOV QRSTOR(R5),R3 ;GET Q REG AREA POINTER
ADD R3,R0 ;MAKE ALL
ADD R3,R1 ; POINTERS
ADD R3,R2 ; ABSOLUTE
MOVB (R2),R4 ;SAVE CHARACTER IN MIDDLE
CLRB (R2) ;THEN FLAG THAT BYTE AS NULL
BR 23$ ;AND ENTER MOVE LOOP
22$: MOVB -(R0),-(R1) ;MOVE A BYTE UP FROM TOP
BNE 22$ ;CANNOT BE END IF NON-ZERO
23$: CMP R0,R2 ;DONE?
BHI 22$ ;NOT YET...
MOVB R4,(R1) ;RESTORE SAVED CHARACTER
24$: MOV QCMND(R5),R0 ;GET COMMAND Q REG NUMBER
MOV #QSUMY,-(SP) ;SET FOR COMMAND SETUP JUST IN CASE
SETCMD: MOV R0,QCMND(R5) ;SET COMMAND Q REG NUMBER
JSR PC,QSUMX ;AND SUM UP FOR THAT REGISTER
MOV R2,QBASE(R5) ;STORE THE BASE OFFSET
MOV (R1),QLENGT(R5) ; AND THE LENGTH
RTS PC ;THEN EXIT
25$: MOV R3,(R4) ;SET NEW Q REG SIZE
ADD R1,QZ(R5) ;LOWER THE TOTAL Q REG SIZE
ADD R2,R1 ;POINT TO THE NEW END
MOV QRSTOR(R5),R3 ;GET Q REG AREA POINTER
ADD R3,R0 ;MAKE ALL
ADD R3,R1 ; POINTERS
ADD R3,R2 ; ABSOLUTE
CLRB (R0) ;FLAG THE END BYTE AS NULL
BR 27$ ;ENTER MOVE LOOP
26$: MOVB (R2)+,(R1)+ ;MOVE A BYTE DOWN
BNE 26$ ;CANNOT BE END IF NON-ZERO
27$: CMP R2,R0 ;DONE?
BLO 26$ ;NOT YET...
BR 24$ ;ALL DONE
90$: ERROR CCC,<"CAN'T CLOBBER COMMAND">
91$: ERROR MEM,<"MEMORY OVERFLOW"> ;NO GO
.DSABL LSB
.SBTTL GENERAL SUBROUTINES
GETXTP: MOV P(R5),R0 ;GET .
CMP R0,ZZ(R5) ;TOO FAR?
BHIS 1$ ;YES [BHIS=BCC]
ADD TXSTOR(R5),R0 ;NO, MAKE ABSOLUTE
MOVB (R0),R0 ;AND GET CHARACTER
SEC ;OK [CARRY SET]
1$: RTS PC ;EXIT
.ENABL LSB
90$: ERROR PDO,<"PUSH-DOWN LIST OVERFLOW">
1$: CMP PDL(R5),SCHBUF(R5) ;PUSHING TOO FAR?
BHIS 90$ ;YEP
ADD R5,(SP) ;NOPE, MAKE OFFSET ABSOLUTE
MOV @(SP)+,@PDL(R5) ;NOW SAVE IT
ADD #2,PDL(R5) ;AND GO TO NEXT LOCATION
PUSH: MOV (R4)+,-(SP) ;GET THE OFFSET
BPL 1$ ;NOT END OF LIST YET
2$: TST (SP)+ ;GET RID OF FLAG
RTS R4 ;AND EXIT
POP: MOV (R4)+,-(SP) ;GET THE OFFSET
BMI 2$ ;GET OUT IF END
SUB #2,PDL(R5) ;BACK UP THE LIST
ADD R5,(SP) ;MAKE ABSOLUTE
MOV @PDL(R5),@(SP)+ ;RESTORE VALUE
BR POP ;AND CONTINUE
.DSABL LSB
SCNUPP: JSR PC,SCAN ;SCAN FIRST
UPPERC: CMP R0,#141 ;ALREADY OK?
BLO 1$ ;YES
CMP R0,#173 ;DONT CHANGE HIGH CHARACTERS
BHIS 1$
BIC #40,R0 ;NO, SO CORRECT IT
1$: RTS PC ;AND EXIT
QSKP: JSR PC,QCHK ;CHECK FOR A QUOTE CHARACTER
MOV (R5),OSCANP(R5) ;AND SAVE "SCANP"
1$: JSR PC,SCAN ;NOW SCAN
CMP R0,QUOTE(R5) ;MATCH?
BNE 1$ ;NOPE
RTS PC ;NOW EXIT
.ENABL LSB
BZCHK: CMP R0,ZZ(R5) ;TOO BIG?
BLOS 1$ ;NOPE
ERROR POP,<"POINTER OFF PAGE">;YEP
NOTRCE: MOV TFLG(R5),TFGTMP(R5) ;SAVE TRACE FLAG
CLR TFLG(R5) ;THEN TURN OFF TRACE
1$: RTS PC ;EXIT
.DSABL LSB
ENTRCE: MOV TFGTMP(R5),TFLG(R5) ;RESTORE TRACE FLAG
RTS PC ;AND EXIT
.ENABL LSB
20$: MOV #1,R0 ;PRETEND WE SAW A ONE
JSR PC,NCOM ;AND COMPUTE ON IT
GETN: MOV N(R5),R0 ;GET THE NUMBER
INC NFLG(R5) ;REALLY THERE?
BNE 20$ ;NOPE
RTS PC ;YES
.DSABL LSB
.ENABL LSB
TERMS: CMP R0,#FF+1 ;TERMINATOR TEST
BHIS 11$ ;TOO BIG, RETURN C=0
10$: CMP #LF-1,R0 ;SET CARRY ON LOW RANGE
11$: RTS PC ;AND EXIT
NUMER: CMP R0,#'9+1 ;NUMERIC TEST
BHIS 1$ ;RETURN CARRY CLEAR IF HIGH
CMP #'0-1,R0 ;SET CARRY ON LOW RANGE
1$: RTS PC ;AND EXIT
RAD50: CMP R0,#'. ;.?
BEQ 10$ ;YES
CMP R0,#'$ ;$?
BEQ 10$ ;YES
ALPHAN: JSR PC,NUMER ;CHECK FOR NUMERIC FIRST
BCS 2$ ;EXIT IF SO
ALPHA: JSR PC,UPPERC ;CHECK FOR ALPHABETIC
CMP R0,#'Z+1 ;ALPHABETIC TEST
BHIS 2$ ;RETURN C=0 IF TOO HIGH
CMP #'A-1,R0 ;SET CARRY ON LOW RANGE
2$: RTS PC ;AND EXIT
TSTNXT: MOV (R5),R0 ;GET COMMAND POINTER
CMP R0,QLENGT(R5) ;END OF COMMAND?
BHIS 20$ ;YES, SO EXIT (C=0)
ADD QBASE(R5),R0 ;NO, ADD COMMAND OFFSET
ADD QRSTOR(R5),R0 ;AND MAKE ABSOLUTE
MOVB (R0),R0 ;FETCH CHARACTER
JSR PC,UPPERC ;AND MAKE UPPER CASE
CMP R0,(R4) ;MATCH?
BNE 20$ ;NO, EXIT (C=0)
INC (R5) ;YES, BUMP POINTER
TST (R4)+ ;SKIP ARGUMENT
SEC ;INDICATE ALL OK
RTS R4 ;AND EXIT
20$: TST (R4)+ ;SKIP ARGUMENT
RTS R4 ;AND EXIT
.DSABL LSB
NLINES: INC CFLG(R5) ;WAS THERE A COMMA?
BEQ 1$ ;YES
CLR CFLG(R5)
MOV P(R5),M(R5) ;NO, SO SAVE . IN "M"
JSR PC,@'L*2+TECOCH ;AND MOVE . FORWARD "N" LINES
MOV P(R5),N(R5) ;"N" IS THE NEW .
MOV M(R5),P(R5) ;RESTORE THE ORIGINAL .
1$: CLR NFLG(R5) ;USE UP THE NUMBER
MOV N(R5),R0 ;GET NTH CHARACTER POSITION
CMP R0,M(R5) ;IS IT AFTER MTH CHARACTER?
BHIS 2$ ;YES
MOV M(R5),N(R5) ;NO, SO SWITCH
MOV R0,M(R5) ; N AND M
MOV N(R5),R0 ;AND GET NTH POSITION AGAIN
2$: JSR PC,BZCHK ;IN RANGE?
SUB M(R5),R0 ;FIND DISTANCE BETWEEN N AND M
RTS PC ;THEN EXIT
ZEROD: MOV (R4)+,TEMP(R5) ;PICKUP OUTPUT ROUTINE ADDRESS
MOV R4,(SP) ;THEN SET THE RETURN ADDRESS
MOV N(R5),-(SP) ;GET NUMBER
BPL 1$ ;IT IS +
TST NMRBAS(R5) ;IT IS -, BUT IS RADIX OCTAL?
BNE 1$ ;IF OCTAL, THEN NO SIGN
MOV #'-,R0 ;IF DECIMAL, THEN SIGNED
JSR PC,@TEMP(R5) ;OUTPUT MINUS SIGN
NEG (SP) ;AND MAKE +
1$: MOV (SP)+,R0 ;RESTORE THE NUMBER
MOV #8.,R2 ;RADIX = 8?
TST NMRBAS(R5) ;THIS TELLS US...
BNE 2$ ;YES
TST (R2)+ ;NO, RADIX = 10.
2$: JSR PC,DIVD ;NOW DIVIDE
MOV R1,-(SP) ;SAVE REMAINDER
TST R0 ;MORE TO GO?
BNE 2$ ;YES
3$: MOV (SP)+,R0 ;GET BACK A DIGIT
CMP R0,#9. ;DIGIT OR RETURN ADDRESS?
BHI 4$ ;RETURN ADDRESS
ADD #'0,R0 ;DIGIT
JSR PC,@TEMP(R5) ;OUTPUT IT
BR 3$ ;AND LOOP
4$: JMP (R0) ;EXIT
.SBTTL SEARCH
.ENABL LSB
SEARCH: CMP #-2,CLNF(R5) ;"::" MODE?
BNE 2$ ;NO
MOV #-1,CFLG(R5) ;YES--FAKE AN ARG OF "1,"
MOV #1,M(R5)
2$: MOV XFLAG(R5),-(SP) ;SAVE SEARCH MATCH FLAG
JSR PC,GETN ;GET THE NUMBER
MOV R0,-(SP) ;NOW SAVE THE NUMBER
BNE 1$ ;MUSTN'T BE ZERO
ERROR ISA <%ILLEGAL SEARCH ARGUMENT%>
1$: JSR PC,QCHK ;SET UP FOR ANY QUOTED STRING
MOV SCHBUF(R5),R4 ;GET SEARCH BUFFER START
MOV #SCHSIZ-1,R3 ; AND ITS SIZE
5$: CLR R2 ;GET INPUT FROM SCAN
10$: TST R2 ;WHERE DO THEY COME FROM?
BNE 25$ ;A Q-REG IF NON-0
JSR PC,SCAN ;PICKUP A CHARACTER TO SEARCH FOR
CMP R0,QUOTE(R5) ;END OF SEARCH STRING?
BEQ 50$ ;YES
CMP R0,#'^ ;CARAT?
BNE 11$ ;NO
BIT #1,EDFLAG(R5) ;SPECIAL TREATMENT FOR IT?
BNE 11$ ;NO
JSR PC,SCNUPP ;GET NEXT AS UPPER CASE
BIC #-77-1,R0 ;AND CONVERT TO CONTROL CODE
11$: CMP R0,#'Q-100 ;CTRL/Q?
BNE 30$ ;NOPE
JSR PC,SCAN ;YES, SO GET NEXT LITERALLY
BR 40$ ;AND STORE IT IN SEARCH BUFFER
20$: TST R2 ;^E - ARE WE IN Q-REG FETCH?
BNE 35$ ;YES, USE AS NORMAL ^E
TSTNXT 'Q ;NO, IS IT Q-REG FETCH?
MOV #'E-100+200,R0 ;RESTORE IT AS CTRL/E
BCC 40$ ;NO, ENTER IT AS SPECIAL
JSR PC,QREF ;YES, REFERENCE THE Q-REG
ADD QRSTOR(R5),R2 ;MAKE SOURCE ABSOLUTE
MOV (R1),R1 ;GET THE COUNT IN R1
25$: DEC R1 ;ANYTHING LEFT IN Q-REG?
BMI 5$ ;NO, GO CLEAR FLAG
MOVB (R2)+,R0 ;YES, GET A BYTE
30$: CMP R0,#' ;LARGER THAN SPACE?
BHIS 33$
CMP R0,#'E-100 ;CTRL/E?
BEQ 20$ ;YES
CMP R0,#'N-100 ;CTRL/N?
BEQ 35$ ;YES, THAT IS SPECIAL
CMP R0,#'S-100 ;CTRL/S?
BEQ 35$ ;YES, THAT IS SPECIAL
CMP R0,#'X-100 ;CTRL/X?
BEQ 35$ ;YES, THAT IS SPECIAL
CMP R0,#'\-100 ;CTRL-\?
BNE 40$ ;NOPE--NORMAL SEARCH CHARACTER
TST XFLAG(R5) ;ANY CASE MODE?
BEQ 34$
CLR XFLAG(R5) ;FORCE ANY CASE MODE
BR 10$
34$: INC XFLAG(R5) ;FORCE EXACT CASE MODE
BR 10$
33$: TST XFLAG(R5) ;EXACT MODE?
BNE 40$ ;GOOD-SAVES TIME
JSR PC,ALPHA ;UPCASES IF ALPHA
BCC 40$ ;NOT ALPHA->NOT SPECIAL
CMPB #'E+100,-1(R4) ;IS THIS AFTER ^E?
BEQ 40$ ;THEN LEAVE IT ALONE
35$: BIS #200,R0 ;FLAG THE SPECIAL CHARACTERS
40$: MOVB R0,(R4)+ ;STORE IN SEARCH BUFFER
MOVB #-1,(R4) ; AND MARK END OF BUFFER
DEC R3 ;MORE ROOM?
BGT 10$ ;YES, SO CONTINUE
ERROR STL,<%SEARCH STRING "%<-1>%" TOO LARGE%>
50$: MOV (SP)+,R2 ;GET THE REPEAT COUNT
TST M(R5) ;MAKE M= ABS(M)
BGE .SURCH
NEG M(R5)
.DSABL LSB
.ENABL LSB
.SURCH: MOV P(R5),-(SP) ;SAVE POINTER LOCATION
MOV #1,-(SP) ;GUESS AT FORWARD TYPE SEARCH
TST R2 ;GOOD GUESS??
BPL 30$ ;YES, MOVE . BY +1 EACH FAILURE
NEG (SP) ;NO, MOVE . BY -1 EACH FAILURE
NEG R2 ;AND GET A POSITIVE HIT COUNTER
30$: CLR LSCHSZ(R5) ;SET LAST STRING SIZE TO 0
MOV P(R5),R1 ;GET .
ADD TXSTOR(R5),R1 ;AND MAKE IT ABSOLUTE
ADD TXSTOR(R5),ZZ(R5) ;NOW MAKE END OF TEXT ABSOLUTE ALSO
40$: MOV R1,R3 ;GET STARTING POINT
MOV SCHBUF(R5),R4 ;AND SEARCH STRING START
.SUR.Y: CMP R3,ZZ(R5) ;END OF TEXT?
BLO 50$ ;NOPE
CMPB (R4),#-1 ;YEP, BUT DOES IT MATCH END OF STRING?
BEQ 62$ ;YES, SO ALL DONE (FOUND)
TST (SP) ;NO, SEARCHING BACKWARDS??
BMI .SUR.N ;IF BACKWARDS THEN MOVE . IF POSSIBLE
47$: CLRB (SP) ;INDICATE FAILURE (0 OR 177400)
TST CFLG(R5) ;BOUNDED SEARCH?
BMI 65$ ;YES, SO KEEP .
BIT #16.,EDFLAG(R5) ;FAILING SEARCH ALWAYS PRESERVE .?
BNE 65$ ;BRANCH IF SO
CLR 2(SP) ;NO, SO .=0
BR 65$ ;AND EXIT
50$: MOVB (R4)+,R0 ;GET A STRING CHARACTER
BMI 60$ ;IT WAS A SPECIAL
CMPB R0,(R3)+ ;MATCH?
BEQ .SUR.Y ;YES, SO CONTINUE
.SUR.N: ADD (SP),R1 ;NOPE, MOVE . ONE POSITION
MOV #-1,R4 ;SIZE OF ENTRY
54$: TST CFLG(R5) ;SPECIAL SEARCH?
BGE 55$ ;NO--CONTINUE
TST M(R5) ;UNLIMITED BOUND?
BEQ 55$ ;YES--CONTINUE
ADD R4,M(R5) ;ADJUST LIMIT
BLE 47$ ;LIMIT REACHED--SEARCH FAILS
55$: CMP R1,TXSTOR(R5) ;NO, IS . TOO SMALL NOW??
BHIS 40$ ;. IS O.K., KEEP SEARCHING
BR 47$ ;. IS TOO SMALL, SEARCH FAILS
60$: INCB R0 ;WAS SPECIAL THE END FLAG?
BNE .SUR.S ;NOPE, REAL SPECIAL
62$: MOV R1,PST(R5) ;SAVE (ABS) STARTING POSITION
MOV R1,R4 ;COPY (ABS) START AGAIN TO
SUB R3,R4 ;GET "START"-"END" = -("LENGTH")
MOV R3,R1 ;SET NEXT START IF FORWARDS
TST (SP) ;IS SEARCH GOING FORWARDS??
BPL 63$ ;YES, SO NEW START IS SET
ADD R4,R1 ;NO, BACKWARDS, SO GO BACK AND
ADD R4,R1 ; BACK AGAIN FOR NEW START
63$: DEC R2 ;SEARCH ANOTHER TIME??
BGT 54$ ;YES, SO SEARCH AGAIN ALREADY
MOV R4,LSCHSZ(R5) ;NO, DONE, STORE -("LENGTH")
SUB TXSTOR(R5),R3 ;MAKE ENDING . RELATIVE
MOV R3,2(SP) ; AND SET THAT ENDING .
SUB TXSTOR(R5),PST(R5) ;MAKE STARTING . RELATIVE
MOV #-1,(SP) ;INDICATE SUCCESS (-1)
65$: SUB TXSTOR(R5),ZZ(R5) ;MAKE END OF TEXT RELATIVE
MOV (SP)+,R1 ;SET CC'S AND RETURN INDICATOR
MOV (SP)+,P(R5) ;SET POINTER
MOV (SP)+,XFLAG(R5) ;RESTORE FLAG
TST R1 ;SET CC'S
RTS PC ;AND EXIT
.DSABL LSB
SUR.Y: TST (SP)+ ;ARE WE IN NEG MODE?
BEQ .SUR.Y ;NO
BR .SUR.N ;YES--SEARCH FAILED!
SUR.N: TST (SP)+ ;ARE WE IN NEG MODE?
BEQ .SUR.N ;NO
BR .SUR.Y ;YES--TAKE ALTERNATE EXIT
.SUR.S: CLR -(SP) ;NEG FLAG
74$: CMPB R0,#'A+200+1 ;IS IT ANYCASE ALPHA?
BHIS 95$
CMPB R0,#'S-100+200+1 ;WAS SPECIAL CTRL/S?
BEQ 80$ ;YES (IT IS CTRL/S)
BHI 85$ ;NO (IT IS CTRL/X)
CMPB R0,#'E-100+200+1 ;NO, IS IT CTRL/E?
BEQ 81$ ;YES
MOVB (R4)+,R0 ;NO (IT IS CTRL/N)
BMI 75$ ;NEXT AS SPECIAL IS VERY SPECIAL
TST (SP)+ ;GET RID OF RETURN ITEM
CMPB R0,(R3)+ ;MATCH? (CTRL/N)
BNE .SUR.Y ;NO MATCH IS GOOD HERE
BR .SUR.N ;MATCH IS BAD...
75$: COM (SP) ;REVERSE NEGATE SENSE
INCB R0 ;TEST VALUE OF COMPARAND
BNE 74$ ;VALID CHARACTER--GO TO IT
TST (SP)+ ;END OF STRING
BR .SUR.Y ;CALL A MATCH
76$: MOVB (R3)+,R0 ;GET A TEXT CHATACTER
JSR PC,@(SP)+ ;GO TEST CHARACTER
78$: INC R4 ;BUMP SEARCH BUFFER POINTER
BCS SUR.Y ;MADE IT
BR SUR.N ;NO GO
80$: MOVB (R3)+,R0 ;GET A TEXT CHARACTER
JSR PC,ALPHAN ;ALPHANUMERIC?
BCC SUR.Y ;NO, SO OK
BR SUR.N ;YES, SO NO
81$: CMPB (R4),#'[ ;CTRL/E AND "["?
BEQ 90$
CMPB (R4),#'S ;CTRL/E AND "S"?
BEQ 87$ ;YES
MOV #ALPHA,-(SP) ;SET FOR A
CMPB (R4),#'A ;A?
BEQ 76$ ;YES
MOV #RAD50,(SP) ;SET FOR C
CMPB (R4),#'C ;C?
BEQ 76$ ;YES
MOV #NUMER,(SP) ;SET FOR D
CMPB (R4),#'D ;D?
BEQ 76$ ;YES
MOV #TERMS,(SP) ;SET FOR L
CMPB (R4),#'L ;L?
BEQ 76$ ;YES
MOV #ALPHAN,(SP) ;ALPHANUMRIC MATCH?
CMPB (R4),#'R
BEQ 76$
TST (SP)+ ;NO, POP ADDRESS
CMPB (R4),#'X ;X?
84$: BNE SUR.N ;NOTHING, SAY NO MATCH
INC R4 ;CTRL/E & X MEAN ANY MATCH
85$: INC R3 ;CTRL/X IS ANY MATCH
BR SUR.Y ;INDICATE SUCCESS
87$: MOV R3,-(SP) ;SAVE POINTER TO TEXT
88$: CMP R3,ZZ(R5) ;END OF TEXT?
BHIS 89$ ;YES, QUIT
MOVB (R3)+,R0 ;NO, GET CHARACTER
CMP R0,#SPACE ;SPACE?
BEQ 88$ ;YES
CMP R0,#TAB ;TAB?
BEQ 88$ ;YES
89$: DEC R3 ;CORRECT TEST POINTER
CMP (SP)+,R3 ;AND CHECK FOR NON-NULL
BR 78$ ;NOW EXIT
90$: INC R4
91$: TSTB (R4) ;IS THIS AN EXACT CASE MATCH?
BMI 94$
CMPB (R3),(R4)+ ;DOES CHAR MATCH?
96$: BEQ 92$ ;YES--GOTO FINISH CODE
CMPB #'],(R4) ;NOT FOUND?
BEQ 97$ ;CARRY IS CLEAR
CMPB #-1,(R4) ;END OF BUFFER?
BNE 91$ ;NO-CONTINUE
97$: INC R3 ;FINISHED (POINT PAST CHAR)
BR 78$ ;FINISHED (CARRY CLEAR)
92$: CMPB #'],(R4) ;SEARCH FOR END
BEQ 93$
CMPB #-1,(R4)+ ;END OF BUFFER
BNE 92$
DEC R4 ;CORRECT POINTER
93$: INC R4
BR 85$ ;FINISHED (MATCHED)
94$: MOVB (R3),R0 ;UPCASE COMPARAND
JSR PC,UPPERC
MOVB (R4)+,-(SP) ;DO SOME STACK ARITHMETIC
BIC #200,(SP) ;CLEAR FLAG BIT
CMPB R0,(SP)+ ;IS THERE A MATCH?
BR 96$
95$: SUB #200+1,R0 ;GET BACK AS UC ASCII CHAR
CMPB (R3),R0 ;IS IT A MATCH?
BEQ 85$
BIS #40,R0 ;CHECK FOR UPPERCASE
CMPB R0,(R3)+
BNE SUR.N ;NO MATCH
JMP SUR.Y ;MATCH
.SBTTL SIZING (SHUFFLING) ROUTINE
SIZE: MOV R0,-(SP) ;SAVE R0
MOV (R4)+,R0 ;GET OFFSET TO MAX TO CHANGE
CMP R1,#077740 ;IS REQUEST AT ALL REASONABLE?
BHIS 99$ ;NOPE [BHIS=BCC => FAILURE]
MOV R1,-(SP) ;SAVE R1
MOV R2,-(SP) ; AND SAVE R2
MOV R0,R2 ;SAVE THE MAX'S OFFSET VALUE
ADD R5,R0 ;MAKE R0 ABS PTR TO MAX
SUB (R0),R1 ;FIND CHANGE AMOUNT
BLO 98$ ;ALREADY DONE [BLO=BCS => OK]
ADD #40,R1 ;FUDGE UP REQUEST A LITTLE
MOV R3,-(SP) ;SAVE R3
SUB #ZMAX,R2 ;GET WHICH AREA IS CHANGING
MOV R2,-(SP) ;0=>TEXT; <>0=>QREGS
MOV R1,-(SP) ;SAVE ORIGINAL DELTA AMOUNT
JSR PC,40$ ;SEE IF CURRENT FREE DOES IT
MOV #QMAX,R2 ;NO, SO GET OTHER AREA'S MAX
MOV QZ(R5),R3 ; AND CURRENT IN USE
TST 2(SP) ;QREGS ARE OTHER AREA IF 0
BEQ 1$ ;WE ARE CHANGING TEXT
MOV #ZMAX,R2 ;ELSE GET REAL OTHER AREA'S
MOV ZZ(R5),R3 ; MAX AND CURRENT IN USE
1$: NEG R3 ;GET -(IN USE)
ADD R5,R2 ;ABS PTR TO OTHER MAX
ADD (R2),R3 ;FREE = MAX -(IN USE)
SUB #200.,R3 ;FIND THE PUNISH AMOUNT
BLOS 10$ ;NOT ENOUGH FREE TO PUNISH
SUB R3,(R2) ;ELSE PUNISH THE OTHER MAX
ADD R3,CURFRE(R5) ;AND UPDATE FREE SPACE
TST 2(SP) ;WHICH AREA ARE WE CHANGING
BEQ 3$ ;IF TEXT, THEN JUST PUNISHED QREGS
MOV QRSTOR(R5),R2 ;PTR TO OLD BEG
NEG R3 ;-(PUNISH)
ADD R2,R3 ;PTR TO NEW BEG (LOWER)
MOV R3,QRSTOR(R5) ;SET NEW BEGINNING
MOV R4,-(SP) ;SAVE R4
MOV R2,R4 ;PTR TO OLD BEG
ADD QMAX(R5),R4 ;PTR TO OLD END +1
MOVB -(R4),-(SP) ;SAVE @ OLD END
CLRB (R4) ;THEN FLAG IT AS NULL BYTE
2$: MOVB (R2)+,(R3)+ ;FROM OLD BEG TO NEW BEG
BNE 2$ ;CANNOT BE END IF NON-NULL
CMP R2,R4 ;OLD BEG+? CAUGHT OLD END??
BLOS 2$ ;NOT YET
MOVB (SP)+,-(R3) ;YES, SO RESTORE @ NEW END
MOV (SP)+,R4 ;RESTORE R4
3$: JSR PC,40$ ;WILL FREE SPACE DO IT NOW?
10$: JSR PC,SIZER ;ASK WHOEVER FOR MORE PLEASE
BCC 3$ ;WE GOT IT!
MOV (SP)+,R3 ;GET BACK ORIGINAL DELTA
SUB R1,R3 ;FIND WHAT WE GAVE OF FREE SPACE
ADD R3,CURFRE(R5) ;AND RETURN IT TO FREE SPACE
TST (SP)+ ;DUMP THE AREA DETERMINATION
BR 97$ ;AND EXIT
40$: MOV CURFRE(R5),R3 ;GET CURRENT FREE AMOUNT
CMP R1,R3 ;WILL IT DO THE TRICK?
BHI 41$ ;NOPE, BUT WILL HELP SOME
MOV R1,R3 ;YEP, SO DON'T USE IT ALL
41$: SUB R3,CURFRE(R5) ;WE GAVE AT THE OFFICE
SUB R3,R1 ;CORRECT DELTA CHANGE AMOUNT
BEQ 50$ ;ALL DONE
RTS PC ;ELSE RETURN FOR MORE WORK
50$: TST (SP)+ ;DUMP THE RETURN ADDRESS
MOV (SP)+,R1 ;GET ORIGINAL DELTA
ADD R1,(R0) ;AND CORRECT THE MAX
TST (SP) ;WHICH AREA IS CHANGING?
BNE 96$ ;QREGS, SO VERY EASY
MOV QRSTOR(R5),R0 ;TEXT, SO GET OLD BEG PTR
ADD R1,QRSTOR(R5) ;UPDATE QREG PTR
MOV R0,R2 ;COPY OLD BEG PTR
ADD QMAX(R5),R0 ;HAVE OLD END PTR +1
ADD R0,R1 ;HAVE NEW END PTR +1 (HIGHER)
MOVB (R2),R3 ;SAVE @ OLD BEG
CLRB (R2) ;THEN FLAG AS A NULL BYTE
51$: MOVB -(R0),-(R1) ;MOVE OLD END TO NEW END
BNE 51$ ;CANNOT BE END IF NON-NULL
CMP R2,R0 ;CAUGHT UP YET?
BLO 51$ ;NOPE, SO CONTINUE
MOVB R3,(R1) ;RESTORE @ NEW BEG
96$: COM (SP)+ ;DUMP AREA FLAG AND CARRY=1
97$: MOV (SP)+,R3 ;RESTORE R3
98$: MOV (SP)+,R2 ; AND R2
MOV (SP)+,R1 ; AND R1
99$: MOV (SP)+,R0 ; AND R0
RTS R4 ;FINALLY EXIT
.SBTTL CHARACTER LIST FOR " COMMANDS
.TABLE .CND
.ENTRY A
.ENTRY C
.ENTRY D
.ENTRY E
.ENTRY F
.ENTRY G
.ENTRY L
.ENTRY N
.ENTRY R
.ENTRY S
.ENTRY T
.ENTRY U
.WORD -1
.SBTTL CHARACTER LIST FOR E COMMANDS
.TABLE .EEE
.word '!,.eeesh ;ENTRY !
.ENTRY B
.ENTRY C
.ENTRY D
.ENTRY F
.ENTRY G
.ENTRY H
.ENTRY I
.ENTRY K
.ENTRY O
.ENTRY Q
.ENTRY R
.ENTRY S
.ENTRY T
.ENTRY V
.ENTRY W
.ENTRY X
.WORD -1
.SBTTL COMMAND CHARACTER LIST
.TABLE .CMD
.WORD BELL, .CMDBL
.WORD BS, .CMDBS
.WORD LF, .CMDLF
.WORD 'U-100, .CMDCU
.WORD ALTMOD, .CMDAM
.WORD SPACE, .CMDSP
.WORD '*, .CMDST
.WORD '?, .CMDQM
.WORD -1
.SBTTL CHARACTER TABLES FOR "SKPSET"
.TABLE .CSM
.WORD 'A-100, .CSMY ;CTRL/A
.WORD 'I-100, .CSMQ ;TAB
.WORD 'U-100, .CSMU ;CTRL/U
.WORD '^-100, .CSMD ;CTRL/^
.WORD '!, .CSMY ;!
.WORD '", .CSMDQ ;"
.WORD '%, .CSMD ;%
.WORD '<, .CSMI ;<
.WORD '>, .CSMO ;>
.WORD '@, .CSMA ;@
.WORD 'E, .CSME ;E (E!, EB, EI, ER, EW)
.WORD 'F, .CSMF ;F (FR, FS, FN, FB, FC)
.WORD 'G, .CSMD ;G
.WORD 'I, .CSMQ ;I
.WORD 'M, .CSMD ;M
.WORD 'N, .CSMQ ;N
.WORD 'O, .CSMQ ;O
.WORD 'Q, .CSMD ;Q
.WORD 'S, .CSMQ ;S
.WORD 'U, .CSMD ;U
.WORD 'X, .CSMD ;X
.WORD '[, .CSMD ;[
.WORD '], .CSMD ;]
.WORD '^, .CSMUA ;^
.WORD '_, .CSMQ ;_
.WORD -1
.TABLE .CSME
.word '!, .csmq ;E!
.WORD 'B, .CSMQ ;EB
.WORD 'I, .CSMQ ;EI
.WORD 'R, .CSMQ ;ER
.WORD 'W, .CSMQ ;EW
.WORD -1
.TABLE .CSMF
.WORD 'B, .CSMQ ;FB
.WORD 'C, .CSM2Q ;FC
.WORD 'N, .CSM2Q ;FN
.WORD 'R, .CSMQ ;FR
.WORD 'S, .CSM2Q ;FS
.WORD -1
.SBTTL F CHARACTER LIST
.TABLE .FFF
.word '',.fffq
.word '<,.fffla
.word '>,.fffra
.ENTRY B
.ENTRY C
.ENTRY N
.ENTRY R
.ENTRY S
.word vbar,.fffvb
.WORD -1
.SBTTL FINAL FIXUPS...
.PSECT TECOER
.EVEN
.END