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

⟦3ab03c604⟧

    Length: 27016 (0x6988)
    Notes: pts_type(SC)
    Names: »DRMS02.SC«

Derivation

└─⟦13e5fd45a⟧ Bits:30009699 Philips computer tape "600507"
    └─⟦this⟧ »TOSSWORK/DRMS02.SC« 
└─⟦bc20f3abf⟧ Bits:30009670 Philips computer tape "600126"
    └─⟦this⟧ »TOSSWORK/DRMS02.SC« 

PTS(SC)

	IDENT DRMS02 	REL 11.0 81-01-26 870105041100 


* 
************************************************* 
* 
*   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
*   /02   READ
*   /06   WRITE CARD	WRITE
*   /0A   READ CARD	RANDOM READ 
*   /21   OPEN		- 
*   /26   END OF OPERATION	DSC0  CC=4 
*   /31   RESET CIRCULAR BUFFER 
*   /37   INSERT CARD	DSC0  CC=0
* 
* 
*   THE FOLLOWING RETURN CODE IS USED:
* 
*   BIT  0   REQUEST ERROR
*        2   CARD MISSING 
*       10   READ/WRITE WARNING 
*       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	LENDER	I/O REQUEST ERROR	=1
	EXTRN	OUTPUT	SEND CHARACTER	=1 
	EXTRN	LDISP	DISPATCHER	=1
	EXTRN	NDGET8	RELOAD REGISTERS AND RETURN	=1
	EXTRN	TENDIO	END I/O	=1
	EXTRN	GETCHR	HET CHARACTER FROM ECB BUFFER	=1
	EXTRN	STABLK	START OF BLOCK	=1 
	EXTRN	ENDBLK	END OF BLOCK	=1 
	EXTRN	DWTDEV	DEVICE STATUS	=1
	EXTRN	INPUT	READ CHARCTER	=1 
* 
*    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
* 
* 
X:B	EQU	10	LENGTH OF CIRCULAR INPUT BUFFER
DWTLNG	EQU	X:B	NUMBER OF BYTES IN DECIMAL FORM
	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	/20	READ/WRITE WARNING 
CARMIS	EQU	/2000	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
* 
* 
DWTTIM	EQU	/2	TIMER POINTER	=1
DWTSEC	EQU	/4 
DWTFRT	EQU	/6	BIT 0   CREDIT CARD / GERMAN BANK BOOK FLAG	=1
			BIT 1-7  NOT USED	=1 
			BIT 8-15 RETRY COUNTER SAVE AREA	=1
DWTLRC	EQU	/8	LRC - ACKUMULATOR	=1
* 
*   CIRCULAR INPUT BUFFER 
* 
DWTINQ	EQU	/0C	POINTER TO FIRST PLACE 
DWTUTQ	EQU	/0E	POINTER TO LAST PLACE
DWTSQ	EQU	/10	START OF BUFFER 
DWTEQ	EQU	DWTSQ+DWTLNG	END OF BUFFER
* 
	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,/2102,/3100 
TABL	EQU	*-TAB-1	NUMBER OF ENTRIES
* 
MSFUN	EQU	*	MAGNETIC STRIPE FUNCTION
	DATA	WRITE,READ,INSERT 
	DATA	ENDOP,OPEN
	DATA	RDPIN,RST	READ PIN - KEYBOARD AND RST BUFFER
	EJECT			DRMS02 
* 
* 
*   A C M S 
* 
*   ACTIVATION PART: CHECKS VALIDITY OF ORDERS
*                    AND STARTS PROCESSING. 
* 
* 
ACMS	EQU	*
	LDK	A1,0	RESET RETURN CODE	=2
	LDK	A3,0	RESET BUFFER INDEX
	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	EQU	*	DISPATCH END I/O	=1 
	ABL	LENDER	REQUEST ERROR	=1
* 
ACMS20	EQU	*
	ADR	A4,A4	GET INDEX
	ABI	MSFUN,A4	BRANCH TO VALID FUNCTION MODULE 
* 
	EJECT			DRMS02 
* 
********************************
* 
*	R E A D  PIN - KEYBOARD 
* 
********************************
* 
RDPIN	EQU	* 
	LD	A2,ECBRL,A8	REQUESTED LENGTH = 0
	RF(E)	OPEN20	YES END I/O 
	LDR	A3,A3	FIRST TIME 
	RF(NE)	RDP020	NO 
	LD	A1,ECBBA,A8	BUFFER ADRESS 
	SUK	A1,1	ADJUST BUFFER ADRESS
	ADR	A1,A2	END OF BUFFER
