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

⟦dd116c6fd⟧ 

    Length: 20780 (0x512c)
    Notes: pts_type(SC)
    Names: »DRMS02.SC«

Derivation

└─⟦110b7ed5e⟧ Bits:30009664 Philips computer tape "600106"
    └─⟦this⟧ »TOSSWORK/DRMS02.SC«

PTS(SC)

	IDENT DRMS02 	REL 9.2 79-11-16  870105040920 

* 
************************************************* 
* 
*   PHILIPS TERMINAL SYSTEM PTS 
* 
*   DRMS02 = DRIVER MAGNETIC STRIPE 
* 
* 
* 
* 
* 
* 
* 
**************************************************
* 
* 
*   THIS DRIVER HANDLES INPUT/OUTPUT ON THE 
*   M A G N E T I C   S T R I P E   U N I T  (M S U)  PTS 6266. 
*   THE MSU MUST BE CONNECTED TO THE CPU VIA CHLT OR CHRT.
* 
*   TRACK 2 AND 3 ON STRIPES CAN BE READ AND TRACK 3 CAN BE 
*   WRITTEN.
* 
*   PIN KEYBOARD IS NOT SUPPORTED BY THIS VERSION OF DRIVER 
*   OFF-LINE TEST IS NOT SUPPORTED BY THIS VERSION OF DRIVER
* 
*   THE DRIVER CONSISTS OF FOLLOWING PARTS: 
* 
*   A C M S :    ACTIVATION PART
*                ORDER PROCESSOR
*   I H M S :    INTERRUPT HANDLER
*   O N M S :    RECOVERY ROUTINE 
* 
* 
	EJECT			DRMS02 
* 
*  THE FOLLOWING ORDERS ARE TREATED:
* 
*			CREDIT
*   /06   WRITE CARD	WRITE
*   /0A   READ CARD	RANDOM READ 
*   /21   OPEN		- 
*   /26   END OF OPERATION	DSC0  CC=4 
*   /37   INSERT CARD	DSC0  CC=0
* 
* 
*   THE FOLLOWING RETURN CODE IS USED:
* 
*   BIT  0   REQUEST ERROR
*        5   READ/WRITE WARNING 
*       10   CARD MISSING 
*       12   INCORRECT LENGTH 
*       13   NEGATIVE ACKNOWLEDGEMENT 
*       14   THROUGHPUT ERROR 
*       15   NOT OPERABLE 
* 
* 
*   NORMAL USE OF REGISTERS:
* 
*   REGISTER  A1   RETURN CODE
*             A2   INPUT/OUTPUT CHARACTER 
*             A3   BUFFER INDEX 
*             A4   RETRY COUNTER
*             A5   STACK BASE POINTER 
*             A6   DWT ADDRESS
*             A7   ORDER
*             A8   ECB ADDRESS
* 
	EJECT			DRMS02 
* 
*********** 
* ENTRIES * 
*********** 
* 
	ENTRY	MSAD	ADDRESS BLOCK 
* 
************* 
* EXTERNALS * 
************* 
* 
*    EXTERNAL ROUTINES
	EXTRN	SAVE8	SAVE REGISTER A1-A8 ON A15 STACK 
	EXTRN	STREG	STORE REGISTERS AND GO TO DISPATCHER 
	EXTRN	LDREG	LOAD REGISTER AND RETURN TO USER VIA A5
	EXTRN	OUTPUT	SUBROUTINE TO SEND CHARACTER
	EXTRN	DISIOE	DISPATCH END I/O, REQUEST ERROR 
	EXTRN	GETCHR	GET NEXT CHARACTER IN ECB-BUFFER
	EXTRN	DISEND	END I/O AND DISPATCH
	EXTRN	TDISP	DISPATCHER ENTRY 
* 
*    DWT DISPLACEMENTS
	EXTRN	DWTST	DWT SOFTWARE STATUS
	EXTRN	DWTECB	ECB-ADDRESS 
	EXTRN	DWTOR	ORDER
	EXTRN	DWTSB2	STACK BASE
