*20
/FRACUS:
/SUBROUTINE TO EXTRACT DECIMAL FRACTIONS
/OR DECIMAL INTEGERS
/FROM QANDA ANSWER FIELDS AND TO DEPOSIT
/THREE WORD FLOATING POINT ANSWER IN CORE.
/
/
	PMODE
	PAGE 0
	*7
	FPNT
	*44
EXP,	0
HORD,	0
LORD,	0
OVER2,	0
EXP1,	0
QUOL,	0
FPAC1,	0
	0
	0
SWIT1,	0
SWIT2,	0
CHAR,	0
DSWIT,	0
FLAG,	0	/ARITHMETIC ERROR FLAG
EX1,	0
AC1H,	0
AC1L,	0
OVER1,	0
/
	PAGE 30
	*6003		/SAVE 0,1 ? 2
FPNT,	0
	CLA CLL
	DCA OVER1
	DCA OVER2
	TAD I FPNT
	DCA JUMP
	TAD JUMP
	AND PAGENO
	SNA CLA
	JMP .+3
	TAD MASK5
	AND FPNT
	DCA ADDR
	TAD MASK7
	AND JUMP
	TAD ADDR
	DCA ADDR
	TAD INDRCT
	AND JUMP
	SNA CLA
	JMP LOOP01
	TAD I ADDR
	DCA ADDR
/
LOOP01,	ISZ FPNT
	TAD I ADDR
	DCA EX1
	TAD ADDR
	DCA SAVE
	ISZ SAVE
	TAD I SAVE
	DCA AC1H
	ISZ SAVE
	TAD I SAVE
	DCA AC1L
	TAD JUMP
	CLL RTL
	RTL
	AND MASK3
	TAD TABLE
	DCA JUMP2
	TAD I JUMP2
	DCA JUMP2
	JMP I JUMP2
/
JUMP,	0
JUMP2,	0
GO2,	0
ADDR,	0
SAVE,	0
MASK3,	17
MASK5,	7600
MASK7,	177
PAGENO,	200
INDRCT,	400
/
TABLE,	.+1
	EXITS
	FLAD
	FLSU
	FLMY
	FLDV
	FLGT
	FLPT
	NORF
/
FLGT,	TAD EX1
	DCA EXP
	TAD AC1H
	DCA HORD
	TAD AC1L
	DCA LORD
	JMP FPNT+1
/
FLPT,	TAD EXP
	DCA I ADDR
	ISZ ADDR
	TAD HORD
	DCA I ADDR
	ISZ ADDR
	TAD LORD
	DCA I ADDR
	JMP FPNT+1
/
FLAD,	JMS I ALGN
	JMP FPNT+1
	JMS I UNORM
	CLL
	TAD OVER1
	TAD OVER2
	DCA OVER2
	RAL
	TAD AC1L
	TAD LORD
	DCA LORD
	RAL
	TAD AC1H
	TAD HORD
	DCA HORD
	JMS I NORM
	JMP FPNT+1
/
FLSU,	JMS I OPMINS
	JMP FLAD
OPMINS,	MINUS2
/
EXITS,	TAD JUMP
	AND MASK3
	SNA
	JMP I FPNT
	TAD ACON6
	DCA JUMP2
	TAD I JUMP2
	DCA JUMP2
	TAD FPNT
	DCA GO2
	JMS I JUMP2
	TAD GO2
	DCA FPNT
	JMP FPNT+1
ACON6,	TABLE6-1
/
FLMY,	CLA IAC
	TAD EX1
	TAD EXP
	DCA EXP
	JMS I MULT
	JMP FPNT+1
/
MULT,	DMULT
NORM,	DNORM
ALGN,	ALIGN
UNORM,	DUNORM
NORF,	JMS I NORM
	JMP FPNT+1
/
	PAGE
ACMINS,	0
	CLL CLA
	TAD OVER2
	CMA IAC
	DCA OVER2
	TAD LORD
	CMA
	SZL
	CLL IAC
	DCA LORD
	TAD HORD
	CMA
	SZL
	CLL IAC
	DCA HORD
	JMP I ACMINS
