FORMATIT	MACRO
	LOCAL	SEXP,LEN,NUMPLACE,NUMZEROES,WHERE,BINDX,NUMBLNKS,LSTDIG
	LOCAL	CH1,I,EXPV,DECLOC,FRONT

	IF	TRS80
RTPOFFSET EQU	4200H
	ELSE
RTPOFFSET EQU	0
	ENDIF


;;
;;	FORMAT REAL NUMBERS VIA DEC AND WIDTH
;;	WRITTEN BY NANCY J. LEHMAN
;;
;;	CONVERTED FROM A PROGRAM COMPILED BY THE PASCAL/MT COMPILER
;;	RELEASE 2.04X
;;
;;	LAST UPDATE:	SEPTEMBER 29, 1979 BY MGL AND NJL
;;

NUMDIGS	EQU	7
PREBUFF	EQU	000AH
SEXP	EQU	0014H
MUL16	EQU	MUL
LB0015	EQU	CHRW
LB0016	EQU	CRLF
LB0017	EQU	INTEQ
LB0018	EQU	INTGT
LB0019	EQU	INTLT
LB0020	EQU	INTGE
LB0021	EQU	FORASSIST
LB0022	EQU	BOOLLE


DECCONV:
	JMP	LB0074

EXPCONV:
LB0024:	LXI	H,SEXP
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LXI	H,'0'
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LXI	H,PREBUFF
	PUSH	H
	CALL	MUL16
	LXI	H,SEXP
	PUSH	H
	LXI	H,2
	POP	D
	DAD	D
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LXI	H,'0'
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	POP	D
	DAD	D
	SHLD	EXPV
	RET
;;
;;	END OF EXPCONV

;;
;;	START OF MOVEDR
;;
MOVEDR:
LB0026:	LHLD	EXPV
	PUSH	H
	LXI	H,0
	PUSH	H
	CALL	LB0017
	POP	PSW
	JNC	LB0027
	LHLD	FRONT
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	XCHG
	MOV	A,L
	STA	CH1
	LHLD	FRONT
	PUSH	H
	LXI	H,'0'
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	FRONT
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	FRONT
	LHLD	FRONT
	PUSH	H
	LDA	CH1
	MOV	L,A
	MVI	H,00H
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	LEN
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	SHLD	LEN
	JMP	LB0031
LB0027:	LHLD	EXPV
	PUSH	H
	LXI	H,NUMDIGS
	PUSH	H
	CALL	LB0019
	POP	PSW
	JNC	LB0028
	LHLD	EXPV
	SHLD	NUMPLACE
	JMP	LB0029
LB0028:	LXI	H,NUMDIGS
	SHLD	NUMPLACE
LB0029:	LXI	H,0
	SHLD	I
	PUSH	H
	LHLD	NUMPLACE
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	CALL	LB0021
	PUSH	H
LB0030:	POP	H
	MOV	A,H
	ORA	A
	JM	LB0031
	DCX	H
	PUSH	H
	LHLD	DECLOC
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	XCHG
	MOV	A,L
	STA	CH1
	LHLD	DECLOC
	PUSH	H
	LHLD	DECLOC
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	DECLOC
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	LDA	CH1
	MOV	L,A
	MVI	H,00H
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	DECLOC
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	SHLD	DECLOC
	LHLD	I
	INX	H
	SHLD	I
	JMP	LB0030
LB0031:	RET
;;
;;	END OF MOVEDR
;;


ADDZEROES:
LB0033:	MVI	A,02H
	POP	B
	LXI	H,WHERE+2
LB0034:	POP	D
	DCX	H
	MOV	M,D
	DCX	H
	MOV	M,E
	DCR	A
	JNZ	LB0034
	PUSH	B
;;
;;	END OF COPYING PARMS
;;

LB0035:	LHLD	NUMZEROES
	PUSH	H
	LXI	H,0
	PUSH	H
	CALL	LB0018
	POP	PSW
	JNC	LB0036
	LHLD	WHERE
	PUSH	H
	LXI	H,'0'
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	NUMZEROES
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	NUMZEROES
	LHLD	WHERE
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	SHLD	WHERE
	JMP	LB0035