* 
*    ECB DISPLACEMENTS
	EXTRN	ECBBA	BUFFER ADDRESS 
	EXTRN	ECBRL	REQUESTED LENGTH 
	EXTRN	ECBEL	EFFECTIVE LENGTH 
	EXTRN	ECBRC	RETURN CODE
	EXTRN	ECBCW	CONTROL WORD 
* 
	EJECT			DRMS02 
* 
************************
* CONDITIONAL ASSEMBLY *
************************
* 
* 
*	A PROGRAM VERSION USING TOSS MMU PAGING 
*	IS OBTAINED BY SETTING MMUPAG EQU 1.
* 
MMUPAG	EQU	0
* 
* 
*	A PROGRAM VERSION USING THE EXTENDED INSTRUCTION
*	SET IS OBTAINED BY SETTING CPU852 EQU 0.
* 
CPU852	EQU	1
* 
* 
*   MMU BUFFER SIZE (BYTES) 
* 
X:A	EQU	108 
DVBLEN	EQU	X:A
* 
	EJECT			DRMS02 
* 
************* 
* CONSTANTS * 
************* 
* 
*    MAGNETIC STRIPE CHARACTERS 
CRWSTX	EQU	/3B	CARD START CHARACTER 
CRDSTX	EQU	/3D	START CHAR, GERMAN BOOK (DIN)
CRWETX	EQU	/3F	END CHARACTER
* 
*    STATUS MESSAGES FROM MSU 
DOCINS	EQU	/C	DOCUMENT INSERTED 
DOCESC	EQU	/E	DOCUMENT ESCAPED
WRWARN	EQU	8	WRITE WARNING
RDERR	EQU	9	READ ERROR
WRERR	EQU	/A	WRITE ERROR
WROK	EQU	/B	WRITE OKAY
* 
*    COMMANDS TO MSU
RESET	EQU	2	GENERAL RESET 
SELTRA	EQU	6	SELECT TRACK 2 FOR READ
ENCTRA	EQU	5	ENCODE TRACK 3 
REATRD	EQU	8	READ TRACK 3 GERMAN BOOK (DIN) 
ENCTRD	EQU	9	ENCODE TRACK 3 GERMAN BOOK (DIN) 
* 
*    ORDERS TO DRIVER 
INCARD	EQU	/37	INSERT CARD
ENOFOP	EQU	/26	END OF OPERATION 
* 
*    MISCELLANEOUS
RTRIES	EQU	2	NUMBER OF RETRIES
* 
	EJECT			DRMS02 
* 
*    RETURN CODES 
REQERR	EQU	/8000	REQUEST ERROR
WARNRW	EQU	/400	READ/WRITE WARNING
CARMIS	EQU	/20	CARD MISSING 
INCLEN	EQU	8	INCORRECT LENGTH 
NEGACK	EQU	4	NEGATIVE ACKNOWLEDGEMENT 
THRERR	EQU	2	THROUGHPUT ERROR 
NOTOPE	EQU	1	NOT OPERABLE 
* 
	EJECT			DRMS02 
* 
********************
* DWT-DISPLACEMENT *
********************
* 
DWTDRD	EQU	/10	START OF DRIVER DEFINED PART 
* 
	IFT	MMUPAG=0 
START	EQU	DWTDRD
	XIF
* 
	IFT	MMUPAG=1 
START	EQU	DWTDRD+4
	XIF
* 
* 
DWTFRT	EQU	START+/14	BIT 0   CREDIT CARD / GERMAN BOOK FLAG 
*			BIT 1-7 NOT USED
*			BIT 8-15 RETRY COUNTER SAVE AREA
DWTLRC	EQU	START+/16	LRC ACCUMULATOR
* 
	EJECT			DRMS02 
* 
**********
* TABLES *
**********
* 
	DATA	DVBLEN	MMU BUFFER SIZE
	DATA	2	MMU DEVICE INDEX