/
ALIGN,	0
	TAD HORD
	SZA CLA
	JMP .+4
	TAD LORD
	SNA CLA
	JMP NOHERE
	TAD AC1H
	SZA CLA
	JMP .+4
	TAD AC1L
	SNA CLA
	JMP I ALIGN
	TAD EX1
	CMA IAC
	TAD EXP
	SNA
	JMP DONE
	SMA
	CMA IAC
	DCA AMOUNT
	TAD AMOUNT
	TAD TEST2
	SMA CLA
	JMP .+6
	JMS OUTGO
	SZL
	TAD TAG2
	TAD TAG1
	JMP NOGO
	JMS OUTGO
	SNL
	TAD TAG2
	TAD TAG1
	DCA TEST3
	TAD AMOUNT
	CMA IAC
	TAD I TEST3
	DCA I TEST3
	ISZ TEST3
	TAD TEST3
	DCA TEST4
	ISZ TEST4
	TAD TEST4
	DCA TEST5
	ISZ TEST5
/
SHIFT,	CLL
	TAD I TEST3
	SPA
	CML
	RAR
	DCA I TEST3
	TAD I TEST4
	RAR
	DCA I TEST4
	TAD I TEST5
	RAR
	DCA I TEST5
	ISZ AMOUNT
	JMP SHIFT
/
DONE,	ISZ ALIGN
	JMP I ALIGN
/
OUTGO,	0
	TAD EX1
	CMA IAC
	TAD EXP
	RAL
	CLA
	JMP I OUTGO
/
NOGO,	DCA TEST3
	TAD I TEST3
	DCA EXP
	ISZ TEST3
	TAD I TEST3
	DCA HORD
	ISZ TEST3
	TAD I TEST3
	DCA LORD
	JMP I ALIGN
/
NOHERE,	TAD EX1
	DCA EXP
	JMP DONE
/
AMOUNT,	0
TEST2,	30
TEST3,	0
TEST4,	0
TEST5,	0
TAG1,	EXP
TAG2,	EX1-EXP
RETN2,	FPNT+1
/
ERROR3,	TAD GOOF
	DCA EXP
	TAD GOOF
	DCA HORD
	CMA
	DCA LORD
	ISZ FLAG
	JMP I RETN2
GOOF,	3777
/
SQUARE,	0
	JMS I 7
	FPUT FPAC1
	FMPY FPAC1
	FEXT
	JMP I SQUARE
/
EXIT6,	0
	JMP I EXIT6
/
	PAGE
DIV1,	0
	CLA CLL
	TAD HORD
	SPA
	CLL CML
	RAR
	DCA HORD
	TAD LORD
	RAR
	DCA LORD
	TAD OVER2
	RAR
	DCA OVER2
	CLL
	ISZ EXP
	NOP
	JMP I DIV1
/
DMULT,	0
	CLA CLL
	TAD SMACLA
	DCA SNSWIT
	JMS SIGNS
	TAD AC1L
	DCA I MP2PT
	TAD LORD
	JMS I MP4PT
	CLA
	TAD I MP5PT
	DCA OVER2
	TAD HORD
	DCA I MP2PT
	TAD AC1L
	JMS I MP4PT
	TAD OVER2
	DCA OVER2
	RAL
	TAD I MP5PT
	DCA D
	RAL
	DCA KEEP
	TAD AC1H
	DCA I MP2PT
	TAD LORD
	JMS I MP4PT
	TAD OVER2
	DCA OVER2
	RAL
	TAD I MP5PT
	TAD D
	DCA D
	RAL
	TAD KEEP
	DCA KEEP
	TAD HORD
	DCA I MP2PT
	TAD AC1H
	JMS I MP4PT
	TAD D
	DCA LORD
	RAL
	TAD I MP5PT
	TAD KEEP
	DCA HORD
	JMS I NORMF
	DCA OVER2
	ISZ SGN
	JMP I DMULT
	JMS I MINS
	JMP I DMULT
/
FLDV,	TAD AC1H
	SZA CLA
	JMP .+4
	TAD AC1L
	SNA CLA
	JMP I ERROR4
	TAD EX1
	CMA IAC
	TAD EXP
	IAC
	DCA EXP
	TAD SPACLA
	DCA SNSWIT
	JMS SIGNS
	JMS I DIVIDE
	TAD I MP5PT
	TAD AC1H
	SZL CLA
	IAC
	DCA AC1L
	DCA AC1H
	ISZ SGN
	JMS I MINS
	JMP I .+1
	FLAD+2