LB0036:	RET
;;
;;	END OF ADDZEROES
;;


BLANKS:
LB0038:	MVI	A,02H
	POP	B
	LXI	H,NUMBLNKS+2
LB0039:	POP	D
	DCX	H
	MOV	M,D
	DCX	H
	MOV	M,E
	DCR	A
	JNZ	LB0039
	PUSH	B
;;
;;	END OF PARM COPY
;;

	LXI	H,0
	SHLD	I
	PUSH	H
	LHLD	NUMBLNKS
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	CALL	LB0021
	PUSH	H
LB0040:	POP	H
	MOV	A,H
	ORA	A
	JM	LB0041
	DCX	H
	PUSH	H
	LHLD	BINDX
	PUSH	H
	LHLD	I
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	FRONT
	LHLD	FRONT
	PUSH	H
	LXI	H,' '
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	I
	INX	H
	SHLD	I
	JMP	LB0040
LB0041:	RET
;;
;;	END OF BLANKS
;;


CHECKWIDTH:
LB0043:	LHLD	WIDTH
	PUSH	H
	LHLD	LEN
	PUSH	H
	CALL	LB0018
	POP	PSW
	JNC	LB0044
	LHLD	FRONT
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LHLD	WIDTH
	PUSH	H
	LHLD	LEN
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	CALL	BLANKS
	JMP	LB0045
LB0044:	LHLD	LEN
	SHLD	WIDTH
LB0045:	RET
;;
;;	END OF CHECKWIDTH
;;


WRITEIT:
LB0047:	LHLD	FRONT
	SHLD	I
	PUSH	H
	LHLD	FRONT
	PUSH	H
	LHLD	WIDTH
	POP	D
	DAD	D
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	CALL	LB0021
	PUSH	H
LB0048:	POP	H
	MOV	A,H
	ORA	A
	JM	LB0049
	DCX	H
	PUSH	H
	LHLD	I
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LDA	PRINTFLAG
	ORA	A
	JNZ	LB0049A
	CALL	CHRW
	JMP	LB0049B
LB0049A:
	CALL	PCHRW
LB0049B:

	LHLD	I
	INX	H
	SHLD	I
	JMP	LB0048
LB0049:	;; CALL TO CRLF REMOVED
	RET
;;
;;	END OF WRITEIT
;;

FINISHUP:
LB0051:	LHLD	DEC
	PUSH	H
	LHLD	EXPV
	POP	D
	DAD	D
	PUSH	H
	LXI	H,2
	POP	D
	DAD	D
	SHLD	LEN
	LHLD	EXPV
	PUSH	H
	LXI	H,0
	PUSH	H
	CALL	LB0017
	POP	PSW
	JNC	LB0052
	LHLD	LEN
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	SHLD	LEN
LB0052:	CALL	CHECKWIDTH
	CALL	WRITEIT
	RET
;;
;;	END OF FINISHUP
;;

ROUNDOFF:
LB0054:	MVI	A,01H
	POP	B
	LXI	H,LSTDIG+2
LB0055:	POP	D
	DCX	H
	MOV	M,D
	DCX	H
	MOV	M,E
	DCR	A
	JNZ	LB0055
	PUSH	B
	LHLD	LSTDIG
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LXI	H,'5'
	PUSH	H
	CALL	LB0020
	POP	PSW
	JNC	LB0060
	LHLD	LSTDIG
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	LSTDIG
LB0056:	LHLD	LSTDIG
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LXI	H,'0'
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	LXI	H,9
	PUSH	H
	CALL	LB0018
	POP	PSW
	JNC	LB0059
	LHLD	LSTDIG
	PUSH	H
	LXI	H,'0'
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	LSTDIG
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LHLD	DECLOC
	PUSH	H
	CALL	LB0017
	POP	PSW
	JNC	LB0057
	LHLD	LSTDIG
	PUSH	H
	LXI	H,2
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	LSTDIG
	JMP	LB0058
LB0057:	LHLD	LSTDIG
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	LSTDIG
LB0058:	JMP	LB0056
LB0059:	LHLD	LSTDIG
	PUSH	H
	LHLD	LSTDIG
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
LB0060:	RET
;;
;;	END OF ROUNDOFF
;;

