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

⟦19359e3a8⟧

    Length: 33352 (0x8248)
    Notes: pts_type(SC)
    Names: »DRKB04.SC«

Derivation

└─⟦7b35573c9⟧ Bits:30009690 Philips computer tape "600402"
    └─⟦this⟧ »M:AF/DRKB04.SC« 

PTS(SC)

	IDENT DRKB04 	REL 11.0 81-05-25 870105041100 

				=2 GREEK CHARACTER SET & NEW CONDITIONS 
				REL 11.0 81-03-27 
			= 1 /00 SKIPPED IF IT CAME FROM SECOND DEVICE
			    ADDRESS VIA CIRCULAR INPUT BUFFER
			REL 11.0 81-01-26
* 
******************************************
* 
* 
*   P H I L I P S  T E R M I N A L  S Y S T E M  P T S
* 
*   DRKB04 = DRIVER KEYBOARD
* 
******************************************
* 
*   THIS DRIVER HANDLES INPUT FROM THE KEYBOARDS
*   PTS 6231, -32, -33, -34, -36, 
*   -71, -72, 6331, 6342 AND BADGE CARD READER
*   PTS 6261 WITH CONNECTED PIN (PERSONAL IDEN- 
*   TIFICATION NUMBER -KEYBOARD). 
* 
*   ONLY INPUT DATA ARE HANDLED BY THIS DRIVER. 
* 
*   AN ECHO DEVICE CAN BE ATTACHED TO EVERY 
*   KEYBOARD, WHERE RECEIVED CHARACTERS ARE 
*   ECHOED. 
* 
*   THE DRIVER CONSISTS OF FOLLOWING PARTS: 
*   R C K B = RECOVERY ROUTINE
*   A C K B = ACTIVATION PART 
*   M A K B = MAIN PART 
*   I H K B = INTERRUPT HANDLER 
* 
*   THE FOLLOWING ORDERS ARE TREATED: 
*     ORDER 01:  BASIC READ 
*           02:  STANDARD READ
*           03:  NUMERIC READ 
*           31:  RESET INPUT BUFFER 
* 
	EJECT
*   NORMAL REGISTER USAGE:
*     REGISTER A1:  RETURN CODE 
*              A2:  INPUT CHARACTER 
*              A3:  BUFFER INDEX
*              A4:  WORK REGISTER 
*              A5:  STACK BASE
*              A6:  DWT-ADDRESS 
*              A7:  ORDER 
*              A8:  ECB-ADDRESS 
* 
*   SYSTEM ADAPTION 
* 
*   DWT-ADDRESS OF ECHO-OUTPUT-DEVICE MUST BE 
*   DEFINED IN DWT. 
* 
*   IF TIMING IS WANTED, BIT 0 IN DWTDEV MUST 
*   BE SET UNEQUAL TO ZERO. STANDARD VALUE FOR TIME-
*   OUT IS 30 SECONDS SINCE LAST DEPRESSED KEY. IF
*   ANOTHER VALUE IS WANTED FOR A SYSTEM, INDICATOR 
*   IN DRIVER MUST BE CHANGED.
* 
* 
*   BIT 1 IN DWTDEV IS SET TO ZERO IF CHARACTERS WITHIN 
*   /30-/39 AND /70-/79 ARE ACCEPTED FOR NUMERIC READ.
*   IF IT IS SET TO ONE, ONLY /30-/39 ARE ACCEPTED. 
* 
*   BIT 2 IN DWTDEV IS SET TO ZERO IF /20-/5F ARE ACCEPTED
*   FOR STANDARD READ. IF IT IS SET TO ONE, /20-/7F ARE 
*   ACCEPTED. 
* 
*   KEYBOARD TYPE MUST ALSO BE DEFINED IN DWT. BIT 3
*   IN DWTDEV MUST BE SET IF PTS 6236/71/72 IS USED.
* 
*   BIT 4 IN DWTDEV IS USED BY THE DRIVER TO INDICATE IF
*   MORE CHARACTERS ARE TO BE ECHOED. 
* 
*   SPACE FOR THE CIRCULAR INPUT BUFFER IS RESERVED IN DWT. 
* 
*   BY MEANS OF CONDITIONAL ASSEMBLY IT IS POSSIBLE 
*   TO EXCLUDE FOLLOWING FUNCTIONS: 
*   ---- ECHO FUNCTION
*   ---- TIME OUT FUNCTION
*   ---- KEYBOARD LOCKED IF NO KEYLOCK ON 
*   ---- COMPLETION OF READ REQUEST AT POWER-ON 
*   ---- SHIFT KEY ON NUMERIC PART OF 6272 USED AS NORMAL KEY 
* 
	EJECT
*   ENTRIES 
* 
	ENTRY	KBAD4	ADDRESSBLOCK 
* 
*   EXTERNAL TOSS MODULE ENTRIES
* 
	EXTRN	LENDER	END REQUEST AND DISPATCH
	EXTRN	INPUT	READ A CHARACTER 
	EXTRN	ECHO	ECHO
	EXTRN	ECHEND	END OF ECHO 
	EXTRN	LDISP	DISPATCH 
	EXTRN	SETIME	SETS TIME 
	EXTRN	LENDIS	END I/O AND DISPATCH
	EXTRN	ABORT	ABORT REQUESTS 
	EXTRN	ABTADR	ABORT-ADDRESS 
	EXTRN	TENDIO 
	EXTRN	TDISP
* 
*   DWT PARAMETERS
* 
	EXTRN	DWTDEV 
	EXTRN	DWTST
	EXTRN	DWTA3
	EXTRN	DWTA5
	EXTRN	DWTADR 
	EXTRN	DWTECH 
	EXTRN	DWTSB2 
	EXTRN	DWTECB 
