Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/rts/txbl.mac
There is 1 other file named txbl.mac in the archive. Click here to see a list.
SUBTTL TEXT HANDLING
SEARCH SIMMAC,SIMMCR,SIMRPA
SALL
RTITLE TXBL
SUBTTL Text procedures for Blanks, Strip, Sub, T1 := T2
ERRMAC TX
MACINIT
TWOSEG
RELOC 400K
COMMENT ;
AUTHOR: ELISABETH $LUND
VERSION: 1
PURPOSE: Contains those text handling routines used by OCIN and IONF
CONTENTS:
;
INTERN .TXBL ;BLANKS
INTERN .TXST ;STRIP
INTERN .TXSU ;SUB
INTERN .TXVA ;Text value assignment T1:=T2
QTXW=30
QTXE=1
EXTERN .CSRA ;RESTORE ACCUMULATORS
EXTERN .CSSA. ;SAVE ACCUMULATORS
EXTERN .SAAR ;ALLOCATE RECORD
SUBTTL MACROS AND OPDEFS
DEFINE RESULT <
SKIPE XSAC,YCSZAC(XLOW)
EXEC .CSRA
CENABLE
RETURN
>
DEFINE INIT2 <EXCH XWAC1,(XTAC)
EXCH XWAC2,1(XTAC)
>
DEFINE EXIT2 <EXCH XWAC2,1(XTAC)
EXCH XWAC1,(XTAC)
RETURN
>
DEFINE INIT3 <EXCH XWAC1,(XTAC)
EXCH XWAC2,1(XTAC)
EXCH XWAC3,2(XTAC)
>
DEFINE EXIT3 <EXCH XWAC3,2(XTAC)
EXCH XWAC2,1(XTAC)
EXCH XWAC1,(XTAC)
RETURN
>
DEFINE INIT4 <IF CAIN XTAC,XWAC1
GOTO FALSE
THEN EXCH XWAC1,(XTAC)
EXCH XWAC2,1(XTAC)
EXCH XWAC3,2(XTAC)
EXCH XWAC4,3(XTAC)
FI
>
DEFINE EXIT4 <IF CAIN XTAC,XWAC1
GOTO FALSE
THEN EXCH XWAC4,3(XTAC)
EXCH XWAC3,2(XTAC)
EXCH XWAC2,1(XTAC)
EXCH XWAC1,0(XTAC)
FI
RETURN
>
SUBTTL TXBL
COMMENT ;
PURPOSE: IMPLEMENT STANDARD TEXT PROCEDURE BLANKS
ENTRY: .TXBL
INPUT ARGUMENTS: REG Xtop CONTAINING LENGTH OF TEXT
NORMAL EXIT: RETURN
ERROR EXIT: -
CALL FORMAT: EXEC .TXBL
;
.TXBL: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
IF ;Any intermediate results
SKIPN XSAC,@(XPDP)
GOTO FALSE
THEN ;Save them, put text length in XWAC1
HLRZ XTAC,XSAC
STACK XWAC1(XTAC)
EXEC .CSSA.
UNSTK XWAC1
FI
AOS (XPDP)
IF ;Not NOTEXT
JUMPE XWAC1,FALSE
THEN
WHILE ;Length < 0 or > 2^18-1 ? [41]
TLNN XWAC1,-1 ;[41]
GOTO FALSE ;[41]
DO ;[41]
;[41]:
TXERC QDSNIN,15,BLANKS: Parameter out of range
NEWVALUE XWAC1 ;[41]
OD
;COMPUTE RECORD LENGTH (WORDS)
LI XSAC,5*ZTE%S+5-1
ADD XSAC,XWAC1
IDIVI XSAC,5
L XTAC,XSAC
HRLI XTAC,QZTE
;[41] The following two instructions were
;moved to precede the .SAAR call:
L X0,[ASCII/ /]
ST X0,YSANIN(XLOW) ;initiate value for SAAR
EXEC .SAAR ;ALLOCATE TEXT RECORD
IFN QSADEA,< ;UPDATE YSADEA IN DEALLOCATE VER.
L X0,YSATOP(XLOW)
ST X0,YSADEA(XLOW)
>
SF XWAC1,ZTECLN(XTAC)
;Note: the following code relies on the following text variable
;format: XWD ZTVSP,ZTVZTE
; XWD ZTVLNG,ZTVCP
MOVSI XWAC2,(XWAC1) ;ZTVLNG=XWAC1, ZTVCP=0 (POS=1)
LI XWAC1,(XTAC) ;ZTVSP=0, ZTVZTE=XTAC
ELSE ;NOTEXT is the answer
SETZB XWAC1,XWAC2
FI
RESULT
EPROC
SUBTTL TXST
COMMENT ;
PURPOSE: IMPLEMENT STANDARD FUNCTION STRIP
ENTRY: .TXST
INPUT ARGUMENTS: REG XTAC CONTAINING NUMBER OF XTOP
XTOP CONTAINING TEXT REFERENCE
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: XTOP, XTOP+1
CALL FORMAT: EXEC .TXST
;
.TXST: PROC
INIT2
STACK XWAC3
STACK XWAC4
STACK XWAC5
;COMPUTE ADDRESS OF WORD CONTAINING LAST CHARACTER
LI X1,ZTE%S(XWAC1)
LF XWAC4,ZTVSP(,XWAC1)
LF X0,ZTVLNG(,XWAC1)
JUMPE X0,L2 ;NOTEXT if length=0
ADD XWAC4,X0
;COMPUTE NUMBER OF WORDS IN TEXT
IDIVI XWAC4,5
ADD X1,XWAC4
IF
JUMPE XWAC5,FALSE
THEN
;LAST CHARACTER IN TEXT DOES NOT TERMINATE A FULL WORD
L XWAC3,(X1)
XCT TXRSH(XWAC5) ;SHIFT OUT IRRELEVANT CHARACTERS
CAME XWAC3,YTXBLW(XWAC5)
GOTO L1 ;ALL WERE NOT BLANK
;ALL WERE BLANK, ACCOUNT FOR THEM
SUB X0,XWAC5
JUMPLE X0,L2 ;[57] NOTEXT if no more char's
FI
LOOP ;CHECK FOR FULL WORDS OF BLANKS
SUBI X1,1
L XWAC3,(X1)
AS
CAME XWAC3,[ASCII / /]
GOTO FALSE
SUBI X0,5
JUMPG X0,TRUE
;All characters are used up, we have NOTEXT
GOTO L2
SA
LSH XWAC3,-1
;Look for blanks at end of current word. Modify count of non-blanks.
L1():! SETZ XWAC4,
LOOP
LSHC XWAC3,-7
AS
TLC XWAC4,(" "B6)
JUMPN XWAC4,FALSE
SOJG X0,TRUE
SA
;LENGTH VALUE, POS=1
HRLZ XWAC2,X0
SKIPN XWAC2
L2():! SETZB XWAC1,XWAC2 ;NOTEXT IF LENGTH=0
;RESTORE REGS
UNSTK XWAC5
UNSTK XWAC4
UNSTK XWAC3
EXIT2
EPROC
;SHIFT OUT CHARACTERS THAT DO NOT BELONG TO TEXT
;INDEX BY XWAC5=NUMBER OF CHARACTERS TO KEEP (1-4)
TXRSH== .-1
LSH XWAC3,-<1+4*7>
LSH XWAC3,-<1+3*7>
LSH XWAC3,-<1+2*7>
LSH XWAC3,-<1+1*7>
;PARTIALLY BLANK WORDS - INDEX BY NUMBER OF CHARACTERS TO MATCH
YTXBLW==.-1
EXP " "," "," "," "
SUBTTL TXSU
COMMENT;
PURPOSE: IMPLEMENT PROCEDURE SUB(P,N)
ENTRY: .TXSU
INPUT ARGUMENTS: XTAC CONTAINING NUMBER OF XTOP
[64] Left half = -1 if no error message is wanted.
Returns NOTEXT on errors if so.
XTOP-XTOP+1 TEXT REFERENCE
XTOP+2 P
XTOP+3 N
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: XTOP AND XTOP+1 CONTAINING NEW TEXT REFERENCE
CALL FORMAT: EXEC .TXSU
;
.TXSU: PROC
INIT4
;[41]:
WHILE ;length negative
JUMPGE XWAC4,FALSE
DO ;run-time error
JUMPL XTAC,L8 ;[64]
TXERC QDSNIN,7,SUB: 2nd parameter out of range
NEWVALUE XWAC4
OD
;End of [41]
IF ;length=0
JUMPG XWAC4,FALSE
THEN ;Return NOTEXT
L8():! SETZB XWAC1,XWAC2
GOTO L9
FI
WHILE ;[41]
SOJGE XWAC3,FALSE ;POS-1 LT 0
DO ;RUNTIME ERROR
JUMPL XTAC,L8 ;[64]
;[41]:
TXERC QDSNIN,6,SUB: 1st parameter out of range
NEWVALUE XWAC3 ;[41]
OD
L7():! ;[41]
;COMPUTE NUMBER OF CHARACTERS IN MAIN TEXT AND SUBTEXT
LF X1,ZTVSP(,XWAC1)
ADD X1,XWAC3 ;NEW STARTING POSITION
LF X0,ZTVLNG(,XWAC1)
;[41]
;CHECK IF TOO LONG SUBFIELD
WHILE
SUBI X0,(XWAC3) ;[41] remaining characters in main text
CAML X0,XWAC4
GOTO FALSE
DO
TXSUER: JUMPL XTAC,L8 ;[64]
;[41]:
LF X0,ZTVLNG(,XWAC1)
IF
;position > length
CAMG XWAC3,X0
GOTO FALSE
THEN
TXERC QDSNIN,6,SUB: 1st parameter out of range
NEWVALUE XWAC3
GOTO L7
FI
TXERC QDSNIN,7,SUB: 2nd parameter out of range
NEWVALUE XWAC4 ;[41]
OD
;CREATE A NEW TEXT REF
HRLZ XWAC2,XWAC4 ;LENGTH = N, POS=1
SF X1,ZTVSP(,XWAC1) ;SP=OLD SP+P-1, ZTE IDENTICAL
;RESTORE REGS
L9():!
EXIT4
EPROC
SUBTTL TXVA
COMMENT;
PURPOSE: TEXT VALUE ASSIGNMENT T1:=T2
ENTRY: .TXVA
INPUT ARGUMENTS: XTAC CONTAINING NUMBER OF XTOP
XTOP-XTOP+1 TEXT VARIABLE T1
XTOP+2-XTOP+3 TEXT VARIABLE T2
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: XTOP ,XTOP+1
CALL FORMAT: EXEC .TXVA
;
;Local definitions: [121]
t1==XWAC1
t2==XWAC3
lt1=XWAC5
lt2==XWAC6
nc==XWAC7
.TXVA: PROC
INIT4
STACK XLOW
LOWADR
CDEFER
LI (t1)
IF ;NOTEXT on l.h.s.
JUMPN X0,FALSE
THEN ;Ok if r.h.s is also NOTEXT
JUMPE t2,L9
ELSE ;[121] Text object must be in the RTS data pool
CAML YSABOT(XLOW)
CAML YSATOP(XLOW)
RTSERR 104 ;Assignment to text constant
FI
STACK XTAC
STACK lt1
STACK lt2
STACK nc
LF lt1,ZTVLNG(,t1) ;t1.Length
LF lt2,ZTVLNG(,t2) ;t2.Length
SUB lt1,lt2
IF ;t2 was too long
JUMPGE lt1,FALSE
THEN ;RUNTIME ERROR
;[41]:
TXERC QDSCON,10,Text assignment: r.h.s. text too long
LI lt1,0 ;[41]
LF lt2,ZTVLNG(,t1);Truncate when user proceeds [41]
FI
;COMPUTE BYTE POINTER TO FIRST BYTE IN T2
LI X2,ZTE%S(t2) ;FIRST WORD OF T2.MAIN
LF ,ZTVSP(,t2)
IDIVI X0,5
ADD X2,TXBY(X1)
ADD X2,X0
;COMPUTE BYTE POINTER TO FIRST BYTE IN T1
LF X0,ZTVSP(,t1)
IDIVI X0,5
L X1,TXBY(X1)
ADDI ZTE%S(t1)
ADD X1,X0
;MOVE TEXT TO T1 FROM T2
IF ;At least one word to be moved
CAIGE lt2,5
GOTO FALSE
TLNN X1,320000 ;AND both T1 and T2 start on fullword
TLNE X2,320000 ;boundary
GOTO FALSE
THEN ;Take advantage of word orientation to move full words
IDIVI lt2,5
EXCH lt2,nc
IF ;At least 3 words
CAIGE nc,3
GOTO FALSE
THEN ;Use BLT
HRL X0,X2
HRR X0,X1
ADD X2,nc
ADD X1,nc
BLT X0,-1(X1)
ELSE ;Move one word at a time
LOOP
L X0,(X2)
ST X0,(X1)
ADDI X1,1
ADDI X2,1
AS
SOJG nc,TRUE
SA
FI
FI
IF ;Any odd characters left to be moved
SOJL lt2,FALSE
THEN ;Copy them one by one
LOOP
ILDB X2
IDPB X1
AS
SOJGE lt2,TRUE
SA
FI
IF ;LEFT HAND TEXT IS LONGER
SOJL lt1,FALSE
THEN ;PAD WITH BLANKS
LI " "
LOOP
IDPB X1
AS
SOJGE lt1,TRUE
SA
FI
;RESTORE REGS
TXVA2:
UNSTK nc
UNSTK lt2
UNSTK lt1
UNSTK XTAC
L9():!
CENABLE
UNSTK XLOW
EXIT4
EPROC
SUBTTL TABLES
TXBY: ;LEFT HAND OF BYTE POINTER BYTE SIZE=7
XWD 440700,0
XWD 350700,0
XWD 260700,0
XWD 170700,0
XWD 100700,0
XWD 010700,0
LIT
END