NEGEXP:
LB0062:	LXI	H,PREBUFF
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	XCHG
	MOV	A,L
	STA	CH1
	LHLD	DECLOC
	PUSH	H
	LHLD	EXPV
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	SHLD	FRONT
	LHLD	EXPV
	PUSH	H
	LHLD	FRONT
	PUSH	H
	CALL	ADDZEROES
	LHLD	FRONT
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	DECLOC
	LHLD	DECLOC
	PUSH	H
	LXI	H,'.'
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	DECLOC
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LXI	H,'0'
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	DECLOC
	PUSH	H
	LXI	H,2
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	FRONT
	LHLD	FRONT
	PUSH	H
	LDA	CH1
	MOV	L,A
	MVI	H,00H
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LXI	H,NUMDIGS
	PUSH	H
	LHLD	EXPV
	POP	D
	DAD	D
	PUSH	H
	LXI	H,3
	POP	D
	DAD	D
	SHLD	LEN
	LHLD	LEN
	PUSH	H
	LXI	H,3
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	DIGSLEFT
	LHLD	DIGSLEFT
	PUSH	H
	LHLD	DEC
	PUSH	H
	CALL	LB0018
	POP	PSW
	JNC	LB0063
	LHLD	DECLOC
	PUSH	H
	LHLD	DEC
	POP	D
	DAD	D
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	CALL	ROUNDOFF
	LXI	H,3
	PUSH	H
	LHLD	DEC
	POP	D
	DAD	D
	SHLD	LEN
	CALL	CHECKWIDTH
	CALL	WRITEIT
	JMP	LB0065
LB0063:	LHLD	DIGSLEFT
	PUSH	H
	LHLD	DEC
	PUSH	H
	CALL	LB0019
	POP	PSW
	JNC	LB0064
	LHLD	DEC
	PUSH	H
	LHLD	DIGSLEFT
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LHLD	LEN
	PUSH	H
	LHLD	FRONT
	POP	D
	DAD	D
	PUSH	H
	CALL	ADDZEROES
	LHLD	LEN
	PUSH	H
	LHLD	DEC
	POP	D
	DAD	D
	PUSH	H
	LHLD	DIGSLEFT
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	LEN
	CALL	CHECKWIDTH
	CALL	WRITEIT
	JMP	LB0065
LB0064:	CALL	CHECKWIDTH
	CALL	WRITEIT
LB0065:	RET
;;
;;	END OF NEGEXP
;;

POSEXP:
LB0067:	CALL	MOVEDR
	LXI	H,NUMDIGS
	PUSH	H
	LHLD	EXPV
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	DIGSLEFT
	LHLD	DIGSLEFT
	PUSH	H
	LXI	H,0
	PUSH	H
	CALL	LB0018
	POP	PSW
	JNC	LB0071
	LHLD	DIGSLEFT
	PUSH	H
	LHLD	DEC
	PUSH	H
	CALL	LB0017
	POP	PSW
	JNC	LB0068
	CALL	FINISHUP
	JMP	LB0070
LB0068:	LHLD	DIGSLEFT
	PUSH	H
	LHLD	DEC
	PUSH	H
	CALL	LB0018
	POP	PSW
	JNC	LB0069
	LHLD	DECLOC
	PUSH	H
	LHLD	DEC
	POP	D
	DAD	D
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	CALL	ROUNDOFF
	CALL	FINISHUP
	JMP	LB0070
LB0069:	LHLD	DEC
	PUSH	H
	LHLD	DIGSLEFT
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LHLD	DECLOC
	PUSH	H
	LHLD	DIGSLEFT
	POP	D
	DAD	D
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	CALL	ADDZEROES
	CALL	FINISHUP