* 
*   ECB PARAMETERS
* 
	EXTRN	ECBBA	BUFFER ADDRESS 
	EXTRN	ECBRL	REQUESTED LENGTH 
	EXTRN	ECBEL	EFFECTIVE LENGTH 
	EXTRN	ECBCW	CONTROL WORD 
* 
*   CONSTANTS 
* 
OVMASK	EQU	/2	OVERFLOW IN INPUT BUFFER
TIME	EQU	300	TIMEOUT CONSTANT 
	EJECT
* 
************************************
* 
*   CONDITIONAL ASSEMBLY
* 
************************************
* 
*   TIME OUT FUNCTION MAY BE INCLUDED BY SETTING X:A = 1
* 
X:A	EQU	0 
CTIMUT	EQU	0
* 
*   ECHO FUNCTION MAY BE EXCLUDED BY SETTING X:B = 0
* 
X:B	EQU	1 
CECHO	EQU	1 
* 
*   COMPLETION OF READ REQUEST AT POWER ON MAY BE 
*   INCLUDED BY SETTING X:C =1
* 
X:C	EQU	0 
RECOV	EQU	1 
* 
*   THE LENGTH OF THE CIRCULAR INPUT BUFFER IS DEFINED
*   IN X:D, NUMBER OF BYTES IN DECIMAL FORM.
* 
X:D	EQU	8 
DWTLNG	EQU	040
* 
*   CODE CONVERSION DUMMY 
* 
X:E	EQU	0 
* 
	EJECT
* 
*   BY SETTING X:F=0 THE KEY A15 ON KB 71/72 GIVES THE CODE 
*   /00 INSTEAD OF BEING A SHIFT KEY
* 
X:F	EQU	1 
NSHIFT	EQU	1
* 
*   BY SETTING X:G = 1 KEYBOARD IS
*   LOCKED IF NO KEYLOCK ON 
* 
X:G	EQU	0 
KBLOCK	EQU	1
* 
*   MMU BUFFER SIZE 
* 
X:H	EQU	10
DVBLEN	EQU	070
* 
*   MMU KEY TABLE SIZE
* 
X:I	EQU	10
DVBKTB	EQU	64 
* 
*   X:J SHOULD BE SET TO 1 IF KB 6236, 71 OR 72	=2
*   IS INCLUDED IN SYSTEM		=2 
* 
X:J	EQU	1 
NEWKB	EQU	1 
* 
*   X:K SHOULD BE SET TO 1 IF OTHER KB THAN 6236	=2 
*   71 OR 72 IS INCLUDED IN SYSTEM		=2
* 
X:K	EQU	1 
OLDKB	EQU	0 
* 
*   X:L SHOULD BE SET TO 1 IF PLC IS USED		=2 
* 
X:L	EQU	1 
PLC	EQU	00
* 
*   IF X:M = 1 IT IS POSSIBLE TO USE		=2
*   GREEK CHARACTER SET		=2 
* 
X:M	EQU	0 
GREECE	EQU	X:M
*   A PROGRAM VERSION USING TOSS MMU-PAGING IS
*   OBTAINED BY SETTING MMUPAG EQU 1. 
* 
MMUPAG	EQU	1
* 
	EJECT
* 
*   DWT-DISPLACEMENT
* 
DWTKEY	EQU	/04	KEYLOCK MEMORY 
DWTCS	EQU	/06	CRTL-SHIFT MEMORY 
DWTCTB	EQU	/08	CONVERSION POINTERS ADDRESS
DWTTP	EQU	/0A	TIMER POINTER 
* 
*   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
* 
*   ADDRESS BLOCK 
* 
	DATA	DVBKTB	MMU KEY TABLE
	DATA	DVBLEN	MMU BUFFER SIZE
	DATA	6	DEVICE INDEX
KBAD4	EQU	* 
	DATA	ACKB	ACTIVATION PART
	DATA	ABKB	ABORT ROUTINE
	DATA	IHKB	INTERRUPT HANDLER
	IFF	RECOV=1
	DATA	0	NO RECOVERY ROUTINE 
	XIF
	IFT	RECOV=1
	DATA	RCKB	RECOVERY ROUTINE 
	EJECT
************************************
* 
*   RECOVERY ROUTINE
* 
************************************* 
RCKB	LDR	A8,A8	BUSY ? 
	RF(NZ)	RC10	YES !
	LDKL	A1,/400	NO !
	ORS	A1,DWTDEV,A6	INDICATE POWER OFF
	ABL	LENDIS	DISPATCH !
* 
RC10	CWK	A7,1	BASIC READ ?
	ABL(E)	LDISP	YES ! 
*		NO ! 
	CF	A15,ABORT	RESET INPUT REQUESTED FLAG
	LD	A3,DWTA3,A6	RELOAD EFFECTIVE LENGTH 
RC15	CM	ECBCW,A8	COMPLETE REQUEST 
	ABL	MKB335	AND SET RETURN CODE =0
	XIF
	EJECT
************************************
* 
* 
*   A C K B 
*   ACTIVATION PART 
* 
* 
************************************
ACKB	EQU	*
	ENB
* 
	LDK	A1,0	RESET REGISTERS 
	LDK	A3,0 
* 
*   CHECK ORDER 
* 
	LDR	A4,A7
	RF(NG)	AKB100	ILLEGAL ORDER
	SUK	A4,4 
	RF(N)	AKB200	ORDER 1, 2 OR 3 
	SUK	A4,/2D		 
	RF(Z)	AKB110	ORDER 31
* 
*   ILLEGAL ORDER 
* 
AKB100	EQU	*
	ABL	LENDER	COMPLETE REQUEST
	EJECT
