*20
	/// FLOAT-HX
/
/
/
/
/ALTERED SO THAT ISTOR1 WILL STORE SAME
/LO ORDER NUMBER THAT ISTOR2 WILL.
/
/--------------------
/
/FLOATIN POINT INTERPRETER
/UTILIZING FFP12
/AND EPM
/
/COPYRIGHT 1972
/N. DAVID CULVER
/
/--------------------
/
/
/
/STORED IN SIGSYS
/BLOCKS 4-7
/RUNS IN BANK 1
/UNDER EXEC CONTROL
/
/
/
	EJECT
/
/
/AC=USER PC
/USRMB AND USDMB PRESET
/
	IOB=500
/
	SEGMNT 1
/
	*2
	FAC+1
	*4
	FAC+2
/
	*20
/
/
	USRMB=JMP .
/
	LDF
	JMP 0
/
	USDMB=JMP .
/
	LDF
	JMP 0
/
/
	*24
INAC,	NOP
INTERP,	STC 6
	ADD 0
	STC GOP
	STC GOAC
	STC DMBLOC
	SKP
/
NXT,	XSK I 6
	NOP
	USRMB
	LDA 6
	SCR I 5
	SAE I
	17
	JMP OTHR
	QAC
	SCR 6
	ADA I
	OPRTAB
	STC 17
	LDA 17
	STC DISP
/
/TEST FOR FAC
TSTIND,	STC INCR
	STC INDR
	LDA I 6
	AZE
	JMP .+3
	JMP FACARG
	JMP GETARG+2
/
/TEST FOR INDIRECT
	ROL I 1
	SCR 5
	APO
	JMP NOINDR
	AZE
	JMP NOINDR
	GETREG
	LZE I
	JMP .+3
	STA I
INCR,	0
	STA I
INDR,	0
	SKP
/
NOINDR,	LDA 6
	STA I
H,	0
	BSE I
C2000,	2000
SETARG,	STC TEMSIN
	JMP UBNK
/
GETARG,	JMP ARGET
TEMSIN,	0
DISP,	JMP
	JMP RET3
/
GO,	CLR
	LDA I
GOAC,	0
	SCR 14
	ADD 6
	USDMB
	LIF 0
GOP,	JMP
/
FACP,	FAC
TEM,	0
	EJECT
RET3,	ADD ONE
RET2,	ADD ONE
RET1,	ADD ONE
RET,	COM
	STC 7
	ADD INCR
	AZE I
	JMP NXT
	USRMB
	GETREG
	STC 10
/
B10,	LDA I 10
	LDA
	10
	STA 3
	BCL I
	6000
	AZE
	JMP NB10
	LDA I
CRFLG,	0
	ADD 22
	STA
DMBLOC,	0
NB10,	XSK I 7
	JMP B10
	JMP NXT
/
	GETREG=JMP .
	LDA 6
	BCL I
	7760
	ADD C2000
	STC 3
	LDA 3
	JMP 0
/
UBNK,	SET 7
	0
	USRMB
	LDA
	H
	ROL I 2
	LZE
	USDMB
	JMP 7
	EJECT
/TEST FOR JMP OR XSK
/AND THEN DO IT
/
OTHR,	SCR 1
	BCL I
	7717
	SHD I
	6000
	JMP ISJMP
/XSK TEST
	LDA 6
	BCL I
	17
	SAE I
	200
	SKP
	JMP TRYSKP
	SAE I
	220
	JMP TSTUB
/
/INDEX
/
	GETREG
	STC 5
	XSK I 5
	NOP
	ADD 5
	STA 3
/
/SKIP  IF 1777
/
TRYSKP,	GETREG
	STC 5
	XSK 5
	SKP
	XSK I 6
	NOP
	JMP NXT
/
TSTUB,	BCL I
	37
	SAE I
	640
	JMP GO 	/FOO
	LDA 6
	STC 22
	ADD 6
	STC DMBLOC
	JMP NXT
