$PAGELENGTH(66) XREF DEBUG
;
;	MODIFIED BY CHARLES CHERNACK 11/29/77
;
;
	NAME	FMTR

	PUBLIC	CONV
	PUBLIC	FINPT
	PUBLIC	MULT
	PUBLIC	PTVAL
	PUBLIC	DCOMP
	PUBLIC	MCHK

	EXTRN	INP,OUTR,ZCHK,WZER,DADD
	EXTRN	LMUL,LDIV,FLOAT



	CSEG


$TITLE('FLOATING POINT <FORMAT> PACKAGE 11/29/77')
 ;******************************************************
 ;		 //// 5 DIGIT FLOATING PT. OUTPUT
 ;******************************************************
 ;
 ;
 ;
 ;
 ;		 ROUTINE TO CONVERT FLOATING PT.
 ;		 NUMBERS TO ASCII AND OUTPUT THEM VIA <OUTR> 
 ;
 ;
CONV:	  CALL	ZCHK		 ;CHECK FOR NEW ZERO
	 JNZ	 NNZRO		;NOT ZERO
	 INR	 C			 ;IT WAS, OFFSET C BY 2
	 INR	 C
	 MOV	 L,C
	 CALL	WZER		 ;WRITE ZERO
	 INR	 L			 ;PNT TO DECIMAL EXPONENT
	 INR	 L
	 INR	 L
	 INR	 L
	 XRA	 A			 ;SET IT TO ZERO
	 MOV	 M,A
	 JMP	 MDSKP		;OUTPUT IT