* 
*   ORDER 31. RESET INPUT BUFFER. 
* 
AKB110	EQU	*
	INH
	LD	A1,DWTDEV+DWTUTQ,A6	BUF END 
	CW	A1,DWTDEV+DWTINQ,A6	BUFFER EMPTY ?
	RF(E)	AKB119	YES ! 
* 
	LDR	A2,A1
	IFT	NEWKB+OLDKB=2		=2
	LD	A4,DWTDEV,A6
	ANKL	A4,/1000	PTS 6236, -71, -72 ? 
	RF(Z)	AKB118	NO !
	XIF
	IFT	NEWKB=1		=2
* 
*   SHIFT, CTRL AND KEYLOCK CHARACTERS ARE NOT REMOVED
*   FROM BUFFER WHEN KB 6236/71/72 IS USED
* 
AKB112	LCR	A4,A1	GET CHARACTER
	ANK	A4,/FF 
	IFT	NSHIFT=0 
	CCK	A4,/7C00	NUMSHIFT DEPRESSED ?
	RF(E)	AKB113	YES ! SKIP CHARACTER
	XIF
	IFT	NEWKB=1		=2
	SUK	A4,/80	SKIP CHARACTER ?
	RF(Z)	AKB113	YES ! 
	ADK	A4,/10	SHIFT, CTRL, KEYLOCK ?
	RF(NN)	AKB120	YES !
* 
AKB113	CF	A15,EOQUEU	GET NEXT POINTER 
	CW	A1,DWTDEV+DWTINQ,A6	END OF BUF ?
	RB(NE)	AKB112	NO ! CHECK NEXT
* 
	XIF
AKB118	SCR	A3,A1
	ST	A2,DWTDEV+DWTINQ,A6	YES!
AKB119	ENB
	ABL	MKB335	SET RC=0 AND COMPLETE REQUEST 
* 
	IFT	NEWKB=1		=2
AKB120	ADK	A4,/70	RESTORE CHAR. 
	SCR	A4,A2	STORE IN BUF.
	LDR	A3,A1	EXCHANGE REGISTERS 
	LDR	A1,A2
	CF	A15,EOQUEU	GET NEXT POINTER 
	LDR	A2,A1
	LDR	A1,A3
	LDK	A3,0 
	RB	AKB113
* 
	XIF
AKB200	EQU	*
	IFT	RECOV=1
* 
*   POWER OFF TEST
* 
	LD	A2,DWTDEV,A6	POWER OFF ?
	ANKL	A2,/400 
	RF(E)	AKB205	NO !
	XRS	A2,DWTDEV,A6	RESET POWER OFF BIT 
	CWK	A7,1	BASIC READ ?
	RB(NE)	RC15	NO ! COMPLETE REQUEST !
	XIF
AKB205	EQU	*
	IFT	CTIMUT=1 
	EJECT
* 
*   INITIATE TIMING ROUTINE 
* 
	LD	A1,DWTDEV,A6	TIMING ? 
	RF(NN)	AKB210	NO!
* 
	LD	A4,DWTTP+DWTDEV,A6	YES ! IS THERE AN EXISTING POINTER ? 
	RF(E)	AKBTIM	NO! 
* 
	CF	A15,RESTRT	YES ! RESTART TIMER
	RF	AKB210
* 
AKBTIM	EQU	*
	LDR	A1,A6	DWT-ADDRESS IN A1
* 
	CF	A15,SETIME	SET TIME 
	DATA	AKBTUT,TIME	TIMEOUT ROUTINE & TIME
* 
	ST	A4,DWTTP+DWTDEV,A6	STORE TIMER ADDRESS IN DWT 
	XIF
	EJECT
* 
*   REQUESTED LENGTH OK ? 
* 
AKB210	LD	A2,ECBRL,A8	REQUESTED LENGTH IN ECB = 0 ? 
	ABL(E)	MKBEND	YES ! COMPLETE REQUEST ! 
* 
*   CLEAR ECB-BUFFER
* 
	LD	A1,ECBBA,A8	BUFFER ADDRESS
	SUK	A1,1 
	ADR	A1,A2	ADD REQUESTED LENGTH 
* 
AKB230	SCR	A3,A1	CLEAR BUFFER UNTIL REQUESTED LENGTH
	SUK	A1,1		 
	SUK	A2,1 
	RB(NE)	AKB230	NOT READY YET
	EJECT
* 
************************************
* 
* 
*   M K B 
*   MAIN PART OF KEYBOARD DRIVER
* 
* 
**************************************
* 
*   CHECK CIRCULAR INPUT BUFFER. IF IT CONTAINS 
*   CHARACTERS AND NO OVERFLOW HAS OCCURRED, A
*   CHARACTER WILL BE PUT IN A2 
* 
MKB100	EQU	*
	INH
	LD	A1,DWTDEV+DWTUTQ,A6	FETCH A CHARACTER FROM
	LCR	A2,A1	CIRCULAR BUFFER END
* 
	LDR	A4,A2
	XRK	A4,/FF	OVERFLOW ?
	RF(NE)	MKB130	NO ! 
* 
	SCR	A4,A1	YES !
	ENB
	LDK	A1,OVMASK	SET OVERFLOW BIT 
	ABL	MKBEND	COMPLETE REQUEST
* 
MKB130	CW	A1,DWTDEV+DWTINQ,A6	ANYTHING IN BUFFER ?
	RF(E)	MKB140	NO !
	CF	A15,EOQUEU	YES ! MOVE POINTER 
	ST	A1,DWTDEV+DWTUTQ,A6	STORE NEW POINTER 
				=1
	IFT	PLC=1		=2
* 
*   TEST IF THERE ARE MORE CHARACTERS IN CIRC. INPUT BUFFER 
* 
	LDKL	A4,/0800	"MORE CHARACTERS" INDICATION BIT 
	CW	A1,DWTDEV+DWTINQ,A6	MORE IN BUFFER ?
	RF(E)	MKB135	NO !
	ORS	A4,DWTDEV,A6 
	XIF