MSAD	EQU	*
	DATA	ACMS	ACTIVATION DRIVER
	DATA	0	ABORT ROUTINE ADDRESS 
	DATA	IHMS	INTERRUPT HANDLER
	DATA	RCMS	RECOVERY ROUTINE 
* 
* 
* 
TAB	EQU	*	ORDER TABLE 
	DATA	/060A,/3726,/2100 
TABL	EQU	*-TAB-1	NUMBER OF ENTRIES
* 
MSFUN	EQU	*	MAGNETIC STRIPE FUNCTION
	DATA	WRITE,READ,INSERT 
	DATA	ENDOP,OPEN
	EJECT			DRMS02 
* 
* 
*   A C M S 
* 
*   ACTIVATION PART: CHECKS VALIDITY OF ORDERS
*                    AND STARTS PROCESSING. 
* 
* 
ACMS	EQU	*
	LDK	A4,TABL-1
ACMS10	CC	A7,TAB,A4	FIND OUT IF LEGAL ORDER 
	RF(E)	ACMS20	VALID ORDER 
	SUK	A4,1 
	RB(NN)	ACMS10	TRY NEXT 
* 
* 
MSERR	ABL	DISIOE	DISPATCH END I/O,REQUEST ERROR 
* 
ACMS20	EQU	*
	ADR	A4,A4	GET INDEX
	ABI	MSFUN,A4	BRANCH TO VALID FUNCTION MODULE 
* 
	EJECT			DRMS02 
* 
**************************************************
* 
* OPEN   /21
* 
*   THE DRIVER IS SET TO HANDLE EITHER CREDIT 
*   CARDS/AMERICAN PASSBOOKS OR GERMAN PASSBOOKS. 
* 
* REGISTER INPUT: 
*   A6  = DWT ADDRESS 
*   A8  = ECB ADDRESS 
* 
**************************************************
* 
OPEN	EQU	*
	LD	A2,ECBCW,A8	FORMAT CODE 
	RF(NZ)	OPEN10	NOT CREDIT CARD / AMERICAN BOOK
	LDKL	A2,/7FFF	MASK FOR BIT 0 
	ANS	A2,DWTFRT,A6	CLEAR FORMAT FLAG, INDICATING 
*			CREDIT CARD / AMERICAN BOOK 
	RF	OPEN20	EXIT 
* 
OPEN10	EQU	*
	SUK	A2,1	FORMAT CODE GERMAN PASSBOOK?
	RB(NZ)	MSERR	NO, ILLEGAL CODE
	LDKL	A2,/8000	MASK FOR BIT 0 
	ORS	A2,DWTFRT,A6	SET FORMAT FLAG,
*			INDICATING GERMAN BOOK
* 
OPEN20	EQU	*
	LDK	A1,0	RETURN CODE 
	RF	ENDIO	EXIT
* 
	EJECT			DRMS02 
* 
**************************************************
* 
*   INSERT CARD   /11 
* 
**************************************************
* 
INSERT	EQU	*
	LDK	A4,DOCINS	CHAR. DOC. INSERTED
	LC	A2,DWTST+1,A6	GET STATUS
	ANK	A2,/FF 
	RF(NE)	INSE10
INSE05	EQU	*
	LDK	A2,RESET	GENERAL RESET 
	CF	A5,OUTPUT	SEND IT 
	CF	A5,STREG	WAIT FOR MESSAGE FROM MSU
INSE10	CWK	A2,DOCESC	DOCUMENT ESCAPED ? 
	RB(E)	INSE05	YES 
	CWR	A2,A4	DOCUMENT INSERTED ?
	RF(NE)	INSE15	NO 
	SC	A4,DWTST+1,A6	YES 
	LDK	A1,0 
	RF	ENDIO 
INSE15	LDK	A1,THRERR	THROUGHPUT ERROR 
	EJECT			DRMS02 
