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

⟦5952e80ec⟧ 

    Length: 46336 (0xb500)
    Notes: pts_type(SC)
    Names: »START.SC«

Derivation

└─⟦fce1dcf99⟧ Bits:30009704 Philips computer tape "KMD15"
    └─⟦this⟧ »IBM3270/START.SC«

PTS(SC)

	IDENT START 	REL 1.2 78-09-15  870150540120

************************************************************* 
* 
*   S T A R T  :  MODULE HANDLING KEYBOARD INPUT.KEYBOARD INITIATED 
*                 MESSAGES ADDRESSED TO THE MAIN FRAME ARE COMPOSED 
*                 AND SENT BY USING ROUTINES IN MODULE VDUPRT.
* 
**************************************************************************




	EJECT
* 
* 
*	ENTRY PARAMETERS
* 
* 
* 
	ENTRY	LMP1ON,LMP1OF,ATMASB 
	ENTRY	LMP3ON,LMP3OF
	ENTRY	EMULA
	ENTRY	OFL:ON	TURN ON OFFLINE LAMP
	ENTRY	OFL:OF	TURN OFF OFFLINE LAMP 
* 
	ENTRY	VDUKB	KB3270 (CREDIT)
	ENTRY	DCTASK 
	ENTRY	SELTAB	SELECT ADDRESS TABLE
* 
* 
* 
*     EXTERNAL REFERENSES 
* 
* 
* 
	EXTRN	ERASE	VDUPRT 
	EXTRN	TRPF 
	EXTRN	SETCUR 
	EXTRN	WCHAR
	EXTRN	TRPA 
	EXTRN	ERASUA 
	EXTRN	DISPL
	EXTRN	ERASUP 
	EXTRN	VDTASK 
	EXTRN	GETT:A 
* 
	EXTRN	HARDCP	PRT 
	EXTRN	DPACK
	EXTRN	BPACK
* 
	EXTRN	I:EVA0	CREDIT EVALUATION ROUTINE 
	EXTRN	I:RT1	RETURN TO CREDIT CODE
	EJECT


**********************************************************
* 
*   CONDITIONAL ASSEMBLY
* 
********************************* 


KB6234	EQU	1
OFLIN	EQU	0	SHOULD ALWAYS BE SET TO ZERO
MZERO	EQU	0 
RDBUF	EQU	0 
PFX	EQU	0 
PAX	EQU	0 
MGTP	EQU	0
EBCDIC	EQU	1


	IFT	KB6234=1 
RSET	EQU	X'BA'	RESET KEY
	XIF
	IFF	KB6234=1 
RSET	EQU	X'3C'	RESET KEY
	XIF

	EJECT
* 
* 
*     EQUATES 
* 
* 
* 
*	COMMON EQU FOR ECB HANDLING 
* 

ECBBA	EQU	2 
ECBRL	EQU	4 
ECBEL	EQU	6 
ECBRC	EQU	8 
ECBCW	EQU	10
* 
* 
*	CREDIT USED EQU 
* 
* 
*	ECB REL. ADDRESSES
* 
* 
DIS	EQU	20
* 
ECB1	EQU	-DIS-8 
ECB2	EQU	ECB1-DIS 
ECB3	EQU	ECB2-DIS 
ECB4	EQU	ECB3-DIS 
ECB5	EQU	ECB4-DIS 
* 
ECBDC	EQU	ECB1
ECBDCT	EQU	ECB2 
ECBVDU	EQU	ECB3 
ECBKB	EQU	ECB4
ECBSD	EQU	ECB5
ECBPR	EQU	ECB3
* 
* 
*	BASE ADDRESS FOR TCA AND ECB
* 
TCABAS	EQU	A11
CREBAS	EQU	A13	ECB
* 
* 
*	TCA REL. ADDRESSES
* 
TCT01	EQU	0 
PRINTER	EQU	TCT01+2 
BVDU	EQU	PRINTER+2	VDU SCREEN BUFFER
PCURS	EQU	BVDU+1920	CURSOR ADDRESS , BINARY 
ATTRIB	EQU	PCURS+2	LAST ATTRIBUTE CHAR
CURATT	EQU	ATTRIB+2 
WCC	EQU	CURATT+2	WCC/CCC CHARACTER
KBINH	EQU	WCC+2	KEYBOARD INHIBIT INDICATOR
LINCNT	EQU	KBINH+2	LINE COUNTER 
DCLENG	EQU	LINCNT+2	DC READ EFFECTIVE LENGTH
DCADDR	EQU	DCLENG+2	DC SUBTERMINAL ADDRESS
TCTGPL	EQU	DCADDR+2 
INTATT	EQU	TCTGPL+2	INTENSITY ATTRIBUTE 
OFFFLG	EQU	INTATT+2	OFFLINE FLAG
LOCK	EQU	OFFFLG+2	COPY LOCK 
VDUBSY	EQU	LOCK+2	LOCK VDU WHEN HARDCOPY
COPNO	EQU	VDUBSY+2	HARDCOPY TASK IDENTITY 
CRE	EQU	COPNO+2	CREDIT ECB:S BASE ADDRESS 
VDUT.A	EQU	CRE+2	T:A BASE ADDRESS 
CCC	EQU	VDUT.A+2	COPY COMMAND CHARACTER 
	EJECT
* 
* 
LBVDU	EQU	1920	1920 CHAR DISPLAY	6344 
LPAGE	EQU	48	LINES ON ONE PAGE
LLINE	EQU	80	80 CHAR PER DISPLAY LINE 
* 
	IFT	EBCDIC=1 
TCADDR	EQU	/6040	TCS & TCP EBCDIC 
	XIF
	IFF	EBCDIC=1 
TCADDR	EQU	/2D20	TCS & TCP  ASCII 
	XIF
* 
SELTAB	EQU	*	SELECT ADDRESSES 
	IFT	EBCDIC=1	EBCDIC DEVICE ADDRESSES 
	DATA	/40 
	DATA	/C1 
	DATA	/C2 
	DATA	/C3 
	DATA	/C4 
	DATA	/C5 
	DATA	/C6 
	DATA	/C7 
	DATA	/C8 
	DATA	/C9 
	DATA	/4A 
	DATA	/4B 
	DATA	/4C 
	DATA	/4D 
	DATA	/4E 
	DATA	/4F 
	DATA	/50 
	DATA	/D1 
	DATA	/D2 
	DATA	/D3 
	DATA	/D4 
	XIF
	IFF	EBCDIC=1	ASCII DEVICE ADDRESSES
	DATA	/20 
	DATA	/41 
	DATA	/42 
	DATA	/43 
	DATA	/44 
	DATA	/45 
	DATA	/46 
	DATA	/47 
	DATA	/48 
	DATA	/49 
	DATA	/5B 
	DATA	/2E 
	DATA	/3C 
	DATA	/28 
	DATA	/2B 
	DATA	/21 
	DATA	/26 
	DATA	/4A 
	DATA	/4B 
	DATA	/4C 
	DATA	/4D 
	XIF
	EJECT