/
SIGNS,	0
	TAD REST
	DCA SGN
	TAD HORD
	SMA CLA
	JMP .+3
	JMS I MINS
	ISZ SGN
	TAD AC1H
/
SNSWIT,	SMA CLA
	JMP I SIGNS
	JMS I MINS2
	ISZ SGN
	NOP
	JMP I SIGNS
/
MP4PT,	MP4
MP2PT,	MP2
MP5PT,	MP5
NORMF,	DNORM
DIVIDE,	DUBDIV
SPACLA,	SPA CLA
SMACLA,	SMA CLA
RETURN,	FPNT+1
SGN,	0
REST,	7776
D,	0
KEEP,	0
MINS2,	MINUS2
RAR2,	DIV2
MINS,	ACMINS
ERROR4,	ERROR3
/
	PAGE
MINUS2,	0
	CLA CLL
	TAD OVER1
	CMA IAC
	DCA OVER1
	TAD AC1L
	CMA
	SZL
	CLL IAC
	DCA AC1L
	TAD AC1H
	CMA
	SZL
	CLL IAC
	DCA AC1H
	JMP I MINUS2
/
DIV2,	0
	CLA CLL
	TAD AC1H
	SPA
	CLL CML
	RAR
	DCA AC1H
	TAD AC1L
	RAR
	DCA AC1L
	TAD OVER1
	RAR
	DCA OVER1
	CLL
	JMP I DIV2
/
MP4,	0
	DCA MP1
	DCA MP5
	TAD THIR
	DCA MP3
	CLL
	TAD MP1
	RAR
	DCA MP1
	TAD MP5
	SNL
	JMP .+3
	CLL
	TAD MP2
	RAR
	DCA MP5
	ISZ MP3
	JMP MP4+6
	TAD MP1
	RAR
	CLL
	JMP I MP4
/
MP5,	0
MP1,	0
MP3,	0
THIR,	7764
MP2,	0
/
DUBDIV,	0
	CLA CLL
	DCA QUOL
	TAD MIF
	DCA MP3
	JMP DVX
/
DV3,	TAD LORD
	RAL
	DCA LORD
	TAD HORD
	RAL
	DCA HORD
/
DVX,	TAD AC1L
	TAD LORD
	DCA MP2
	RAL
	TAD HORD
	TAD AC1H
	SNL
	JMP DV2-1
	DCA HORD
	TAD MP2
	DCA LORD
	CLA
/
DV2,	TAD QUOL
	RAL
	DCA QUOL
	TAD OVER2
	RAL
	DCA OVER2
	ISZ MP3
	JMP DV3
	TAD QUOL
	DCA LORD
	TAD HORD
	CLL RTL
	DCA MP5
	TAD OVER2
	DCA HORD
	DCA OVER2
	TAD MP5
	JMP I DUBDIV
MIF,	7751
/
TABLE6,	SQUARE
	SQROOT
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
	EXIT6
/
DUNORM,	0
	JMS DIV2
	JMS I RAR1
	ISZ EX1
	NOP
	JMP I DUNORM
RAR1,	DIV1
/
	PAGE
DNORM,	0
	CLA CLL
	DCA AMT1
	DCA SIGN1
	TAD HORD
	SPA
	ISZ SIGN1
	SZA CLA
	JMP GO6
	TAD LORD
	SZA CLA
	JMP GO6
	TAD OVER2
	SNA CLA
	JMP EXIT2
/
GO6,	TAD SIGN1
	SZA CLA
	JMS I NEG
/
LOP,	TAD HORD
	RAL CLL
	SPA CLA
	JMP EXIT1
	TAD OVER2
	CLL RAL
	DCA OVER2
	TAD LORD
	RAL
	DCA LORD
	TAD HORD
	RAL
	DCA HORD
	ISZ AMT1
	JMP LOP
/
EXIT1,	TAD AMT1
	CMA IAC
	TAD EXP
	DCA EXP
	TAD SIGN1
	SZA CLA
	JMS I NEG
	JMP I DNORM
/
EXIT2,	DCA EXP
	JMP I DNORM