/
ISJMP,	LDA 6
	BCL I
	6000
	AZE I
	JMP J0
	LDA
	6
	BCL I
	6000
	AZE I
	JMP J0
	ADD ONE
	BSE I
	6000
	STA
	2000
J0,	LDA 6
	STC 6
	JMP NXT+1
/
CROSS,	ADD ONE
NOCROS, STC CRFLG
	JMP NXT+1
	EJECT
OPRTAB,	JMP STARTE
	JMP FSUB
	JMP FMUL
	JMP FDIV
	JMP FLOAD
	JMP QSTORE
	JMP SETWRD
	JMP INPUT
	JMP OUTPUT
	JMP ISTOR1
	JMP FSQRT
	JMP DFLOAT
	JMP SFLOAT
	JMP DFIX
	JMP FADD
	JMP ISTOR2
	JMP STARTF
	JMP FCOMP
	JMP ZERF
	JMP FAPO
	JMP FAZE
	JMP RECIP
	JMP NEXTIN
	JMP SETIN
	JMP SETOUT
	JMP OUTNUM
	JMP ACAFAC
	JMP ACSFAC
	JMP FACAC
	JMP UNFIX
	JMP CROSS
	JMP NOCROS
FLAG,	0
	EJECT
ARGET,	SET 17
	0
	JMP PSET
	SET 15
	16
	LDA 15
	APO
	JMP TWOCOM
	STC ARG
	UMBTST
	LDA I 15
	STC ARG+1
	UMBTST
	LDA I 15
	STC ARG+2
EXTARG,	JMP ARGX
	LDA I 15
	STC ARG+3
	UMBTST
	LDA I 15
	STC ARG+4
	UMBTST
	LDA I 15
	STC ARG+5
ARGX,	XSK I 17
	JMP 17
/
ARGFAC,	CLR
	ADD ARG
	STC FAC
	ADD ARG+1
	STC FAC+1
	ADD ARG+2
	STC FAC+2
	ADD ARG+3
	STC FAC+3
	ADD ARG+4
	STC FAC+4
	ADD ARG+5
	STC FAC+5
	JMP 0
/
FACARG,	CLR
	ADD FAC
	STC ARG
	ADD FAC+1
	STC ARG+1
	ADD FAC+2
	STC ARG+2
	ADD FAC+3
	STC ARG+3
	ADD FAC+4
	STC ARG+4
	ADD FAC+5
	STC ARG+5
	JMP 0
/
PSET,	LDA
	17
	BCL I
	6000
	STC 16
	LDA 16
	STC 16
	JMP 0
/
/INCOMING DATA
/CHANGE NEGATIVE TO
/TWOS COMPLEMENT
/
/OUTGOING DATA
/CHANGE NEGATIVE TO 
/ONES COMPLEMENT
/
TWOCOM,	PDP
	PMODE
	CLL
	IAC
	LINC
	LMODE
	JMP 0
/
ONECOM,	PDP
	PMODE
	CLL
	TAD TONE
	LINC
	LMODE
	JMP 0
/
TONE,	7777
	EJECT
	UMBTST=JMP .
/
	LDA
	INDR
	AZE I
	JMP 0
	CLR
	XSK 15
	JMP 0
/
UB1,	LDA I
	1
	ADD 22
	STC .+1
	LDF
	JMP 0
	EJECT
DFIX,	JMP ARGFAC
	JMP FIX
	JMP RET3
/
SFLOAT,	JMP UBNK
	LDA 16
	APO
	JMP TWOCOM
	STA 4
	SCR 13
	STA 2
	JMP FLOAT
	JMP RET1
/
DFLOAT,	JMP UBNK
	LDA 16
	STC FAC+2
	LDA I 16
	STA 2
	APO I
	JMP .+5
	LDA 4
	JMP TWOCOM
	STC FAC+2
	LAM 2
	JMP FLOAT
	JMP RET2
/
FLOAD,	JMP ARGFAC
	JMP RET3
/
LOAD,	SET 17
	0
	JMP PSET
	LDA 16
	STC FAC
	LDA I 16
	STC FAC+1
	LDA I 16
	STC FAC+2
	LDA I 16
	STC FAC+3
	LDA I 16
	STC FAC+4
	LDA I 16
	STC FAC+5
	XSK I 17
	JMP 17