* 
*     KEYTABLES 
* 
KEYTAB	EQU	*
	IFT	KB6234=1 
	DATA	CHAR	SPACE
	DATA	CHAR	!
	DATA	CHAR	"
	DATA	CHAR	#
	DATA	CHAR	$
	DATA	CHAR	%
	DATA	CHAR	&
	DATA	CHAR	'
	DATA	CHAR	(
	DATA	CHAR	)
	DATA	CHAR	*
	DATA	CHAR	+
	DATA	CHAR	,
	DATA	NUM	- 
	DATA	NUM	. 
	DATA	CHAR	/
* 
	DATA	NUM 
	DATA	NUM	1 
	DATA	NUM	2 
	DATA	NUM	3 
	DATA	NUM	4 
	DATA	NUM	5 
	DATA	NUM	6 
	DATA	NUM	7 
	DATA	NUM	8 
	DATA	NUM	9 
	DATA	CHAR	:
	DATA	CHAR	;
	DATA	CHAR	<
	DATA	CHAR	=
	DATA	CHAR	>
	DATA	CHAR	?
* 
	DATA	CHAR	E' 
	DATA	CHAR	A
	DATA	CHAR	B
	DATA	CHAR	C
	DATA	CHAR	D
	DATA	CHAR	E
	DATA	CHAR	F
	DATA	CHAR	G
	DATA	CHAR	H
	DATA	CHAR	I
	DATA	CHAR	J
	DATA	CHAR	K
	DATA	CHAR	L
	DATA	CHAR	M
	DATA	CHAR	N
	DATA	CHAR	O
* 
	DATA	CHAR	P
	DATA	CHAR	Q
	DATA	CHAR	R
	DATA	CHAR	S
	DATA	CHAR	T
	DATA	CHAR	U
	DATA	CHAR	V
	DATA	CHAR	W
	DATA	CHAR	X
	DATA	CHAR	Y
	DATA	CHAR	Z
	DATA	CHAR	POUND SIGN 
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR	// 
	DATA	CHAR	-
* 
	DATA	CHAR	LOWER CASE CHARACTERS
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
* 
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	CHAR
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	PF7	PROGRAM FUNCTION
	DATA	CRUP
	DATA	CRRIGT
	DATA	BAKTAB
	DATA	CRLEFT
	DATA	CRNL
	DATA	PA3 
	DATA	TAB 
	DATA	CRDOWN
	DATA	PF1 
	DATA	PF2 
	DATA	PF3 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	CLEAR 
	DATA	ERINPT
	DATA	ENTER 
	DATA	PF8 
	DATA	PF9 
	DATA	PF10
	DATA	EREOF 
	DATA	CANCEL
	DATA	PA1 
	DATA	PF6 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	PF5 
	DATA	PF4 
	DATA	COPY
	DATA	DUP 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RESET 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	XIF


	IFF	KB6234=1 
			CODE SET FOR PTS 6232
	DATA	DUP 
	DATA	COPY
	DATA	PF10
	DATA	PA2 
	DATA	EREOF 
	DATA	ENTER 
	DATA	CLEAR 
	DATA	ERINPT
	DATA	CHAR	SPACE
	DATA	CHAR	!
	DATA	CHAR	"
	DATA	CHAR	#
	DATA	CHAR	$
	DATA	CHAR	%
	DATA	CHAR	&
	DATA	CHAR	'

	DATA	CHAR	(
	DATA	CHAR	)
	DATA	CHAR	*
	DATA	CHAR	+
	DATA	CHAR	,
	DATA	NUM	- 
	DATA	NUM	. 
	DATA	CHAR	/
	DATA	NUM	
	DATA	NUM	1 
	DATA	NUM	2 
	DATA	NUM	3 
	DATA	NUM	4 
	DATA	NUM	5 
	DATA	NUM	6 
	DATA	NUM	7 

	DATA	NUM	8 
	DATA	NUM	9 
	DATA	CHAR	:
	DATA	CHAR	;
	DATA	RESET 
	DATA	CHAR	=
	DATA	CHAR	>
	DATA	CHAR	?
	DATA	CHAR	E' 
	DATA	CHAR	A
	DATA	CHAR	B
	DATA	CHAR	C
	DATA	CHAR	D
	DATA	CHAR	E
	DATA	CHAR	F
	DATA	CHAR	G

	DATA	CHAR	H
	DATA	CHAR	I
	DATA	CHAR	J
	DATA	CHAR	K
	DATA	CHAR	L
	DATA	CHAR	M
	DATA	CHAR	N
	DATA	CHAR	O
	DATA	CHAR	P
	DATA	CHAR	Q
	DATA	CHAR	R
	DATA	CHAR	S
	DATA	CHAR	T
	DATA	CHAR	U
	DATA	CHAR	V
	DATA	CHAR	W

	DATA	CHAR	X
	DATA	CHAR	Y
	DATA	CHAR	Z
	DATA	CHAR	POUND SIGN 
	DATA	RETURN
	DATA	CHAR
	DATA	CHAR	// 
	DATA	CHAR
	DATA	CRNL
	DATA	BAKTAB
	DATA	TAB 
	DATA	PF3 
	DATA	CRUP
	DATA	CRDOWN
	DATA	PF2 
	DATA	CRLEFT

	DATA	CRRIGT
	DATA	PF1 
	DATA	PA3 
	DATA	PF6 
	DATA	PA1 
	DATA	PF7 
	DATA	PF8 
	DATA	PF9 
	DATA	PF4 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN

	DATA	RETURN
	DATA	RETURN
	DATA	PF5 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN

	XIF
	EJECT

	IFT	PFX=1

* 
* 
* 
KEYPF0	EQU	*
	DATA	PF1	PROGRAM FUNCTION
	DATA	PF2 
	DATA	PF3 
	DATA	PF4 
	DATA	PF5 
	DATA	PF6 
	DATA	PF7 
	DATA	PF8 
	DATA	PF9 
KEYPF1	EQU	*
	DATA	PF10
	DATA	PF11
	DATA	PF12


	XIF


	IFT	PAX=1


KEYPA0	EQU	*
	DATA	PA1 
	DATA	CANCEL
	DATA	PA3 


	XIF
	EJECT
* 
* 
*	DC TASK 
* 
* 
DCTASK	EQU	*
	LDKL	A1,TCADDR 
	LDKL	A8,ECBDCX	ECB DC FOR DC TASK
	ST	A1,ECBCW,A8 
	LDK	A7,/B7	TRANSFER PARAMETERS 
	LKM
	DATA	1 