MKB133	ENB
	RF	MKB150
* 
	IFT	PLC=1		=2
MKB135	C1R	A4,A4
	ANS	A4,DWTDEV,A6	CLEAR "MORE CHARACTERS" INDICATION
	RB	MKB133
	XIF
	EJECT
* 
*   READ A CHARACTER FROM KEYBOARD
* 
MKB140	EQU	*
	CF	A5,INPUT	READ CHARACTER 
	ENB
* 
	ANK	A2,/7F	MASK TO GET CHARACTER 
* 
	IFT	PLC=1		=2
*   SET "MORE CHARACTERS" INDICATION BIT IF THERE 
*   ARE MORE CHARACTERS 
* 
	ANK	A1,/1	MASK NOT SIGNIFICANT BITS
	SRC	A1,5 
	ORS	A1,DWTDEV,A6 
* 
	XIF
	IFT	CTIMUT=1 
	CF	A15,RESTRT	RESTART TIMEOUT TIMER
	XIF
* 
MKB150	EQU	*
	IFT	NEWKB+OLDKB=2		=2
* 
*   CHECK WHICH KEYBOARD THAT IS USED 
* 
	LD	A4,DWTDEV,A6	KEYBOARD WITH
	ANKL	A4,/1000	SPECIAL CONVERSION ? 
	RF(Z)	MKB290	PERHAPS ! 
	XIF
	IFT	NEWKB=1		=2
* 
*   KB 6236/71/72 IS USED 
*   CHECK INCOMING CHARACTER
* 
	LDR	A4,A2
	SUK	A4,/80	SKIP CHAR. FROM CIRC. BUF.? 
	RB(Z)	MKB100	YES, READ NEXT CHARACTER
	ADK	A4,/8	CTRL/SHIFT ? 
	RF(NN)	MKB220	YES !
	ADK	A4,/8	NORMAL CHARACTER ? 
	RF(N)	MKB300	YES ! 
	EJECT
* 
*   KEYLOCK IS TURNED. SET/CLEAR CORRESPONDING BIT IN DWT.
*   IF THE KEYLOCK ISN'T CHANGED, WHICH MEANS THAT THE
*   CHARACTER IS COMING BECAUSE OF POWER UP, THE CHARAC-
*   TER SHOULD BE IGNORED.
* 
	LDK	A1,1	"FLAG BIT"
	LDR	A4,A4	KEYLOCK CHAR. - /70
MKB160	RF(Z)	MKB170	KEYLOCK ON !
	SUK	A4,1 
	RF(Z)	MKB180	KEYLOCK OFF ! 
	SLC	A1,1	SHIFT "FLAG BIT" LEFT 
	SUK	A4,1 
	RB	MKB160	NEXT KEYLOCK, PERHAPS ?
* 
MKB170	EQU	*
	LD	A4,DWTDEV+DWTKEY,A6	TEST IF KEYLOCK IS CHANGED
	TM	A4,A1 
	RB(NE)	MKB100	NO CHANGE, READ A NEW CHAR.
	ORS	A1,DWTDEV+DWTKEY,A6	SET "FLAG BIT" 
	RF	MKB190
MKB180	EQU	*
	LD	A4,DWTDEV+DWTKEY,A6	TEST IF KEYLOCK CHANGED 
	TM	A4,A1 
	RB(Z)	MKB100	NO CHANGE 
	C1R	A1,A1	COMPLEMENT FOR AND-FUNCTION
	ANS	A1,DWTDEV+DWTKEY,A6	CLEAR "FLAG BIT" 
MKB190	EQU	*
	CF	A15,STORE	STORE KEYLOCK CHARACTER IN ECB
	LDR A4,A7	LOAD ORDER CODE
	SUK	A4,2 
	RF(N)	MKB325	ORDER 1 ! 
	EJECT
* 
*   KEYLOCK IS TURNED ! MAKE A NEGATIVE CODE
*   TO THE CONTROLWORD IN ECB AND COMPLETE REQUEST
* 
MKB200	EQU	*
	LDR	A4,A2	LOAD CHARACTER 
	SUK	A4,/70 
	SRC	A4,1	SHIFT TO GET KEY NUMBER 
	RF(N)	MKB210	ON OR OFF ? 
	ADK	A4,/4	ON ! 
MKB210	SLL	A4,1	MAKE WORD POSI- 
	SRL	A4,1	TIVE AGAIN
	C1R	A4,A4	CHANGE 0 TO 1 AND VICE VERSA 
	ST	A4,ECBCW,A8	STORE CODE IN ECB 
	RF	MKB335	SET RC=0 AND COMPLETE REQUEST
* 
*   CTRL OR (NUM.) SHIFT IS DEPRESSED (RELEASED)
* 
MKB220	EQU	*
	IFT	KBLOCK=1 
	LD	A1,DWTDEV+DWTKEY,A6	IS KB LOCKED ?
	RB(Z)	MKB100	YES ! READ A NEW CHARACTER
	XIF
	IFT	NEWKB=1		=2
	IFT	NSHIFT=0 
* 
*   MAKE CHARACTER /00 IF NUMERIC SHIFT KEY IS
*   DEPRESSED, AND SKIP THE INCOMING CHARACTER
*   IF IT IS RELEASED.
* 
	CCK	A2,/7C00	DEPRESSED ? 
	RF(NE)	MKB230	NO ! 
	LDK	A2,/00	YES ! LOAD CHARACTER
	RF	MKB300
* 
MKB230	CCK	A2,/7D00	RELEASED ?
	RB(E)	MKB100	YES ! SKIP CHARACTER
	XIF
	IFT	NEWKB=1		=2