/
STORE,	SET 17
	0
	JMP PSET
	SET 15
	16
	JMP FSTORE
	XSK I 17
	JMP 17
/
FSTORE,	LDA
	FAC
	SET 14
	0
	STA 15
	UMBTST
	ADD FAC+1
	STA I 15
	UMBTST
	ADD FAC+2
	STA I 15
FSTEX,	JMP CX
	ADD FAC+3
	STA I 15
	UMBTST
	ADD FAC+4
	STA I 15
	UMBTST
	ADD FAC+5
	STA I 15
CX,	CLR
	JMP 14
/
QSTORE,	JMP UBNK
	LDA
	FAC
	APO
	JMP ONECOM
	SET 15
	16
	JMP FSTORE+2
	JMP RET3
	EJECT
ISTOR1,	JMP NEGFIX
	STA 16
	CLR
	JMP RET1
/
ISTOR2,	JMP NEGFIX
	STA 16
	LDA 2
	STA I 16
	CLR
	JMP RET2
/
/ROUTINE TO CHANGE FIXED FAC
/FOR NEG NUMBERS BY SUBTRACTING 1.
NEGFIX,	LDA
	0
	STC NGFXX
	LDA 2		/HI ORDER
	APO I
	JMP .+11	/NO CHANGE, POS NUM
	LDA 4		/LO ORDER
	JMP ONECOM	/SUBTRACT 1
	STA 4
	LZE
	JMP .+4
	LDA 2		/HI ORDER
	JMP ONECOM
	STA 2
	JMP UBNK	/USERS BANK
	LDA 4		/GET LO ORDER
NGFXX,	0		/EXIT
/
/
SETWRD,	ADD H
	STC ARG2
	JMP NXT
/
FCOMP,	JMP COMP
	JMP NXT+1
/
ZERF,	JMP FZER
	JMP NXT+1
/
FAPO,	ADD FAC+1
	APO I
	XSK I 6
	JMP NXT+1
/
FAZE,	ADD FAC+1
	AZE I
	XSK I 6
	JMP NXT+1
/
FZER,	LDA I
	4010
	STC FAC
	STC FAC+1
	STC FAC+2
	STC FAC+3
	STC FAC+4
	STC FAC+5
	JMP 0
/
RECIP,	JMP LOAD
	FLTONE
	JMP FDIV
	JMP RET3
/
COMP,	SET 17
	0
	LDA I
	2\FNEG
	JMP EXCT
	JMP 17
	EJECT
FADD,	SET 17
	0
	LDA I
	2\FFAD
	JMP EXCT
	JMP 17
/
FSUB,	SET 17
	0
	LDA I
	2\FFSUB
	JMP EXCT
	JMP 17
/
FMUL,	SET 17
	0
	LDA I
	2\FFMUL
	JMP EXCT
	JMP 17
/
FDIV,	SET 17
	0
	LDA I
	2\FFDIV
	JMP EXCT
	JMP 17
/
FIX,	SET 17
	0
	LDA I
	2\FFIX
	JMP EXCT
	JMP 17
/
FLOAT,	SET 17
	0
	LDA I
	27
	STC FAC
	LDA I
	2\FFLT
	JMP EXCT
	JMP 17
/
FSQRT,	LDA I
	2\DSQRT
	JMP EXCT
	JMP RET3
	EJECT
ACSFAC,	ADD INAC
	APO
	JMP TWOCOM
	STA 4
	SCR 13
	JMP ACAFAC+2
/
ACAFAC,	ADD INAC
	STC FAC+2
	STC FAC+1
	JMP FLOAT
	JMP NXT+1
/
FACAC,	JMP FIX
	LDA 4
	STC GOAC
	JMP NXT+1
/
UNFIX,	LDA I
	2\FFLT
	JMP EXCT
	JMP NXT+1
/
STARTE,	LDA I
	ADD FOUR
	STC RET3
	LDA I
	4000
	STC EXCTE
	LDA I
	UMBTST
	STA
	EXTARG
	STC FSTEX
	JMP NXT+1