DCT100	LDK	A7,/82	READ FROM DC TASK 
	LKM
	DATA	1 
	LD	A1,ECBRC,A8	GET RETURN CODE 
	ANKL	A1,/2000
	RB(NZ)	DCT100	STATUS CHANGE
	LDK	A7,/A2	MESSAGE: RELEASE READ BUFFER
	LKM
	DATA	1 
	RB	DCT100
* 
* 
ECBDCX	DATA	/60,0,0,0,0,0 
	EJECT
* 
* 
*	SUBROUTINE ACTIVATED BY ALL TASKS 
* 
* 
EMULA	EQU	* 
	LD	A1,DCADDR,TCABAS	ADDRESS TO TCA 
	LDKL	A8,ECBDCT 
	ADR	A8,CREBAS	GET ECB ADDRESS
	ST	A1,ECBCW,A8	STORE IN ECBDCT 


	IFT	RDBUF=1

	LDKL	A2,BVDU 
	ADR	A2,TCABAS	VDU-BUFFER ADDRESS 
	ST	A2,ECBBA,A8 

	LDKL	A3,PCURS
	ADR	A3,TCABAS	CURSOR ADDRESS 
	ST	A3,ECBRL,A8 

	XIF

	ADKL	A8,ECBDC-ECBDCT	RELATIVE ADDRESS	RELATIVE ADDR. TO ECBDC
	ST	A1,ECBCW,A8	STORE IN ECBC 


	IFT	RDBUF=1

	ST	A2,ECBBA,A8	SAVE VDU-BUFFER ADDRESS 
	ST	A3,ECBRL,A8	SAVE CURSOR ADDRESS 

	XIF


	LDK	A7,/B7	TRANSFER PARAMETERS 
	LKM
	DATA	1 
	RTN	A14
	EJECT
* 
***************************************************** 
* 
*     VDUKB 
* 
*	MAIN MODULE FOR KEYBOARD VDU
* 
********************************************************
VDUKB	EQU	* 
	CF	A14,I:EVA0
	LDR	TCABAS,A9	LOAD ASSEM TCA BASE
	CF	A14,I:EVA0	GET TASK INDEX 

	IFT	OFLIN=1


	STR	A12,A14	SAVE REGISTERS A12-A13 ON A14 STACK
	ST	A13,-2,A14
	SUKL	A14,4	UPDATE STACK POINTER


	XIF

	LDR*	A9,A9 
	IFF	MGTP=0 
	LDR	A1,A9	 
	ORKL	A1,'G0'	HARDCOPY TASK IDENTITY
	ST	A1,COPNO,TCABAS	
	XIF
	ADR	A9,A9
	LD	A1,SELTAB,A9	GET SELECT ADDRESS 
	ST	A1,DCADDR,TCABAS
	CF	A14,EMULA 

	IFT	OFLIN=1

	CM	OFFFLG,TCABAS	CLEAR OFFLINE FLAG
	CF	A14,OFL:OF	TURN OFF OFFLINE LAMP
	XIF

	CF	A14,ERASE	ERASE SCREEN
	IFT	MGTP=0 
	LDKL	A1,'G0'	HARDCOPY TASK IDENTITY
	ST	A1,COPNO,TCABAS	SAVE IT IN USER WORK BLOCK
	XIF

	LDK	A1,1 
	LDKL	A8,ECBKB
	ADR	A8,CREBAS
	ST	A1,ECBRL,A8	REQUESTED LEN =1
	LDKL	A1,LBVDU+1
	ST	A1,CURATT,TCABAS	INITIATE WITH UNFORM. SCREEN 
VDU100	CF	A14,READKB	READ KEYBOARD
	IFT	KB6234=1 
	SUK	A2,/20	INDEX TO KEYTABLE 
	XIF
	IFF	KB6234=1 
	SUK	A2,X'18' 
	XIF
	ADR	A2,A2
VDU200	LDKL	A8,ECBVDU 
	ADR	A8,CREBAS
	CFI	A14,KEYTAB,A2	GET KEY MODULE 
	RB	VDU100
	EJECT

* 
* 
**********************************************************
* 
*	RETURN
* 
**************************************************************
* 
RETURN	RTN	A14
	EJECT
* 
******************************************************* 
* 
*     CRLEFT
* 
*     THIS MODULE MOVES THE CURSOR ONE POS TO LEFT
* 
******************************************************* 
* 
CRLEFT	EQU	*
	LD	A2,PCURS,TCABAS	GET CURSOR BINARY 
	SUK	A2,1 
	RF(NN)	CRL050	NOT LEFTMOST POS 
	LDKL	A2,LBVDU-1
CRL050	RF	CRH100
* 
********************************************************
* 
*     CRRIGT
* 
*     THIS MODULE MOVES THE CURSOR ONE POS. TO THE RIGHT
* 
********************************************************
* 
*	A3=CHARACTER
* 
CRRIGT	EQU	*
	LD	A2,PCURS,TCABAS	GET CURSOR BINARY 
	ADK	A2,1 
	CWK	A2,LBVDU	END OF BUFFER?
	RF(L)	CRR050	NO
	LDK	A2,0 
CRR050	RF	CRH100
	EJECT
* 
*********************************************************** 
* 
*	CRDOWN
* 
*	THE MODULE MOVES THE CURSOR TO NEXT ROW. SAME COLUMN. 
* 
************************************************************
* 
CRDOWN	EQU	*
	LD	A2,PCURS,TCABAS	GET CURSOR POS
	ADKL	A2,LLINE
	CWK	A2,LBVDU	LAST LINE?
	RF(L)	CRD050	NO
	SUKL	A2,LBVDU
CRD050	RF	CRH100
* 
**************************************************************
* 
*	CRUP
* 
*	MOVE CURSOR ONE LINE UP. SAME COL.
* 
**************************************************************
* 
CRUP	EQU	*
	LD	A2,PCURS,TCABAS	GET CURSOR BINARY 
	SUKL	A2,LLINE
	RF(NN)	CRU050	UPMOST LINE
	ADKL	A2,LBVDU
CRU050	RF	CRH100
	EJECT
* 
******************************************************
* 
*	CRHOME
* 
*	HOME POSITIONING OF CURSOR
* 
******************************************************
* 
CRHOME	EQU	*
	LDK	A2,0 
CRH100	EQU	*
	ST	A2,PCURS,TCABAS	GET CURSOR BINARY 
	CF	A14,ATMASB	UPDATE ATTRIB
	CF	A14,SETCUR	DISPLAY CURSOR 
	RTN	A14
	EJECT
* 
***************************************************** 
* 
*	CRNL
* 
*	CURSOR IN FIRST UNPROTECTED POS ON NEW LINE 
* 
***************************************************** 
* 
CRNL	EQU	*
	LD	A2,PCURS,TCABAS	GET CURSOR POS
	ADKL	A2,LLINE	NEXT LINE
	CWK	A2,LBVDU 
	RF(L)	CRN050 
	LDK	A2,0	WRAP AROUND 