MKB250	LDK	A1,/2	SHIFT BIT
	LDR	A4,A4	SHIFT ON ? 
	RF(Z)	MKB260	YES ! 
	SUK	A4,1	SHIFT OFF ? 
	RF(Z)	MKB270	YES ! 
	LDK	A1,/4	CONTROL BIT
	SUK	A4,1	CONTROL ON ?
	RF(Z)	MKB260	YES ! 
	SUK	A4,1	CONTROL OFF ? 
	RF(Z)	MKB270	YES ! 
	SUK	A4,1	NUMERIC SHIFT ? 
	RB	MKB250	YES !
* 
MKB260	ORS	A1,DWTDEV+DWTCS,A6	SET 
	RF	MKB280
MKB270	C1R	A1,A1	COMPLEMENT 
	ANS	A1,DWTDEV+DWTCS,A6	CLEAR 
* 
MKB280	ABL	MKB100	NEXT CHARACTER
	XIF
	IFT	OLDKB=1		=2
	EJECT
* 
*   SPECIAL CONVERSION OF CHARACTERS FROM 
*   NUMERIC PART OF 6234. 
* 
MKB290	EQU	*
	LDR	A1,A6	IF THE DWT-ADDRESS IS
	ANK	A1,1	ODD, SHOULD SPECIAL CONVERSION
	RF(NZ)	MKB295	BE USED
	LDR	A4,A2	IF BIT 8 IN CHARACTER IS 
	ANK	A4,/80	SET SHOULD SPECIAL CONV. BE USED
	RF(Z)	MKB310	NO SPECIAL CONVERSION 
	ANK	A2,/7F	MASK AWAY BIT 8 
* 
*   INDICATE SPECIAL CONVERSION ! 
* 
MKB295	ANKL	A6,/FFFE	MAKE THE DWT-ADDRESS EVEN
	LDK	A4,/8	LOAD SPECIAL BIT 
	ST	A4,DWTDEV+DWTCS,A6
	RF	MKB310
	XIF
	EJECT
* 
*   NORMAL CONVERSION 
* 
MKB300	EQU	*
* 
	IFT	KBLOCK=1 
	LD	A1,DWTDEV+DWTKEY,A6	IS KB LOCKED ?
	ABL(Z)	MKB100	YES ! READ A NEW CHARACTER 
	XIF
* 
MKB310	EQU	*
	LD	A1,DWTDEV+DWTCTB,A6	GET CTAB ADDRESS
	RF(E)	MKB320	NO CONVERSION 
	AD	A1,DWTDEV+DWTCS,A6	GET CURRENT CONVERSION TABLE 
	LDR*	A1,A1 
	RF(E)	MKB320	NO CONVERSION TABLE 
	LDR	A4,A2
	SRL	A4,3	LINE INDEX
	ADR	A1,A4
	LDR*	A1,A1	COLUMN TABLE ADDRESS
	RF(E)	MKB320	NO COLUMN 
	LDR	A4,A2
	ANK	A4,/F
	ADR	A1,A4	ADD ROW INDEX
	LCR	A2,A1	LOAD CHARACTER 
* 
MKB320	EQU	*
	IFT	OLDKB=1		=2
	LDK	A4,/7	RESET SPECIAL BIT
	ANS	A4,DWTDEV+DWTCS,A6 
	XIF
	EJECT
* 
*   CHECK IF BASIC READ OR ORDER 2 OR 3 
* 
	LDR	A4,A7	LOAD ORDER CODE
	SUK	A4,2 
	RF(NN)	MKB330	ORDER 2 OR 3 ! 
* 
*   ORDER 1, BASIC READ 
* 
	CF	A5,STOECH	STORE CHAR. IN ECB-BUFFER 
*                                        AND SEND IT TO ECHO-DEVICE 
*                                        IF ECHO WANTED 
* 
MKB325	EQU	*
	CW	A3,ECBRL,A8	EFF. LENGTH = REQ. LENGTH ? 
	ABL(NE)	MKB100	NO ! READ A NEW CHARACTER 
* 
	RF	MKB335	YES ! SET RETURN CODE = 0
	EJECT
* 
*   ORDER 2 OR 3, STANDARD OR NUMERIC READ
* 
MKB330	EQU	*
* 
*   CHECK IF IT IS AN END-OF-RECORD-KEY 
* 
	LD	A1,ECBCW,A8	KEY-TABLE ADDRESS 
	RF(Z)	MKB360	NO KEYTABLE ! 
	LCR	A4,A1	TABLE LENGTH IN A4 
	ANK	A4,/FF 
	ADR	A1,A4	ADDRESS TO LAST PLACE IN KEYTABLE
	ADK	A1,1 
MKB340	SUK	A4,1 
	RF(N)	MKB360	KEY NOT FOUND IN KEYTABLE 
	SUK	A1,1	NEXT KEY
	CCR	A2,A1	EOR-CHARACTER ?
	RB(NE)	MKB340	NO ! TRY NEXT KEY IN KEYTABLE
* 
	ADK	A4,1	YES ! MAKE KEYTABLE INDEX 
MKB350	EQU	*
	ST	A4,ECBCW,A8	STORE INDEX IN CONTROL WORD 
* 
	CF	A15,STORE	STORE CHARACTER IN ECB BUFFER 
	IFT	CECHO=1
	ORK	A2,/80	INDICATE EOR CHARACTER
	CF	A5,EORECH	ECHO CHARACTER
	XIF
* 
MKB335	EQU	*
	LDK	A1,0	SET RETURN CODE = 0 
	RF	MKBEND	AND COMPLETE REQUEST 
* 
	EJECT