/
STARTF,	LDA I
	ADD ONE
	STC RET3
	STC EXCTE
	LDA I
	JMP ARGX
	STC EXTARG
	LDA I
	JMP CX
	STC FSTEX
	JMP NXT+1
	EJECT
EXCT,	STC FPC
	ADD 0
	STC XECT
	LDA I
	1210
	IOB
	6553
	LDA I
EXCTE,	0
	IOB
	6567
	LDA I
	2\APT
	IOB
	6555
	JMP .-4
	IOB
	6557
	JMP .-2
	IOB
	6552
	CLR
XECT,	JMP
	EJECT
	DLDA=0200
	DADD=1200
	DSUB=2200
	DDIV=3200
	DMUL=4200
	DSTA=6200
	DALN=10
	DATX=20
	DXTA=30
	DNOP=40
	DEXIT=0
	DPAUS=1
	DCLA=2
	DNEG=3
	DNORM=4
	STRTF=5
	STRTD=6
	JAC=7
	JEQ=1000
	JGE=1010
	JLE=1020
	JA=1030
	JNE=1040
	JLT=1050
	JGT=1060
	JAL=1070
	JXN=2100
	LDX=100
	ADDX=110
	SETX=1100
	SETB=1110
	JSR=1130
	JSA=1120
/
	DARG=0
	DNUM=2
	DINTGR=4
	DFRAC=6
	DSAV=10
	DSUBN=12
	DONE=14
	DHAF=16
	DTEN=20
	EJECT
FFAD,	DADD DARG
	DEXIT
FFSUB,	DSUB DARG
	DEXIT
FFMUL,	DMUL DARG
	DEXIT
FFDIV,	DDIV DARG
	DEXIT
FFLT,	DNORM
	DEXIT
FFIX,	DALN
	DEXIT
FNEG,	DNEG
	DEXIT
/
INTGIZ,	DSTA DNUM
	JAL
	2\.+3
	DALN
	DNORM
	DSTA DINTGR
	DSUB DNUM
	DNEG
	DSTA DFRAC
	DLDA DINTGR
	DEXIT
	EJECT
DSQRT,	DLDA DARG
	JLE
	2\SQRTX
	LDX
	-20+1
/
SQ1,	DMUL DHAF
	DSTA DFRAC
	DLDA DARG
	DDIV DFRAC
	DADD DFRAC
	JXN
	2\SQ1
	DMUL DHAF
SQRTX,	DEXIT
/
	EJECT
/
/INOUT
/INPUT OUTPUT
/ARG1 CONTAINS POINTER
/TO INPUT BUFFER
/
INPUT,	JMP SETIN
	JMP NUMIN
	JMP NXT
/
NEXTIN,	JMP NUMIN
	JMP NXT+1
/
/
NUMIN,	ADD 0
	STC NUMX
	SET I 7
INBEG,	0
	STC MFLAG
	STC NFLAG
	STC PFLAG
	STC FRCNT
	JMP FZER
LOOP1,	JMP STORE 
	NUMBER
	JMP ARGET
	TEN
	LDH I 7
	SHD I
	5500 	/-
	JMP MINUS
	SHD I
	5600 	/.
	JMP PERIOD
	SHD I
	4500
	JMP ENDSCN
	ADA I
	-57
	APO
	JMP CHKFLG
	ADA I
	-12
	APO I
	JMP CHKFLG
GOTONE,	ADD CX
	AZE I
	COM
	STC TEMSIN
	JMP FMUL
	JMP STORE
	NUMBER
	ADD TEMSIN
	STC FAC+2
	STC FAC+1
	JMP FLOAT
	JMP ARGET
	NUMBER
	JMP FADD
	ADD ONE
	STC NFLAG
	ADD PFLAG
	AZE I
	JMP LOOP1
	ADM
	FRCNT
	JMP LOOP1
MINUS,	LDA
	NFLAG
	AZE
	JMP ENDSCN
	ADD ONE
	STC MFLAG
	JMP LOOP1