* 
*	COMPUTE LEFTMOST POS
* 
CRN050	LDK	A1,0 
CRN100	SUKL	A2,LLINE
	RF(N)	CRN120 
	ADKL	A1,LLINE
	RB	CRN100
CRN120	ST	A1,PCURS,TCABAS	STORE CURSOR ADDRESS
	EJECT

******************************************************************
	LDR	A2,A1
	CF	A14,ATMASB	SEARCH ATTRIBUTE BACKWARDS 
	SUK	A1,1 
	RF(Z)	CRN130	NO ATTRIBUTE FOUND
	ANK	A3,/10 
	RF(NZ)	TAB	PROTECTED FIELD 
	CW	A2,PCURS,TCABAS	CURSOR ON ATTRIBUTE ??
	RF(NE)	CRN150	NO!! 
	CWK	A2,1919	LAST SCREEN POSITION?? 
	RF(NE)	CRN140	NO!! 
CRN130	LDKL	A2,-1 
CRN140	ADK	A2,1 
	ST	A2,PCURS,TCABAS	
CRN150	CF	A14,SETCUR	POSITION CURSOR
	RTN	A14
******************************************************************* 
	EJECT
* 
****************************************************
* 
*	TAB 
* 
*	MOVE THE CURSOR TO THE FIRST CHAR. LOCATION 
*	OF THE NEXT UNPROTECTED DATA FIELD
* 
****************************************************
* 
*	A1=END OF BUFFER PAREM.   	0=EOB NOT REACHED
*			2=EOB 
*			3=ATTRIB. IN EOB POS
*	A2=CURSOR BINARY ADDRESS
*	A3=CHARACTGR
* 
TAB	EQU	* 
	LDK	A5,1 
	LD	A2,PCURS,TCABAS	GET CURSOR POS
TAB100	CF	A14,ATMASF	SEARCH ATTRIBUTE 
	CWK	A1,0	END OF BUFFER?
	RF(G)	TAB300	YES 
	ADK	A2,1 
TAB150	ANK	A3,/10	UNPROTECTED?
	RF(E)	TAB200	YES 
	RB	TAB100	NEXT ATTRIB. 
TAB200	ST	A2,PCURS,TCABAS	
	CF	A14,SETCUR	DISPLAY NEW CURSOR 
	RTN	A14
TAB300	LDK	A2,0 
	CWK	A1,3	ATTRIBUTE IN LAST POSITION ?? 
********************************************************
	RF(NE)	TAB350	NO!! 
	ANK	A5,1	WHOLE BUFFER CONTROLLED ??
	RB(Z)	TAB200	YES!! 
	SUR	A5,A5	 
	RB	TAB150	CHECK ATTRIBUTE
TAB350	EQU	*
********************************************************
	ANK	A5,1	WHOLE BUFF. CONTROLED?
	RF(G)	TAB400	NO
	RB	TAB200	ALL PROT. OR NON-FORMATTED BUFF. 
TAB400	LDK	A5,0 
	RB	TAB100
	EJECT
* 
*********************************************************** 
* 
*	DUP 
* 
*	DUPLICATE KEY 
*	OPERATION OF THIS KEY CAUSES A UNIQUE CHARACTER CODE
*	TO BE ENTERED INTO THE DISPLAY BUFFER AND A STANDARD
*	TAB KEY OPERATION TO BE PERFORMED 
* 
************************************************************
* 
DUP	EQU	* 
	LDK	A2,/7B 
	LD	A3,ECBKB+ECBBA,CREBAS	GET KB BUFF. ADDR.
	SCR	A2,A3
	CF	A14,CHAR
	CF	A14,TAB 
	RTN	A14
	EJECT
* 
***************************************************** 
* 
*	BAKTAB
* 
*	MOVE THE CURSOR TO THE FIRST CHARACTER LOCATION 
*	OF THE NEXT PRECIDING UNPROTECTED DATA FIELD
* 
****************************************************
* 
*	A2=CURSOR BINARY ADDRESS
*	A3=CHARACTER
BAKTAB	EQU	*
	LDK	A5,1 
	LD	A2,PCURS,TCABAS	GET CURSOR POS
	CF	A14,GBUFFC	GET BUFF CHAR. 
	CWK	A3,/1F	ATTRIB. CHAR? 
	RF(NG)	BAK100	YES
	CWK	A2,0	UPPER LEFTMOST POS? 
	RF(E)	BAK400	YES 
	SUK	A2,1 
BAK100	CWK	A2,0	UPPER LEFTMOST POS? 
	RF(E)	BAK400	YES 
BAK200	SUK	A2,1 
	CF	A14,ATMASB	SEARCH ATTRIBUTE 
************************************************************
	SUK	A1,1	
	RF(Z)	BAK400	NO ATTRIBUTE
	RF(N)	BAK250	ATTRIBUTE FOUND. NOT IN LAST POS. 
	SUR	A2,A2	ATTRIBUTE FOUND IN LAST POSITION 
	RF	BAK300
BAK250	EQU	*
********************************************************* 
	ANK	A3,/10	PROTECTED?
	RB(NE)	BAK100	YES
	ADK	A2,1 
BAK300	ST	A2,PCURS,TCABAS 
	CF	A14,SETCUR	SET CURSOR 
	RTN	A14
BAK400	SUK	A5,1	WHOLE BUFF CONTROLLED?
	RB(NZ)	BAK300	YES
	LDKL	A2,LBVDU-1	END BUFFER ADDRESS 
	CF	A14,GBUFFC	GET BUFF CHAR. 
	CWK	A3,/1F	ATTRIBUTE CHAR? 
	RB(G)	BAK200	NO
	ANK	A3,/10	PROTECTED?
	RB(NE)	BAK200	YES
	ST	A3,ATTRIB,TCABAS	UPDATE NEW ATTRIBUTE 
	ST	A2,CURATT,TCABAS
*************************************************************** 
	RB	BAK200
****************************************************************
	EJECT
	EJECT

************************************************************* 
* 
*   CONVERT LOWER CASE CHARACTERS 7B,7C AND 7D TO UPPER 
*   CASE CHARACTERS 5B,5C RESPECTIVLY 5D
* 
*************************************************************** 

CON7B	LDK	A2,/5B
	RF	CON:ST
CON7C	LDK	A2,/5C
	RF	CON:ST
CON7D	LDK	A2,/5D
CON:ST	SC*	A2,ECBBA,A8	SAVE CONVERTED CHARACTER IN ECB BUFFER 
	RF	CHAR