* 
* 
*   CHARACTER CHECK 
* 
MKB360	EQU	*
	STR	A2,A15	SAVE CHARACTER ON STACK 
	LD	A1,DWTDEV,A6
	CWK	A7,2	STANDARD READ ? 
	RF(NE)	MKB380	NO ! 
	LDK	A4,/20	LOWER LIMIT 
	SLC	A1,2	/20-/7F ? 
	RF(Z)	MKB370	YES ! 
	LDK	A1,/5F	NO ! UPPER LIMIT
	RF	MKB400
* 
MKB370	LDK	A1,/7F	UPPER LIMIT 
	RF	MKB400
* 
MKB380	SLC	A1,1	/30-/39 & /70-/79 ? 
	RF(NZ)	MKB390	NO ! 
* 
	ANK	A2,/3F	RESET BIT 9 
MKB390	LDK	A1,/39	UPPER LIMIT 
	LDK	A4,/30	LOWER LIMIT 
* 
MKB400	SUR	A1,A2
	RF(N)	MKB420	NOT WITHIN LIMITS 
	SUR	A4,A2
	RF(P)	MKB420	NOT WITHIN LIMITS 
	LDR*	A1,A15	DUMMY LOAD 
	EJECT
* 
*   IT IS A "NORMAL" CHARACTER !
* 
MKB405	EQU	*
	CF	A5,STOECH	STORE AND ECHO CHARACTER
* 
	CW	A3,ECBRL,A8	LENGTH OVERFLOW ? 
	ABL(L)	MKB100	NO ! TAKE NEXT CHARACTER 
* 
MKB410	LDK	A1,8	YES ! SET ERROR CODE
	RF	MKBEND
* 
*   CHECK IF IT IS BACKSPACE, CLEAR, MULTIPLE ZERO, 
*   STANDARD EOR, SKIP OR UNKNOWN CHARACTER 
* 
MKB420	LDR*	A2,A15	RELOAD CHARACTER 
	LDR	A1,A2
	ANK	A1,/FF 
	LD	A4,ECBCW,A8 
	RF(NZ)	MKB440	STANDARD EOR NOT USED !
	LDK	A4,1	INDEX TO STORE IN ECBCW IF STANDARD EOR 
	CCK	A1,/0D00	STANDARD EOR ?
	RB(E)	MKB350	YES ! 
MKB440	EQU	*
	SUK	A1,/1B	TRIPLE ZERO ? (/1B) 
	ABL(E)	MZ30	YES !
* 
	ADK	A1,/13	BACKSPACE ? (/08) 
	ABL(E)	BACKSP	YES !
* 
	SUK	A1,/10	CLEAR ? (/18) 
	ABL(E)	CLEAR	YES ! 
* 
	SUK	A1,/2	DOUBLE ZERO ? (/1A)
	ABL(E)	MZ20	YES !
* 
	SUK	A1,/E5	SKIP CHARACTER (/FF)
	ABL(E)	MKB100	YES !
	IFT	GREECE=1		=2 
	LDR	A1,A2	CHECK IF CHARACTER IS
	SUK	A1,/B0	WITHIN LIMITS FOR THE 
	RF(N)	MKB460	GREEK CHARACTER SET 
	SUK	A1,/9
	RB(NP)	MKB405	YES IT IS OK 
MKB460	EQU	*
	XIF
* 
*   SET ERROR CODE FOR UNKNOWN CHARACTER
* 
	CF	A15,STORE	STORE CHARACTER IN ECB-BUFFER 
	LDK	A1,4 
* 
	EJECT
****************************************
* 
* 
*   COMMON END
* 
* 
************************************* 
MKBEND	EQU	*
* 
	IFT	CTIMUT=1 
	LD	A4,DWTTP+DWTDEV,A6
	RF(E)	MKBE10	NO TIMING ! 
	CM*	DWTTP+DWTDEV,A6	SCRATCH TIMER
	CM	DWTTP+DWTDEV,A6 
	XIF
* 
MKBE10	EQU	*
	ST	A3,ECBEL,A8	STORE EFFECTIVE LENGTH
* 
	IFT	CECHO=1
	LDR	A4,A1	SAVE A1
	CF	A5,ECHEND	END OF ECHOING
	LDR	A1,A4
	XIF
* 
	ABL	LENDIS	PERFORM END I/O AND DIPATCH 
	EJECT
**************************************
* 
* 
*   INTERRUPT HANDLER 
* 
* 
**************************************
IHKB	EQU	*
	ANK	A2,/7F	MASK TO GET CHARACTER 
	IFT	CTIMUT=1 
	CF	A15,RESTRT	RESTART TIMEOUT TIMER
	XIF
* 
*   STORE INCOMING CHARACTER IN CIRCULAR BUFFER 
* 
	IFT	OLDKB=1		=2
	LDR	A1,A6	SPECIAL CONVERSION ? 
	ANK	A1,1 
	RF(Z)	IHKB02	NO !
	ORK	A2,/80	YES INDICATE BY SETTING BIT 8 
	XIF
IHKB02	LD	A1,DWTDEV+DWTINQ,A6 
	LCR	A4,A1
	XRK	A4,/FF	ALREADY OVERFLOW ?
	RF(E)	IHKB05	YES ! 
* 
	LDR	A4,A1
	CF	A15,EOQUEU	GET NEXT OUTQUEUE POINTER ADDRESS
* 
	CW	A1,DWTDEV+DWTUTQ,A6	OVERFLOW ?
	RF(NE)	IHKB20	NO ! 
	LDK	A1,/FF	OVERFLOW INDICATION 
	SCR	A1,A4	SET OVFL. IND. IN BUFFER 
* 
IHKB05	EQU	*
	IFT	NEWKB+OLDKB=2		=2
	LD	A1,DWTDEV,A6	6236, 71, 72 ? 
	ANKL	A1,/1000
	RF(Z)	EXIT	NO !