* 
*   END OF INPUT/OUTPUT REQUEST 
* 
ENDIO	EQU	* 
	ABL	DISEND 
	EJECT			DRMS02 
* 
**************************************************
* 
*   READ CARD   /0A 
* 
**************************************************
* 
READ	EQU	*
	LC	A2,DWTST+1,A6	GET STATUS
	ANK	A2,/FF 
	SUK	A2,DOCINS	DOCUMENT INSERTED? 
	RF(NE)	WRIT02	NO 
* 
* 
	LDK	A4,RTRIES	NUMBER OF RETRIES
READ10	EQU	*
	LDK	A3,0	RESET BUFFER INDEX
	LD	A2,DWTFRT,A6	FORMAT CODE
	RF(N)	READ20	GERMAN BOOK 
* 
	EJECT			DRMS02 
* 
*    READ CREDIT CARD / AMERICAN PASSBOOK 
	LD	A2,ECBCW,A8	GET TRACK NUMBER
	SUK	A2,2 
	RB(N)	MSERR	TRACK < 2
	CWK	A2,1 
	RB(G)	MSERR	TRACK > 3
	ADK	A2,SELTRA	COMPUTE TRACK TO SELECT
* 
	CF	A5,OUTPUT	SEND READ TRACK COMMAND (/06 OR /07)
* 
	CF	A5,REABLK	READ ONE DATA BLOCK 
	CWK	A1,NEGACK	RETURN CODE READ ERROR?
	RB(NE)	ENDIO	NO, OK OR INCORRECT LENGTH. EXIT
* 
	SUK	A4,1	MORE RETRIES? 
	RB(NN)	READ10	YES, PERFORM RETRY 
	RB	ENDIO	NO, EXIT
* 
	EJECT			DRMS02 
* 
READ20	EQU	*
*    READ GERMAN PASSBOOK 
	LDK	A2,REATRD
	CF	A5,OUTPUT	SEND "READ GERMAN BOOK" COMMAND 
* 
	CF	A5,REABLK	READ FIRST BLOCK
	CWK	A1,INCLEN	BUFFER OVERFLOW? 
	RB(E)	ENDIO	YES, EXIT
* 
	SC	A4,DWTFRT+1,A6	SAVE RETRY COUNTER 
	LDR	A4,A1	SAVE RETURN CODE 
	CF	A5,REABLK	READ SECOND BLOCK 
	CWK	A1,INCLEN	BUFFER OVERFLOW? 
	RB(E)	ENDIO	YES, EXIT
* 
	CWR	A1,A4
	RF(E)	READ30	BOTH BLOCKS OK OR BOTH WRONG
* 
*    ONE BLOCK WAS OK, ONE WAS ERRONEOUS
	LDKL	A1,WARNRW	RETURN CODE "READ/WRITE WARNING"
	RF	READ40	CHECK IF MORE RETRIES LEFT 
* 
READ30	EQU	*
*    BOTH BLOCKS WERE OK OR BOTH WERE ERRONEOUS 
	LDR	A1,A1	BOTH OK? 
	RB(Z)	ENDIO	YES, EXIT
* 
READ40	EQU	*
*    CHECK IF MORE RETRIES SHOULD BE MADE 
	LC	A4,DWTFRT+1,A6	GET RETRY COUNTER
	ANK	A4,/FF	CLEAN 
	SUK	A4,1	MORE RETRIES? 
	RB(NN)	READ10	YES, PERFORM RETRY 
	RB	ENDIO	NO, EXIT
* 
	EJECT			DRMS02 