CHKFLG,	LDA I
NFLAG,	0
	AZE
	JMP ENDSCN
	JMP LOOP1
PERIOD,	LDA I
PFLAG,	0
	AZE
	JMP ENDSCN
	ADD GM1
	STC PFLAG
	JMP LOOP1
/
ENDSCN,	LDA I
FRCNT,	0
	AZE I
	JMP .+5
	STC 10
	JMP FDIV
	XSK I 10
	JMP .-2
	LDA I
MFLAG,	0
	AZE
	JMP COMP
/POINTER FIXUP
	ADD 7
	STC INBEG
	ADD INCR
	AZE I
	JMP NUMX
	USRMB
	GETREG
	LDA
	7
	STA 3
NUMX,	JMP
/
SETIN,	ADD H
	ADD M4000
	BSE I
	2000
	STC INBEG
	JMP 0
/
/FINI INPUT
	EJECT
/OUTNUM
/OUTBEG IS SET TO
/OUTPUT BUFFER
/ARG IS TRANSFERRED TO FAC
/AND OUTPUT
/
OUTNUM,	JMP ARGFAC
	JMP OUT
	JMP RET3
/
/
/
/OUTPUT
/OUTBEG IS POINTER 
/TO BUFFER
/ARG2 CONTAINS CONTROL WORD
/NUMBER IS IN FAC
/
OUTPUT,	JMP SETOUT
	JMP OUT
	LDA
	INCR
	AZE I
	JMP NXT
	USRMB
	GETREG
	LDA
	OUTBEG
	STA 3
	JMP NXT
/
/
OUT,	LDA
	0
	STC OUTX
	SET I 11
OUTBEG,	0
	JMP STORE
	SAVN
	STC TEMSIN
	ADD FAC+1
	APO
	JMP COMPLI
O1,	JMP STORE
	NUMBER
/INITIALIZE OUTPUT BUFFER
/WITH BLANKS
/
	ADD ARG2
	ROL 6
	BCL I
SPCC,	7740
	AZE I
	JMP RET
	COM
	STA I
LNG,	0
	STC 10
/
/BLANK FILL
/
	SET I 12
	4\BUFFER-1
	ADD SPCC
	SKP
	STH I 11
	STH I 12
	STH 11
	XSK I 10
	JMP .-4
	STH I 12
	SET 12
	11
	LDH I 12
	LDA
	12
	STC OUTBEG 	/FOR OUTNUM
	EJECT
/SET BUFFER POINTER
	SET I 10
	4\BUFFER-1
/ROUNDOFF
	ADD GM1
	STC PERLNG
ROUND,	LDA I
ARG2,	0 	/SETWRD VALUE
	BCL I
	7770
C17,	COM
	STA
	FLNGTH
	AZE I
	STC PERLNG
	COM
	ADD ONE
	JMP GETSBN
	ADD ARG2
	ROL 6
	APO I
	JMP SEPNUM
/
/ROUNDOFF FOLLOWS
/
	JMP LOAD
	ONEHAF
	JMP FDIV
/CROCK
/LEAVE IN TO PREVENT
/ARGET OF INTERNAL FRACTION
	JMP FACARG
	JMP LOAD
	NUMBER
	JMP FADD
	JMP STORE
	NUMBER
	JMP SEPNUM
/
GETSBN,	ADD GM1
	STC SUBCT
	ADD 0
	STC GETSBX
	JMP LOAD
	FLTONE
	JMP ARGET
	TEN
/
	LDA I
SUBCT,	0
	APO
	JMP MVGT
	ADD GM1
	STC SUBCT
	JMP FMUL
	JMP .-7
/
MVGT,	JMP FACARG
GETSBX,	JMP
	EJECT
/SEPARATE NUMBER
/INTO INTEGER AND FRACTION
/
SEPNUM,	JMP LOAD
	NUMBER
	LDA I
	2\INTGIZ
	JMP EXCT
	LDA
	ARG2
	BCL I
	4077
	SCR 6
	ADD FLNGTH
	ADA I