RDP010	EQU	*
	SCR	A3,A1	CLEAR ECB BUFFER 
	SUK	A1,1	
	SUK	A2,1	WHOLE BUFFER CLEARED
	RB(NE)	RDP010	NO 
RDP020	EQU	*
	LD	A1,DWTDEV+DWTUTQ,A6	GET CHARACTER ;CHECK IF OVERFLOW
	LCR	A2,A1	GET CHARACTER
	LDR	A4,A2	 
	XRK	A4,/FF	OVERFLOW
	RF(NE)	RDP030	NO 
	SCR	A4,A1	YES
	LDK	A1,2	SET OVERFLOW IN RETURN CODE 
	RF	ENDIO	END I/O REQUEST 
RDP030	EQU	*
	CW	A1,DWTDEV+DWTINQ,A6	ANYTHING IN QUEUE 
	RF(NE)	RDP040	YES
	CF	A5,INPUT	NO ; READ A CHARACTER
	RF	RDP047	 
RDP040	EQU	*
	CF	A15,EOQUEU	SET NEW BUFFER POINTER 
	ST	A1,DWTDEV+DWTUTQ,A6	SET NEW BUFFER
RDP047	EQU	*
	CW	A3,ECBRL,A8	REQ.LEN = EFF.LEN 
	RF(NL)	RDP080	YES ; ERROR
	LD	A1,ECBCW,A8	KEY TABLE ADRESS
	RF(Z)	RDP060	NO
	LCR	A4,A1	GET KEY TABLE LENGTH 
	ANK	A4,/FF 
	ADR	A1,A4	LAST PLACE IN KEY TABLE
	ADK	A1,1	
RDP050	EQU	*
	SUK	A4,1 
	RF(N)	RDP060	KEY NOT FOUND IN KEY TABLE
	SUK	A1,1	NEXT KEY
	CCR	A2,A1	FOUND
	RB(NE)	RDP050	NO 
	ADK	A4,1	KEY FOUND ; MAKE KEY TABLE INDEX
RDP055	EQU	*
	ST	A4,ECBCW,A8	STORE INDEX IN CONTROL WORD 
	ST	A3,ECBEL,A8	STORE EFFECTIVE LENGTH IN ECB 
	CF	A15,STORE	STORE KEY IN ECB BUGFFER
	RF	OPEN20	END I/O
RDP060	EQU	*
	CWK	A2,/0D	NO KEY TABLE CHECK IF STANDARD END OF RECORD
	RF(NE)	RDP070	NOT EOR - KEY
	LDK	A4,1	SET INDEX TO STANDARD EOR 
	RB	RDP055	END I/O
RDP070	EQU	*
	CF	A15,STORE	STORE CHARACTER IN ECB BUFFER 
	RB	RDP020	GET NEXT CHARACTER 
RDP080	EQU	*
	LDK	A1,8	SET ERROR CODE
	RF	ENDIO	END I/O REQUEST 
	EJECT			DRMS02 
* 
***************************** 
* 
*	R S T  CIRCULAR INPUT BUFFER
* 
********************************* 
* 
* 
RST	EQU	* 
	INH
	LD	A2,DWTDEV+DWTINQ,A6	POINTER TO FIRST PLACE
	SCR	A1,A2	RESET POINTER
	ST	A2,DWTDEV+DWTUTQ,A6	SET POINTER TO LAST PLACE 
	ENB
	RF	ENDIO	END I/O REQUEST 
	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+DWTDEV,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+DWTDEV,A6	SET FORMAT FLAG, 
*			INDICATING GERMAN BOOK
* 
OPEN20	EQU	*
	LDK	A1,0	RETURN CODE 
	RF	ENDIO	EXIT
* 
	EJECT			DRMS02 
* 
**************************************************
* 
*   END OF OPERATION /26 AND INSERT CARD /11	=2 
* 
**************************************************
* 
ENDOP	EQU	*		=2 
	LDK	A4,DOCESC		=2
	RF	COMMON		=2
INSERT	EQU	*		=2
	LDK	A4,DOCINS		=2
	CC	A4,DWTDEV+1,A6		=2
	RF(E)	ENDIO	DOCUMENT ALREADY INSERTED	=2 