* 
********************************************************* 
* 
*	CHAR
* 
*	ALPHABETIC AND SPECIAL CHAR UPDATING AND DISPLAYING 
* 
********************************************************* 
* 
CHAR	EQU	*
	LD	A2,PCURS,TCABAS	GET CURSOR POS
	LD	A3,CURATT,TCABAS	GET ATTRIBUTE ADDRESS
	CWR	A2,A3	CURSOR ON ATTRIB?
	RF(E)	CHA300	YES 
CHA100	LD	A3,ATTRIB,TCABAS	GET ATTRIBUTE CHAR 
	LDR	A4,A3
	ANK	A4,/10	PROTECTRED FIELD? 
	RF(NE)	CHA300	YES
CHA200	LDR	A4,A3
	ANK	A4,/8	NUMERIC FIELD? 
	RF(E)	ANCOMM	NO
CHA300	ABL	ERROR	NOT ALLOWED DISPLAY POS
	EJECT
* 
**********************************************************
* 
*	NUM 
* 
*	DISPLAY AND UPDATE NUMERICS 
* 
**********************************************************
* 
NUM	EQU	* 
	LD	A2,PCURS,TCABAS	GET CURSOR POS
	LD	A3,CURATT,TCABAS	GET ATTRIBUTE ADDRESS
	CWR	A2,A3	CURSOR ON ATTRIBUTE? 
	RF(E)	NUM200	YES 
NUM100	LD	A3,ATTRIB,TCABAS	GET ATTRIBUTE CHAR 
	LDR	A4,A3
	ANK	A4,/10	PROTECTED FIELD?
	RF(E)	ANCOMM	NO
NUM200	ABL	ERROR	NOT ALLOWED DISPLAY POS
	EJECT
* 
**********************************************************
* 
*	ANCOMM
* 
*	COMMON SUBMODULE FOR ALPHANUMERIC CHAR. DISPLAYING AND
*	UPDATING
* 
**********************************************************
* 
ANCOMM	EQU	*
	LD*	A4,ECBKB+ECBBA,CREBAS	GET KEY CODE 
	SRL	A4,8 
	LDKL	A6,BVDU 
	ADR	A6,TCABAS
	ADR	A6,A2
	SCR	A4,A6	UPDATE VDU BUFF
	LD	A5,CURATT,TCABAS
	CWK	A5,LBVDU+1	UNFORMATTED SCREEN? 
	RF(E)	ANC100	YES 
	SUR	A6,A2	BVDU START ADDR. 
	ADR	A6,A5	ATTRIB. POS
	LD	A3,ATTRIB,TCABAS	GET ATTRIBUTE CHAR 
	ORK	A3,1	MDT-BIT ON
	SCR	A3,A6
ANC100	LDK	A5,/2B	CURSOR NOT MOVED BEF. DISPLAY 
	LD	A1,ECBVDU+ECBBA,CREBAS	 
	STR	A5,A1
	LDK	A5,/1E 
	ADK	A1,2	NEXT POS
	SCR	A5,A1	LOW INT, STORE IN BUFFER 
	LDR	A6,A3
	ANK	A3,/4	STANDARD DISPLAYING? 
	RF(Z)	ANC200	YES 
	ANK	A6,/2	INTENSIFIED DISPLAYING?
	RF(Z)	ANC150	YES 
	LDK	A2,/20	LOAD SPACE
	RF	ANC250	NON DISPLAYING 
ANC150	LDK	A5,/1F	SET HIGH INTENSITY
	SCR	A5,A1	STORE IN BUFFER
ANC200	LDR	A2,A4	UPDATE A2 WITH CHAR
ANC250	CF	A14,WCHAR	DISPLAY CHAR AND CURSOR 
	LD	A2,PCURS,TCABAS	GET CURSOR POS
	ADK	A2,1 
	CWK	A2,LBVDU 
	RF(NE)	ANC255
	LDKL	A2,0
ANC255	EQU	*
	ST	A2,PCURS,TCABAS 
	CF	A14,GBUFFC	GET BUFFER CHAR
	CWK	A3,/1F	ATTRIBUTE CHAR? 
	RF(G)	ANC300	NO

	CF	A14,TAB	SKIP TO NEXT UNPROTECTED
*******************************************  78-08-15 
ANC300	EQU	*
	LD	A1,ECBCW,A8	CONTROL WORD
	ANK	A1,X'FF'	CHARACTER POSITION
	SUK	A1,81
	RF(NZ)	ANC350	NOT LAST POSITION ON LINE
*******************************************  78-08-15 
	CF	A14,SETCUR	POSITION CURSOR TO 1:ST POS. NEXT LINE 
ANC350	EQU	*
	RTN	A14
	EJECT
* 
********************************************************* 
* 
*	CANCEL
* 
*	PROGRAM ATTENTION KEY WHICH CAUSES AN I/O OPERATION 
*	AND GENERATE AN AID CHARACTER 
* 
********************************************************* 
* 
CANCEL	EQU	*
PA2	EQU	* 
	LDK	A2,/3E	CANCEL CHAR CODE
CAN100	EQU	*
	CF	A14,LMP1ON	TURN ON "KEYBOARD INHIBIT" 
	CF	A14,TRPA	UPDATE AID AND TRANSMIT
	RTN	A14
* 

	IFT	PAX=1

* 
* 
*	PROGRAM ATTENTION KEY IS PRESSED AND NUMBER WILL BE INSERTED TO 
*	DEFINE ONE OF THE FUNCTIONS UNDER PA1.CANCEL OR PA3 
* 
* 
PA	EQU	*
	CF	A14,READKB	READ ONE NUM.CHAR. 
	SUK	A2,/31	CHECK IF NUM.1-3
	RF(L)	PFERR	ILLEGAL CHAR.
	SUK	A2,/2	CHECK IF NUM.1-3 
	RF(G)	PFERR	ILLEGAL CHAR.
	ADK	A2,/2	PREPARE A2 AS INDEX
	ADR	A2,A2
	CFI	A14,KEYPA0,A2	GO TO PA-HANDLING
	RTN	A14	RETURN TO MAIN READ LOOP 

	XIF
	EJECT

* 
*    PA1    PROGRAM ATTENTION KEY 
* 
* 
PA1	EQU	* 
	LDK	A2,/25	PA1 CHAR CODE 
	RB	CAN100
* 
* 
*    PA3   PROGRAM ATTENTION KEY
* 
* 
PA3	EQU	* 
	LDK	A2,/2C	PA3 CHAR CODE 
	RB	CAN100
	EJECT
* 
********************************************************
* 
*	ENTER 
* 
*	PROGRAM FUNCTION KEY WHICH CAUSES AN I/O OPERATION
*	AND GENERATE AN AID CHARACTER FOLLOWED BY AN SBA ORDER
*	ATTRIBUTE ADDRESS AND TEXT FOR EACH MODIFIED FIELD
*	NULLS ARE SUPRESSED 
* 
********************************************************* 
* 
ENTER	EQU	* 
	LDK	A2,/27	ENTER CHAR CODE 