PERLNG,	0
	STA I
ILNGTH,	0
	COM
	STC 7
	JMP LOOP6-2
/
LOOP5,	LDA I
GM1,	-1
	ADM
	ILNGTH
LOOP6,	SET I 13
	0
	JMP GETSBN
	JMP LOAD
	INTGER
/FIRST TRY
	JMP FSUB
	ADD FAC+1
	APO I
	JMP OKSUB
	CLR
	JMP FINSUB 	/BIG FIELD
/
	JMP FSUB
	ADD FAC+1
	APO
	JMP .+3
/
OKSUB,	XSK I 13
	JMP .-5
	JMP FADD
	JMP STORE
	INTGER
/
FINSUB,	ADD 13
	ADA I
	-11
	APO I
	JMP STAR
	LDA
	13
	ADD SIXTY
	STH I 10
	XSK I 7
	JMP LOOP5
	LDA
	FLNGTH
	AZE I
	JMP EBT 	/END
/
/DO FRACTION
/
	LDA I
	56
	STH I 10
	JMP LOAD
	FRAC
	SET I 7
FLNGTH,	0
	JMP LOOP4+2
LOOP4,	JMP LOAD
	FRAC
	JMP ARGET
	TEN
	JMP FMUL
	LDA I
	2\INTGIZ
	JMP EXCT
FIXADR,	JMP FIX
	LDA 4 	/POINTS TO FIX
	ADD SIXTY
	STH I 10
	XSK I 7
	JMP LOOP4
	EJECT
/INTERNAL BUFFER
/TO EXTERNAL BUFFER
/TRANSFER
EBT,	SET 16
	LNG
	SET I 12
	4\BUFFER-1
LOOP7,	LDH I 12
	SHD I
	6000
	JMP FILSEV
	SHD I
	4000
	JMP SIXTY-1
	SAE I
	56
	JMP LOOP2
	LDA I
SIXTY,	60
	STH 1
LOOP2,	LDH 10
	SHD I
	5000
	JMP CHKSIN
	STH 11
	XSK I 16
	SKP
	JMP CHKSIN
	LDA I
M4000,	3777
	ADD 10
	STC 10
	ADD M4000
	ADM
	11
	JMP LOOP2
/
COMPLI,	JMP COMP
	LDA I
	55
	STC TEMSIN
	JMP O1
/
FILSEV,	LDA I
	50
	STH 12
	SET 1
	12
	JMP LOOP7
/
CHKSIN,	LDA
	TEMSIN
	AZE
	STH 11
CKX,	JMP LOAD
	SAVN
OUTX,	JMP
/
SETOUT,	ADD H
	BSE I
	2000
	STC OUTBEG
	JMP 0
/
STAR,	LDA I
	77
	STH 11
	JMP CKX
	EJECT
/CONSTANTS
/
	5050
BUFFER,	*.+14
ARG,	*.+6
NUMBER,	*.+6
INTGER,	*.+6
FRAC,	*.+6
SAVN,	*.+6
SUBN,	*.+6
ONE,	
FLTONE,	1
	2000
	0
	0
	0
	0
ONEHAF,	0
	2000
	0
	0
	0
	0
FOUR,	
TEN,	4
	2400
	0
	0
	0
X0,	0
AA,	
/
/
	*1765
APT,	0
FPC,	0
IR0,	2\X0
BASE,	2\ARG
	2\ARG
FAC,	0
	0
	0
	0
	0
	0
/
/
/CONTAINS REVISIONS OF FP FORMAT TO BE
/COMPATABLE WITH FOCAL AND CURRENT SFPP.
/HFPP FP NUMBER FORMAT AS FOLLOWS:
/   EXPONENT - INTERNALLY FOR HFPP IN
/              2S COMP FORM, I.E. FAC IS               ALWAYS IN 2S COMP.
/              STORED FOR USER (STORE, 
/              ISTORE) IN 1S COMP.
/   MANTISSA - ALWAYS IN 2S COMP FORM.
	 
///END FLOAT-HX.
/18 FEB 74.
/NDC,JLB,FHD.