COMMON	EQU	*		=2
	LDK	A2,/6	BLOCK SIZE	=1
	CF	A5,STABLK	START OF BLOCK	=1 
	RF(NZ)	ERRMS1	ERROR END I/O	=1 
	LDK	A2,RESET	GENERAL RESET 
	CF	A5,OUTPUT	SEND IT 
	RF(NZ)	ERRMS1	ERROR END I/O	=1 
	CF	A5,ENDBLK	END BLOCK	=1
	RF(NZ)	ERRMS1	ERROR END I/O	=1 
	CC	A4,DWTDEV+1,A6		=2
	RF(E)	ENDIO	DOCUMENT ALREADY ESCAPED	=2
	CF	A5,INPUT	WAIT FOR MESSAGE FROM MSU
	LDR	A3,A2		=2
	SUK	A2,DOCINS		=2
	RF(E)	COM100	DOCUMENT INSERTED	=2
	SUK	A2,DOCESC-DOCINS		=2 
	RF(E)	COM100	DOCUMENT ESCAPED	=2 
	LDK	A1,THRERR	THROUGHPUT ERROR	=2
COM100	EQU	*		=2
	SC	A3,DWTDEV+1,A6	UPDATE DOCUMENT STATUS	=2
	EJECT			DRMS02 
* 
*   END OF INPUT/OUTPUT REQUEST 
* 
ENDIO	EQU	* 
	CF	A15,TENDIO	END I/O	=1 
	ABL	LDISP	DISPATCH	=1
	EJECT			DRMS02 
* 
**************************************************
* 
*   READ CARD   /0A 
* 
**************************************************
* 
READ	EQU	*
	LC	A2,DWTDEV+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	A2,104	MAX BLOCK SIZE	=1 
	CF	A5,STABLK	START BLOCK	=1
	RF(NZ)	ERRMS1	ERROR END I/O	=1 
	LDK	A3,0	RESET BUFFER INDEX
	LD	A2,DWTFRT+DWTDEV,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 
	ABL(N)	MSERR	TRACK < 2 
	CWK	A2,1 
	ABL(G)	MSERR	TRACK > 3 
	ADK	A2,SELTRA	COMPUTE TRACK TO SELECT
* 
	CF	A5,OUTPUT	SEND READ TRACK COMMAND (/06 OR /07)
	RF(NZ)	ERRMS1	ERROR END I/O	=1 
	CF	A5,ENDBLK	END OF BLOCK	=1 
	RF(NZ)	ERRMS1	ERROR END I/O	=1 
* 
	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 
	RF(NZ)	ERRMS1	ERROR END I/O	=1 
	CF	A5,ENDBLK	END OF BLOCK	=1 
* 
ERRMS1	EQU	*	ERROR END I/O	=1 
	RF(NZ)	ERRMS2	ERROR END I/O	=1 
	CF	A5,REABLK	READ FIRST BLOCK
	CWK	A1,INCLEN	BUFFER OVERFLOW? 
	RB(E)	ENDIO	YES, EXIT
* 
	SC	A4,DWTFRT+DWTDEV+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
	LDK	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+DWTDEV+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,INPUT	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,DWTDEV+1,A6	GET STATUS 
	ANK	A2,/FF 
	SUK	A2,DOCINS	DOCUMENT INSERTED? 
	RF(E)	WRIT05	YES 
WRIT02	LDKL	A1,CARMIS	CARD MISSING
ENDIO2	RB	ENDIO 
* 
* 
WRIT05	EQU	*
	CM	DWTLRC+DWTDEV,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+DWTDEV,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	A3,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	A3,CRDSTX	START CHAR GERMAN BOOK 
* 
WRIT09	EQU	*
	LDK	A2,80	MAX BLOCK SIZE	=1
	CF	A5,STABLK	START BLOCK	=1
ERRMS2	EQU	*	ERROR END I/O	=1 
	RF(NZ)	ERRMS	EERROR END I/O	=1 
	LDR	A2,A3		=2
	LDK	A3,0	RESET BUFFER INDEX
* 
WRIT10	EQU	*
	XRS	A2,DWTLRC+DWTDEV,A6	UPDATE LRC-ACKUMULATOR 
	CF	A5,OUTPUT	SEND CHARACTER
	RF(NZ)	ERRMS	ERROR END I/O	=1
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+DWTDEV,A6	UPDATE LRC 
	CF	A5,OUTPUT	SEND CHARACTER
	RF(NZ)	ERRMS	ERROR END I/O	=1
	LD	A2,DWTLRC+DWTDEV,A6	LRC-CHARACTER 
	ORK	A2,/30	SET ZONE
	CF	A5,OUTPUT	SEND LRC-CHARACTER
	RF(NZ)	ERRMS	ERROR END I/O	=1
