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

⟦923b55e3b⟧ 

    Length: 4658 (0x1232)
    Notes: pts_type(SC)
    Names: »DATCHK.SC«

Derivation

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

PTS(SC)

	IDENT	DATCHK	REL 10.0 80-04-11 
			80-03-27/PEEN
			UPD 79-03-16/PEEN
* 
* 
*   THIS ROUTINE CHECKS THE DATE PLAUSIBILITY 
*   EUROPEAN (AA-MM-DD) OR AMERICAN (MM-DD-AA)
*    OR GERMAN (DD-MM-AA) 
*   STANDARD. 'DD' IS CHECKED ACCORDING TO CORRESPONDING
*   MONTH. FEBRUARI NOT > 29
* 
*   NOT NUMERIC CHARACTERS ARE SKIPPED
* 
*   SYNTAX:  CALL   MMDDCK,SKIP,BUFF
*              CALL   DDMMCK,SKIP,BUFF
* 
*            SKIP = BIN ITEM TELLING HOW MANY DIGITS COUNTED
*                   FROM THE RIGHT TO BE SKIPPED BEFORE THE 
*                   CHECK IS PERFORMED
*            BUFF = STRING ITEM HOLDING THE DATA TO BE CHECKED
* 
*            OUTPUT:   CR = O    OK 
*                      CR = 1    NOT OK 
* 
	EJECT
	ENTRY	DATCHK 
	ENTRY	DDMMCK 
	ENTRY	MMDDCK 
* 
	EXTRN	I:EVA0 
	EXTRN	I:RT1
* 
* 
CALL	FORM	16=/F6A1,16 
BYTE	FORM	8,8 
* 
* 
DATCHK	EQU	*
MMDDCK	EQU	*
	SUR	A6,A6	INDICATE MMDDCK
CHECK	EQU	* 
	CALL	I:EVA0
	LDR*	A10,A9	GET NO. TO BE SKIPPED
	CALL	I:EVA0	GET BUFFER ADDRESS 
	LDR	A11,A5	SAVE END POINTER
	LDR	A7,A10	GET NO.TO BE SKIPPED
	ADR	A7,A6	ADJUST FOR PLACE OF 'DD' 
	CALL	GETTWO	GET DAY IN BINARY
	LDR	A8,A7	SAVE DAY 
	RF(Z)	NOK	JUMP IF ZERO 
	LDR	A7,A10	GET NO. TO BE SKIPPED 
	ADK	A7,2	SKIP 'DD' 
	SUR	A7,A6	ADJUST FOR PLACE OF 'MM' 
	LDR	A5,A11	RESTORE END ADDRESS 
	CALL	GETTWO	GET MONTH BINARY 
	LDR	A7,A7
	RF(Z)	NOK	IF MONTH = 0 
	LDK	A6,0	INDICATE OK 
	SUK	A7,13
	RF(NN)	NOK	IF WRONG MONTH
	LC	A1,TAB,A7	GET BYTE FOR COMPARISON 
	SUR	A1,A8
	RF(NL)	OUT	IF OK 
NOK	EQU	* 
	LDK	A6,1	INDICATE CR = 1 
OUT	EQU	* 
	LD	A1,2,A13	GET STACK BASE 
	SC	A6,-2,A1	STORE CR 
	ABL	I:RT1
* 
* 
DDMMCK	EQU	*
	LDK	A6,2	INDICATE DDMMCK 
	RB	CHECK 
	EJECT
GETTWO	EQU	*
	CALL	GETDIG
	SUK	A7,1 
	RB(NN)	GETTWO	IF TO BE SKIPPED 
	LDR	A7,A1	SAVE DIGIT 
	CALL	GETDIG
* MULTIPLY DIGIT BY 10 AND ADD
	ADR	A7,A1
	ADR	A7,A1
	SLL	A1,3	TIMES 8 
	ADR	A7,A1
	RTN	A14
	EJECT
GETDIG	EQU	*
	CWR	A5,A9
	RF(NE)	GETD10	IF NOT FINISHED
	ADKL	A14,8	ADJUST STACK
	RB	NOK 
GETD10	EQU	*
	SUK	A5,1 
	LCR	A1,A5	GET CURRENT CHARACTER
	CCK	A1,'00'
	RB(L)	GETDIG 
	CCK	A1,'99'
	RB(G)	GETDIG 
	ANK	A1,/F
	RTN	A14
* 
* 
TAB	EQU	*+12
	BYTE	31,29	JAN,FEB 
	BYTE	31,30	MAR,APR 
	BYTE	31,30	MAY,JUN 
	BYTE	31,31	JUL,AUG 
	BYTE	30,31	SEP,OCT 
	BYTE	30,31	NOV,DEC 
* 
	END

Full view