* 
**************************************************
* 
* READ DATA BLOCK 
* 
*   ONE DATA BLOCK IS READ FROM THE MSU. READING
*   IS TERMINATED WHEN READ ERROR MESSAGE IS
*   RECIEVED, END CHARACTER IS READ OR INPUT
*   BUFFER IS FULL. 
* 
* REGISTER INPUT: 
*   A3  = BYTE INDEX
*   A5  = LOCAL STACK POINTER 
*   A6  = DWT ADDRESS 
*   A8  = ECB ADDRESS 
*   A15 = SYSTEM STACK POINTER
* 
* REGISTER OUTPUT:
*   A1  = RETURN CODE 
*   A3  = UPDATED BYTE INDEX
* 
**************************************************
* 
REABLK	EQU	*
	CF	A5,STREG	FETCH DATA 
	CWK	A2,RDERR	READ ERROR? 
	RF(E)	RB100	YES, EXIT
* 
	CWK	A2,CRWETX	END CHARACTER? 
	RF(E)	RB110	YES, EXIT
	CW	A3,ECBRL,A8	BUFFER ALREADY FULL?
	RF(NL)	RB120	YES, EXIT 
* 
	EJECT			DRMS02 
* 
	CF	A15,CDCHK	CHECK IF LEGAL CHAR 
	CF	A15,STORE	PUT CHAR IN BUFFER
	RB	REABLK	READ NEXT CHAR 
* 
* 
*    BLOCK TREATED. SET RETURN CODE AND EFFECTIVE LENGTH. 
* 
RB100	EQU	* 
	LDK	A1,NEGACK	READ ERROR 
	LD	A3,ECBEL,A8	RESET BYTE INDEX
	RF	RB140	EXIT
* 
RB110	EQU	* 
	LDK	A1,0	NORMAL ENDING 
	RF	RB130	EXIT
* 
RB120	EQU	* 
	LDK	A1,INCLEN	BUFFER OVERFLOW
* 
RB130	EQU	* 
	ST	A3,ECBEL,A8	EFFECTIVE LENGTH TO ECB 
* 
RB140	EQU	* 
	RTN	A5 
* 
	EJECT			DRMS02 
* 
**************************************************
* 
*   WRITE CARD   /06
* 
**************************************************
* 
WRITE	EQU	* 
	LDK	A4,RTRIES	SET NO OF RTRIES 
	LC	A2,DWTST+1,A6	GET STATUS
	ANK	A2,/FF 
	SUK	A2,DOCINS	DOCUMENT INSERTED? 
	RF(E)	WRIT05	YES 
WRIT02	LDK	A1,CARMIS	CARD MISSING 
ENDIO2	RB	ENDIO 
* 
* 
WRIT05	EQU	*
	CM	DWTLRC,A6	CLEAR LRC-ACKUMULATOR 
* 
*    TEST REQUESTED LENGTH AND GET START CHARACTER. 
* 
	LDK	A1,INCLEN	SET ERROR CODE JUST IN CASE
	LD	A2,ECBRL,A8	REQUESTED LENGTH
	LD	A3,DWTFRT,A6	FORMAT CODE FLAG 
	RF(N)	WRIT07	GERMAN BOOK 
* 
	EJECT			DRMS02 
* 
*    CREDIT CARD / AMERICAN PASSBOOK
	SUK	A2,104 
	RB(P)	ENDIO	ERROR IF LENGTH > MAX
	LDK	A2,CRWSTX	START CHAR CREDIT CARD / AMERICAN BOOK 
	RF	WRIT09	CONTINUE 
* 
WRIT07	EQU	*
*    GERMAN PASSBOOK
	SUK	A2,45
	RB(P)	ENDIO	ERROR IF LENGTH > MAX
	LDK	A2,CRDSTX	START CHAR GERMAN BOOK 
* 
WRIT09	EQU	*
	LDK	A3,0	RESET BUFFER INDEX
* 
WRIT10	EQU	*
	XRS	A2,DWTLRC,A6	UPDATE LRC-ACKUMULATOR
	CF	A5,OUTPUT	SEND CHARACTER
WRIT15	CF	A15,GETCHR	GET NEXT CHAR FROM ECB-BUFFER
	LDR	A1,A1	ANY CHARACTERS LEFT? 
	RF(E)	WRIT20	NO
	CF	A15,CDCHK	VALID CODE? 
	LDR	A1,A1
	RB(Z)	WRIT10	YES 
	RB	WRIT15