NNZRO:	 MOV	 D,M		  ;/GET THE NUMBER TO CONVERT
	INR L
	MOV B,M
	INR L
	MOV E,M
	INR L		 ;/4 WORD***TP
	MOV A,M	  ;/***TP
	INR C		 ;/OFFSET SCRATCH POINTER BY 2
	INR C
	MOV L,C	  ;/L NOT NEEDED ANY MORE
	MOV M,D	  ;/SAVE NUMBER IN SCRATCH
	INR L
	MOV M,B
	INR L
	MOV M,E	  ;/***TP
	INR L		 ;/***TP
	MOV B,A	  ;/SAVE COPY OF CHAR ] SIGN
	ANI 177Q	 ;GET ONLY CHAR.
	MOV M,A	  ;/SAVE ABS(NUMBER)
	CPI 100Q	 ;CK FOR ZERO
	JZ  NZRO
	SUI 1		 ;/GET SIGN OF DEC. EXP
	ANI 100Q	 ;/GET SIGN OF CHAR.
 NZRO:	RLC			;MOVE IT TO SIGN POSITION
	INR L		 ;/MOVE TO DECIMAL EXP.
	MOV M,A	  ;/SAVE SIGN OF EXP.
	MOV A,B	  ;/GET MANT. SIGH BACK
	CALL SIGN	;/OUTPUT SIGN
	LXI D,TEN5	;/TRY MULT. OR DIV. BY 100000 FIRST
	CALL COPT	;/MAKE A COPY IN RAM
 TST8:	CALL GCHR	;/GET CHAR. OF NUMBER
	MOV B,A	  ;/SAVE A COPY
	ANI 100Q	 ;/GET ABSOLUTE VALUE OF CHAR
	MOV A,B	  ;/INCASE PLUS
	JZ  GOTV	 ;/ALREADY PLUS
	MVI A,200Q		  ;/MAKE MINUS INTO PLUS
	SUB B		 ;/PLUS=200B-CHAR
 GOTV:	CPI 22Q	  ;/TEST FOR USE OF 100000
	JM  TRY1	 ;/WONT GO
	CALL MORD	;/WILL GO SO DO IT
	ADI 5		 ;/INCREMENT DEC. EXPONENT BY 5
	MOV M,A	  ;/UPDATE MEM
	JMP TST8	 ;/GO TRY AGAIN
TRY1:	 LXI D,TEN  ;/NOW USE JUST TEN
	CALL COPT	;/PUT IT IN RAM
 TST1:	CALL GCHR	;/GET CHARACTERISTIC
	CPI 1		 ;/MUST GET IN RANGE 1 TO 6
	JP  OK1	  ;/ATLEAST ITS 1 OR BIGGER
 MDGN:	CALL MORD	;/MUST MUL OF DIV BY 10
	ADI 1		 ;/INCREMENT DECIMAL EXP.
	MOV M,A	  ;/UPDATE MEM
	JMP TST1	 ;/NOW TRY AGAIN
 OK1:	 CPI 7		 ;/TEST FOR LESS THAN 7
	JP  MDGN	 ;/NOPE - 7 OR GREATER
MDSKP:	 MOV	 L,C		  ;/SET UP DIGIT COUNT
	DCR L
	DCR L		 ;/IN 1ST WORD OF SCRATCH
	MVI M,5	  ;/5 DIGITS
	MOV E,A	  ;/SAVE CHAR. AS LEFT SHIFT COUNT
	CALL LSFT	;/SHIFT LEFT PROPER NUMBER
	CPI 12Q	  ;/TEST FOR 2 DIGITS HERE
	JP  TWOD	 ;/JMP IF 2 DIGITS TO OUTPUT
	CALL DIGO	;/OUTPUT FIRST DIGIT
 POPD:	CALL MULTT		  ;/MULTIPLY THE NUMBER BY 10
 INPOP:  CALL DIGO	;/PRINT DIGIT IN A
	JNZ POPD	 ;/MORE DIGITS?
	MVI A,305Q		  ;/NO SO PRINT E
	CALL OUTR	;/BASIC CALL TO OUTPUT
	CALL GETEX		  ;/GET DECIMAL EXP
	MOV B,A	  ;/SAVE A COPY
	CALL SIGN	;/OUTPUT SIGN
	MOV A,B	  ;/GET EXP BACK
	ANI 77Q	  ;/GET GOOD BITS
	CALL CTWO	;/GO CONVERT 2 DIGITS
 DIGO:	ADI 260Q	 ;/MAKE A INTO ASCII
	CALL OUTR	;/OUTPUT DIGIT
	MOV L,C	  ;/GET DIGIT COUNT
	DCR L		 ;/BACK UP TO DIGIT COUNT
	DCR L
	MOV A,M	  ;/TEST FOR DECIMAL PT
	CPI 5		 ;/PRINT . AFTER 1ST DIGIT
	MVI A,256Q		  ;/JUST IN CASE
	CZ  OUTR	 ;/OUTPUT . IF 1ST DIGIT
	MOV D,M	  ;/NOW DECREMENT DIGIT COUNT
	DCR D
	MOV M,D	  ;/UPDATE MEM AND LEAVE FLOPS SET
	RET			;/SERVES AS TERM FOR DIGO ] CVRT
 MULTT:  MVI E,1	  ;/MULT. BY 10 (START WITH X2)
	CALL LSFT	;/LEFT SHIFT 1 = X2
	MOV L,C	  ;/SAVE X2 IN ^RESULT^
	DCR L		 ;/SET TO TOP OF NUMBER
	MOV A,C	  ;/SET C TO RESULT
	ADI 11Q
	MOV C,A	  ;/NOW C SET RIGHT
	MOV A,H	  ;/SHOW RAM TO RAM TRANSFER
	CALL COPY	;/SAVE X2 FINALLY
	MOV A,C	  ;/MUST RESET C
	SUI 11Q	  ;/BACK TO NORMAL
	MOV C,A
	MVI E,2	  ;/NOW GET (X2)X4=X8
	MOV L,C	  ;/BUT MUST SAVE OVERFLOW
	DCR L
	CALL TLP2	;/GET X8
	MOV L,C	  ;/SET UP TO CALL DADD
	MOV A,C	  ;/SET B TO X2
	ADI 12Q	  ;/TO X2
	MOV B,A
	CALL DADD	;/ADD TWO LOW WORDS
	DCR L		 ;/BACK UP TO OVERFLOW
	MOV A,M	  ;/GET IT
	MOV L,B	  ;/NOW SET TO X2 OVERFLOW
	DCR L		 ;/ITS AT B-1
	ADC M		 ;/ADD WITH CARRY - CARRY WAS PRESERVED
	RET			;/ALL DONE, RETURN OVERFLOW IN A
 LSFT:	MOV L,C	  ;/SET PTR FOR LEFT SHIFT OF NUMBER
	DCR L		 ;/BACK UP TO OVERFLOW
	XRA A		 ;/OVERFLOW=0 1ST TIME
 TLOOP:  MOV M,A	  ;/SAVE OVERFLOW
 TLP2:	DCR E		 ;/TEST FOR DONE
	RM			 ;/DONE WHEN E MINUS
	INR L		 ;/MOVE TO LOW
	INR L
	INR L		 ;/***TP EXTENSION
	MOV A,M	  ;/SHIFT LEFT 4 BYTES
	RAL
	MOV M,A	  ;/PUT BACK
	DCR L		 ;/***TP - ALL DONE
	MOV A,M	  ;/GET LOW
	RAL			;/SHIFT LEFT 1
	MOV M,A	  ;/RESTORE IT
	DCR L		 ;/BACK UP TO HIGH
	MOV A,M	  ;/GET HIGH
	RAL			;/SHIFT IT LEFT WITH CARRY
	MOV M,A	  ;/PUT IT BACK
	DCR L		 ;/BACK UP TO OVERFLOW
	MOV A,M	  ;/GET OVERFLOW
	RAL			;/SHIFT IT LEFT
	JMP TLOOP	;/GO FOR MORE
 SIGN:	ANI 200Q	 ;/GET SIGN BIT
	MVI A,240Q		  ;/SPACE INSTEAD OF PLUS
	JZ  PLSV	 ;/TEST FOR +
	MVI A,255Q		  ;/NEGATIVE
 PLSV:	CALL OUTR	;/OUTPUT SIGN
	RET
 GCHR:	MOV L,C	  ;/GET CHARCTERISTIC
 GETA:	INR L		 ;/MOVE TO IT
	INR L
	INR L		 ;/***TP
	MOV A,M	  ;/FETCH INTO A
	RET			;/DONE
 MORD:	CALL GETEX		  ;/MUL OR DIV DEPENDING ON EXP
	MOV E,A	  ;/SAVE DECIMAL EXP
	MOV B,L	  ;/SET UP TO MULT OR DIV
	INR B		 ;/NOW BOP POINTER SET
	MOV L,C	  ;/L POINTS TO NUMBER TO CONVERT
	MOV A,C	  ;/POINT C AT ^RESULT^ AREA
	ADI 11Q	  ;/IN SCRATCH
	MOV C,A	  ;/NOW C SET RIGHT
	MOV A,E	  ;/NOW TEST FOR MUL
	ANI 200Q	 ;/TEST NEGATIVE DEC. EXP.
	JZ  DIVIT	;/IF EXP IS + THEN DIVIDE
	CALL LMUL	;/MULT.
 FINUP:  MOV A,C	  ;/SAVE LOC. OF RESULT
	MOV C,L	  ;/C=LOC OF NUMBER (IT WAS DESTROYED)
	MOV L,A	  ;/SET L TO LOC. OF RESUTL
	MOV A,H	  ;/SHOW RAM TO RAM TRANSFER
	CALL COPY	;/MOVE RESULT TO NUMBER
 GETEX:  MOV L,C	  ;/NOW GET DECIMAL EXP
	INR L
	JMP GETA	 ;/USE PART OF GCHR
 DIVIT:  CALL LDIV	;/DIVIDE
	JMP FINUP
 TWOD:	CALL CTWO	;/CONVERT TO 2 DIGITS
	MOV B,A	  ;/SAVE ONES DIGIT
	CALL GETEX		  ;/GET DECIMAL EXP
	MOV E,A	  ;/SAVE A COPY
	ANI 200Q	 ;/TEST FOR NEGATIVE
	JZ  ADD1	 ;/BUMP EXP BY 1 SINCE 2 DIGITS
	DCR E		 ;/DECREMENT NEGATIVE EXP SINCE 2 DIGITS
 FINIT:  MOV M,E	  ;/RESTORE EXP WITH NEW VALUE
	MOV A,B	  ;/NOW DO 2ND DIGIT
	JMP INPOP	;/GO OUT 2ND AND REST FO DIGITS
 ADD1:	INR E		 ;/COMPENSATE FOR 2 DIGITS
	JMP FINIT
 CTWO:	MVI E,377Q		  ;/CONVERT 2 DIGIT BIN TO BCD
 LOOP:	INR E		 ;/ADD UP TENS DIGIT
	SUI 12Q	  ;/SUBTRACT 10
	JP  LOOP	 ;/TIIL NEGATIVE RESULT
	ADI 12Q	  ;/RESTORE ONES DIGIT
	MOV B,A	  ;/SAVE ONES DIGIT
	MOV A,E	  ;/GET TENS DIGIT
	CALL DIGO	;/OUTPUT IT
	MOV A,B	  ;/SET A TO 2ND DIGIT
	RET


;	MOVE 4 BYTES FROM SOURCE (DE) TO DESTINATION (HC+5)
;
COPT:	PUSH	H
	PUSH	B
	MOV	A,C
	ADI	5
	MOV	C,A	; C <= C+5
	MOV	B,H	; BC WILL BE DESTINATION
	MVI	L,4	; 4 BYTES
;
COPT1:	LDAX	D
	STAX	B
	INX	D
	INX	B
	DCR	L
	JNZ	COPT1
;
	POP	B
	POP	H
	RET

 COPY:	MOV B,H	  ;/SAVE RAM H
	MOV H,A	  ;/SET TO SOURCE H
	MOV A,M	  ;/GET 4 WORDS INTO THE REGS.
	INR L
	MOV D,M
	INR L
	MOV E,M
	INR L
	MOV L,M	  ;/LAST ONE ERASES L
	MOV H,B	  ;/SET TO DESTINATION RAM
	MOV B,L	  ;/SAVE 4TH WORD IN B
	MOV L,C	  ;/SET TO DESTINATION
	MOV M,A	  ;/SAVE FIRST WORD
	INR L
	MOV A,M	  ;/SAVE THIS WORD IN A (INPUT SAVES C HERE
	MOV M,D	  ;/NOW PUT 2ND WORD
	INR L
	MOV M,E
	INR L
	MOV M,B	  ;/ALL 4  COPIED NOW
	RET			;/ALL DONE
 ;
 ;
 TEN5:  DB 303Q,120Q,0Q,21Q  ;/303240(8) = 100000.
 TEN:	DB 240Q,0Q,0Q,4Q  ;/12(8) = 10
 ;
 ;		 SCRATCH MAP FOR I/O CONVERSION ROUTINES
 ;
 ;		 RELATIVE TO (C+2)USE
 ;		 C-2		 DIGIT COUNT
 ;		 C-1		 OVERFLOW
 ;		 C			HIGH NUMBER - MANTISSA
 ;		 C+1		 LOW NUMBER
 ;		 C+2		 CHARACTERISTIC
 ;		 C+3		 DECIMAL EXPONEXT (SIGN ] MAG.)
 ;		 C+4		 TEN**N
 ;		 C+5		 TEN**N
 ;		 C+6		 TEN**N
 ;		 C+7		 RESULT OF MULT ] DIV
 ;		 C+8		 AND TEMP FOR X2
 ;		 C+9		 ^		 ^
 ;		 C+10		L FOR NUMBER TO GO INTO (INPUT ONLY)
 ;		 C+11		DIGIT JUST INPUT (INPUT ONLY)
 ;
 ;
 ;			  /*****BEGIN INPUT*************
 ;
 ;
ERR:		STC			;ERROR FLAG
	 RET			;AND RETURN
$EJECT
 ;********************************************************
 ;		 //// 4 1/2 DIGIT INPUT ROUTINE
 ;*******************************************************
 ;
 ;
 ;			  /L POINTS TO WHERE TO PUT INPUT NUMBER
 ;			  /C POINTS TO 13(10) WORDS OF SCRATCH
 ;
FINPT:  MOV B,L	  ;/SAVE ADDRESS WHERE DATA IS TO GO
	MOV A,C	  ;/IN SCRATCH
	ADI 17Q	  ;/COMPUTE LOC. IN SCRATCH
	MOV L,A
	MOV M,B	  ;/PUT IT
	INR C		 ;/OFFSET SCRATCH POINTER
	INR C		 ;/BY 2
	CALL ZROIT		  ;/ZERO NUMBER
	INR L		 ;/AND ZERO
	MOV M,A	  ;/DECIMAL EXPONENT
	CALL GNUM	;/GET INTEGER PART OF NUM
	CPI 376Q	 ;/TERM=.?
	JZ  DECPT	;/YES
 TSTEX:  CPI 25Q	  ;/TEST FOR E
	JZ  INEXP	;/YES - HANDLE EXP
	CPI 360Q	 ;/TEST FOR SPACE TERM (240B-260B)
	JNZ ERR	  ;/NOT LEGAL TERM
	CALL FLTSGN		 ;/FLOAT : AND SIGN IT
 SCALE:  CALL GETEX		  ;/GET DECIMAL EXP
	ANI 177Q	 ;/GET GOOD BITS
	MOV E,A	  ;/SAVE COPY
	ANI 100Q	 ;/GET SIGN OF EXP
	RLC			;/INTO SIGN BIT
	ORA A		 ;/SET FLOPS
	MOV B,A	  ;/SAVE SIGN
	MOV A,E	  ;/GET EXP BACK
	JZ  APLS	 ;/JMP IS +
	MVI A,200Q		  ;/MAKE MINUS +
	SUB E		 ;/NOW ITS +
 APLS:	ADD B		 ;/SIGN NUMBER
	MOV M,A	  ;/SAVE EXP (SIGN ] MAG.)
	LXI D,TEN5  ;/TRY MORD WITH 10**5 FIRST
	CALL COPT	;/TRANSFER TO RAM
	CALL GETEX		  ;/GET DECIMAL EXP
 INT5:	ANI 77Q	  ;/GET MAG. OF EXP
	CPI 5Q		;/TEST FOR USE OF 10**5
	JM  TRYTN	;/WONT GO - TRY 10
	CALL MORD	;/WILL GO SO DO IT
	SUI 5Q		;/MAG = MAG -5
	MOV M,A	  ;/UPDATE DEC. EXP IN MEM
	JMP INT5	 ;/GO TRY AGAIN
TRYTN:	LXI D,TEN  ;/PUT TEN IN RAM
	CALL COPT
	CALL GETEX		  ;/SET UP FOR LOOP
 INT1:	ANI 77Q	  ;/GET MAGNITUDE
	ORA A		 ;/TEST FOR 0
	JZ  SAVEN	;/DONE, MOVE NUM OUT AND GET OUT
	CALL MORD	;/NOT DONE - DO 10
	SUI 1Q		;/EXP = EXP -1
	MOV M,A	  ;/UPDATE MEM
	JMP INT1	 ;/TRY AGAIN
 DECPT:  MOV L,C	  ;/ZERO DIGIT COUNT
	DCR L		 ;/SINCE ITS NECESSARY
	DCR L		 ;/TO COMPUTE EXP.
	MVI M,0	  ;/ZEROED
	CALL EP1	 ;/GNUM IN MIDDLE
	MOV E,A	  ;/SAVE TERMINATOR
	MOV L,C	  ;/MOVE DIGIT COUNT TO EXP
	DCR L		 ;/BACK UP TO DIGIT COUNT
	DCR L
	MOV B,M	  ;/GOT DIGIT COUNT
	CALL GETEX		  ;/SET L TO DEC. EXP
	MOV M,B	  ;/PUT EXP
	MOV A,E	  ;/TERM BACK TO A
	JMP TSTEX	;/TEST FOR E+OR-XX
 INEXP:  CALL FLTSGN		 ;/FLOAT AND SIGN NUMBER
	CALL SAVEN		  ;/SAVE NUMBER IN (L) TEMP
	CALL ZROIT		  ;/ZERO OUT NUM. FOR INPUTTING EXP
	CALL GNUM	;/NOW INPUT EXPONENT
	CPI 360Q	 ;/TEST FOR SPACE TERM.
	JNZ ERR	  ;/NOT LEGAL - TRY AGAIN
	MOV L,C	  ;/GET EXP OUT OF MEM
	INR L		 ;/***TP
	INR L		 ;/EXP LIMITED TO 5 BITS
	MOV A,M	  ;/GET LOWEST 8 BITS
	ANI 37Q	  ;/GET GOOD BITS
	MOV B,A	  ;/SAVE THEM
	INR L		 ;/GET SIGN OF EXP
	MOV A,M	  ;/INTO A
	ORA A		 ;/SET FLOPS
	MOV A,B	  ;/INCASE NOTHING TO DO
	JM  USEIT	;/IF NEG. USE AS +
	MVI A,0Q	 ;/IF + MAKE -
	SUB B		 ;/0-X = -X
 USEIT:  INR L		 ;/POINT AT EXP
	ADD M		 ;/GET REAL DEC. EXP
	MOV M,A	  ;/PUT IN MEM
	MOV A,C	  ;/NOW GET NUMBER BACK
	ADI 15Q	  ;/GET ADD OF L
	MOV L,A	  ;/L POINTS TO L OF NUMBER
	MOV L,M	  ;/NOW L POINTS TO NUMBER
	MOV A,H	  ;/RAM TO RAM COPY
	CALL COPY	;/COPY IT BACK
	JMP SCALE	;/NOW ADJUST FOR EXP
 GNUM:	CALL INP	 ;/GET A CHAR
	CPI 240Q	 ;/IGNORE LEADING SPACES
	JZ  GNUM
	CPI 255Q	 ;/TEST FOR -
	JNZ TRYP	 ;/NOT MINUS
	MOV L,C	  ;/MINUS SO SET SIGN
	INR L		 ;/IN CHAR LOC.
	INR L		 ;/***TP
	INR L
	MVI M,200Q		  ;/SET - SIGN
	JMP GNUM
 TRYP:	CPI 253Q	 ;/IGNORE +
	JZ  GNUM
 TSTN:	SUI 260Q	 ;/STRIP ASCII
	RM			 ;/RETURN IF TERM
	CPI 12Q	  ;/TEST FOR NUMBER
	RP			 ;/ILLEGAL
	MOV E,A	  ;/SAVE DIGIT
	CALL GETN	;/LOC. OF DIGIT STORAGE TO L
	MOV M,E	  ;/SAVE DIGIT
	CALL MULTT		  ;/MULT NUMBER BY 10
	ORA A		 ;/TEST FOR TOO MANY DIGITS
	RNZ			;/TOO MANY DIGITS
	CALL GETN	;/GET DIGIT
	MOV L,C	  ;/SET L TO NUMBER
	INR L
	INR L		 ;/***TP
	ADD M		 ;/ADD IN THE DIGIT
	MOV M,A	  ;/PUT RESULT BACK
	DCR L		 ;/NOW DO HIGH
	MOV A,M	  ;/GET HIGH TO ADD IN CARRY
	ACI 0Q		;/ADD IN CARRY
	MOV M,A	  ;/UPDATE HIGH
	DCR L		 ;/***TP EXTENSION
	MOV A,M
	ACI 0Q		;/ADD IN CARRY
	MOV M,A	  ;/***TP ALL DONE
	RC			 ;/OVERFLOW ERROR
	DCR L		 ;/BUMP DIGIT COUNT NOW
	DCR L
	MOV B,M	  ;/GET DIGIT COUNT
	INR B		 ;/BUMP DIGIT COUNT
	MOV M,B	  ;/UPDATE DIGIT COUNT
 EP1:	 CALL INP	 ;/GET NEXT CHAR
	JMP TSTN	 ;/MUST BE NUM. OR TERM
FLTSGN:  MOV	  L,C	;POINT L AT NUMBER TO FLOAT
	JMP	  FLOAT		 ;GO FLOAT IT
 SAVEN:  MOV A,C	  ;/PUT NUMBER IN (L)
	ADI 15Q	  ;/GET ADD OF L
	MOV L,A
	MOV E,M	  ;/GET L OF RESULT
	MOV L,E	  ;/POINT L AT (L)
	INR L		 ;/SET TO 2ND WORD TO SAVE C
	MOV M,C	  ;/SAVE C IN (L) +1 SINCE IT WILL BE DESTROYED
	MOV L,C	  ;/SET UP TO CALL COPY
	MOV C,E	  ;/NOW L]C SET
	MOV A,H	  ;/RAM TO RAM COPY
	CALL COPY	;/COPY TO L
	MOV C,A	  ;/(L)+1 RETURNED HERE SO SET AS C
	 ORA	 A			 ;MAKE SURE CY=0 (NO ERROR)
	RET			;/NOW EVERYTHING HUNKY-DORRY
 GETN:	MOV A,C	  ;/GET DIGIT
	ADI 16Q	  ;/LAST LOC. IN SCRATCH
	MOV L,A	  ;/PUT IN L
	MOV A,M	  ;/GET DIGIT
	RET
 ZROIT:  MOV L,C	  ;/ZERO NUMBER
	XRA A
	MOV M,A	  ;/***TP
	INR L		 ;/***TP
	MOV M,A
	INR L
	MOV M,A
	INR L		 ;/NOW SET SIGN TO +
	MOV M,A
	RET			;/DONE
; CONTAIN LOW BYTE OF TWO BYTE VALUE. RETURNS CY=1 IF
; BC<DE, CY=0 IF BC_DE: Z=1 IF BC=DE.
DCOMP:	 MOV	 A,E
	 CMP	 C
	 RNZ
	 MOV	 A,D
	 CMP	 B
	 RET
; ROUTINE TO ADJUST VALUES OF BIN, FORWARD PNT. AND
; LINE LENGTH OF SOURCE LINE.  PASSED ADD OF TEMP VARIABLE
; CONTAINING ADD OF SOURCE LINE.
PTVAL:	 PUSH	PSW
	 PUSH	D
	 PUSH	H
	 MVI	 A,002
	 MOV	 E,M
	 INR	 L
	 MOV	 D,M
	 INR	 L
	 PUSH	D
N1:		 XTHL
	 MOV	 E,M
	 INX	 H
	 MOV	 D,M
	 INX	 H
	 XTHL
	 MOV	 M,E
	 INR	 L
	 MOV	 M,D
	 INR	 L
	 DCR	 A
	 JNZ	 N1
	 XTHL
	 MOV	 D,M
	 POP	 H
	 MOV	 M,D
	 POP	 H
	 POP	 D
	 POP	 PSW
	 RET
; ROUTINE TO CHK FLAGS ON INPUT AND OUTPUT.
; PASSED FLAG VALUE IN REG B.
MCHK:	  PUSH	PSW
MCHK1:	 IN	  3
	 ANA	 B
	 JZ	  MCHK1
	 POP	 PSW
	 RET
$EJECT
; MULTIPLICATION ROUTINE (ADD. VALUES)
MULT:	  MOV	 E,M
	 DCX	 H
	 MOV	 D,M
	 MVI	 M,11H
	 MVI	 B,0
	 MOV	 C,B
TOP:		MOV	 A,E
	 RAR
	 MOV	 E,A
	 MOV	 A,D
	 RAR
	 DCR	 M
	 MOV	 D,A
	 RZ
	 JNC	 SHIFT
	 DCX	 H
	 DCX	 H
	 MOV	 A,B
	 ADD	 M
	 MOV	 B,A
	 INX	 H
	 MOV	 A,C
	 ADC	 M
	 MOV	 C,A
	 INX	 H
SHIFT:	 MOV	 A,C
	 RAR
	 MOV	 C,A
	 MOV	 A,B
	 RAR
	 MOV	 B,A
	 JMP	 TOP
	END