Google
 

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