* 
	EJECT			DRMS02 
* 
WRIT20	EQU	*
	LDK	A2,CRWETX	CARD END CHARACTER 
	XRS	A2,DWTLRC,A6	UPDATE LRC
	CF	A5,OUTPUT	SEND CHARACTER
	LD	A2,DWTLRC,A6	LRC-CHARACTER
	ORK	A2,/30	SET ZONE
	CF	A5,OUTPUT	SEND LRC-CHARACTER
* 
*    SEND WRITE TRACK COMMAND 
	LDK	A2,ENCTRD	ASSUME GERMAN PASSBOOK 
	LD	A1,DWTFRT,A6	IS IT GERMAN BOOK? 
	RF(N)	WRIT30	YES, CONTINUE 
	LDK	A2,ENCTRA	NO, SET CREDIT CARD / AMERICAN BOOK
* 
WRIT30	EQU	*
	CF	A5,OUTPUT	SEND WRITE TRACK COMMAND
	CF	A5,STREG	WAIT FOR STATUS MESSAGE
	LDK	A1,0	RETURN CODE OK
	CWK	A2,WROK	WAS IT OK? 
	RB(E)	ENDIO2	YES, EXIT 
* 
	SUK	A4,1	MORE RETRIES? 
	RB(NN)	WRIT05	YES, PERFORM RETRY 
* 
	LDK	A1,NEGACK	RETURN CODE NEGATIVE ACK 
	CWK	A2,WRERR	WAS IT WRITE ERROR? 
	RB(E)	ENDIO2	YES, EXIT 
* 
	LDKL	A1,WARNRW	RETURN CODE READ/WRITE WARNING
	CWK	A2,WRWARN	WAS IT WRITE WARNING?
	RB(E)	ENDIO2	YES, EXIT 
* 
	LDK	A1,THRERR	ILLEGAL STATUS FROM MSU. THROUGHPUT ERR
	RB	ENDIO2
* 
	EJECT			DRMS02 
* 
**************************************************
* 
*   END OF OPERATION   /26
* 
**************************************************
* 
ENDOP	EQU	* 
	LDK	A4,DOCESC	DOCUMENT ESCAPED 
	LC	A2,DWTST+1,A6	GET STATUS
	ANK	A2,/FF 
	RF(NE)	END10 
END05	LDK	A2,RESET	GENERAL RESET
	CF	A5,OUTPUT	SEND CHARACTER
	CF	A5,STREG	WAIT FOR MESSAGE FROM MSU
END10	CWK	A2,DOCINS	DOCUMENT INSERTED ? 
	RB(E)	END05	YES
	CWR	A2,A4	DOCUMENT ESCAPED ? 
	RF(NE)	END15	NO
	SC	A4,DWTST+1,A6	CHAR TO STATUS IN DWT 
	LDK	A1,0 
	RB	ENDIO2
END15	LDK	A1,THRERR	THROUGHPUT ERROR
ENDIO3	RB	ENDIO2
	EJECT			DRMS02 
* 
*   I H M S 
* 
*   INTERRUPT HANDLER 
* 
* 
IHMS	EQU	*
	ANK	A2,/FF 
	LD	A3,DWTST,A6	GET STATUS WORD 
	RF(NN)	IHM100	BUSY 
	LDR	A3,A2	SAVE CHAR
	SUK	A3,DOCINS	DOCUMENT INSERTED
	RF(E)	IHMS10 
	ADK	A3,DOCINS
	SUK	A3,DOCESC	DOCUMENT ESCAPED 
	RF(NE)	EXIT
IHMS10	EQU	*
	SC	A2,DWTST+1,A6	SET STATUS WORD 
EXIT	ABL	TDISP	GO TO DISPATCHER 
* 
	EJECT			DRMS02 