* 
*    SEND WRITE TRACK COMMAND 
	LDK	A2,ENCTRD	ASSUME GERMAN PASSBOOK 
	LD	A1,DWTFRT+DWTDEV,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
	RF(NZ)	ERRMS	ERROR END I/O	=1
	CF	A5,ENDBLK	END BLOCK	=1
	RF(NZ)	ERRMS	ERROR END I/O	=1
	CF	A5,INPUT	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 
* 
	LDK	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 
* 
*   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 
	SUK	A3,DOCESC-DOCINS		=2 
	RF(NE)	IHMS20	NEITHER INSERTED OR ESCAPED
IHMS10	EQU	*
	SC	A2,DWTDEV+1,A6	SET STATUS WORD
EXIT	ABL	LDISP	GO TO DISPATCHER 
* 
IHMS20	EQU	*
* 
*   STORE INCOMING CHARACTER IN CIRCULAR BUFFER 
* 
	LD	A1,DWTDEV+DWTINQ,A6 
	LCR	A4,A1
	XRK	A4,/FF	ALREADY OVERFLOW ?
	RB(E)	EXIT	YES ! 
* 
	LDR	A4,A1
	CF	A15,EOQUEU	GET NEXT OUTQUEUE POINTER ADDRESS
* 
	CW	A1,DWTDEV+DWTUTQ,A6	OVERFLOW ?
	RF(NE)	IHMS30	NO ! 
	ORK	A2,/FF	SET OVERFLOW BIT IN BUFFER
	RF	IHMS40
* 
IHMS30	ST	A1,DWTDEV+DWTINQ,A6	STORE INQUEUE POINTER 
IHMS40	SCR	A2,A4	STORE CHARACTER IN INPUT BUFFER
* 
	RB	EXIT	DISPATCH 
	EJECT			DRMS02 
* 
*   DEVICE BUSY 
* 
IHM100	EQU	*
	SUK	A7,INCARD
	RF(E)	IHRET	INSERT CARD ORDER CODE 
	ADK	A7,INCARD-ENOFOP		=2 
	RF(E)	IHRET	END OF OPERATION ORDER CODE
	LDR	A4,A2
	SUK	A4,DOCESC
	RF(E)	IHM140	DOCUMENT ESCAPED
IHRET	EQU	* 
	ABL	LENDER 
* 
IHM140	EQU	*		=2
	SC	A2,DWTST+1,A6	UPDATE STATUS WORD	=2 
	LDKL	A1,CARMIS	CARD MISSING
ENDIO4	RB	ENDIO2
	EJECT			DRMS02 
* 
* 
*   R C M S 
* 
*   RECOVERY ROUTINE
* 
* 
RCMS	EQU	*
	LDK	A2,DOCESC
	SC	A2,DWTDEV+1,A6	RESET STATUS WORD
	LD	A7,DWTST,A6	BUSY? 
	RB(N)	EXIT	NO
	LDK	A1,THRERR	THROUGHPUT ERROR 
	RB	ENDIO4
	EJECT			DRMS02 
**
* 
***************************** 
* 
* 
*	E R R M S 
* 
*	ERROR ROUTINE 
* 
* 
******************************
* 
* 
ERRMS	EQU	*	ERROR ROUTINE	=1
	ANK	A1,/12	OUTPUT ERROR OR LRC - ERROR 
	RB(NZ)	RCMS	YES DO RECOVERY	=1 
	LDK	A1,NOTOPE	RETURN CODE NOT OPERABLE	=1
	RB	ENDIO4	END I/O REQUEST	=1 
	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		DROD01
* 
* 
*    EOQUEU = SUBROUTINE TO GET NEXT QUEUE POINTER
* 
*    ON ENTRY:
* 
*    A1 = QUEUE POINTER 
*    A6 = DWT-ADDRESS 
* 
*    ON EXIT: 
* 
*    A1 = NEW QUEUE POINTER 
EOQUEU	EQU	*
	ADK	A1,1 
	SUR	A1,A6
	CWK	A1,DWTEQ+DWTDEV	END OF QUEUE?
	RF(NE)	EOQU10
	LDKL	A1,DWTSQ+DWTDEV	SET QUEUE START ADRESS
EOQU10	ADR	A1,A6
	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+DWTDEV,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