/MPAK2--MULTI-PRECISION PACKAGE	8-11-69
/GENERAL FORMAT OF OPERATION CALLS
/ CALL MP(<N>OP,ARG,M)
/ N- NEGATE PSUEDO ACCUMULATOR BEFORE OPERATION- OP
/ OP- ARITHMETIC OPERATION
/ ARG- ARGUMENT
/ M- ARGUMENT SIZE
/ OP'S USED MUST APPEAR IN EXTERNAL LIST IN F4
/ CALL ZRA  0 TO ACCUMULATOR
/ CALL NEG  NEGATE ACCUMULATOR
/
	.GLOBL .DA,.BA,.AP,.AO,.AW,.MF,.AV
	.GLOBL .AQ,.XCH,.ZS,.AI,.AS,.APH
	.GLOBL LD,ST,ADD,SUB,MUL,DIV,RDIV,NEG
	.GLOBL NST,NADD,NSUB,NMUL,NDIV,NRDIV,ZRA
	.GLOBL SETUP,MP,.MA
/
CMQ	0	/CURRENT MQ POINTER
CTP	0	/CURRENT TEMP POINTER
/
/STEMS
NAP=SVMP
CAC=.MA
MP1=SETUP
WCT=OUTP
WCT2=ZRA
MQCT=NEG
LOW=OP
/
/SETUP- SETUP MULTI-PRECISION & SET ACC SIZE = N
SETUP	XX
	JMS*	.DA
	JMP	.+3
ASIZE	0		/ACC SIZE
.MA	0		/CURRENT ACC POINTER
	LAC*	ASIZE
	SPA!SNA
	JMP	DIAG1	/SIZE= - OR 0
SU1	TAD*	ASIZE
	TAD*	ASIZE
	DAC	CTP	/3*N
	TAD	CAC
	DAC	CMQ
	TAD	CTP
	DAC	CTP
	CLC
	TAD*	ASIZE
	CMA
	DAC	ASIZE	/-ACC SIZE
	JMP*	SETUP
/
/MP- GENERAL OP ROUTINE
MP	XX
	JMS*	.DA
	JMP	.+4
OP	0	/ALSO LOW
XX	0
NN	0
	LAC	XX
	DAC	ARG
	LAW	-1
	TAD*	NN
	SPA
	JMP	DIAG2	/WCT=0 OR -
	TAD	ASIZE
	SMA!CMA
	JMP	DIAG2	/WCT>ASIZE
	TAD	ASIZE
MPD	DAC	WCT	/- NO OF WDS
	JMP*	OP	/DO OPERATION
/
/0 TO PSEUDO ACC
ZRA	XX
	LAC	ASIZE
	TAD	ASIZE
	TAD	ASIZE	/-(3*ASIZE)
	DAC	ACTR
	LAC	CAC
	DAC	ACP	/ACC POINTER
ZR1	DZM*	ACP
	ISZ	ACP
	ISZ	ACTR
	JMP	ZR1	/LOOP
	JMP*	ZRA
/
/ ADV. ARG POINTER
INC3	XX
	XCT*	INC3
	XCT*	INC3
	JMP*	INC3
/
/NEGATE PSEUDO ACC
NEG	XX
	LAC	ASIZE
	DAC	ACTR	/-(ASIZE)
	LAC	CAC
	DAC	NAP
	ISZ	NAP