/
NEG,	ACMINS
SIGN1,	0
AMT1,	0
/
SQROOT,	0
	DCA FLAG1
	JMS I 7
	FPUT FPAC1
	FEXT
	TAD HORD
	SPA CLA
	JMP SQEND1
	TAD EXP
	CLL
	SPA
	CML
	RAR
	DCA ITER1
	SZL
	ISZ ITER1
	NOP
	TAD SQCON1
	DCA ITER1+1
	DCA ITER1+2
	TAD FPAC1+1
	SZA CLA
	JMP CLCU
	TAD FPAC1+2
	SNA CLA
	JMP SQEND
/
CLCU,	JMS I 7
	FGET FPAC1
	FDIV ITER1
	FADD ITER1
	FEXT
	CLA CMA
	TAD EXP
	DCA EXP
	TAD EXP
	CMA IAC
	TAD ITER1
	SZA CLA
	JMP ROOTGO
	TAD HORD
	CMA IAC
	TAD ITER1+1
	SZA CLA
	JMP ROOTGO
	TAD LORD
	CMA IAC
	TAD ITER1+2
	SMA
	CMA IAC
	IAC
	SPA CLA
	JMP ROOTGO
	TAD FLAG1
	DCA FLAG
	JMP I SQROOT
/
ROOTGO,	JMS I 7
	FPUT ITER1
	FEXT
	JMP CLCU
/
SQEND1,	JMS I NEG
	ISZ FLAG
	JMP SQROOT+2
/
SQEND,	DCA EXP
	JMP I SQROOT
/
ITER1,	0
	0
	0
SQCON1,	3015
FLAG1,	0
/
/QANDA INTERPRETER FOR INPUT
/
	PAGE
FLINTP,	0
	CLA CMA
	DCA PRSW
	DCA DSWIT
	JMS I DPCVPT
	CLA
	TAD CHAR
	TAD PER
	SZA CLA
	JMP FIGO1
	TAD PRSW
	SNA CLA
	JMP FIGO2
	DCA I DPN
	DCA PRSW
	JMP I DPCSPT
/
FIGO1,	TAD PRSW
	SNA CLA
FIGO2,	TAD I DPN
	CMA IAC
	DCA SEXP
	JMS I MSGNPT
FIGO3,	TAD C27
	DCA EXPONT
	JMS I 7
	FNOR
	FPUT FPAC1
	FEXT
	TAD CHAR
	TAD MINUSE
	SZA CLA
	JMP TESTCH
	JMS I DPCVPT
	JMS I MSGNPT
	TAD HORDER
	SPA
	IAC
	SZA CLA
	JMP EXCESS
	TAD LORDER
	TAD SEXP
	DCA SEXP
/
TESTCH,	CLA
	TAD CHAR
	TAD MCR
	SNA
	JMP STASH
	TAD MLF
	SNA
	JMP QUIT
	JMP I ERROR1
/
STASH,	JMS ENDFI
	JMS I PUT
	JMP FLINTP+1
/
QUIT,	JMS ENDFI
	JMS I PUT
	JMP I FLINTP
/
ENDFI,	0
	JMS I 7
	FGET FPAC1
	FEXT
	TAD SEXP
	SNA
	JMP I ENDFI
	SMA CLA
	JMP FIGO4
	JMS I 7
	FMPY I PC10
	FEXT
	ISZ SEXP
	JMP ENDFI+4
	JMP I ENDFI
/
FIGO4,	JMS I 7
	FMPY TEN
	FEXT
	CLA CMA
	TAD SEXP
	DCA SEXP
	JMP ENDFI+4
/
EXCESS,	TAD C3777
	DCA EXPONT
	TAD C3777
	DCA HORDER
	JMP I ERROR1
/
TEN,	4
	2400
	0
PC10,	C10
MINUSE,	-305
C27,	27
PER,	-256
PRSW,	0
SEXP,	0
C3777,	3777
DPCVPT,	DECONV
DPCSPT,	DECON
MSGNPT,	MSIGN
DPN,	DNUMBR
MCR,	-274
MLF,	274-234
ERROR1,	ERROR2
PUT,	PUTS
/
	PAGE
DECONV,	0
	CLA
	DCA HORDER
	DCA LORDER
	DCA SIGN
	DCA DNUMBR
	JMS INPUT
	TAD PLUS
	SNA
	JMP DECON
	TAD MINUS
	SZA
	JMP .+4
	CLA CMA
	DCA SIGN
