eric@tekadg.UUCP (eric) (01/05/85)
Okay! Someone sed that teco.m11 got truncated after symbol QSUMY: (QSMUY:?)
thereby resulting in the heartbreaking loss of the last 700 lines of that
worthy program. Sooooo....., in typical tearjerk fashion, the conclusion
is here once again presented. If you missed earlier episodes, tough. Go
harrass me or one of the inveterate pack rats who is always complaining about
a few extra bytes wasted on their infinite net.sources archive tapes by
net.sources.wanted.requests.in.net.sources. Their reverie of quiche, fine-wine
and cheese is made more attractive and warm by occasional intrusions of the
real world.......
--------------------------------------------------------------------------------
.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