* 
	XIF
	IFT	NEWKB=1		=2
	SUK	A2,/70	KEYLOCK, SHIFT, CTRL ?
	RF(N)	EXIT	NO !
	ADK	A2,/70	YES ! 
* 
	LDK	A1,0 
	SC	A1,DWTDEV+1,A6
	LD	A1,DWTDEV+DWTINQ,A6 
	LDR	A4,A1
	CF	A15,EOQUEU
	CW	A1,DWTDEV+DWTUTQ,A6	BUFFER FILLED ? 
	RF(E)	IHKB07	YES ! 
	SCR	A2,A4	STORE NEW CHARACTER
	LDK	A2,/FF	MOVE OVERFLOW INDICATION
	LDR	A4,A1	FORWARD IN BUFFER
	RF	IHKB20
* 
*   CHECK BUFFER
* 
IHKB07	LD	A1,DWTDEV+DWTINQ,A6	POINTER TO LAST POS IN BUF. 
IHKB10	EQU	*
	CW	A1,DWTDEV+DWTUTQ,A6	END OF QUEUE ?
	RF(E)	IHKB19	YES ! 
	CF	A15,SOQUEU	GET PREVIOUS POINTER 
* 
	LCR	A4,A1	GET CHARACTER
	ANK	A4,/7F 
	XRR	A4,A2	 
	RF(Z)	EXIT	EQUAL CHARACTER ! 
	SUK	A4,1	INVERTED CHAR. ?
	RF(NZ)	IHKB17	NO ! 
	LDK	A2,/80	YES ! LOAD SKIP CHAR FOR CIRC BUF 
	RF	IHKB18
* 
IHKB17	EQU	*
	SUK	A4,/F	CTRL, SHIFT, KEYLOCK ? 
	RB(N)	IHKB10	YES ! 
* 
IHKB18	SCR	A2,A1	NO ! STORE CHAR IN BUFFER
	RF	EXIT
* 
*   CHECK BUFFER AGAIN AND SORT OUT 
*   EQUAL AND INV. CHARACTERS 
* 
IHKB19	LC	A4,DWTDEV+1,A6	SORT OUT EQUAL AND INV. CHAR 
	ANK	A4,/FF 
	LD	A1,DWTDEV+DWTINQ,A6 
IHKB21	CF	A15,SOQUEU
	SUK	A4,1 
	RB(NN)	IHKB21
	IM	DWTDEV,A6 
	LCR	A4,A1	GET OLD CHAR FROM BUFFER 
	CCK	A4,/FF00	END OF BUFFER ? 
	RF(E)	EXIT	YES ! 
	SCR	A2,A1	STORE THE NEW ONE
	LDR	A2,A4	PUT CHAR IN A2 
	ANK	A2,/7F 
	RB	IHKB07
	XIF
* 
IHKB20	ST	A1,DWTDEV+DWTINQ,A6	STORE INQUEUE POINTER 
IHKB30	SCR	A2,A4	STORE CHARACTER IN INPUT BUFFER
* 
EXIT	ABL	LDISP	DISPATCH ! 
	EJECT
* 
*   STORING (&ECHOING) SUBROUTINE 
*   SKIPS OTHER CHARACTERS THAN DIGITS IF 
*   NUMERIC READ
* 
STOECH	EQU	*
	CF	A15,STORE	STORE CHAR. IN ECB-BUFFER 
* 
	IFT	CECHO=1
	IFT	GREECE=1		=2 
	RF	EORECH	DO NOT MASK
	XIF
	IFT	CECHO=1
ECHSUB	ANK	A2,/7F	MASK TO GET CHARACTER 
EORECH	EQU	*
	IFT	PLC=1		=2
	LD	A1,DWTDEV,A6	GET "MORE CHARACTERS" INDICATION BIT 
	ANKL	A1,/0800
	XRS	A1,DWTDEV,A6	RESET INDICATION BIT
	SLC	A1,5 
	XIF
	IFT	CECHO=1
	CF	A5,ECHO	ECHO CHARACTER
	XIF
* 
	RTN	A5 
* 
	EJECT
	IFT	CTIMUT=1 
* 
*   THIS IS THE TIMEOUT ROUTINE 
* 
AKBTUT	EQU	*
	LDR	A6,A1	LOAD DWT-ADDRESS 
	CM	DWTTP+DWTDEV,A6 
	LD	A2,DWTST,A6 
	ABL(N)	LDISP	DISPATCH IF NO REQUEST ON 
* 
	CF	A15,ABORT	RESET INPUT REQUESTED FLAG
	LDR	A5,A6	INITIATE DWT-STACK POINTER 
	ADKL	A5,DWTSB2 
	LD	A3,DWTA3,A6	RELOAD EFFECTIVE LENGTH FROM DWT
	LD	A8,DWTECB,A6	RELOAD ECB-ADDRESS 
	LDK	A1,/40	SET RETURN CODE 
	ABL	MKBEND	COMPLETE REQUEST
* 
*   RESTART TIMEOUT TIMER 
* 
RESTRT	EQU	*
	LD	A4,DWTTP+DWTDEV,A6
	RF(E)	NOTIME	NO TIMING 
	LDKL	A4,-TIME	RESTART TIMER
	ST*	A4,DWTTP+DWTDEV,A6 
NOTIME	RTN	A15
	XIF
	EJECT
* 
*   STORE = SUBROUTINE TO STORE A CHARACTER 
*   IN ECB-BUFFER AND INCREMENT BUFFER INDEX
* 
*     ON ENTRY:  A2 = CHARACTER TO STORE
*                A3 = BUFFER INDEX
* 
STORE	EQU	* 
	LD	A1,ECBBA,A8	BUFFER ADDRESS
	ADR	A1,A3	ADD BUFFER INDEX 
	SCR	A2,A1	STORE CHARACTER IN BUFFER
	ADK	A3,1	INCREMENT BUFFER INDEX
	RTN	A15