ENT100	EQU	*
	CF	A14,LMP1ON	TURN ON "KEYBOARD INHIBIT" 
	CF	A14,TRPF	AID+MODIFIED FIELDS+TRANSMIT 
ENT200	EQU	*
	RTN	A14
* 

	IFT	PFX=1

* 
* 
*	PROGRAM FUNCTION KEY IOS PRESSED AND NUMBER WILL BE INSERTED TO 
*	DEFINE ONE OF THE FUNCTIONS UNDER PF1-PF12
* 
* 
PF	EQU	*
	CF	A14,READKB	READ FIRST NUM.
	SUK	A2,/30	LEGAL CHAR ?
	RF(L)	PFERR	ILLEGAL,GO TO ERR.HANDLING 
	RF(Z)	PF0	FIRST NUM. 0 GO TO PF0 
	SUK	A2,/1	FIRST NUM. 1 ? 
	RF(G)	PFERR	ILLEGAL NUM. 
	CF	A14,READKB	READ SEC.NUM.
	SUK	A2,/30	LEGAL NUM.? 
	RF(L)	PFERR	ILLEGAL GO TO ERR.HANDLING 
	SUK	A2,/2	LEGAL NUM ?
	RF(G)	PFERR	ILLEGAL GO TO ERR.HANDLING 
	ADK	A2,/2	PREPARE A2 AS INDEX
	ADR	A2,A2
	CFI	A14,KEYPF1,A2	GO TO PF-HANDLING
	RF	PFRTN 

PF0	EQU	* 
	CF	A14,READKB	READ SEC.NUM.
	SUK	A2,/31	LEGAL NUM ? 
	RF(L)	PFERR	ILLEGAL GO TO ERR.HANDLING 
	SUK	A2,/8	LEGAL NUM ?
	RF(G)	PFERR	ILLEGAL GO TO ERR.HANDLING 
	ADK	A2,/8	PREPARE A2 AS INDEX
	ADR	A2,A2
	CFI	A14,KEYPF0,A2	GO TO PF-HANDLING
PFRTN	EQU	* 
	RTN	A14
PFERR	EQU	* 
	CF	A14,ERROR	GO TO ERR-HANDLING RUTIN
	RTN	A14	GO TO MAIN READ MODULE 

	XIF
* 
*	PF1 
* 
* 
PF1	EQU	* 
	LDK	A2,/31 
	RB	ENT100
	EJECT
* 
* 
*	PF2 
* 
* 
PF2	EQU	* 
	LDK	A2,/32 
	RB	ENT100
* 
* 
*	PF3 
* 
* 
PF3	EQU	* 
	LDK	A2,/33 
	RB	ENT100
* 
* 
*	PF4 
* 
* 
PF4	EQU	* 
	LDK	A2,/34 
	RB	ENT100
	EJECT
* 
* 
*	PF5 
* 
* 
PF5	EQU	* 
	LDK	A2,/35 
	RB	ENT100
* 
*	PF6 
* 
PF6	EQU	* 
	LDK	A2,/36 
	RB	ENT100
* 
*	PF7 
* 
PF7	EQU	* 
	LDK	A2,/37 
	RB	ENT100
* 
*	PF8 
* 
PF8	EQU	* 
	LDK	A2,/38 
	RB	ENT100
* 
*	PF9 
* 
PF9	EQU	* 
	LDK	A2,/39 
	RB	ENT100
* 
*	
*	PF10
* 
PF10	EQU	*
	LDK	A2,/3A 
	RB	ENT100
	EJECT



PF11	EQU	*
	LDK	A2,/23 
	RB	ENT100
* 
* 
* 

PF12	EQU	*
	LDK	A2,/40 
	RB	ENT100


	IFT	OFLIN=1

	EJECT
* 
************************************************************
* 
*	OFLINE
*            THE OFFLINE SWITCH "OFFFLG" IS SET = 1 AND 
*           A BRANCH IS MADE BACK TO CREDIT PROGRAM 
* 
************************************************************* 
* 
OFLINE	EQU	*
	CF	A14,OFL:ON	TURN ON OFFLINE LAMP 
	IM	OFFFLG,TCABAS	SET OFFLINE FLAG
	ADKL	A14,4	SKIP ONE STACK LEVEL
	LD	A13,2,A14	RELOAD REGISTERS A12-A13
	LD	A12,4,A14 
	ADKL	A14,4	UPDATE STACK POINTER
	ABL	I:RT1	RETURN TO "OFFLINE" PROGRAM

	XIF
	EJECT
* 
********************************************************
* 
*	CLEAR 
* 
*	PROGRAM ATTENTION KEY WHICH CAUSES AN I/O OPERATION 
*	AND GENERATE AN AID CHARACTER. THE ENTIRE DISPLAY 
*	BUFFER IS CLEARED TO NULLS AND CURSOR IS LOCATED IN 
*	HOME POS
* 
********************************************************
* 
CLEAR	EQU	* 
	LDK	A2,/5F	CLEAR CHAR CODE 
	CF	A14,LMP1ON	TURN ON "KEYBOARD INHIBIT" 
	CF	A14,TRPA	UPDATE AID AND TRANSMIT
	CF	A14,ERASE	ERASE ENTIRE SCREEN 
	RTN	A14
	EJECT
* 
************************************************************
* 
*	EREOF 
* 
*	ERASE TO END OF FIELD 
* 
************************************************************
* 
EREOF	EQU	* 
	LDK	A6,1 
	LD	A3,ATTRIB,TCABAS	GET ATTRIBUTE
	ANK	A3,/10	UNPROTECTED?
	RF(E)	ERE100	YES 
	ABL	ERROR
ERE100	LD	A2,PCURS,TCABAS 

************************   77.06.01 

	CW	A2,CURATT,TCABAS	STANDING ON ATTRIBUTE ?? 
	ABL(E)	ERROR	YES!! TURN ON ERROR LAMP

************************   77.06.01 

ERE150	CF	A14,GBUFFC	GET BUFF. CHAR 
	CWK	A3,/1F	ATTRIBUTE CHAR
	RF(G)	ERE200	NO
ERE160	LDR	A1,A2
	LD	A3,PCURS,TCABAS 
ERE170	EQU	*
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
	ADR	A4,A3
	CF	A14,ERASUA	ERASE AND REPLASE WITH NULLS 
	CF	A14,DISPL	DISPLAY ERASED SCREEN 
