DataMuseum.dk

top - metrics - download

    Length: 4432 (0x1150)
    Notes: pts_type(UF)
    Names: »UPDSET.UF«

└─⟦2a21e4bb5⟧ Bits:30009691 Philips computer tape "600408"
    └─⟦this⟧ »BDKAPP/UPDSET.UF« 

PTS(SC)

LED C:SET,/S!!
!!DL 1
			UPDATE #2 77.03.08 JES 
!!IL 26 
*	K:ID	78.03.07 
!!IL 43 
	ENTRY	K:ID	INCREMENT DATE
!!DL 96,97
!!DL 400,410
!!DL 502
	RF	SDRET	RETURN
!!DL 510
SDRET	EQU	* 
!!IL 516
	EJECT		IDENT C:SET 
******************* K : I D **********************************
* 
* 
* 
*SUBROUTINE  K : I D
*INCREMENTS DATE
* 
* 
* 
* CALL SEQUENCE:	CF A14,K:ID
* 
* 
*   ENTRY PARAM:	A7 = NUMBER OF DAYS TO INCREMENT 
* 
*   SUBROUTINES:
* 
*  RETURN PARAM:	NONE 
* 
*  RETURN METOD:	VIA A14
* 
*  CHANGED REGS:	A1-A6
* 
*  STACKER NEED:	6
* 
*   LIMITATIONS:
* 
*  CALLING TASK:	ANY
* 
* 
************************************************************* 
	EJECT		IDENT C:SET 
************************************************************* 
* 
* 
*	K : I D 
* 
* 
K:ID	EQU	*

* 
*   GET DATE FROM WORK BLOCK
*   AND CONVERT TO HEXADECIMAL
* 
	LDKL	A3,K:WBD	GET DATE WB ADDRESS
	SUK	A3,2 
	CF	A14,SUB2	CONVERT YEAR TO HEXADECIMAL
	LDR	A1,A6	SAVE YEAR VALUE
	CF	A14,SUB2	CONVERT MONTH TO HEXADECIMAL 
	LDR	A2,A6	SAVE MONTH VALUE 
	CF	A14,SUB2	CONVERT DAY TO HEXADECIMAL 
	LDR	A3,A6	SAVE DAY VALUE 
* 
*	INCREMENT DATE
* 
	ADR	A3,A7	ADD CARRY VALUE TO DAY 
	CF	A14,DATCHK	CHECK IF VALID DATE
	RF(NN)	ID100	VALID DATE
	ADR	A6,A3	RECALL MAX DAY OF MONTH
	SUR	A3,A6	NEW DAY VALUE
	ADK	A2,1	INCREMENT MONTH 
	CWK	A2,12
	RF(NG)	ID100	NOT NEW YEAR
	LDK	A2,1	SET JANUARY 
	ADK	A1,1	INCREMENT YEAR
* 
*   CONVERT NEW DATE TO ASCII AND 
*   MOVE DATE TO WORK BLOCK 
* 
ID100	EQU	* 
	LDKL	A4,K:WBD	DATE WB ADDRESS
	LDR	A6,A1	GET YEAR 
	CF	A14,SUBA	CONVERT TO ASCII AND STORE 
	LDR	A6,A2	GET MONTH
	CF	A14,SUBA	CONVERT AND STORE
	LDR	A6,A3	GET DAY
	CF	A14,SUBA	CONVERT AND STORE
	RTN	A14
* 

	EJECT		IDENT C:SET 
!!IL 520
	RF	SUB9
SUB2	ADK	A3,2 
SUB9	EQU	*
!!IL 531
* 
*   CREATE ASCII AND STORE
* 
SUBA	EQU	*
	LDK	A5,0 
SUBA05	SUK	A6,10
	RF(N)	SUBA10 
	ADK	A5,1 
	RB	SUBA05
SUBA10	ADK	A6,10
	SLL	A5,8 
	ADR	A5,A6
	ADKL	A5,/3030
	STR	A5,A4
	ADK	A4,2 
	RTN	A14
* 
!!EN
BEA /S
KPF /O
ASG /E0,TY10