LB0070:	JMP	LB0073
LB0071:	LHLD	EXPV
	PUSH	H
	LXI	H,NUMDIGS
	PUSH	H
	CALL	LB0018
	POP	PSW
	JNC	LB0072
	LHLD	EXPV
	PUSH	H
	LXI	H,NUMDIGS
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	PUSH	H
	LHLD	DECLOC
	PUSH	H
	CALL	ADDZEROES
	LHLD	DECLOC
	PUSH	H
	LHLD	EXPV
	POP	D
	DAD	D
	PUSH	H
	LXI	H,NUMDIGS
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	DECLOC
	LHLD	DECLOC
	PUSH	H
	LXI	H,'.'
	PUSH	H
	POP	B
	POP	H
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	M,C
	LHLD	DEC
	PUSH	H
	LHLD	DECLOC
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	CALL	ADDZEROES
	LHLD	DECLOC
	PUSH	H
	LHLD	DEC
	POP	D
	DAD	D
	PUSH	H
	LXI	H,2
	POP	D
	DAD	D
	PUSH	H
	LXI	H,PREBUFF
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	LEN
	CALL	CHECKWIDTH
	CALL	WRITEIT
	JMP	LB0073
LB0072:	LHLD	DEC
	PUSH	H
	LHLD	DECLOC
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	PUSH	H
	CALL	ADDZEROES
	LXI	H,NUMDIGS
	PUSH	H
	LXI	H,2
	POP	D
	DAD	D
	PUSH	H
	LHLD	DEC
	POP	D
	DAD	D
	SHLD	LEN
	CALL	CHECKWIDTH
	CALL	WRITEIT
LB0073:	RET
;;
;;	END OF POSEXP
;;


;;IF FLTOUT LEFT A '0' IN THE SIGN PLACE THEN MANTISSA IS 0.0. THIS
;; CODE MOVES THE BLOCK ZEROSTR INTO BUFF SO DECCONV HAS A ZERO IN
;;PROPER FORMAT

LB0074:	LDA	BUFF+PREBUFF
	CPI	'0'	;IF FLTOUT DID NOT LEAVE 0.0 IN BUFF THEN
	JNZ	GOODREAL	;PROCEED ELSE ...
	LXI	D,ZEROSTR	;SOURCE
	LXI	H,BUFF+PREBUFF	;DEST
	LXI	B,13		;BYTE COUNT
	CALL 	BLKMOVE	;MOVE 0 IN E-FORMAT TO BUFF
GOODREAL:
	CALL	EXPCONV
	LXI	H,PREBUFF
	PUSH	H
	LXI	H,1
	POP	D
	DAD	D
	SHLD	DECLOC
	LXI	H,NUMDIGS
	PUSH	H
	LXI	H,6
	POP	D
	DAD	D
	SHLD	LEN
	LHLD	DECLOC
	PUSH	H
	LXI	H,1
	POP	D
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	FRONT
	LHLD	DEC
	PUSH	H
	LXI	H,0
	PUSH	H
	CALL	LB0017
	POP	PSW
	JNC	LB0075
	CALL	CHECKWIDTH
	CALL	WRITEIT
	JMP	LB0077
LB0075:	LXI	H,SEXP
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LXI	H,'+'
	PUSH	H
	CALL	LB0017
	LXI	H,SEXP
	XCHG
	LXI	H,BUFF
	DAD	D
	MOV	E,M
	MVI	D,00H
	PUSH	D
	LXI	H,' '
	PUSH	H
	CALL	LB0017
	POP	H
	POP	D
	MOV	A,L
	ORA	E
	MOV	L,A
	MOV	A,H
	ORA	D
	MOV	H,A
	PUSH	H
	POP	PSW
	JNC	LB0076
	CALL	POSEXP
	JMP	LB0077
LB0076:	CALL	NEGEXP
LB0077:	JMP	ENDDTA
ZEROSTR:
	DB	' .0000000E+00'
;;
;;	END OF DECCONV
;;



;;
;;	DATA AREA
;;

DEC:	DW	0
WIDTH:	DW	0
I:	DW	0
EXPV:	DW	0
DECLOC:	DW	0
FRONT:	DW	0
LEN:	DW	0
DIGSLEFT:	DW	0
CH1:	DW	0
;;	BUFF USED BY INPUT IS USED FOR OUTPUT TOO
;;
NUMPLACE:	DW	0
NUMZEROES:	DW	0
WHERE:	DW	0
BINDX:	DW	0
NUMBLNKS:	DW	0
LSTDIG:	DW	0
ENDDTA: EQU	$
	ENDM