* 
*   SET MDT BIT IF FORMATTED SCREEN 
* 

	LD	A2,CURATT,TCABAS
	CWK	A2,LBVDU+1 
	RF(E)	ERE180	UNFORMATTED SCREEN

	ADK	A2,BVDU
	ADR	A2,TCABAS	ABSOLUTE ATTRIBUTE ADDRESS 
	LCR	A1,A2	GET ATTRIBUTE
	ORK	A1,1	SET MDT BIT 
	SCR	A1,A2
ERE180	EQU	*
	RTN	A14
ERE200	CWK	A2,LBVDU-1	END OF BUFFER?
	RF(E)	ERE300	YES 
	ADK	A2,1 
	RB	ERE150	NEXT 
ERE300	SUK	A6,1	WHOLW BUFF CONTROLED? 
	RB(N)	ERE160 
	LDK	A2,0	WRAP AROUND.
	RB	ERE150
	EJECT
* 
********************************************************
* 
*	ERINPT
* 
*	CLEARS ALL UNPROTECTED CHARACTER LOCATIONS TO NULLS 
*	AND REPOSITIONS THE CURSOR TO THE FIRST UNPROTECTED 
*	CHAR LOCATION ON THE SCREEN 
* 
******************************************************* 
* 
ERINPT	EQU	*
	CF	A14,ERASUP	ERASE ALL UNPROTECTED
	CF	A14,DISPL 
	LD	A2,PCURS,TCABAS 
	CF	A14,ATMASB
********************************************************* 
	SUK	A1,1 
	RF(Z)	ERI:10	NO ATTRIBUTE FOUND
	RF(N)	ERI:5	ATTRIBUTE NOT IN LAST POSITION 
	LDKL	A2,-1	ATTRIBUTE IN LAST POSITION
ERI:5	EQU	* 
**********************************************************
	ADK	A2,1 

ERI:10	EQU	*
	ST	A2,PCURS,TCABAS 
	RTN	A14
	EJECT
* 
************************************************************
* 
*	ERROR 
* 
*	THE MODULE TAKES CARE OF UNALLOWED KEYS 
* 
*********************************************************** 
* 
ERROR	EQU	* 
	CF	A14,LMP2ON	TURN ON 'ERROR' LAMP 
	LD	A5,KBINH,TCABAS 
	ORK	A5,4	BIT 13:=1,ERROR HANDLING.RESET ALLOWED
	ST	A5,KBINH,TCABAS 

* 
*   TURN ON SOUND ALARM 
* 

	LDKL	A8,ECBVDU 
	ADR	A8,CREBAS	VDU-ECB ADDRESS
	LD	A2,ECBBA,A8	BUFFER ADDRESS
	LDK	A7,X'2B'	CONTROL CHARACTER 
	SC	A7,1,A2 
	LDK	A7,X'07'	BELL CHARACTER
	SC	A7,2,A2 
	LDK	A7,3	REQUESTED LENGTH
	ST	A7,ECBRL,A8 

	LDK	A7,X'86'	SOUND ALARM 
	LKM
	DATA	1 

	RTN	A14
	EJECT
* 
********************************************************
* 
*	READKB
* 
*	READ KEYBOARD MONITOR REQUEST 
* 
********************************************************
* 
READKB	EQU	*
	LDK	A7,/81	BASIC READ WITH WAIT
	LDKL	A8,ECBKB
	ADR	A8,CREBAS
	ST	A7,ECBCW,A8	INDICATE NOT POWER OFF
	LKM
	DATA	1 
	LD	A2,ECBCW,A8	POWER OFF ??? 
	RF(Z)	READ05	YES!!!
	LD	A2,ECBRC,A8 
	RF(0)	READ10 
READ05	EQU	*
	LDK	A7,/04	RESET KEYBOARD ECB BUFFER 
	LKM
	DATA	1 
	RB	READKB
READ10	EQU	*
	LD	A1,KBINH,TCABAS 
	ANK	A1,1	RESETTING BY 'RESET' ALLOWED
	RB(NZ)	READ05	NO 
	LC*	A2,ECBBA,A8	GET INPUT CHARACTER
	LD	A1,KBINH,TCABAS 
	ANK	A1,6	MUST BE RESET KEY 
	RF(Z)	READ20	NO
	CWK	A2,RSET	RESET KEY ???
	RB(NE)	READ05	NO 
READ20	EQU	*
	RTN	A14
	EJECT
* 
********************************************************
* 
*	LAMPMODULE
* 
* 
********************************************************
* 
LMP1ON	EQU	*
	LDK	A7,/B7	LIGHT ON
	LDK	A3,2 
	CF	A14,SDISP 
	RTN	A14
LMP1OF	EQU	*
	LDK	A7,/B8	LIGHT OFF 
	LDK	A3,2 
	CF	A14,SDISP 
	RTN	A14
LMP2ON	EQU	*
	LDK	A7,/B7	LIGHT ON
	LDK	A3,4 
	CF	A14,SDISP 
	RTN	A14
LMP2OF	EQU	*
	LDK	A7,/B8	LIGHT OFF 
	LDK	A3,4 
	CF	A14,SDISP 
	RTN	A14
LMP3ON	EQU	*
	LDK	A7,/B8	LIGHT OFF 
	LDK	A3,8 
	CF	A14,SDISP 
	EJECT


	RTN	A14
LMP3OF	EQU	*
	LDK	A7,/B7	LIGHT ON
	LDK	A3,8 
	CF	A14,SDISP 
	RTN	A14

	IFT	OFLIN=1

OFL:ON	LDK	A7,X'B7'	TURN ON "OFFLINE" LAMP
	LDK	A3,1 
	CF	A14,SDISP 
	RTN	A14


OFL:OF	LDK	A7,X'B8'	TURN OFF "OFFLINE" LAMP 
	LDK	A3,1 
	CF	A14,SDISP 
	RTN	A14



	XIF

	IFF	OFLIN=1
OFL:ON	EQU	*
OFL:OF	EQU	*
	RTN	A14
	XIF
	EJECT

* 
********************************************************
* 
*	SDISP 
* 
*	SIGNAL DISPLAY MONITOR REQUEST
* 
********************************************************
* 
SDISP	EQU	* 
	LDKL	A8,ECBSD
	ADR	A8,CREBAS
	ST	A3,ECBCW,A8 
	LKM
	DATA	1 
	RTN	A14
	EJECT
* 
********************************************************
* 
*     ATMASB
* 
*     SEARCH FOR ATTRIBUTE CHAR BACKWARDS AND MASK IT 
* 
********************************************************
* 
*     A2=CURSOR BINARY ADDRESS
*     A1=BUFFER SCANNING PARAM. 
*	0=ATTRIB FOUND     1=END OF BUFFER LEFT 
*      2= ATTRIBUTE IN LAST POSITION
* 
ATMASB	EQU	*
	LDK	A1,0 
