DataMuseum.dk

Presents historical artifacts from the history of:

Philips Data Systems

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Philips Data Systems

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download

⟦668a2f183⟧ 

    Length: 10956 (0x2acc)
    Notes: pts_type(SC)
    Names: »MULDIV.SC«

Derivation

└─⟦2a21e4bb5⟧ Bits:30009691 Philips computer tape "600408"
    └─⟦this⟧ »BDKAPP/MULDIV.SC« 
└─⟦71472ef1e⟧ Bits:30009661 Philips computer tape "600103"
    └─⟦this⟧ »BDKAPP/MULDIV.SC«

PTS(SC)

	IDENT  MULDIV 	REL=7.2  DATE=77-09-09
			UPDATE   #0   77-09-09 
* 
******************************************* 
* 
*   PHILIPS TERMINAL SYSTEM PTS 
* 
*   MULDIV = MULTIPLICATION/DIVISION
* 
* 
*   LEVEL     #2  77-09-09
* 
*   RELEASE   #7  77-09-09
* 
******************************************* 
* 
* 
* THIS MODULE CONTAINS SUBROUTINES TO HANDLE
* INTEGER MULTIPLICATION AND DIVISION 
* 
* FORMAT MULTIPLICATION:
*	CF	A14,T:MUL
*	BYTE	EL1,EL2
*	BYTE	EL3,EL4
* 
* FORMAT DIVISION:
*	CF	A14,T:DIV
*	BYTE	EL1,EL2
*	BYTE	EL3,EL4
* 
* RESULT RETURNED IN EL1
* 
	ENTRY	T:MUL,T:DIV
	ENTRY	T:SIGN,T:BRK 
	ENTRY	T:MULC,T:DIVC
	ENTRY	M:BRK,M:SIGN 
	EJECT
* 
	EXTRN	T:ADD,T:SUB
	EXTRN	T:MOV,T:CMP,T:OPA
	EXTRN	T:SHR,T:SHL
	EXTRN	T:OPS
	EXTRN	RETMMM 
	EXTRN	M:ADD,M:SUB,M:MOV,M:CMP,M:OPA
	EXTRN	M:SHR,M:SHL,M:OPS
* 
OVERLY	EQU	0
	EJECT
* 
***************** 
* MULTIPLICATION* 
***************** 
* 
T:MULC	EQU	*
	ADKL	A13,1	INDICATE MULC 
* 
T:MUL	EQU	* 
	SUKL	A14,8 
	IFT	OVERLY=0 
	CF	A14,T:BRK	GET ARGUMENT AND BREAK
	CF	A14,T:SIGN	SET START VALUES 
	CF	A14,T:MOV	MOVE EL1 TO EL3 
MU10	DATA	/3010 
	CF	A14,T:SUB	SUB EL3 FROM EL1
MU20	DATA	/1030 
* 
MU30	CF	A14,T:BRK	GET ARG. AND BREAK
	XIF
	IFT	OVERLY=1 
	CF	A14,M:BRK	GET ARGUMENT AND BREAK
	CF	A14,M:SIGN	SET START VALUES 
	CF	A14,M:MOV	MOVE EL1 TO EL3 
MU10	DATA	/3010 
	CF	A14,M:SUB	SUB EL3 FROM EL1
MU20	DATA	/1030 
* 
MU30	CF	A14,M:BRK	GET ARG. AND BREAK
	XIF
	LD	A1,4,A14	GET POINTER EL4
	LCR	A2,A1	GET BYTE 
	LDR	A3,A2	COPY TO A3 
	SRL	A2,4	GET DIGIT 
	ANK	A2,/F	MASK DIGIT 
	RF(Z)	MU50	NEXT DIGIT
	SUK	A2,/F
	RF(Z)	MU80	JUMP IF FINISHED
	SUK	A3,/10	DECREMENT DIGIT 
	SCR	A3,A1	RESTORE BYTE 
	IFT	OVERLY=0 
	CF	A14,T:ADD	ADD EL3 TO EL1
MU40	DATA	/1030 
	RB	MU30
