DataMuseum.dk

top - metrics - download

    Length: 4548 (0x11c4)
    Notes: pts_type(SC)
    Names: »CDVASM.SC«

└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
    └─⟦this⟧ »S:DE/CDVASM.SC« 
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
    └─⟦this⟧ »DEN10/CDVASM.SC« 
└─⟦bf903a231⟧ Bits:30009665 Philips computer tape "600109"
    └─⟦this⟧ »DEN10/CDVASM.SC« 
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
    └─⟦this⟧ »S:DE/CDVASM.SC« 

PTS(SC)

	IDENT	CDVASM 
* 
* 
*	BANKDATA APPLICATION
* 
* 
* 
*	CHECK CDV ON ITEM IN INPBUF 
	EJECT
* 
*		USE OF REGISTERS 
*	REGISTER  USE 
*	A5	POINTER TO INPBUF (INDEX)
*	A2	ACTUAL WEIGHT
*	A3	SUM OF PRODUCTS
*	A4	WORK REGISTER FOR CHAR 
*	A1	MAX FOR 'RESTART' OF WEIGHT
*	A6	COUNTER FOR MULTIPLY 
*	A7	LIMIT FOR DIGITSUM IN CDV-10 
* 
* 
* 
*		PARAMETERS FOR CDV 
*	AREA	USE             CONTENT AT CDVEL0 CDVEL1 CDVTEN
*	A1	MAX FOR RESTART OF WEIGHT    10     10      2
*	A7	LIMIT FOR DIGITSUM IN CDV-10 10     10      4
*	WBASE	RESTART VALUE FOR WEIGHT      0      1      1 
*	WDIV	DIVIDEND FOR TOTAL SUM       11     11     10
* 
* 
*        CALLING SEQUENSE 
* 
*        CALL CDV0N,PARAM     *CDV10 TEST 
* 
*        CALL CDV1N,PARAM     *CDV11 TEST 
* 
*        CALL CDV1S,PARAM     *CDV11 TEST SPECIAL 
* 
* 
*	RETURNS WITH PARAMETER=NEATIVE VALUE IF ERROR 
* 
* 
* 
* 
	EJECT
	ENTRY	CDV0N
	ENTRY	CDV1N
	ENTRY	CDV1S
	ENTRY	CDVSUB 
	ENTRY	CHANFC 
	EXTRN	T:FDSP 
	EXTRN	I:EVA0 
	EXTRN	I:RT1
* 
*	HERE IS JOINED COMMON PART OF ALL MODULES 
* 
	NLIST
	LIST 
	EJECT
CDV1N	LDK	A5,0	FOR P-DATA 
	ST	A5,WBASE	SET RESTART VALUE FOR WEIGHT 
CDV10	LDK	A5,11 
	ST	A5,WDIV	SET CHECK VALUE FOR TOTAL 
	LDK	A1,10	 
	LDK	A7,10
	RF	CDV20 
* 
* 
CDV1S	LDK	A5,1	FOR GOTABANKEN 
	ST	A5,WBASE	RESTART VALUE FOR WEIGHT 
	RB	CDV10 
* 
* 
WBASE	DATA	0
WDIV	DATA	0 
* 
* 
CDV0N	LDK	A5,1	10 MODULO
	ST	A5,WBASE	RESTART VALUE FOR WEIGHT 
	LDK	A5,10	CHECK VALUE FOR TOTAL
	ST	A5,WDIV 
	LDK	A1,2 
	LDK	A7,4 
* 
CDV20	CF	A14,I:EVA0	GET PARAM ADDR
	LDK	A2,1 
	SUK	A5,1 
	LDK	A3,0	ZERO TO SUM 
* 
CDV30	LCR	A4,A5	FETCH CHAR
	ANK	A4,/F	MASK 
	CWK	A4,9	IS ALL DIGITS DONE ?
	RF(G)	CDV40	  YES
	CF	A14,CDVSUB	MULTIPLY AND ACCUMULATE DIGIT
* 
	LCR	A4,A5	FETCH CHAR 
	SRL	A4,4	SHIFT 
	ANK	A4,/F	MASK 
	CWK	A4,9	ALL DONE ?
	RF(G)	CDV40	  YES
	CF	A14,CDVSUB
* 
	SUK	A5,1	DECREMENT POINTER 
	RB	CDV30 
* 
CDV40	LD	A8,WDIV	GET DIVIDEND FOR SUM 
	LDR	A3,A3
	RF(NZ)	CDV45 
CDV42	ABL	I:RT1	RTURN IF ZERO 
CDV45	SUR	A3,A8	SUBTRACT 11/10 FROM SUM 
	RB(P)	CDV45	SUM STILL > 0
	RB(Z)	CDV42
	SUKL	A12,1 
	CF	A14,I:EVA0
	LCR	A1,A9
	ANK	A1,/F
	ADK	A1,/D0 
	SCR	A1,A9
	RB	CDV42	GO FOR NEW MISSIONS IN CREDIT PART
	EJECT
* 
*	SUBROUTINE TO MULTIPLY AND ACCUMULATE ONE DIGIT 

* 
CDVSUB	LDR	A6,A2	SET COUNTER = WEIGHT 
	RF(Z)	CDVS30	WAS ZERO
CDVS10	ADR	A3,A4	ADD DIGIT TO SUM 
	SUK	A6,1	DECREMENT COUNTER 
	RB(G)	CDVS10	POS.
	CWR	A2,A1	IS MULTIPLY BY 2(10) ? 
	RF(NE)	CDVS30	  NO 
	CWR	A4,A7	SHALL THERE BE DIGIT SUM FO 10-MODULO
	RF(NG)	CDVS30	  NO 
	SUK	A3,9	  YES - SUBTRACT 9 FROM SUM 
CDVS30	ADK	A2,1	INCREMENT WEIGHT
	CWR	A2,A1	IS MAX WEIGHT ?
	RF(NG)	CDVS40	  NO 
	LD	A2,WBASE	SET BASE WEIGHT
CDVS40	RTN	A14
	EJECT
* 
*   CHANGE FILE CODE IN ECB 
*   CALL: 
*        CALL CHANFC,DATASET,FILECODE 
* 
CHANFC	EQU	*
	CF	A14,T:FDSP	GET ECB-ADDRESS
	CF	A14,I:EVA0	GET ADDRESS TO BIN.
	LC	A3,1,A9	GET FILE CODE 
	SC	A3,1,A8	STORE FILE CODE IN ECB
	ABL	I:RT1	RETURN 
	END