ASB05	EQU	* 
	CF	A14,GBUFFC	GET BUFFER CHAR
	CWK	A3,/1F	ATTRIB. CHAR. 
	RF(G)	ASB10	NO 
ASB08	ST	A3,ATTRIB,TCABAS 
	ST	A2,CURATT,TCABAS	CURSOR ON ATTRIBUTE
	RTN	A14
ASB10	CWK	A2,0	END OF BUFFER
	RF(E)	ASB20	YES
	SUK	A2,1 
	RB	ASB05	NEXT
ASB20	EQU	* 

************************************************* 
	LDK	A1,2	ATTRIBUTE IN LAST POS.
	LDKL	A2,1919	LAST BUFFER POSITION
	CF	A14,GBUFFC	GET CHARACTER
	CWK	A3,/1F	ATTRIBUTE ??? 
	RB(NG)	ASB08	YES!!!
	SUR	A2,A2	FIRST SCREEN POS.
********************************************* 

	LDK	A1,1	END BUFFER LEFT 
	CM	ATTRIB,TCABAS 
	LDKL	A7,LBVDU+1
	ST	A7,CURATT,TCABAS	POSSIBLY UNFORMATTED SCREEN
	RTN	A14
	EJECT
* 
********************************************************
* 
*     ATMASF
* 
*     SEARCH FOR ATTRIBUTE CHAR. FORWARDS AND MASK IT 
* 
********************************************************* 
* 
*	A3=CHARACTER
*     A2=CURSOR BINARY ADDRESS
*     A1=BUFFER SCANNING PARAM. 
*	0=ATTRIB FOUND     2=END OF BUFFER RIGHT
*			A3=ATTRIB IN LAST BUFF POS
* 
ATMASF	EQU	*
	LDK	A1,0 
ASF05	EQU	* 
	CF	A14,GBUFFC	GET BUFFER CHAR
	CWK	A3,/1F	ATTRIB CHAR?
	RF(G)	ASF10	NO 
************************************************************
	CWK	A2,LBVDU-1	EOB +ATTRIB IN LAST POS 
************************************************************
	RF(NE)	ASF08	NO
	LDK	A1,3 
ASF08	ST	A3,ATTRIB,TCABAS 
	ST	A2,CURATT,TCABAS	CURSOR ON ATTRIBUTE
	RTN	A14
ASF10	CWK	A2,LBVDU-1	END OF BUFFER? 
	RF(L)	ASF20	NO 
	LDK	A1,2 
	RTN	A14
ASF20	ADK	A2,1
	RB	ASF05 
	EJECT
* 
**************************************************
* 
*	GBUFFC
* 
*	GET VDU BUFFER CHAR WHICH IS INDICATED BY CURSOR
* 
**************************************************
* 
*	A2=CURSOR BINARY ADDR 
*	A3=CHARACTER
* 
* 
GBUFFC	EQU	*
	LDK	A3,0 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS	GET VDU BUFFER 
	ADR	A4,A2
	LCR	A3,A4	GET CHARACTER IN BUFF. 
	RTN	A14
	EJECT

	IFT	MZERO=1

*************************************************************** 
* 
*   Z E R O : 3    TRIPLE ZERO KEY
*   Z E R O : 2     DOUBLE ZERO KEY 
* 
************************************************* 

ZERO:3	EQU	*
	LDK	A1,X'30'	CHARACTER ZERO
	SC*	A1,ECBKB+ECBBA,CREBAS	STORE CHARACTER IN BUFFER
	CF	A14,NUM	DISPLAY CHARACTER 

ZERO:2	EQU	*
	LDK	A1,X'30'	CHARACTER ZERO
	SC*	A1,ECBKB+ECBBA,CREBAS	STORE CHARACTER IN BUFFER
	CF	A14,NUM	DISPLAY CHARACTER 
	CF	A14,NUM	DISPLAY CHARACTER 
	RTN	A14	RETURN 

	XIF
	EJECT
* 
************************************************************
* 
*	RESET 
* 
*	RESET 'KEYBOARD INHIBIT' IN FOLLOWING SITUATIONS: 
*	1- A DEVICE WITH AN ATTACHED KEYBOARD IS EXECUTING
*		A COMMAND. BIT 14=1 IN KBINH 
*	2- A PA-KEY OPERATION IS IN PROCESS PRIOR TO
*		INITIATION OF A COMMAND FOR A DEVICE WITH AN ATTACHED
*		KEYBOARD. BIT 14=1 IN KBINH
*	3- ERRORSITUATION. BIT 14=1 IN KBINH
* 
*	IF BIT 15=1 IN KBINH => NO RESETTING ALLOWED DURING 
*	UPDATE AND DISPLAY SITUATION. 
* 
*********************************************************** 
* 
RESET	EQU	* 
	CM	KBINH,TCABAS	RESSTORE KEYBOARD
	CF	A14,LMP2OF	TURN OFF 'ERROR' LAMP
	CF	A14,LMP1OF	TURN OFF 'KEYBOARD INHIBIT' LAMP 
	RTN	A14
	EJECT


*************************************************************** 
* 
*   C O P Y  :   COPY CONTENTS IN VDU BUFFER ON 
*                HARDCOPY DEVICE
* 
************************************************************

COPY	LD	A9,COPNO,TCABAS	GET HARDCOPY TASK IDENTITY
	RF(NP)	COP:10	NO HARDCOPY DEVICE CONNECTED 

	CF	A14,LMP1ON	TURN ON " KEYBOARD INHIBIT " 
	LDR	A7,A9	HARDCOPY TASK IDENTITY 

	IM	VDUBSY,TCABAS	SET VDU BUSY WHEN HARDCOPY
	LDK	A1,1 
	ORS	A1,KBINH,TCABAS	SET KEYBOARD TOT. INHIBITED


	CF	A14,GETT:A	GET T:A ADDRESS
	ST	A1,CRE,TCABAS	SAVE HARDCP. DEV. TCA ADDRESS 
	ST	CREBAS,VDUT.A,TCABAS	SAVE VDU TASK T:A ADDRESS

	LDR	A1,TCABAS	PASS VDU BUFFER AS PARAMETER 
	LKM		ACTIVATE HARDCOPY TASK
	DATA	-4
	DATA	HARDCP
	EJECT


COP:05	EQU	*
	LD	A1,VDUBSY,TCABAS	HARDCOPY GOING ON ???
	RF(Z)	COP:08	NO!!! ALREADY FINISHED

	LDKL	A8,10	DELAY TASK 1 SEK. 
	LKM
	DATA	6 

	RB	COP:05	CHECK IF HARDCOPY READY

COP:08	CF	A14,LMP1OF	TURN OFF " KEYBOARD INHIBIT "
	RTN	A14	RETURN 


COP:10	CF	A14,ERROR	TURN ON ERROR LAMP
	RTN	A14	RETURN 
	END

Full view