* 
MU50	CF	A14,T:SHR	SHIFT RIGHT EL4 
MU60	DATA	/4001 
	CF	A14,T:SHL	SHIFT LEFT EL3
	XIF
	IFT	OVERLY=1 
	CF	A14,M:ADD	ADD EL3 TO EL1
MU40	DATA	/1030 
	RB	MU30
* 
MU50	CF	A14,M:SHR	SHIFT RIGHT EL4 
MU60	DATA	/4001 
	CF	A14,M:SHL	SHIFT LEFT EL3
	XIF
MU70	DATA	/3001 
	RB	MU30
* 
MU80	EQU	*
	ADKL	A14,8	ADJUST STACK POINTER
	LD	A6,-6,A14	GET SIGN ADDRESS
	LCR	A1,A6	LOAD SIGN BYTE 
	ANK	A1,/F0	MASK DIGIT
	LDR*	A2,A14	GET RESULT SIGN
	ORR	A1,A2	INSERT SIGN
	SCR	A1,A6	RESTORE SIGN BYTE
* 
RET	LDK	A2,4
	ADS	A2,4,A14	MODIFY RETURN ADR 
	IFT	OVERLY=0 
	RTN	A14
	XIF
	IFT	OVERLY=1 
	DATA	/C0FF 
	XIF
	EJECT
* 
***************** 
* DIVISION      * 
***************** 
* 
T:DIVC	EQU	*
	ADKL	A13,1	INDICATE DIVC 
* 
T:DIV	EQU	* 
	SUKL	A14,8 
	IFT	OVERLY=0 
	CF	A14,T:BRK	GET ARGUMENT AND BREAK
	CF	A14,T:SIGN	SET START VALUES 
	CF	A14,T:MOV	EL4 TO EL3
DI005	DATA	/3040
	CF	A14,T:SUB	CLEAR EL4 
DI010	DATA	/4040
	ST	A11,10,A14	SAVE A11 
	SUR	A11,A11	CLEAR A11
	CF	A14,T:CMP 
DI015	DATA	/3040
	RF(E)	DI180	JUMP IF DIVISION WITH ZERO 
* 
DI020	CF	A14,T:BRK	BACK TO DISPATCHER 
	CF	A14,T:CMP	CMP EL1 AND EL3 
DI030	DATA	/1030
	RF(L)	DI050	EL1 < EL3
	RF(E)	DI070	EL1 = EL3
	IM	6,A14	INCREMENT COUNTER 
	RF(Z)	DI180	JUMP IF WHOLE EL3 SHIFTED
	CF	A14,T:SHL	SHIFT LEFT EL3
DI040	DATA	/3001
	SUKL	A11,1	DECREMENT SHIFT COUNTER 
	RB	DI020 
* 
DI050	LDR	A11,A11 
	RF(Z)	DI130	DIVIDEND LESS THAN DIVISOR 
	CF	A14,T:SHR	SHIFT RIGHT EL3 
DI060	DATA	/3001
	ADKL	A11,1	INCREMENT SHIFT COUNTER 
* 
DI070	ST	A11,6,A14	STORE SHIFT COUNTER
* 
DI080	CF	A14,T:BRK	BACK TO DISPATCHER 
	CF	A14,T:SUB	EL1 - EL3 
DI090	DATA	/1030
	LD	A2,4,A14	GET SIGN BYTE ADR EL4
	LCR	A1,A2	GET BYTE 
	ADK	A1,/10	INCREMENT QUOTIENT
	SCR	A1,A2	RESTORE BYTE 
* 
DI095	EQU	* 
	CF	A14,T:CMP 
DI100	EQU	* 
	DATA	/1030 
	RB(NL)	DI080	JUMP IF NOT LESS
	IM	6,A14	INCREMENT COUNTER 
	RF(P)	DI130	JUMP IF FINISHED 
	CF	A14,T:SHR	SHIFT EL3 RIGHT 
DI110	DATA	/3001
	CF	A14,T:SHL	SHIFT EL4 LEFT
