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

⟦33623db94⟧ 

    Length: 4380 (0x111c)
    Notes: pts_type(SC)
    Names: »DATUM.SC«

Derivation

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

PTS(SC)

	IDENT    DATCHK	79-03-16/PEEN
* 
* 
*   THIS ROUTINE CHECKS THE DATE PLAUSIBILITY 
*   EUROPEAN (AA-MM-DD) OR AMERICAN (MM-DD-AA)
*   STANDARD. 'DD' IS CHECKED ACCORDING TO CORRESPONDING
*   MONTH. FEBRUARI NOT > 29
* 
*   NOT NUMERIC CHARACTERS ARE SKIPPED
* 
*   SYNTAX:  CALL   DATCHK,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 
* 
	EXTRN	I:EVA0 
	EXTRN	I:RT1
* 
* 
CALL	FORM	16=/F6A1,16 
BYTE	FORM	8,8 
* 
* 
DATCHK	EQU	*
	LDK	A6,2	SET SWITCH
	CALL	I:EVA0	NO. TO BE SKIPPED
	LDR*	A7,A9 
	CALL	I:EVA0	BUFFER ADDRESS 
DAT100	EQU	*
	CALL	GETDIG
	SUK	A7,1 
	RB(NN)	DAT100	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
	RF(Z)	NOK
	SUK	A6,1 
	RF(Z)	DAT200	JUMP IF DD AND MM ARE FETCHED 
	LDR	A8,A7	SAVE DAY 
	LDK	A7,0	INDICATE NO SKIP
	RB	DAT100	GET MONTH
DAT200	EQU	*
	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
	EJECT
GETDIG	EQU	*
	CWR	A5,A9
	RB(E)	NOK	IF FINISHED
	LC	A1,-1,A5	GET CURRENT CHARACTER
	SUK	A5,1 
	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