* 
*   EOQUEU = SUBROUTINE TO GET NEXT QUEUE POINTER 
* 
*     ON ENTRY:  A1 = QUEUE POINTER 
*                A6 = DWT-ADDRESS 
* 
EOQUEU	EQU	*
	ADK	A1,1 
	SUR	A1,A6
	CWK	A1,DWTDEV+DWTEQ	END OF QUEUE ? 
	RF(NE)	EOQU10
	LDKL	A1,DWTDEV+DWTSQ	SET QUEUE START ADDRESS 
EOQU10	ADR	A1,A6
	RTN	A15
* 
*   SOQUEUE = SUBROUTINE TO GET PREVIOUS QUEUE POINTER
* 
*     ON ENTRY:  A1 = QUEUE POINTER 
*                A6 = DWT-ADDRESS 
* 
SOQUEU	EQU	*
	SUR	A1,A6
	CWK	A1,DWTDEV+DWTSQ	FIRST POS IN QUEUE ? 
	RF(NE)	SOQ10	NO !
	LDKL	A1,DWTDEV+DWTEQ	GET LAST POS IN QUEUE 
SOQ10	ADR	A1,A6 
	SUK	A1,1	GET PREVIOUS POINTER POS. 
	RTN	A15
	EJECT
* 
*   BACKSPACE 
* 
BACKSP	EQU	*
	LDR	A3,A3
	RF(Z)	KBBSPA	ECB-BUFFER EMPTY
	SUK	A3,1	ONE STEP BACKWARDS
	SUR	A2,A2	CLEAR A2 
	CF	A15,STORE	STORE A BLANK INSTEAD OF LAST CHAR
	SUK	A3,1	STEP BACKWARDS AGAIN
* 
KBBSPA	EQU	*
	IFT	CECHO=1
	LDK	A2,/8	BACKSPACE TO ECHODEVICE
	XIF
KBBSP2	EQU	*
	IFT	CECHO=1
	CF	A5,ECHSUB	ECHSUB CHARACTER
	XIF
	ABL	MKB100	NEXT CHARACTER
* 
*   CLEAR 
* 
CLEAR	EQU	* 
	LDK	A3,0	RESET ECB-BUFFER
	RB	KBBSP2	NEXT CHARACTER 
	EJECT
* 
*   MULTIPLE ZERO 
* 
MZ20	EQU	*	DOUBLE ZERO
	LDK	A4,2 
	RF	MZ50
* 
MZ30	EQU	*	TRIPLE ZERO
	LDK	A4,3 
* 
MZ50	EQU	*
	SUK	A4,1	ANY MORE ZEROES ? 
	ABL(L)	MKB100	NO, NEXT CHARACTER 
* 
	EJECT
	INH
	LD	A1,DWTDEV+DWTUTQ,A6	GET OUTQUEUE POINTER
	CF	A15,SOQUEU	GET PREVIOUS POINTER 
* 
	CW	A1,DWTDEV+DWTINQ,A6	ANY SPACE LEFT ?
	RF(E)	MZ90	NO !
MZ75	EQU	*
	ST	A1,DWTDEV+DWTUTQ,A6	STORE NEW OUTQUEUE POINTER
	LDK	A2,/30	STORE ZERO IN CIRCULAR BUFF.
	SCR	A2,A1
	RB	MZ50
* 
MZ80	EQU	*
	LDK	A4,/FF	INDICATE BUFFER OVERFLOW
	SCR	A4,A1
	ST	A1,DWTDEV+DWTUTQ,A6	UPPDATE POINTER 
	LDK	A1,/A	SET RETURN CODE FOR BOTH LENGTH AND
	ENB		THROUGHPUT ERRORS 
* 
	ABL	MKBEND 
* 
MZ90	EQU	*
	LDR	A4,A4	ALL ZEROES ? 
	RB(E)	MZ80	YES 
	LDKL	A2,/FFFF	NO, MOVE IN-POINTER
	ADS	A2,DWTDEV+DWTINQ,A6
	RB	MZ75
	EJECT
* 
****************************************
* 
*   ABORT ROUTINE 
* 
****************************************
* 
ABKB	EQU	*
	CF	A15,ABORT	ABORT INPUT REQUEST 
	IFT	CTIMUT=1 
	LD	A4,DWTTP+DWTDEV,A6
	RF(Z)	ABKB05	NO TIMER !
	CM*	DWTTP+DWTDEV,A6
	CM	DWTTP+DWTDEV,A6	RESET TIMER 
ABKB05	EQU	*
	XIF
* 
	LD	A4,DWTST,A6	GET STATUS WORD 
	CF	A15,TENDIO	END I/O ON KEYBOARD
	SLC	A4,2	GET ECHO-MODE INDICATION BIT
ABKB10	EQU	*
	ABL(NN)	LDISP	NOT AN ECHO REQUEST
* 
	LD	A4,DWTECH,A6	GET DWT-ADDRESS OF ECHO DEVICE 
	LD	A3,DWTADR,A4	GET ADDRESS BLOCK
	LD	A3,ABTADR,A3	GET ABORT-ADDRESS OF ECHO DEVICE 
	RB(Z)	ABKB10	ABORT-ADDRESS = 0 ! NO ABORT
* 
	LDR	A6,A4	RESTORE DWT-ADDRESS OF ECHO DEVICE 
	LDKL	A5,DWTSB2	STACK BASE 2 DISPLACEMENT 
	ADR	A5,A6	ADD DWT-ADDRESS
* 
	ABR	A3	JUMP TO ABORT ROUTINE OF ECHO DEVICE
	END

Full view