* 
*   DEVICE BUSY 
* 
IHM100	EQU	*
	LDR	A1,A1	RETURN CODE FROM CHLT/CHRT 
	RB(NE)	ENDIO3	YES; INDICATE NOT OPERABLE 
	LDR	A4,A4	OUTPUT ANSWER ?
	RF(Z)	IHRET	YES
	SUK	A7,INCARD	INSERT CARD
	RF(E)	IHRET	YES
	ADK	A7,INCARD
	SUK	A7,ENOFOP	END OF OPERATION ? 
	RF(E)	IHRET
	LDR	A4,A2
	SUK	A4,DOCESC	DOCUMENT ESCAPED ? 
	RF(E)	IHM140	YES 
IHRET	ABL	LDREG	LOAD REG. AND RETURN CALLING SEQ VIA A5 
* 
IHM140	LDK	A4,DOCESC
	SC	A4,DWTST+1,A6	UPDATE STATUS WORD
	LDK	A1,CARMIS	CARD MISSING 
ENDIO4	RB	ENDIO3
	EJECT			DRMS02 
* 
* 
*   R C M S 
* 
*   RECOVERY ROUTINE
* 
* 
RCMS	EQU	*
* 
	IFT	CPU852=1 
	CF	A15,SAVE8	SAVE A1-A8 ON A15 STACK 
	XIF
* 
	IFT	CPU852=0 
	MSR	8,A15	SAVE A1-A8 
	XIF
* 
	LDK	A2,DOCESC
	SC	A2,DWTST+1,A6	RESET STATUS WORD 
	LD	A7,DWTST,A6	BUSY? 
	RB(N)	EXIT	NO
	LDK	A1,THRERR	THROUGHPUT ERROR 
	RB	ENDIO4
	EJECT			DRMS02 
* 
*   STORE = SUBROUTINE TO STORE CHARACTER 
*           IN ECB-BUFFER AND INCREMENT BUFFER INDEX. 
* 
STORE	EQU	* 
	LD	A7,ECBBA,A8	BUFFER ADDRESS
	ADR	A7,A3	ADD BUFFER INDEX 
	SCR	A2,A7	STORE CHAR 
	ADK	A3,1	INCR. INDEX 
	RTN	A15
* 
	EJECT
* 
*   CDCHK = CHECK IF CODE CHECK ERROR 
* 
*   AT ENTRY: A2=CHARACTER
*   AT EXIT: A1=RERURN CODE 0,2 
* 
CDCHK	EQU	* 
	LDR	A1,A2
	SUK	A1,/30	VALID CODE? 
	RF(N)	CDC20	NO 
	SUK	A1,10	DIGIT? 
	RF(N)	CDC30	YES, OK
* 
*    THE CHARACTER IS A CONTROL CHARACTER 
	LD	A1,DWTFRT,A6	CREDIT CARD? 
	RF(NN)	CDC10	YES 
* 
*    GERMAN PASSBOOK
	CWK	A2,/3E	FIELD SEPARATOR?
	RF(E)	CDC30	YES, OK
	RF	CDC20	NO, ERROR 
* 
CDC10	EQU	* 
*    CREDIT CARD / AMERICAN PASSBOOK
	LDR	A1,A2	CHARACTER
	SUK	A1,/3A	ACCOUNT SEPARATOR?
	RF(Z)	CDC30	YES, OK
	SUK	A1,3	FIELD SEPARATOR?
	RF(Z)	CDC30	YES, OK
* 
CDC20	EQU	* 
*    ILLEGAL CHARACTER
	LDK	A1,THRERR	RET CODE := THROUGHPUT ERR 
	ORS	A1,ECBRC,A8	INSERT IN ECB
	RF	CDC40	EXIT
* 
CDC30	EQU	* 
*    VALID CHARACTER
	LDK	A1,0	RETURN CODE := OK 
CDC40	EQU	* 
	RTN	A15
* 
	END

Full view