NEG1	LAC*	NAP	/ACC SIGN
	SZA
	XOR	(400000
	DAC*	NAP
	JMS	INC3	/ADV ACC POINTER
	ISZ	NAP
	ISZ	ACTR	/DONE?
	JMP	NEG1	/NO
	JMP*	NEG
/
/LOAD & STORE ARG
NST	JMS	NEG	/STORE -
ST	LAC	ARG
	DAC	NAP	/INTERCHANGE ARG POINTER
	LAC	CAC	/& ACC POINTER
	DAC	ARG
	JMP	LD+3
/
LD	JMS	ZRA
	LAC	CAC
	DAC	NAP
	LAC	WCT
	TAD	WCT
	TAD	WCT
	DAC	WCT	/-3*N
LD1	LAC*	ARG	/LD ARG (ACC)
	DAC*	NAP	/ST ACC (ARG)
	ISZ	ARG
	ISZ	NAP
	ISZ	WCT	/DONE?
	JMP	LD1	/NO
	JMP	EX2
/
/ ADD-SUBTRACT
NADD	JMS	NEG	/-ACC
ADD	JMS*	.AO	/LD ARG
		ARG+400000
	CLL
	JMS	.STD	/ADD TO ACC
	JMS	INC3	/NEXT ARG
	ISZ	ARG
	ISZ	WCT
	JMP	ADD
EXIT  CLA		/0 TO FAC
	JMS*	.AW	/FLOAT ,LINK=1
	JMS	.STD	/STANDARDIZE
	JMP	EXIT+1
EX2	LAC	CAC
	DAC	LOW
	ISZ	LOW
	LAC*	LOW
	JMP*	MP
/
SUB	JMS	NEG	/-ACC
NSUB	JMS	SVMP	/SAVE EXIT
	JMP	ADD
	JMS	NEG
	JMP*	MP1
/
SVMP	XX
	LAC	MP
	DAC	MP1
	LAC	SVMP
	DAC	MP
	ISZ	MP
	JMP*	SVMP
/
/STANDARDIZE & ADD TO ACC
.STD	XX
	LAC	CAC
	DAC	AP1
	DAC	AP2	/ST POINTER
	LAC	ASIZE
	DAC	NAP	/N0 OF ACC WDS
STD1	JMS*	.AQ	/+ NEW VALUE
AP1		AP1
	LAC	AP1
	SAD	CAC	/FIRST WD?
	ISZ*	.MF	/YES,SET MULTI-PASS FLAG
	DZM*	AP1	/0 TO ACC WD
	ISZ	AP1	/NEXT WD
	DZM*	AP1
	ISZ	AP1
	DZM*	AP1
	ISZ	AP1
	JMS*	.XCH	/FLIP FAC & HAC
	JMS*	.ZS	/TEST FOR 0
	SZL
	JMP	STD2	/RES=0
	JMS*	.APH	/ST HAC = HI
AP2		AP2	/IF RES.NE.0
	JMS*	.AI	/NORM RES BY ADDING 0
		.MF+400000
	JMS	INC3	/ADV ST POINTER
	ISZ	AP2
	SKP
STD2	JMS*	.XCH	/FLIP FAC & HAC
	ISZ	NAP	/LAST WD OF ACC?
	JMP	STD1	/NO
	LAC	AP2
	SAD	AP1
	JMP	STD3	/EXIT IF AP1=AP2
	JMS*	.AP	/ELSE ST LAST PIECE
		AP2+400000
STD3	LAC	.STD
	SPA!CLA		/DONE IF +
	LAC*	.MF
	SZA		/DONE IF .NE. 0
	ISZ	.STD
	JMP*	.STD	/GO BACK THRU .STD
/
/
/MULTIPLY
NMUL	JMS	NEG
MUL	JMS	EXCH	/EXCHANGE AC & MQ POINTERS
	JMS	ZRA	/0 TO ACC
	JMS	.MDR	/COM ROUTINE FOR MUL&DIV
MUL2	NOP
	NOP
	JMP	EXIT	/COMMON EXIT
/
/DIVISION
NDIV	JMS	NEG
DIV	JMS	.MDR
	JMP	DV1
	JMS*	.BA
	JMS	EXCH	/PUT QUOTIENTS BACK IN ACC
	JMP	EXIT
DV1	JMS*	.AO	/LD ARG
		ARG+400000
	JMS*	.AV	/RDIV
		CAC+400000	/A1/ARG1
	JMS*	.AP	/ =QUOTIENT WD
		ACP+400000
	JMP	MD0+1
/
.MDR	XX
	LAC	ASIZE
	DAC	MQCT	/ -(ASIZE)
	LAC	CMQ	/MQ POINTER
	DAC	ACP
	LAC*	.MDR
	DAC	.+2
	ISZ	.MDR
MD0	NOP		/JMP DV1 IF DIV
	LAC	ARG	/INIT. ARG POINTER
	DAC	ARG2
	LAC	WCT	/N0. OF ARGS
	DAC	WCT2
MD1	JMS*	.AO	/LD ARG
ARG2		ARG2
	XCT*	.MDR	/NEGATE IF DIV
	JMS*	.AS	/ *MQ
ACP		ACP
	JMS*	.APH	/STOR HAC
		LOW
	CLL
	JMS	.STD	/ADD TO ACC
	JMS*	.AO	/LD LOW
		LOW
	CLL
	JMS	.STD	/ADD TO ACC
	JMS	INC3	/NEXT ARG
	ISZ	ARG2
	ISZ	WCT2	/LAST ARG?
	JMP	MD1	/NO
	JMS	INC3	/NEXT MQ WD
	ISZ	ACP
	ISZ	MQCT	/LAST MQ WD?
	JMP	MD0	/NO
	ISZ	.MDR
	JMP*	.MDR
/
EXCH	XX		/EXCH. ACC&MQ POINTERS
	LAC	CAC
	DAC	LOW
	LAC	CMQ
	DAC	CAC
	LAC	LOW
	DAC	CMQ
	JMP*	EXCH
/
/REVERSE DIVIDE
NRDIV	JMS	NEG
RDIV	LAC	CAC	/EXCHANGE
	DAC	XX	/ACC & TP
	LAC	CTP	/POINTERS
	DAC	CAC
	JMS	SVMP	/SAVE EXIT
	JMP	LD	/LD ARG TO ACC
	LAC	XX	/OLD ACC
	DAC	CTP	/IS NOW ARG
	DAC	ARG
	LAC	ASIZE	/ARG SIZE
	DAC	WCT
	LAC	MP1	/PUT EXIT BACK IN MP
	DAC	MP
	JMP	DIV	/ ARG/ACC
/
/ERROR ROUTINES
DIAG1	JMS	OUTP
	406064		/AC
	311001		/2 CR
	LAC	(TWO
	DAC	ASIZE
	JMP	SU1
TWO	2
DIAG2	JMS	OUTP
	536104		/WD
	406061		/AC CR
	LAC	ASIZE
	JMP	MPD
MES	011002	/ERROR MESSAGE HEADER
ACTR	0
 .ASCII '  ILLEGAL WD SIZE-- '
 .ASCII <136>'P SETS SIZE = '
	0
	500000
/
OUTP	XX	/WRITE ERROR MESSAGE
	LAC*	OUTP
	DAC	MES+6
	ISZ	OUTP
	LAC*	OUTP
	DAC	MES+20
	ISZ	OUTP
	.INIT	-3,1,RA
	CAL	02775	/.WRITE
		11
		MES
ARG	0
	.CLOSE	-3
	JMP	.	/IDLE
RA	JMP*	OUTP
/
	.END