DI120	DATA	/4001
	CF	A14,T:BRK	BACK TO DISPATCHER
	RB	DI095 
* 
DI130	CF	A14,T:MOV	MOVE EL4 TO EL1
	DATA	/1040 
* 
DI140	LDK	A1,0	INDICATE CR=0
DI150	LD	A11,10,A14	RESTORE A11 
	SC	A1,10,A14	STORE PSW ON STACK
	RB	MU80
* 
DI180	LDK	A1,3	INDICATE CR=3
	RB	DI150 
	XIF
	IFT	OVERLY=1 
	CF	A14,M:BRK	GET ARGUMENT AND BREAK
	CF	A14,M:SIGN	SET START VALUES 
	CF	A14,M:MOV	EL4 TO EL3
DI005	DATA	/3040
	CF	A14,M:SUB	CLEAR EL4 
DI010	DATA	/4040
	ST	A11,10,A14	SAVE A11 
	SUR	A11,A11	CLEAR A11
	CF	A14,M:CMP 
DI015	DATA	/3040
	RF(E)	DI180	JUMP IF DIVISION WITH ZERO 
* 
DI020	CF	A14,M:BRK	BACK TO DISPATCHER 
	CF	A14,M:CMP	CMP EL1 AND EL3 
DI030	DATA	/1030
	RF(L)	DI050	EL1 < EL3
	RF(E)	DI070	EL1 = EL3
	IM	6,A14	INCREMENT COUNTER 
	RF(Z)	DI180	JUMP IF WHOLE EL3 SHIFTED
	CF	A14,M:SHL	SHIFT LEFT EL3
DI040	DATA	/3001
	SUKL	A11,1	DECREMENT SHIFT COUNTER 
	RB	DI020 
* 
DI050	LDR	A11,A11 
	RF(Z)	DI130	DIVIDEND LESS THAN DIVISOR 
	CF	A14,M:SHR	SHIFT RIGHT EL3 
DI060	DATA	/3001
	ADKL	A11,1	INCREMENT SHIFT COUNTER 
* 
DI070	ST	A11,6,A14	STORE SHIFT COUNTER
* 
DI080	CF	A14,M:BRK	BACK TO DISPATCHER 
	CF	A14,M:SUB	EL1 - EL3 
DI090	DATA	/1030
	LD	A2,4,A14	GET SIGN BYTE ADR EL4
	LCR	A1,A2	GET BYTE 
	ADK	A1,/10	INCREMENT QUOTIENT
	SCR	A1,A2	RESTORE BYTE 
* 
DI095	EQU	* 
	CF	A14,M:CMP 
DI100	EQU	* 
	DATA	/1030 
	RB(NL)	DI080	JUMP IF NOT LESS
	IM	6,A14	INCREMENT COUNTER 
	RF(P)	DI130	JUMP IF FINISHED 
	CF	A14,M:SHR	SHIFT EL3 RIGHT 
DI110	DATA	/3001
	CF	A14,M:SHL	SHIFT EL4 LEFT
DI120	DATA	/4001
	CF	A14,M:BRK	BACK TO DISPATCHER
	RB	DI095 
* 
DI130	CF	A14,M:MOV	MOVE EL4 TO EL1
	DATA	/1040 
* 
DI140	LDK	A1,0	INDICATE CR=0
DI150	LD	A11,10,A14	RESTORE A11 
	CF	A14,DI155	GET CURR PSW
DI155	LD	A6,2,A14 
	ADKL	A14,4 
	ANKL	A6,/FCFF	DELETE COND
	ECR	A1,A1
	ORR	A6,A1
	ST	A6,10,A14 
	RB	MU80
* 
DI180	LDK	A1,3	INDICATE CR=3
	RB	DI150 
	XIF
	EJECT
* 
* 
* T:SIGN SETS EL1 AND EL4 POSITIVE, 
* COMPUTES SIGN OF RESULT AND 
* STORE PARAMETERS OF EL1,EL3 AND EL4 
* 
M:SIGN	EQU	*
	IFT	OVERLY=1 
	LDK	A7,/80 
	XRS	A7,2,A14 
	XIF