/
DECON,	JMS INPUT
	CLA
	TAD CHAR
	TAD MIN9
	SMA
	JMP I DECONV
	TAD PLUS12
	SPA
	JMP I DECONV
	DCA DIGIT
	TAD HORDER
	AND MASK
	SZA
	JMP DECON
	ISZ DSWIT
	ISZ DNUMBR
	JMS MULT10
	JMP DECON
/
MULT10,	0
	TAD LORDER
	DCA LTEMP
	TAD HORDER
	DCA HTEMP
	DCA REMAIN
	JMS MULT2
	JMS MULT2
	JMS DUBLAD
	JMS MULT2
	TAD DIGIT
	DCA LTEMP
	DCA HTEMP
	JMS DUBLAD
	TAD REMAIN
	JMP I MULT10
/
LTEMP,	0
HTEMP,	0
DIGIT,	0
REMAIN,	0
SIGN,	0
DNUMBR,	0
/
MULT2,	0
	CLA CLL
	TAD LORDER
	RAL
	DCA LORDER
	TAD HORDER
	RAL
	DCA HORDER
	TAD REMAIN
	RAL
	DCA REMAIN
	JMP I MULT2
/
DUBLAD,	0
	CLA CLL
	TAD LORDER
	TAD LTEMP
	DCA LORDER
	RAL
	TAD HORDER
	TAD HTEMP
	DCA HORDER
	RAL
	TAD REMAIN
	DCA REMAIN
	JMP I DUBLAD
/
MSIGN,	0
	CLA CLL
	ISZ SIGN
	JMP I MSIGN
	TAD LORDER
	CMA IAC
	DCA LORDER
	TAD HORDER
	CMA
	SZL
	IAC
	DCA HORDER
	JMP I MSIGN
/
MINUS,	253-255
PLUS,	-253
MIN9,	-272
PLUS12,	272-260
MASK,	7600
/
INPUT,	0
	LINC
	LMODE
	LDH I 2
	ADA I
	200
	PDP
	PMODE
	DCA CHAR
	TAD CHAR
	SNA
	JMP INPUT+1
	TAD M200
	SNA
	JMP INPUT+1
	TAD MM
	SNA CLA
	JMP ERRORS
	TAD CHAR
	JMP I INPUT
/
ERRORS,	CLA CMA
	JMP I .+1
	ERROR-5
/
FLIN,	FLINTP
MM,	200-277
M200,	-200
C10,	7775		/0.1 DECIMAL
	3146
	3147
/
	LMODE
	SEGMNT 3
	*1600
DECODE,	STA I
	0
	CLR
	ADD 0
	BCL I
	6000
	ADD DECODE+1
	STC DECODE+1
	PDP
	PMODE
	TAD I DECODE+1
	DCA I PTWO
	ISZ DECODE+1
	TAD I DECODE+1
	DCA I PONE
	TAD I PZERO
	TAD K2
	DCA ERROR
	TAD ERROR
	TAD K1
	DCA EXIT
	JMS I FLINT
/
	LINC
	LMODE
	IOB
	RMF
	SAE I
	+0
ERROR,	0
EXIT,	0
/
	PMODE
PTWO,	6002
PONE,	6001
PZERO,	6000
K2,	2
K1,	1
FLINT,	FLINTP
/
ERROR2,	CLA IAC
	JMP ERROR-5
/
LPUT,	0
	LINC
	LMODE
	STA 1
	XSK I 1
	NOP
	PDP
	PMODE
	CLA CLL
	JMP I LPUT
/
PUTS,	0
	CLA CLL
	TAD 44
	JMS LPUT
	TAD 45
	JMS LPUT
	TAD 46
	JMS LPUT
	JMP I PUTS
/
	EXPONT=EXP
	HORDER=HORD
	LORDER=LORD
	FEXT=0000
	FADD=1000
	FSUB=2000
	FMPY=3000
	FDIV=4000
	FGET=5000
	FPUT=6000
	FNOR=7000
	FENT=4407
/
	LMODE
	LINC=6141
	DCA=3000
	RMF=6244
	RIF=6224
	IAC=7001
/
/
/FRACUS:
/1-DEC-70
/