Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/17/tx.mac
There are 2 other files named tx.mac in the archive. Click here to see a list.
SUBTTL TEXT HANDLING
SEARCH SIMMAC,SIMMCR,SIMRPA
SALL
RTITLE TX
ERRMAC TX
MACINIT
TWOSEG
RELOC 400K
COMMENT ;
AUTHOR: ELISABETH $LUND
VERSION: 1
PURPOSE: TX CONTAINS ROUTINES FOR TEXT HANDLING
CONTENTS:
;
INTERN .TXCY ;COPY
INTERN .TXDA ;Compute dynamic address of pseudo text variable
INTERN .TXGC ;GETCHAR
INTERN .TXGF ;GETFRAC
INTERN .TXGI ;GETINT
INTERN .TXGR ;GETREAL
INTERN .TXLT ;LOWTEN
INTERN .TXMN ;MAIN
INTERN .TXPC ;PUTCHAR
INTERN .TXPF ;PUTFRAC
INTERN .TXPI ;PUTINT
INTERN .TXPR ;PUTREAL
INTERN .TXPX ;PUTFIX
INTERN .TXRE ;Text value relation
INTERN .TXSE ;SETPOS
EXTERN .CSRA ;Restore accumulators
EXTERN .CSSA. ;Save accumulators
EXTERN .SAAR ;Allocate record
EXTERN .TXVA ;Text value assignment
EXTERN IOTXR ;[41] Return address for INFRAC, ININT and INREAL calls.
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 <INIT2
EXCH XWAC3,2(XTAC)
>
DEFINE EXIT3 <EXCH XWAC3,2(XTAC)
EXIT2
>
DEFINE INIT4 <IF CAIN XTAC,XWAC1
GOTO FALSE
THEN
INIT3
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
>
;[41] Define macro to get the calling routine from the XPDP stack
; at offset NSTK and skip if GET routine
DEFINE GETROU <HRRZ X0,-NSTK(XPDP)
CAIN X0,IOTXR
>
QIOIMG==OFFSET(ZFIIMG) ;[41]
;[41] Define macro to zero IMAGE.POS. File ref is found in (XPDP) stack.
DEFINE ZFIMPO <EXCH X2,NFO-NSTK(XPDP)
ZF ZTVCP(X2,QIOIMG)
EXCH X2,NFO-NSTK(XPDP)
>
SUBTTL TXBD (Binary to decimal)
COMMENT ;
Purpose: Convert binary number to decimal ASCII format
Entry: TXBD
Input arguments: Ac X0 containing current number
Normal exit: RETURN
Output arguments: YTXBN = number of bytes in text
YTXBP = byte pointer to text
Call format: EXEC TXBD
;
TXBD:
PROC
SAVE <X2,X3,X4>
SETZB X2,YTXBN(XLOW)
IF ;Negative number
JUMPGE X0,FALSE
THEN
IF ;Max negative number
CAME X0,[XWD 400000,0]
GOTO FALSE
THEN ;Cannot be converted normally
LD X0,TXMAXNEG
STD X0,YTXB(XLOW)
L X0,TXMAXNEG+2
ST X0,YTXB+2(XLOW)
LI X0,^D12
ST X0,YTXBN(XLOW)
L X3,TXNEGP
GOTO TXBD2
FI
MOVN X0,X0 ;Load magnitude
LI X2,"-" ;Save sign
FI
L X3,[010700,,YTXB+2(XLOW)] ;Pointer to text end byte
LI X4,5 ;Count of bytes in a word
LOOP ;Convert number to ASCII, working backwards in text
IDIVI X0,^D10
ADDI X1,"0"
DPB X1,X3
TXBD1: AOS YTXBN(XLOW) ;Count digits
IF ;Current word filled
SOJG X4,FALSE
THEN ;Modify byte pointer
SUBI X3,1
TLZ X3,777700
TLO X3,010700
LI X4,5 ;Initialise count
ELSE ;Back up pointer one byte
ADD X3,[XWD 070000,0]
FI
AS ;Long as more non-zero digits are available
JUMPN X0,TRUE
SA
IF ;Negative number
JUMPE X2,FALSE
THEN ;Put "-" in front
DPB X2,X3
LI X2,0
GOTO TXBD1
FI
TXBD2:
ST X3,YTXBP(XLOW)
RETURN
EPROC
SUBTTL TXCY
Comment ;
Purpose: Implement standard TEXT PROCEDURE Copy
Entry: .TXCY
Input arguments: See call format
Normal exit: RETURN
BRANCH .CSRA if YCSZAC non-zero
Error exit:
Output arguments: Text variable in XWAC1+n, XWAC1+n+1 (see below)
Call format: Text variable in XWAC1+n,XWAC1+n+1
EXEC .TXCY
XWD n,admap
;
.TXCY: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
STD XWAC1,YTXZTV(XLOW)
SKIPE XSAC,@(XPDP)
EXEC TXSA
AOS (XPDP) ;Account for inline parameter
LD XWAC3,YTXZTV(XLOW)
LF XSAC,ZTVLNG(,XWAC3)
IF ;Not NOTEXT
JUMPE XSAC,FALSE
THEN ;Make a copy
ADDI XSAC,5*ZTE%S+5-1
IDIVI XSAC,5
L XTAC,XSAC
HRLI XTAC,QZTE
SETOM YSANIN(XLOW)
EXEC .SAAR
LD XWAC3,YTXZTV(XLOW) ;May be changed by g.c.
IFN QSADEA,< ;Update YSADEA in deallocate version
L X0,YSATOP(XLOW)
ST X0,YSADEA(XLOW)
>
HLLZ XWAC2,YTXZTV+1(XLOW)
HLLM XWAC2,OFFSET(ZTECLN)(XTAC)
;Create text variable
WSF XTAC,ZTVZTE(,XWAC1)
LI XTAC,XWAC1
EXEC .TXVA
ELSE ;Return NOTEXT
SETZB XWAC1,XWAC2
FI
SETZM YTXZTV(XLOW)
RESULT
EPROC
SUBTTL .TXDA
; Purpose: To generate a pseudo text variable to stand for a
; text expression.
; Input: According to the calling sequence:
; EXEC TXDA
; XWD n,acs map address
; a text descriptor for the expression is in Xtop & Xtop+1,
; where Xtop=XWAC1+n.
; Output: Dynamic address of pseudo variable in Xtop,
; absolute address in Xtop+1.
; Function: Generate ZTT object, copy input.
; Create dynamic and absolute address.
; Calls: .SAAR
.TXDA: PROC
LOWADR
CDEFER
STD XWAC1,YTXZTV(XLOW) ;Save over g.c., if any
SKIPE XSAC,@(XPDP)
EXEC TXSA
L XTAC,[QZTT,,ZTT%S]
EXEC .SAAR
LD XWAC1,YTXZTV(XLOW)
TLNN XWAC2,-1 ;[6] Return NOTEXT if length=0
SETZB XWAC1,XWAC2
STD XWAC1,OFFSET(ZTTSP)(XTAC)
HRLI XWAC1,OFFSET(ZTTSP) ;OFFSET
HRRI XWAC1,(XTAC) ;OBJECT ADDRESS
HLRZ XWAC2,XWAC1 ;Absolute address may be useful
ADDI XWAC2,(XWAC1)
SETZM YTXZTV(XLOW)
IF ;Results saved explicitly for TXDA
SKIPN @(XPDP)
GOTO FALSE
THEN ;Restore them
SKIPE XSAC,YCSZAC(XLOW)
EXEC .CSRA
FI
AOS (XPDP)
CENABLE
RETURN
EPROC
SUBTTL TXDF
TXDF:
;Input: XWAC4 has number of characters in integer part
; XWAC5 has number of characters in fraction part
; XWAC6 has exponent
; YTXB has number in ASCII
; YTXBPE points to last character in buffer, received by LDB
;Output: XWAC1 and XWAC2 contain number in floating format
;Call format: EXEC TXDF
; correct return
; return if overflow
; Called by TXGR
IF ;No integer or fraction part
JUMPN XWAC5,FALSE
JUMPN XWAC4,FALSE
THEN ;Only exponent
LD XWAC1,TXFL1
GOTO TXDF3
FI
L X0,[POINT 7,YTXB(XLOW)]
SETZB XWAC1,XWAC2
IF ;There is an integer part
JUMPLE XWAC4,FALSE
THEN ;Convert the integer
LOOP
ILDB X1,X0
LSH X1,1
DFMP XWAC1,TXFD10
;Next instruction is a NOP but the trap
;handling routine jumps to address
;defined in address part
JFCL TXDF2
CAIE X1,2*"0"
DFAD XWAC1,TXFL1-"1"-"1"(X1)
AS
SOJG XWAC4,TRUE
SA
FI
SETZB XWAC3,XWAC4
L X0,YTXBPE(XLOW) ;Pointer to last byte of buffer
IF ;Any fraction part
SOJL XWAC5,FALSE
THEN ;Convert fraction
LOOP ;Read fraction bytes from low end
LDB X1,X0
LSH X1,1
CAIE X1,2*"0"
DFAD XWAC3,TXFL1-"1"-"1"(X1)
DFMP XWAC3,TXFF10
JFCL TXDF2
IF ;1st byte of word treated
CAMGE X0,[XWD 350000,0]
GOTO FALSE
THEN ;Point to last byte of preceding word
TLZ X0,777700
TLO X0,010700
SUBI X0,1
ELSE ;Point to preceding byte in word
ADD X0,[XWD 70000,0]
FI
AS
SOJGE XWAC5,TRUE
SA
FI
DFAD XWAC1,XWAC3
JUMPE XWAC1,TXDF1 ;Zero magnitude, finished
TXDF3:
JUMPE XWAC6,TXDF1 ;No exponent, finished
;Modify number with exponent
IF ;Exp > 0
JUMPL XWAC6,FALSE
THEN
LOOP
DFMP XWAC1,TXFD10
JFCL TXDF2
AS
SOJG XWAC6,TRUE
SA
ELSE ;Exp < 0
MOVN XWAC6,XWAC6
LOOP
DFMP XWAC1,TXFF10
AS
SOJG XWAC6,TRUE
SA
FI
GOTO TXDF1
TXDF2:
AOS (XPDP) ;Skip return on overflow
TXDF1:
RETURN
SUBTTL TXBPST,TXBP,TXERR
TXBPST:
;Input: Same as TXBP
;Output: Same as TXBP +
;X2 has length of text
;ZTVCP := X2
LF X2,ZTVLNG(XWAC1)
SF X2,ZTVCP(XWAC1)
;Create byte pointer to intermediate text buffer
L [POINT 7,YTXB(XLOW)]
ST YTXBPE(XLOW)
TXBP:
;Input: XWAC1 has pointer to text variable
;Output:X1 has byte pointer to current position
LF X1,ZTVZTE(XWAC1)
ADD X1,[POINT 7,<ZTE%S>]
LF X0,ZTVSP(XWAC1)
;Increase byte pointer up to current position
IF SOJL FALSE
THEN
IBP X1
SOJGE .-1
FI
RETURN
TXERR:
;Output faulty character found in a text editing routine
;Input: X0 has character
ROT X0,-7
IOR X0,["'"B13]
TLNN X0,770000
LSH X0,7
OUTSTR TXILCH
OUTSTR X0
RETURN
SUBTTL TXFD
Comment;
Purpose: Convert floating number in double
precision to decimal ASCII
Entry: TXFD
Input argument: XWAC3-XWAC4 contain number in floating format
Number should be positive, but the negative number
represented as 400000,,0 in XWAC3 and 0 in XWAC4 may
occur due to truncation in conversions between
LONG REAL and REAL
XWAC5 rh= number of digits in number if lh=0
XWAC5 rh=number of decimals if lh=-1
Normal exit: RETURN
Output arguments: YTXBP byte pointer to decimal number
YTXBN number of digits in number
YTXBPE byte pointer last character, received by LDB
YTXEXP exponent, power of ten
Call format: EXEC TXFD
;
TXFD:
PROC
SAVE <XWAC3,XWAC4,XWAC5,XWAC6,XWAC7>
IF ;Number = 0
JUMPN XWAC3,FALSE
THEN ;Handle special case, save lots of instructions
L X0,XWAC3
;Convert number and update pointers etc
EXEC TXBD
TLZ XWAC5,-1
;One extra digit for rounding
ADDI XWAC5,1
L X2,[POINT 7,YTXB+3(XLOW)]
SETZB XWAC7,YTXEXP(XLOW)
IF
JUMPL XWAC5,FALSE
THEN ;Output zeroes
LI X0,"0"
LOOP
IDPB X0,X2
AS
SOJLE XWAC5,FALSE
AOJA XWAC7,TRUE
SA
FI
ADDM XWAC7,YTXBN(XLOW)
GOTO TXFD1
FI
;[7] Set a negative arg to the most positive number
; i.e XWAC3:=377777,,777777
; and XWAC4:=377777,,777777
;***AUBEG
;For KA10 XWAC$ becomes 344777,,777777
;***AUEND
IF
JUMPG XWAC3,FALSE
THEN
;***AUBEG
;Set max LONG REAL value differently for KI10 and KA10
KI10,< ADDI XWAC4,1
DMOVN XWAC3,XWAC3>
KA10,< LD XWAC3,<[377777,,777777
344777,,777777]>>
;***AUEND
ADDI XWAC4,1
;***AUBEG
;Use DFN to negate KA10 LONG REAL format.
KI10,< DMOVN XWAC3,XWAC3>
KA10,< DFN XWAC3,XWAC4>
;***AUEND
FI
SETZB X2,YTXBN(XLOW) ;COUNT OF CHARACTERS
IF ;Number >= 1
CAMGE XWAC3,TXFL1
GOTO FALSE
THEN
HRLZI X1,-4
;Look for factor to scale real number to form A*10E8+B*10E-N
LOOP
AS
CAMGE XWAC3,TXFL(X2)
GOTO FALSE
ADDI X2,2
AOBJN X1,TRUE
SA
LI X0,0
IF ;Number > 10E9
TRNN X1,-1
GOTO FALSE
THEN
L X0,TXEXP-1(X1)
DFMP XWAC3,TXFL+10(X2)
FI
ELSE ;Number < 1
HRLZI X1,-4 ;[2] -5 CHANGED TO -4
;Error for numbers less E-38
LOOP ;Look for factor to scale real number to form A*10E9+B+10E-N
AS
CAML XWAC3,TXFL+12(X2)
GOTO FALSE
ADDI X2,2
AOBJN X1,TRUE
SA
MOVN X0,TXEXP(X1)
DFMP XWAC3,TXFL(X2)
FI
ST X0,YTXEXP(XLOW)
;Convert integer part of fraction to decimal ASCII
FIX X0,XWAC3
FLTR XWAC6,X0
LI XWAC7,0
EXEC TXBD
DFSB XWAC3,XWAC6
; Now XWAC3 contains number less than 1
L X0,YTXBN(XLOW)
ADDM X0,YTXEXP(XLOW)
SOS YTXEXP(XLOW)
IF
TLZN XWAC5,-1
GOTO FALSE
THEN ;XWAC5 contains number of decimals
;YTXBN:=Number of digits including leading zeroes
IF ;Exponent is negative
SKIPL X1,YTXEXP(XLOW)
GOTO FALSE
THEN ;Number is still < 1
MOVN X1,X1
SUBI X1,1
ADDM X1,YTXBN(XLOW)
ELSE
ADDI XWAC5,1(X1)
FI
FI
SUB XWAC5,YTXBN(XLOW)
ADDM XWAC5,YTXBN(XLOW) ;YTXBN should be number of characters
IF
AOJL XWAC5,FALSE ;1 extra digit for rounding
THEN
CAIL XWAC5,^D40
LI XWAC5,^D40 ;Max 40 characters
L X2,[POINT 7,YTXB+2(XLOW),34]
LOOP ;Multiply fraction by 10 to develop decimal digits
DFMP XWAC3,TXFD10
FIX X0,XWAC3
FLTR XWAC6,X0
ADDI X0,"0"
IDPB X0,X2
DFSB XWAC3,XWAC6
AS
SOJG XWAC5,TRUE
SA
ELSE ;Make YTXBPE point to last character in number
IDIVI XWAC5,5
MOVN XWAC6,XWAC6
L X2,TXBPE(XWAC6)
ADD X2,XWAC5
FI
TXFD1:
ST X2,YTXBPE(XLOW)
RETURN
EPROC
SUBTTL TXFDR
;Purpose: Perform rounding of number in ASCII format
;Input arg YTXBP: Pointer to first character accessed by ILDB
;YTXBPE: Byte pointer to last character, loaded by LDB
TXFDR:
PROC
;Last digit in buffer is only for rounding
;Will not be counted later on
L X1,YTXBPE(XLOW)
L X2,YTXBP(XLOW)
IBP X2
LDB X0,X1 ;Get last digit
IF ;Digit >= 5
CAIGE X0,"5"
GOTO FALSE
THEN ;If only one digit in buffer,
; the number is zeroes followed by this digit
; and is rounded to one in last pos
CAMN X1,X2
GOTO TXFDR1
LOOP
IF ;Word filled (backwards)
CAMGE X1,[XWD 350000,0]
GOTO FALSE
THEN ;Back up byte pointer one word
SUBI X1,1
TLZ X1,777700
TLO X1,010700
ELSE ;Just back up one byte
ADD X1,[XWD 070000,0]
FI
LDB X0,X1
AS
CAIGE X0,"9"
AOJA X0,FALSE
LI X0,"0"
DPB X0,X1
CAME X1,X2
GOTO TRUE
DPB X0,YTXBPE(XLOW) ;For .TXPX
TXFDR1: LI X0,"1"
AOS YTXBN(XLOW)
AOS YTXEXP(XLOW)
SA
DPB X0,X1
FI
RETURN
EPROC
SUBTTL TXGC
Comment;
Purpose: Implement GETCHAR
Entry: .TXGC
Input argument: XTAC has number of top ac
Top ac has address of text variable
Normal exit: RETURN
Error exit: -
Output arguments: Top ac has character
Call format: EXEC .TXGC
;
.TXGC: PROC
;Top ac to XWAC1, XWAC1 saved
EXCH XWAC1,(XTAC)
STACK XWAC3
STACK XTAC
L1():! edit(41) ;[41]
LF X1,ZTVCP(XWAC1)
LF X0,ZTVLNG(XWAC1)
IF ;t.More
CAML X1,X0
GOTO FALSE
THEN ;Compute byte pointer of current position
LF X0,ZTVZTE(XWAC1)
LF X2,ZTVSP(XWAC1)
ADDI X1,(X2)
IDIVI X1,5
ADDI X0,<ZTE%S>(X1)
ADD X0,TXBY(X2)
;Now X0 contains byte pointer
;Increment position pointer and get character
AOS OFFSET(ZTVCP)(XWAC1)
ILDB XWAC1,X0
ELSE ;Position out of range. Runtime error
TXERC QDSNIN,5,GETCHAR: pos out of range
NEWVALUE XWAC3 ;[41]
EXEC .TXSE ;[41] Setpos(XWAC3)
GOTO L1 ;Try again [41]
FI
UNSTK XTAC
UNSTK XWAC3 ;[41]
EXCH XWAC1,(XTAC)
RETURN
EPROC
SUBTTL TXGF
COMMENT;
PURPOSE: IMPLEMENT STANDARD FUNCTION GETFRAC
ENTRY: .TXGF
INPUT ARGUMENTS: REG XTAC CONTAINING NUMBER OF XTOP
REG XTOP CONTAINING ADDR OF TEXT
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: REG XTOP CONTAINING VALUE
CALL FORMAT: EXEC .TXGF
;
.TXGF: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
EXCH XWAC1,(XTAC)
;SAVE REGS
STACK XWAC3
STACK XWAC4
STACK XWAC5
NFO==4 ;[41] Number of stack elements incl. file ref
STACK XWAC2 ;[41] file ref in stack
NXTAC==5 ;[66] No of stk elements incl. XTAC
STACK XTAC
NSTK==5 ;[41] Number of words stacked
;COMPUTE BYTE POINTER
TXGFEC: ;[41] Entry to continue after error in INFRAC
EXEC TXBPST
;NOW X1 CONTAINS BYTE POINTER TO FIRST CHARACTER
; X2 LENGTH OF TEXT
;CHECK SIGN PART AND GET FIRST CHARACTER IN NUMBER
TLO XWAC1,-1
SETZB XWAC4,XWAC5
EXEC TXSGN
GOTO TXGF2
;ERROR RETURN
SKIPA
TXGFEL:
LDB X0,X1
TXGFE: ;RUNTIME ERROR, NO DIGITS FOUND
STACK X0 ;[66] Save char
NSTK==NSTK+1
IF ;[41] GETFRAC
GETROU
GOTO FALSE
THEN
UNSTK X0 ;[66]
NSTK==NSTK-1 ;[66]
IF ;[66] XTAC was negative
SKIPL NXTAC-NSTK(XPDP)
GOTO FALSE
THEN ;Clear left half to signal error
HRRZS NXTAC-NSTK(XPDP)
CAME XWAC5,[400000,,0] ;Avoid repeated error
BRANCH L8
BRANCH L9
FI ;[66]
EXEC TXERR ;Output first unacceptable char
TXERR 14,GETFRAC: no item found or item too large
ELSE ;INFRAC
UNSTK X0 ;[66]
EXEC TXERR ;Output first unacceptable char
TXERC QDSNIM,22,INFRAC: no item found or item too large
ZFIMPO ;Zero IMAGE.POS
GOTO TXGFEC ;Continue after error
FI ;[41] end
GOTO L9
;LOOK FOR DIGITS, SPACE IS IGNORED
;ONLY ONE SPACE IS ALLOWED BETWEEN CHARACTERS IN NUMBER
LOOP
ILDB X0,X1
TXGF2:
IF ;Digit
CAIL X0,"0"
CAILE X0,"9"
GOTO FALSE
THEN ;CONVERT DIGITS TO BINARY
IMULI XWAC5,^D10
;NEXT INSTRUCTION IS A NOP BUT THE MODULE THAT HANDLES TRAPS
;RECOGNIZES JFCL AND JUMPS TO THE ADDRESS IT SPECIFIES
JFCL TXGFEL
SUBI X0,"0"
ADD XWAC5,X0
JFCL TXGFEL
ELSE
IF ;not space
CAIN X0," "
GOTO FALSE
THEN
;DEC POINT?
CAIE X0,"."
GOTO TXGF1 ;NO DEC POINT
JUMPG XWAC4,TXGF1
;ONLY ONE DEC POINT ALLOWED
L XWAC4,X0
ELSE
;ONLY ONE SPACE
CAIN XWAC3," "
GOTO TXGF1
FI
FI
L XWAC3,X0 ;SAVE PRECEDING CHARACTER
AS
TLZ XWAC1,-1
SOJGE X2,TRUE
SA
TXGF1:
;CHECK IF ANY DIGIT WAS FOUND
JUMPL XWAC1,TXGFE
L8():! ;UPDATE POS TO POINT AFTER LAST CHARACTER
MOVNI X2,1(X2)
ADDM X2,OFFSET(ZTVCP)(XWAC1)
L XWAC1,XWAC5
SKIPE YTXSGN(XLOW)
MOVN XWAC1,XWAC1
JFCL TXGFEL ;[66]
;RESTORE REGS
L9():! JFCL TXGFEL ;[66]
UNSTK XTAC
UNSTK XWAC2 ;[41]
UNSTK XWAC5
UNSTK XWAC4
UNSTK XWAC3
EXCH XWAC1,(XTAC)
CENABLE
RETURN
EPROC
SUBTTL TXGI
COMMENT ;
PURPOSE: IMPLEMENT STANDARD FUNCTION GETINT
ENTRY: .TXGI
INPUT ARGUMENTS: REG XTAC CONTAINING NUMBER OF XTOP
REG XTOP CONTAINING POINTER TO TEXT VARIABLE
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: REG XTOP CONTAINING CURRENT INTEGER
;
.TXGI: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
EXCH XWAC1,(XTAC)
NFO==1 ;[41] Number of stack elements incl. file ref
STACK XWAC2
NXTAC==2 ;[66] No of stk elements incl. XTAC
STACK XTAC
NSTK==2 ;[41] Number of words stacked
;COMPUTE BYTE POINTER
TXGIEC: ;[41] Entry to continue after error in ININT
EXEC TXBPST
;NOW X1 CONTAINS BYTE POINTER
;X2 LENGTH OF TEXT
LI XWAC2,0
;CHECK SIGN PART AND GET FIRST CHARACTER IN NUMBER
EXEC TXSGN
IF
GOTO FALSE
THEN
;ERROR RETURN
SKIPA
TXGIEL:
LDB X0,X1
TXGIE:
;RUN TIME ERROR
STACK X0 ;[66] Save char
NSTK==NSTK+1
IF ;[41] GETINT
GETROU
GOTO FALSE
THEN
UNSTK X0 ;[66]
NSTK==NSTK-1 ;[66]
IF ;[66] XTAC was negative
SKIPL NXTAC-NSTK(XPDP)
GOTO FALSE
THEN ;Clear left half to signal error
HRRZS NXTAC-NSTK(XPDP)
CAME XWAC2,[400000,,0] ;Avoid
BRANCH L8 ;repeated
BRANCH L9 ;error
FI ;[66]
EXEC TXERR ;Output first unacceptable char
TXERR 11,GETINT: no digits or number too large
ELSE ;ININT
UNSTK X0 ;[66]
EXEC TXERR ;Output first unacceptable char
TXERC QDSNIM,17,ININT: no digits or number too large
ZFIMPO ;Zero IMAGE.POS
GOTO TXGIEC ;Continue after error
FI ;[41] end
GOTO L9
FI
CAIL X0,"0"
CAILE X0,"9"
GOTO TXGIE ;Was not a digit
GOTO TXGI2
;LOOK FOR DIGITS AND CONVERT TO BIN
LOOP
ILDB X0,X1
CAIL X0,"0"
CAILE X0,"9"
GOTO FALSE
;CONVERT NUMBER TO BINARY
IMULI XWAC2,^D10
;NEXT INSTRUCTION IS A NOP BUT THE MODULE THAT HANDLES TRAPS
;RECOGNIZES JFCL AND JUMPS TO THE ADDRESS IT SPECIFIES
JFCL TXGIEL
TXGI2: SUBI X0,"0"
ADD XWAC2,X0
JFCL TXGIEL ;[66]
AS
SOJGE X2,TRUE
SA
L8():! ;POS AFTER LAST CHARACTER IN ITEM
MOVNI X2,1(X2)
ADDM X2,OFFSET(ZTVCP)(XWAC1)
L XWAC1,XWAC2
SKIPE YTXSGN(XLOW)
MOVN XWAC1,XWAC1
JFCL TXGIEL ;[66]
L9():!
UNSTK XTAC
UNSTK XWAC2
EXCH XWAC1,(XTAC)
CENABLE
RETURN
EPROC
SUBTTL TXGR
Comment ;
Purpose: Implement standard function GETREAL
Entry: .TXGR
Input arguments: XTAC has value of Xtop
Xtop has address of text variable
Normal exit: RETURN
Error exit: -
Output arguments: Xtop-Xtop+1 contain value
Call format: EXEC .TXGR
;
.TXGR: PROC
INIT2
STACK XWAC4
STACK XWAC5
STACK XWAC6
NFO==4 ;[41] Number of stack elements incl. file ref
STACK XWAC3 ;[41] file ref in stack
STACK XWAC7 ;[70]
NXTAC==6 ;[66] No of stk elements incl. XTAC
STACK XTAC
NSTK==6 ;[41] Number of words stacked
LOWADR
CDEFER
;Compute byte pointer
TXGREC: ;[41] Entry to continue after error in INREAL
EXEC TXBPST
;Now X1 contains byte pointer to text
;X2 has length of text
SETZB XWAC3,XWAC5
SETZB XWAC6,YTXEXP(XLOW)
SETZM YTXBN(XLOW) ;Number of characters
;Check sign part and get first character in number
EXEC TXSGN
GOTO TXGR2 ;Good return
GOTO TXGRE ;Error return
;Check for digits
LOOP
ILDB X0,X1
TXGR2:
IF ;Digit
CAIL X0,"0"
CAILE X0,"9"
GOTO FALSE
THEN
IDPB X0,YTXBPE(XLOW)
ADDI XWAC5,1
ELSE ;Not digit, check if decimal point
IF ;Point
CAIE X0,"."
GOTO FALSE
THEN ;Only one dec point allowed
SKIPE YTXEXP(XLOW)
GOTO TXGR1
L XWAC4,XWAC5
LI XWAC5,0
SETOM YTXEXP(XLOW) ;To indicate dec point found
ELSE ;Check for exponent
CAME X0,YTXLT(XLOW)
GOTO TXGR1
GOTO L1
FI
FI
AS
SOJGE X2,TRUE
SA
GOTO TXGR1
;Check sign part of exponent
L1():!
EXCH XWAC3,YTXSGN(XLOW)
LI XWAC7,(X2) ;[70]save pos before exp if no digits are found
EXEC TXSGN
GOTO TXGR3 ;Good return, found sign or digit
GOTO TXGR4 ;Error return
LOOP
ILDB X0,X1
TXGR3:
CAIL X0,"0"
CAILE X0,"9"
GOTO FALSE
SUBI X0,"0"
IMULI XWAC6,^D10
JFCL TXGREL ;Overflow exit
ADD XWAC6,X0
JFCL TXGREL
;Count number of characters in exponent
AOS YTXBN(XLOW)
AS
SOJGE X2,TRUE
SA
TXGR4: edit(303) ;[303]
;Sign of number must be in YTXSGN
EXCH XWAC3,YTXSGN(XLOW)
;Check for negative exponent
SKIPE XWAC3
MOVN XWAC6,XWAC6 ;Negate value if sign was negative
SKIPN YTXBN(XLOW) ;[70]for exp without any digits behind
L X2,XWAC7 ;end of [70]
TXGR1:
IF ;No fraction
SKIPE YTXEXP(XLOW)
GOTO FALSE
THEN
L XWAC4,XWAC5
LI XWAC5,0
;[53]Decimal point not allowed if no digit follows
ELSE ;Decimal point found,not allowed if no fraction
SKIPN XWAC5
ADDI X2,1 ;Do not count decimal point
FI ;End of [53]
;Pos after last character
MOVNI X2,1(X2)
ADDM X2,OFFSET(ZTVCP)(XWAC1)
IF ;No value, no digits
JUMPN XWAC4,FALSE
JUMPN XWAC5,FALSE
SKIPE YTXBN(XLOW)
GOTO FALSE
THEN
;Runtime error
TXGRE:
STACK X0 ;[66] Save char
NSTK==NSTK+1
IF ;[41] GETREAL
GETROU
GOTO FALSE
THEN
UNSTK X0 ;[66]
NSTK==NSTK-1 ;[66]
IF ;[66] XTAC was negative
SKIPL NXTAC-NSTK(XPDP)
GOTO FALSE
THEN ;Clear left half to signal error
HRRZS NXTAC-NSTK(XPDP)
BRANCH L9
FI ;[66]
EXEC TXERR ;Output first unacceptable char
TXERR 12,GETREAL: no digits
ELSE ;INREAL
UNSTK X0 ;[66]
EXEC TXERR ;Output first unacceptable char
TXERC QDSNIM,20,INREAL: no digits
ZFIMPO ;Zero IMAGE.POS
GOTO TXGREC ;Continue after error in INREAL
FI ;[41] end
ELSE
EXEC TXDF
IF
GOTO FALSE ;CORRECT RETURN
THEN
TXGREL:
IF ;[41] GETREAL
GETROU
GOTO FALSE
THEN
IF ;[66] XTAC was negative
SKIPL NXTAC-NSTK(XPDP)
GOTO FALSE
THEN ;Clear left half to signal error
HRRZS NXTAC-NSTK(XPDP)
BRANCH L9
FI ;[66]
TXERR 13,GETREAL: item too large
ELSE ;INREAL
LI XWAC1,YTXZTV(XLOW)
TXERC QDSNIM,21,INREAL: item too large
ZFIMPO ;Zero IMAGE.POS
GOTO TXGREC ;Continue after error
FI ;[41] end
ELSE
SKIPE YTXSGN(XLOW)
DFMP XWAC1,TXFLN1
FI
FI
L9():! CENABLE
UNSTK XTAC
UNSTK XWAC7 ;[70]
UNSTK XWAC3 ;[41]
UNSTK XWAC6
UNSTK XWAC5
UNSTK XWAC4
EXIT2
EPROC
SUBTTL TXLT
COMMENT ;
PURPOSE: IMPLEMENT LOWTEN(C) WHERE C IS A CHARACTER
ENTRY: .TXLT
INPUT ARG: REG XWAC1 CONTAINING CHARACTER
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: YTXLT CONTAINING CHARACTER FOR EXPONENT
CALL FORMAT: EXEC .TXLT
;
.TXLT: PROC
LOWADR
LI X1,QNTXLT-1
LOOP
;CHECK THAT NO ILLEGAL CHARACTER IS USED
CAMN XWAC1,TXLTT(X1)
GOTO TXLT1
AS
SOJGE X1,TRUE
SA
CAIG XWAC1," "
GOTO TXLT1
;CHECK THAT NO DIGITS ARE USED
IF
CAIL XWAC1,"0"
CAILE XWAC1,"9"
GOTO FALSE
THEN
TXLT1: TXERR 16,LOWTEN: Illegal parameter
ELSE
EXCH XWAC1,YTXLT(XLOW)
FI
RETURN
EPROC
SUBTTL TXMN
COMMENT ;
PURPOSE: COMPUTE A TEXT REFERENCE FOR THE EXPRESSION T.MAIN
WHERE T IS A TEXT REFERENCE
ENTRY: .TXMN
INPUT ARGUMENTS: XTAC points to the text reference (a copy of T) in Xtop, Xtop+1
NORMAL EXIT: RETURN
ERROREXIT: -
OUTPUT ARG: XTOP
CALL FORMAT: EXEC .TXMN
;
.TXMN: PROC
LF X0,ZTVLNG(XTAC)
IF ;NOTEXT
JUMPN X0,FALSE
THEN ;Result is also NOTEXT
SETZM (XTAC)
SETZM 1(XTAC)
ELSE ;CONSTRUCT A NEW TEXT DESCRIPTOR
ZF ZTVSP(XTAC)
;COMPUTE LENGTH OF TEXT
LF X1,ZTVZTE(XTAC)
LF X0,ZTECLN(X1)
HRLZM 1(XTAC)
FI
RETURN
EPROC
SUBTTL TXPC
COMMENT ;
PURPOSE: IMPLEMENT STANDARD FUNCTION PUTCHAR
ENTRY: .TXPC
INPUT ARGUMENTS: REG XWAC1 POINTER TO TEXT VARIABLE
REG XWAC3 CONTAINING CHARACTER
NORMAL EXIT: RETURN
OUTPUT ARGUMENTS: -
CALL FORMAT: EXEC .TXPC
;
.TXPC:
PROC
;CHECK IF T.MORE TRUE
LF X2,ZTVCP(XWAC1)
LF X1,ZTVLNG(XWAC1)
IF
CAMGE X2,X1
GOTO FALSE
THEN ;RUNTIME ERROR. T.MORE FALSE
;[41]:
TXERC QDSNIN,4,PUTCHAR: pos out of range
STACK XWAC3 ;[41]
NEWVALUE XWAC3 ;[41]
EXEC .TXSE ;[41] setpos(xwac3)
UNSTK XWAC3 ;[41]
GOTO .TXPC ;[41]
FI
;COMPUTE BYTE POINTER TO CURRENT POSITION
LF X0,ZTVZTE(XWAC1)
LF X1,ZTVSP(XWAC1)
ADDI X1,(X2)
IDIVI X1,5
ADDI X0,<ZTE%S>(X1)
ADD X0,TXBY(X2)
;NOW X0 CONTAINS BYTE POINTER
IDPB XWAC3,X0
;INCREMENT POSTION POINTER
AOS OFFSET(ZTVCP)(XWAC1)
RETURN
EPROC
SUBTTL TXPX
COMMENT ;
PURPOSE: IMPLEMENT STANDARD FUNCTION PUTFIX
ENTRY: .TXPX
INPUT ARGUMENTS: REG XWAC1 CONTAINING POINTER TO TEXT VARIBLE
XWAC3-4 REAL ARG DOUBLE PRECISION
XWAC5 NUMBER OF DIGITS IN FRACTION
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: -
CALL FORMAT: EXEC .TXPX
;
.TXPX: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
IF
SKIPE (XWAC1)
GOTO FALSE
THEN
;NOTEXT CAUSES RUNTIME ERROR
TXERR 0,NOTEXT in editing procedure
GOTO TXPX1
FI
WHILE
JUMPGE XWAC5,FALSE
DO ;RUNTIME ERROR!
;NUMBER OF DIGITS IN FRACTION LESS THAN 0
;[41]:
TXERC QDSNIN,2,PUTFIX or OUTFIX: number of digits negative
NEWVALUE XWAC5 ;[41]
OD
SETZM YTXBN(XLOW)
SETZM YTXSGN(XLOW)
IF
JUMPGE XWAC3,FALSE
THEN
;NEGATIVE NUMBER
;***AUBEG
;Use DFN to negate KA10 LONG REAL format.
KI10,< DMOVN XWAC3,XWAC3>
KA10,< DFN XWAC3,XWAC4>
;***AUEND
LI X0,"-"
ST YTXSGN(XLOW)
FI
;CONVERT NUMBER TO DEC ASCII FORM
TLO XWAC5,-1
EXEC TXFD
EXEC TXFDR ;[107] round number
;NO ROUNDING IF NO DIGITS,OUTPUT ZERO
SKIPN YTXBN(XLOW)
AOS YTXBN(XLOW) ;[54]NO DECIMALS,AND NUMBER LESS THAN 1,NUMBER MAY BE ROUNDED
;[107] line moved
IF
TRNN XWAC5,-1 ;CHECK IF DECIMALS
GOTO FALSE
THEN
;DECIMALS WANTED
IF
SKIPL YTXEXP(XLOW)
GOTO FALSE
THEN
;NUMBER LESS THAN 1, ZERO BEFORE .
HRRZM XWAC5,YTXBN(XLOW)
AOS YTXBN(XLOW) ;ONE MORE CHARACTER FOR DEC POINT
FI
AOS YTXBN(XLOW)
FI
;CHECK IF SPACE FOR CHARACTERS IN TEXT STRING
SKIPE YTXSGN(XLOW)
AOS YTXBN(XLOW)
EXEC TXPT
SKIPA
GOTO TXPX1 ;NO SPACE, RETURN
;YTXTP NOW POINTS TO TEXT STRING WHERE TO PUT CHARACTERS
;OUTPUT MINUS SIGN IF NEG NUMBER
SKIPE X1,YTXSGN(XLOW)
IDPB X1,YTXTP(XLOW)
;OUTPUT INTEGER PART OF NUMBER
IF
SKIPGE X1,YTXEXP(XLOW)
GOTO FALSE
THEN
ILDB X0,YTXBP(XLOW) ;[4] INHIBIT OUTPUT
; OF LEADING ZEROES
IF
CAIE X0,"0" ; OCCURS FOR E8, E16, E24 ETC.
GOTO FALSE
THEN
SKIPE X1
LI X0," " ; BLANK IT
FI
SKIPA
LOOP
ILDB X0,YTXBP(XLOW)
IDPB X0,YTXTP(XLOW)
AS
SOSL YTXEXP(XLOW)
GOTO TRUE
SA
ELSE
LI X0,"0"
IDPB X0,YTXTP(XLOW)
FI
TRNN XWAC5,-1
GOTO TXPX1
LI X0,"."
IDPB X0,YTXTP(XLOW)
TLZ XWAC5,-1
IF
AOJGE X1,FALSE
THEN
;OUTPUT LEADING ZEROES
LI X0,"0"
ADD XWAC5,X1
SKIPGE XWAC5
SUB X1,XWAC5
LOOP
IDPB X0,YTXTP(XLOW)
AS
AOJL X1,TRUE
SA
FI
JUMPLE XWAC5,TXPX1
;OUTPUT FRACTION PART
LOOP
ILDB X0,YTXBP(XLOW)
SKIPN X0 ;[4] OUTPUT ZEROES INSTEAD OF NULLS AT THE
LI X0,"0" ; END OF THE CHARACTER STRING
IDPB X0,YTXTP(XLOW)
AS
SOJG XWAC5,TRUE
SA
TXPX1:
CENABLE
RETURN
EPROC
SUBTTL TXPF
COMMENT ;
PURPOSE: IMPLEMENT STANDARD FUNCTION PUTFRAC
ENTRY: .TXPF
INPUT AGRUMENTS: XWAC1 POINTER TO TEXT VARIABLE
XWAC3 INTEGER ARGUMENT
XWAC4 IF > 0 NUMBER OF DIGITS AFTER DEC POINT
IF <= 0 NUMBER OF ZEROES AFTER NUMBER
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: -
CALL FORMAT: EXEC .TXPF
USED ROUTINES: TXBD,TXPT
;
.TXPF: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
IF
SKIPE (XWAC1)
GOTO FALSE
THEN
;NOTEXT CAUSES RUNTIME ERROR
TXERR 0,NOTEXT in editing procedure
GOTO TXPF1
FI
SETZM YTXSGN(XLOW)
IF
JUMPGE XWAC3,FALSE
THEN
;NEGATIVE NUMBER
MOVN XWAC3,XWAC3
LI X0,"-"
ST X0,YTXSGN(XLOW)
FI
L X0,XWAC3
;CONVERT NUMBER TO DEC ASCII
EXEC TXBD
L XWAC2,YTXBN(XLOW)
L XWAC6,XWAC2
SUB XWAC6,XWAC4
SKIPGE XWAC4
ST XWAC6,YTXBN(XLOW)
IF
JUMPLE XWAC6,FALSE
THEN
;COMPUTE NUMBER OF GROUPS BEFORE DEC POINT
IDIVI XWAC6,3
IF
JUMPN XWAC7,FALSE
THEN
;ONE GROUP MORE THAN SPACE
SUBI XWAC6,1
LI XWAC7,3
FI
ADDM XWAC6,YTXBN(XLOW)
ELSE
;NO INTEGER PART
;A ZERO MUST BE OUTPUT
ST XWAC4,YTXBN(XLOW)
LI XWAC7,1
LI XWAC2,0
AOS YTXBN(XLOW)
FI
IF
JUMPLE XWAC4,FALSE
THEN
;COMPUTE NUMBER OF GROUPS AFTER DEC POINT
IDIVI XWAC4,3
SKIPE XWAC5
AOS YTXBN(XLOW)
ADDM XWAC4,YTXBN(XLOW)
ELSE
LI XWAC5,0
FI
;ONE MORE CHARACTER IF NEG NUMBER
SKIPE YTXSGN(XLOW)
AOS YTXBN(XLOW)
;CHECK IF SPACE FOR CHARACTERS IN TEXT STRING
EXEC TXPT
SKIPA
GOTO TXPF1
;OUTPUT MINUS IF NEG NUMBER
SKIPE X1,YTXSGN(XLOW)
IDPB X1,YTXTP(XLOW)
LOOP
;NOW XWAC6= NUMBER OF GROUPS BEFORE . AND
;XWAC7= NUMBER OF CHARACTERS IN FIRST GROUP
;XWAC2= NUMBER OF SIGNIFICANT DIGITS IN DEC NUMBER
;OUTPUT INTEGER PART OF ITEM
;GROUPS OF 3 DIGITS WITH SPACE BETWEEN THEM
WHILE
SOJL XWAC7,FALSE
DO
;OUTPUT ZEROES IF NEG EXP
IF
SOJGE XWAC2,FALSE
THEN
LI X1,"0"
ELSE
ILDB X1,YTXBP(XLOW)
FI
IDPB X1,YTXTP(XLOW)
OD
AS
SOJL XWAC6,FALSE
LI XWAC7,3
LI X1," "
IDPB X1,YTXTP(XLOW)
GOTO TRUE
SA
;CHECK IF FRACTION PART
;XWAC4= NUMBER OF GROUPS
;XWAC5= NUMBER OF DIGITS IN LAST GROUP
SKIPG XWAC4
JUMPE XWAC5,TXPF1
LI X1,"."
IDPB X1,YTXTP(XLOW)
;OUTPUT FRACTION PART OF ITEM
LI X0,"0"
LI X1,3
IF
SOJL XWAC4,FALSE
THEN
LOOP
LOOP
AOSL XWAC6 ;OUTPUT LEADING ZEROES
ILDB YTXBP(XLOW)
IDPB YTXTP(XLOW)
AS
SOJG X1,TRUE
SA
LI X1," "
SKIPN XWAC4
SKIPE XWAC5
IDPB X1,YTXTP(XLOW)
LI X1,3
AS
SOJGE XWAC4,TRUE
SA
FI
LI X1,"0"
IF
SOJL XWAC5,FALSE
THEN
;OUTPUT DIGITS IN LAST GROUP
LOOP
AOSL XWAC6
ILDB X1,YTXBP(XLOW)
IDPB X1,YTXTP(XLOW)
AS
SOJGE XWAC5,TRUE
SA
FI
TXPF1:
CENABLE
RETURN
EPROC
SUBTTL TXPI
COMMENT ;
PURPOSE: IMPLEMENT EDITING PROCEDURE PUTINT
ENTRY: .TXPI
INPUT ARGUMENTS: REG XWAC1 CONTAINING POINTER TO TEXT VARIABLE
REG XWAC3 CONTAINING INTEGER ARG
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENT: -
CALL FORMAT: EXEC .TXPI
CALLED ROUTINES: TXBD,TXPT
;
.TXPI: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
IF
SKIPE (XWAC1)
GOTO FALSE
THEN
;NOTEXT CAUSES RUNTIME ERROR
TXERR 0,NOTEXT in editing procedure
GOTO TXPI1
FI
;CONVERT NUMBER TO ASCII FORMAT
L X0,XWAC3
EXEC TXBD
;NOW YTXBN(XLOW) CONTAINS NUMBER OF CHARACTERS
;YTXBP BYTE POINTER TO TEXT
EXEC TXPT
SKIPA ;CORRECT RETURN
GOTO TXPI1
;PUT TEXT INTO FIELD
WHILE
SOSGE YTXBN(XLOW)
GOTO FALSE
DO
ILDB X5,YTXBP(XLOW)
IDPB X5,YTXTP(XLOW)
OD
TXPI1:
CENABLE
RETURN
EPROC
TXPT: PROC
;SUBROUTINE CALLED BY TXPI, TXPR, TXPF
;PURPOSE COMPUTE BYTEPOINTER YTXTP
; OUTPUT **** IF EDIT OVERFLOW
; UPDATE ZTVCP=CURRENT POSITION
;INPUT: XWAC1 POINTER TO TEXT VARIABLE
; YTXBN(XLOW) NUMBER OF CHARACTERS TO OUTPUT
;OUTPUT: SPACE BEFORE TEXT IF RELEVANT
; **** IN TEXT FIELD IF EDIT OVERFLOW
; YTXTP BYTE POINTER TO START OF TEXT WHERE TO PUT CHARACTERS
;IF MORE REGS ARE SAVED CHECK AOS INSTR
SAVE <XWAC2,XWAC3>
;COMPUTE BYTE POINTER OF CURRENT CHARACTER IN TEXT
EXEC TXBP
;NOW X1 CONTAINS BYTE POINTER
L X2,X1
LF XWAC3,ZTVLNG(XWAC1)
IF
CAML XWAC3,YTXBN(XLOW)
GOTO FALSE
THEN
;EDIT OVERFLOW PUT *** INTO TEXT FIELD AND GIVE A WARNING
AOS YEDOFL(XLOW)
LI X1,"*"
WHILE
SOJL XWAC3,FALSE
DO
IDPB X1,X2
OD
AOS -2(XPDP)
GOTO TXPT1
FI
SUB XWAC3,YTXBN(XLOW)
LI X1," "
IF ;LEADING SPACES
SOJL XWAC3,FALSE
THEN
IDPB X1,X2
SOJGE XWAC3,.-1
FI
LF XWAC3,ZTVLNG(XWAC1)
SF XWAC3,ZTVCP(XWAC1)
ST X2,YTXTP(XLOW)
TXPT1:
RETURN
EPROC
SUBTTL TXPR
COMMENT ;
PURPOSE: IMPLEMENT STANDARD FUNCTION PUTREAL
ENTRY: .TXPR
INPUT ARGUMENTS: XWAC1 CONTAINING POINTER TO TEXT VARIABLE
XWAC5 NUMBER OF SIGNIFICANT DIGITS
XWAC3-4 LONG REAL ARG
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENT: NUMBER IN TEXT STRING IN THE FORM
(-)A.BE+-XX
1<=A<=9
B = DECIMAL NUMBER WITH AS MANY DIGITS AS NEEDED ACCORDING TO INPUT
E IS DEFAULT CHARACTER FOR EXPONENT
E IS FOOLOWED BY SIGN AND TWO DIGITS FOR EXP
CALL FORMAT: EXEC .TXPR
;
.TXPR: PROC
LOWADR
CDEFER ;Defer ^C-REENTER
IF
SKIPE (XWAC1)
GOTO FALSE
THEN
;NOTEXT CAUSES RUNTIME ERROR
TXERR 0,NOTEXT in editing procedure
GOTO TXPR1
FI
WHILE
JUMPGE XWAC5,FALSE
DO ;INTEGER CONTAINING NUMBER OF SIGNIFICANT DIGITS LESS THAN 0
;CAUSES RUNTIME ERROR
;[41]:
TXERC QDSNIN,3,PUTREAL or OUTREAL: number of digits negative
NEWVALUE XWAC5 ;[41]
OD
LI X0,4(XWAC5) ;NUMBER OF CHARACTERS INCLUDING EXP
SKIPGE XWAC3
ADDI X0,1 ;1 CHARACTER FOR MINUS SIGN
ST X0,YTXBN(XLOW) ;NUMBER OF CHARACTERS TO OUTPUT TO TEXT STRING
;ONE EXTRA CHARACTER IF DEC POINT NEEDED
CAIL XWAC5,2
AOS YTXBN(XLOW)
;CHECK IF ROOM IN TEXTSTRING FOR CHARACTERS
EXEC TXPT
SKIPA ;RETURN IF ROOM
GOTO TXPR1 ;NO ROOM
;OUTPUT MINUS SIGN IF NEG NUMBER
IF
JUMPGE XWAC3,FALSE
THEN
;NEGATIVE NUMBER
LI X1,"-"
IDPB X1,YTXTP(XLOW)
DMOVN XWAC3,XWAC3
FI
;CONVERT NUMBER TO DEC ASCII FORM
EXEC TXFD
EXEC TXFDR
ILDB X1,YTXBP(XLOW)
IF
JUMPE XWAC5,FALSE
THEN
IDPB X1,YTXTP(XLOW)
IF CAIN XWAC5,1
GOTO FALSE
THEN
LI X2,"."
IDPB X2,YTXTP(XLOW)
FI
IF
SOJLE XWAC5,FALSE
THEN
LOOP
ILDB X1,YTXBP(XLOW)
IDPB X1,YTXTP(XLOW)
AS
SOJG XWAC5,TRUE
SA
FI
FI
L X0,YTXLT(XLOW)
IDPB X0,YTXTP(XLOW)
SETZM YTXBN(XLOW)
L X0,YTXEXP(XLOW)
EXEC TXBD
IF
SKIPGE YTXEXP(XLOW)
GOTO FALSE
THEN
;POS EXP
LI X0,"+"
ELSE
ILDB X0,YTXBP(XLOW)
SOS YTXBN(XLOW)
FI
IDPB X0,YTXTP(XLOW)
;OUTPUT EXP, TWO DIGITS IN EXP
LI X0,"0"
SOSE YTXBN(XLOW)
ILDB X0,YTXBP(XLOW)
IDPB X0,YTXTP(XLOW)
ILDB X0,YTXBP(XLOW)
IDPB X0,YTXTP(XLOW)
TXPR1:
CENABLE
RETURN
EPROC
SUBTTL TXRE
COMMENT;
PURPOSE: COMPARE TWO TEXT VALUES
ENTRY: .TXRE
INPUT ARGUMENTS: REG XTAC CONTAINING NUMBER OF XTOP
XTOP-XTOP+1 CONTAINING TEXT REF VARIBLE 1
XTOP+2-XTOP+3 TEXT REF VARIABLE 2
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: XTOP =-1 IF T1<T2
=0 IF T1=T2
=1 IF T1>T2
;
.TXRE:
PROC
INIT4
STACK XWAC5
STACK XWAC6
STACK XTAC
LOWADR
CDEFER
IF ;SAME POSITION IN SAME TEXT OBJECT
CAME XWAC1,XWAC3
GOTO FALSE
THEN ;SEE IF T1==T2, WHICH IMPLIES T1=T2
XOR XWAC2,XWAC4
IF ;SAME LENGTH
TLNE XWAC2,-1
GOTO FALSE
THEN ;T1==T2, IMPLIES T1=T2
SETZ XWAC1,
ELSE ;RELATION DEPENDS ON LENGTH ONLY NOW
XOR XWAC2,XWAC4
SETO XWAC1,
CAML XWAC2,XWAC4
LI XWAC1,1
FI
GOTO TXRE1
FI
IF
JUMPN XWAC2,FALSE
THEN
;T1=NOTEXT
SETO XWAC1,
JUMPN XWAC4,TXRE1
SETZ XWAC1,
GOTO TXRE1
FI
IF
JUMPN XWAC4,FALSE
THEN
;T2=NOTEXT T1>T2
LI XWAC1,1
GOTO TXRE1
FI
;COMPUTE BYTE POINTERS TO TEXT VARIABLES POINTING TO FIRST CHARACTER
LF X1,ZTVZTE(,XWAC1)
LF X2,ZTVZTE(,XWAC3)
LF XWAC5,ZTVSP(,XWAC1)
IDIVI XWAC5,5
ADDI X1,ZTE%S(XWAC5)
ADD X1,TXBY(XWAC6)
LF XWAC5,ZTVSP(,XWAC3)
IDIVI XWAC5,5
ADDI X2,ZTE%S(XWAC5)
ADD X2,TXBY(XWAC6)
;COMPUTE LENGTH OF FIELDS
LF XWAC5,ZTVLNG(,XWAC1)
LF XWAC6,ZTVLNG(,XWAC3)
IF
CAMG XWAC5,XWAC6
GOTO FALSE
THEN
;T1 LONGER THAN T2
LI XWAC1,1
L XWAC5,XWAC6
ELSE
;T2 LONGER THAN T1
SETO XWAC1,
CAMN XWAC5,XWAC6
LI XWAC1,0 ;T1 AS LONG AS T2
FI
;COMPARE CHARACTERS IN T1 AND T2
LOOP
ILDB X0,X1
ILDB XWAC6,X2
AS
CAME X0,XWAC6
GOTO FALSE
SOJG XWAC5,TRUE
GOTO TXRE1
SA
LI XWAC1,1
CAMG X0,XWAC6
SETO XWAC1,
;RESTORE REGS
TXRE1:
CENABLE
UNSTK XTAC
UNSTK XWAC6
UNSTK XWAC5
EXIT4
EPROC
SUBTTL TXSA
COMMENT;
PURPOSE: TO SAVE INTERMEDIATE RESULTS WHEN TOP AC'S
CONTAIN A TEXT VARIABLE
;
TXSA: HLRZ XTAC,XSAC ;NUMBER OF RESULTS
LD X0,XWAC1(XTAC)
STD X0,YTXZTV(XLOW)
L XSAC,@-1(XPDP)
BRANCH .CSSA.
SUBTTL TXSE
COMMENT ;
PURPOSE: IMPLEMENT STANDARD PROCEDURE SETPOS
ENTRY: .TXSE
INPUT ARGUMENTS: REG XWAC1 CONTAINING POINTER TO TEXT VARIABLE
REG XWAC3 CONTAINING INTEGER VALUE
NORMAL EXIT: RETURN
ERROR EXIT: -
OUTPUT ARGUMENTS: -
CALL FORMAT: EXEC .TXSE
;
.TXSE:
PROC
LF X1,ZTVLNG(XWAC1) ;LENGTH OF TEXT
SOJL XWAC3,.+2
CAILE XWAC3,(X1)
LI XWAC3,(X1)
SF XWAC3,ZTVCP(XWAC1)
RETURN
EPROC
SUBTTL TXSGN
COMMENT;
PURPOSE: CALLED BY DEEDITING PROCEDURES TO TAKE CARE OF SIGN PART
AND FIND FIRST CHARACTER OF NUMBER
ENTRY: TXSGN
INPUT ARGUMENTS: REG X1 CONTAINING BYTEPOINTER TO TEXT
REG X2 CONTAINING LENGTH OF TEXT
NORMAL EXIT: RETURN
ERROR EXIT: RETURN AND SKIP
OUTPUT ARGUMENTS: YTXSGN =0 IF NO SIGN OR +
="-" IF -
REG X0 CONTAINING FIRST CHARACTER OF NUMBER
CALL FORMAT: EXEC TXSGN
CORRECT RETURN
ERROR RETURN
;
TXSGN:
;SKIP LEADING SPACES AND TABS
LI X0,0
WHILE
SOJL X2,TXSGN1
DO
ILDB X0,X1
CAIE X0," "
CAIN X0," "
OD
SETZM YTXSGN(XLOW)
;CHECK FOR SIGN
IF
CAIN X0,"+"
GOTO FALSE
THEN
CAIE X0,"-"
GOTO TXSGN2
ST X0,YTXSGN(XLOW)
FI
;CHECK FOR SPACE
WHILE
SOJL X2,TXSGN1
DO
ILDB X0,X1
CAIN X0," "
OD
TXSGN2:
RETURN
TXSGN1:
AOS (XPDP)
RETURN
TXILCH: ASCIZ /FIRST UNACCEPTABLE CHARACTER IS '/
SUBTTL TABLES
;***AUBEG
;DEFINE DOCT MACRO TO FACILITATE TABLE CONSTRUCTION.
DEFINE DOCT(A,B,C)<
IFN QKI10,< OCT A,B>
IFN QKA10,< OCT A,C>
> ;END OF DOCT
;***AUEND
TXBPE: ;LEFT HAND OF POINTER
POINT 7,YTXB+2(XLOW),34
POINT 7,YTXB+2(XLOW),27
POINT 7,YTXB+2(XLOW),20
POINT 7,YTXB+2(XLOW),13
POINT 7,YTXB+2(XLOW),6
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
TXFL1:
OCT 201400000000,0
OCT 202400000000,0
OCT 202600000000,0
OCT 203400000000,0
OCT 203500000000,0
OCT 203600000000,0
OCT 203700000000,0
OCT 204400000000,0
OCT 204440000000,0
TXFD10: OCT 204500000000,0
TXEXP: DEC 8,16,24,32,38
;***AUBEG
;MUST USE KA10 LONG REAL FORMAT
TXFF10: DOCT 175631463146,146314631463,142314631463 ;1/10
TXFLN1: OCT 576400000000,0
TXFL:
DOCT 233575360400,0,0 ;10E8
DOCT 266434157115,370100000000,233760200000 ;10E16
DOCT 320647410336,166316664100,265354635550 ;10E24
DOCT 353473426555,101267026547,320202556055 ;10E32
DOCT 377454732312,205520661075,344413241542 ;10E38
DOCT 146527461670,214106071675,113430214164 ;10E-8
DOCT 113715126245,366104674123,060754211570 ;10E-16
DOCT 061465370246,152107247321,026324216517 ;10E-24
DOCT 026637304365,152123462450,000006505163 ;10E-32
DOCT 002663437347,152474344216,000000000003 ;10E-38
;***AUEND
TXLTT:
;TABLE OF CHARACTERS NOT ALLOWED IN LOWTEN
";"
"+"
"-"
","
"."
QNTXLT=.-TXLTT ;LENGTH OF TXLTT
TXMAXNEG: ASCII / -34359738368/
TXNEGP: POINT 7,YTXB(XLOW),20
LIT
END