T:SIGN	EQU	*
ARG1	LDK	A7,/30	GET ELEMNT EL3
	IFT	OVERLY=0 
	CF	A14,T:OPA	GET ELEMENT DATA FOR EL3
	SLL	A1,1	NEG. NUMBER OF BYTES TIMES 2
	ST	A1,10,A14	STORE COUNTER ON STACK
	CF	A14,T:MOV	MOVE EL2 TO EL4 
	DATA	/4020 
ARG2	EQU	*-2
	LDKL	A7,/1040	GET ADDRESS TO EL1 AND EL4 
ARG3	EQU	*-2
	CF	A14,T:OPS	GET DATA FOR EL1 AND EL4
	XIF
	IFT	OVERLY=1 
	CF	A14,M:OPA	GET ELEMENT DATA FOR EL3
	SLL	A1,1	NEG. NUMBER OF BYTES TIMES 2
	ST	A1,10,A14	STORE COUNTER ON STACK
	CF	A14,M:MOV	MOVE EL2 TO EL4 
	DATA	/4020 
ARG2	EQU	*-2
	LDKL	A7,/1040	GET ADDRESS TO EL1 AND EL4 
ARG3	EQU	*-2
	CF	A14,M:OPS	GET DATA FOR EL1 AND EL4
	XIF
	ST	A6,6,A14	STORE ADDRESS OF EL1 ON STACK
	ST	A10,8,A14	STORE ADDRESS OF EL4 ON STACK 
	LCR	A1,A6	GET SIGN BYTE EL1
	LDR	A2,A1	COPY A1
	LCR	A3,A10	GET SIGN BYTE EL4 
	ADR	A2,A3	ADD BYTES
	ANK	A1,/F0	MASK AWAY SIGN EL1
	ANK	A3,/F0	MASK AWAY SIGN EL4
	ADK	A1,/B	SET POS SIGN EL1 
	ADK	A3,/B	SET POS. SIGN EL4
	SCR	A1,A6	STORE POS SIGN EL1 
	SCR	A3,A10	STORE POS. SIGN EL4 
	LDK	A1,/B	LOAD PLUS SIGN 
	SRC	A2,2	SHIFT BIT 14 TO SIGN BIT
	RF(N)	SIG100	JUMP IF BIT 14=1
	LDK	A1,/D	LOAD MINUS SIGN
SIG100	EQU	*
	ST	A1,12,A14	STORE RESULT SIGN 
RETUR	ABL	RETMMM
* 
* 
* T:BRK RETURNS CONTROL TO MONITOR AND
* COMPUTES ARGUMENTS FOR ALL CALLS
* 
M:BRK	EQU	* 
	IFT	OVERLY=1 
	LDK	A1,/80 
	XRS	A1,2,A14 
	XIF
T:BRK	LKM		RETURN VIA DISPATCHER
	DATA	0 
	LD	A1,16,A14	GET SECOND
	LD	A2,2,A1	- ARGUMENT /3040
	LDR*	A1,A1	GET FIRST ARGUMENT /1020
	ST	A1,ARG2 
	ST	A2,DI005
	ST	A2,DI015
	ST	A2,DI010
	SC	A2,DI010	/4040
	SC	A2,MU60 
	SC	A2,DI120
	SC	A2,DI140-1
	SC	A2,ARG3+1 
	SC	A2,ARG2 
	SRL	A2,8	A2=/0030
	ANKL	A1,/FF00	A1=/1000 
	ADR	A2,A1	A2=/1030 
	SC	A2,MU70 
	SC	A2,DI040
	SC	A2,DI060
	SC	A2,DI110
	SC	A2,ARG1+1 
	ST	A2,MU20 
	ST	A2,MU40 
	ST	A2,DI030
	ST	A2,DI090
	ST	A2,DI100
	ECR	A2,A2	A2=/3010 
	ST	A2,MU10 
	SC	A2,DI140-2
	SC	A2,ARG3 
	RB	RETUR 
	END

Full view