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

⟦0592a564e⟧ 

    Length: 55600 (0xd930)
    Notes: pts_type(SC)
    Names: »STARTX.SC«

Derivation

└─⟦f445cacdf⟧ Bits:30009666 Philips computer tape "600111"
    └─⟦this⟧ »NJ-AMT/STARTX.SC«

PTS(SC)

	IDENT START   	2.1DK 5 79-10-20 870150540210 

			=1, ODD BUFFER ADDRESS 
			REL 2.1 79-05-23 
			=2, 6234 LAMPS 
			REL 2.1 79-05-23 
			=3, UNDEFINED LABEL
			REL 2.1 79-05-23 
			=4, CURSOR STOPS AT LAST POS. EACH LINE
			REL 2.1 79-05-23 
			=5, RESET KEY FOR KB6235 
			REL 2.1 79-05-23 
			DK5 - LMPVDU=1, 6272 ON VDU	DK5
			DK4 - FIELD SEPARATOR 6234	DK4 
			DK3 - PA 4-9	DK3 
			DK2 - LAMPMODULE, 6272	DK2 
			DK1 - NUM COMMA	DK1
************************************************************* 
* 
*   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	LINHON,LINHOF,ATMASB 
	ENTRY	LSAVOF,LSAVON
	ENTRY	EMULA
	ENTRY	LIOLON	TURN ON OFFLINE LAMP
	ENTRY	LIOLOF	TURN OFF OFFLINE LAMP 
	ENTRY	VDUKB	KB3270 (CREDIT)
	ENTRY	DCTASK 
	ENTRY	DC1INQ 
	ENTRY	DC2INQ 
	ENTRY	REQTIM	SET REQUEST TIMER 
	ENTRY	ICWRTE 
* 
* 
* 
*     EXTERNAL REFERENSES 
* 
* 
* 
	EXTRN	DCINP
	EXTRN	DCGETM 
	EXTRN	ICREAD 
	EXTRN	GTRBUF 
	EXTRN	RLRBUF 
	EXTRN	ERASE	VDUPRT 
	EXTRN	TRPF 
	EXTRN	SETCUR 
	EXTRN	WCHAR
	EXTRN	TRPA 
	EXTRN	ERASUA 
	EXTRN	DISPL
	EXTRN	ERASUP 
* 
	EXTRN	KEYCNV	KEY CONVERSION IF NOT PTS 6272
	EXTRN	TASCII 
* 
	EXTRN	I:EVA0	CREDIT EVALUATION ROUTINE 
	EXTRN	I:RT1	RETURN TO CREDIT CODE
	EJECT


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

* 
KB6272	EQU	1	IF PTS 6272 (6236) IS NOT USED YOU MUST USE 'KEYCNV' 
			USE THE KEY CONVERSION TABLE IN 'TB3270' 
KEYLST	EQU	0	KEY LOCK STATUS SAVED IN 'KEYS'
OFLIN	EQU	1 
DCLIN	EQU	1	NUMBER OF MAIN FRAMES (1 OR 2)
PFX	EQU	1 
PAX	EQU	1 
IN:DL	EQU	1	INSERT&DELETE FUNCTIONS 
COPCMD	EQU	1	COPY COMMAND (ONLY TO PRINTER) IF := 1 
COPL	EQU	1	COPY LOCK IF := 1
LMPVDU	EQU	0	=1, 6272 ON 6346	DK5 
			=0, 6272 ON SELECTOR	DK5 
PA49	EQU	1	=1, PA4-9 ALLOWED	DK3
	EJECT
* 
* 
*     EQUATES 
* 
RSET	EQU	/B2	RESET KEY
*	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
* 
ECBDC	EQU	-DIS-14 
	IFT	DCLIN=2
	IFT	COPCMD=1 
ECBDC2	EQU	ECBDC-DIS
ECBICR	EQU	ECBDC2-DIS 
ECBICW	EQU	ECBICR-DIS 
	XIF
	IFT	DCLIN=2
	IFF	COPCMD=1 
ECBDC2	EQU	ECBDC-DIS
ECBICW	EQU	ECBDC2-DIS 
	XIF
	IFF	DCLIN=2
	IFT	COPCMD=1 
ECBICR	EQU	ECBDC-DIS
ECBICW	EQU	ECBICR-DIS 
	XIF
	IFF	DCLIN=2
	IFF	COPCMD=1 
ECBICW	EQU	ECBDC-DIS
	XIF
ECBVDU	EQU	ECBICW-DIS 
ECBKB	EQU	ECBVDU-DIS
ECBSD	EQU	ECBKB-DIS 
	EJECT
* 
* 
*	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
ICWORK	EQU	DCLENG+2	WORK FIELD INTERTASK COMM 
INTATT	EQU	ICWORK+2	INTENSITY ATTRIBUTE 
OFFFLG	EQU	INTATT+2	OFFLINE FLAG
COPNO	EQU	OFFFLG+2	HARDCOPY TASK ID 
CCC	EQU	COPNO+2	COPY COMMAND CHARACTER
MAIN	EQU	CCC+2	MAIN FRAME 
MODE	EQU	MAIN+2	INSERT MODE SWITCH
KEYS	EQU	MODE+2	KEY LOCK STATUS 
ECBDCC	EQU	KEYS+2	ECB ADDRESS LAST READ DC
ECBBLK	EQU	ECBDCC+2	ECBS FOR MULTIPLE WAIT &C 
RDMORE	EQU	ECBBLK+10	BRANCH ADDRESS NEXT READ KB
LAMSAV	EQU	RDMORE+2	SAVE AREA FOR LAMPS	DK2 
	EJECT
NULL	EQU	/7F	NULL CHARACTER 
DUPCH	EQU	/7B 
FMCH	EQU	/60
LBVDU	EQU	1920	1920 CHAR DISPLAY	6344 
LPAGE	EQU	48	LINES ON ONE PAGE
LLINE	EQU	80	80 CHAR PER DISPLAY LINE 
* 
*	CONFIG DATA 'CB1' REL ADDRESSES 
* 
NBRKBV	EQU	0	NUMBER OF KB/VDUS
NBRGTP	EQU	NBRKBV+2	NUMBER OF GTPS
* 
MF1KBV	EQU	NBRGTP+2	DV ADDRESSES KB/VDU MF #1 
MF1GTP	EQU	MF1KBV+16	DV ADDRESSES GTPS MF # 1 
	IFT	DCLIN=2
MF2KBV	EQU	MF1GTP+16
MF2GTP	EQU	MF2KBV+16
	XIF
	EJECT
* 
*	KEY TABLE	FIXED ENTRY FOR EACH FUNCTION 
* 
KEYTAB	EQU	*
	DATA	CHAR	SPACE
	DATA	CHAR	!
	DATA	CHAR	"
	DATA	CHAR	#
	DATA	CHAR	$
	DATA	CHAR	%
	DATA	CHARFS	&  FIELD SEPARATOR	DK4 
	DATA	CHAR	'
	DATA	CHAR	(
	DATA	CHAR	)
	DATA	CHAR	*
	DATA	CHAR	+
	DATA	NUM	,	DK
	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	[
	DATA	CHAR	BACK SLASH 
	DATA	CHAR	]
	DATA	CHAR	CIRCOMFLEX 
	DATA	CHAR	UNDERLINE
* 
	DATA	RETURN	/60 CANNOT BE USED 
	DATA	CHAR	LOWER CASE 
	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
* 
	IFT	KEYLST=1 
	DATA	KEYL	KEYLOCK
	DATA	KEYL
	DATA	KEYL
	DATA	KEYL
	DATA	KEYL
	DATA	KEYL
	DATA	KEYL
	DATA	KEYL
	XIF
	IFF	KEYLST=1 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	XIF
	DATA	CHAR	LOWER CASE X 
	DATA	CHAR
	DATA	CHAR
	DATA	RETURN	/7B-/7F CANNOT BE USED 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	IFT	PAX=1
	DATA	PAEX
	XIF
	IFF	PAX=1
	DATA	RETURN
	XIF
	DATA	PA1 
	DATA	PA2 
	DATA	PA3 
	DATA	PA410	PA4 - PA10 (ALFASKOP) 
	DATA	PA410 
	DATA	PA410 
	DATA	PA410 
	DATA	PA410 
	DATA	PA410 
	DATA	PA410 
	DATA	CLEAR 
	IFT	PFX=1
	DATA	PFEX
	XIF
	IFF	PFX=1
	DATA	RETURN
	XIF
	DATA	PF	1
	DATA	PF	2
	DATA	PF	3
* 
	DATA	PF	4
	DATA	PF	5
	DATA	PF	6
	DATA	PF	7
	DATA	PF	8
	DATA	PF	9
	DATA	PF	10 
	DATA	PF	11 
	DATA	PF	12 
	DATA	RETURN	/99-/A4 RESERVED FOR PF13-24 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
	DATA	ENTER 
	DATA	CRUP
	DATA	CRLEFT
	DATA	CRRIGT
	DATA	CRDOWN
	DATA	BAKTAB
	DATA	TAB 
	DATA	CRNL
	DATA	RDHOME
	DATA	ERINPT
	DATA	EREOF 
* 
	IFT	IN:DL=1
	DATA	INSERT
	DATA	DELETE
	XIF
	IFF	IN:DL=1
	DATA	RETURN
	DATA	RETURN
	XIF
	DATA	RESET 
	DATA	DUP 
	DATA	FLDMRK
	DATA	COPY
	IFT	OFLIN=1
	DATA	OFLINE
	XIF
	IFF	OFLIN=1
	DATA	RETURN
	XIF
	IFT	DCLIN=2
	DATA	MFCHGE
	XIF
	IFF	DCLIN=2
	DATA	RETURN
	XIF
	DATA	RETURN
	DATA	RETURN
	DATA	ZERO:2
	DATA	ZERO:3
	DATA	NUMCOM
	DATA	RETURN
	DATA	RETURN
	DATA	RETURN
* 
	DATA	LCASPW	LOWER CASE P - W (BECAUSE OF KEYLOCK)
	DATA	LCASPW
	DATA	LCASPW
	DATA	LCASPW
	DATA	LCASPW
	DATA	LCASPW
	DATA	LCASPW
	DATA	LCASPW
	EJECT
************************************************************* 
* 
*	START ADDRESS FOR DC TASKS
************************************************************* 

DCTASK	EQU	*
	CF	A14,I:EVA0
	LDR*	A1,A9	POLL & SELECT ADDRESS 
	LDKL	A8,ECBDC
	ADR	A8,CREBAS
	ST	A1,ECBCW,A8 
	LDK	A7,/B7	TRANSFER PARAMETERS 
	LKM
	DATA	1 
DCT100	EQU	*
	LDK	A7,/80	TEST IF ANY MESSAGE WITH WAIT 
	LKM
	DATA	1 
	CF	A14,GTRBUF	GET RECEIVE BUFFER 
	LDKL	A8,ECBDC
	ADR	A8,CREBAS
	CF	A14,DCGETM
	LD	A4,ECBBA,A8 
	CF	A14,RLRBUF	RELEASE BUFFER 
	RB	DCT100
	EJECT
* 
* 
*	SUBROUTINE ACTIVATED BY ALL TASKS 
* 
* 
EMULA	EQU	* 
	ADR	A8,CREBAS	GET ECB ADDRESS
	ST	A1,ECBCW,A8	STORE IN ECBDCT 
	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

	IFT	OFLIN=1


	STR	A12,A14	SAVE REGISTERS A12-A13 ON A14 STACK
	ST	A13,-2,A14
	SUKL	A14,4	UPDATE STACK POINTER
	CM	OFFFLG,TCABAS 
	CM	LAMSAV,TCABAS	CLEAR LAMP STATUS	DK2 
	CF	A14,LIOLOF	TURN OFF OFF LINE LAMP 
	XIF

	EJECT
**************************************************************
* 
*   TRANSFER PARAMETER FOR MAIN FRAME #1
* 
************************************************************* 

	LDR*	A4,TCABAS	REL TASK NO 
	AD	A4,6,CREBAS	'CB1' ADDRESS 
	LC	A1,MF1KBV-1,A4	GET DV-ADDRESS 
	ANK	A1,/FF 
	LDKL	A8,ECBDC
	CF	A14,EMULA 

	IFT	DCLIN=2
************************************************************* 
* 
*   TRANSFER PARAMETER FOR MAIN-FRAME #2
* 
************************************************************* 

	LC	A1,MF2KBV-1,A4	GET DV ADDRESS 
	ANK	A1,/FF 
	LDKL	A8,ECBDC2 
	CF	A14,EMULA 
	XIF
	EJECT
VDU080	EQU	*
	CF	A14,ERASE	ERASE SCREEN

	LDK	A1,1 
	LDKL	A1,LBVDU+1
	ST	A1,CURATT,TCABAS	INITIATE WITH UNFORM. SCREEN 
	CF	A14,LMF1ON
	CM	MAIN,TCABAS	INDICATE MAIN-FRAME # 1 
	EJECT
* 
*	RELATIVE POS IN ECBBLK
KB	EQU	2
DC1	EQU	4 
	IFT	DCLIN=2
	IFT	COPCMD=1 
DC2	EQU	6 
ICR	EQU	8 
ECBBS	EQU	4 
	XIF
	IFT	DCLIN=2
	IFF	COPCMD=1 
DC2	EQU	6 
ECBBS	EQU	3 
	XIF
	IFF	DCLIN=2
	IFT	COPCMD=1 
ICR	EQU	6 
ECBBS	EQU	3 
	XIF
	IFF	DCLIN=2
	IFF	COPCMD=1 
ECBBS	EQU	2 
	XIF
* 
	LDK	A1,ECBBS 
	ST	A1,ECBBLK,TCABAS
VDU100	EQU	*
	LD	A1,ECBBLK+DC1,TCABAS
	RF(NZ)	VDU110	PENDING
	CF	A14,DC1INQ	TEST IF ANY MESSAGE, NO WAIT 
VDU110	EQU	*
	IFT	DCLIN=2
	LD	A1,ECBBLK+DC2,TCABAS
	RF(NZ)	VDU120	PENDING
	CF	A14,DC2INQ	TEST IF ANY MESSAGE MF # 2, NO WAIT
	XIF
VDU120	EQU	*
	IFT	COPCMD=1 
	LD	A1,ECBBLK+ICR,TCABAS
	RF(NZ)	VDU125	PENDING
	LDKL	A3,ICWORK	BUFFER
	ADR	A3,TCABAS	  ADDRESS
	LDK	A6,2	REQ LENGTH
	CF	A14,ICREAD
	ST	A8,ECBBLK+ICR,TCABAS
	XIF
VDU125	EQU	*
	LD	A1,ECBBLK+KB,TCABAS 
	RF(NZ)	VDU150	PENDING
	CF	A14,RDKBNW	READ KEYBOARD NO WAIT
VDU150	EQU	*
	LDKL	A7,ECBBLK 
	ADR	A7,TCABAS
	LKM
	DATA	7	MULTIPLE WAIT 
	CW	A8,ECBBLK+KB,TCABAS 
	RF(E)	KBINP	INPUT FROM KEYBOARD
	IFT	COPCMD=1 
	CW	A8,ECBBLK+ICR,TCABAS
	RF(E)	BUFCOP	SEND BUFFER TO PRINTER
	XIF
	ST	A8,ECBDCC,TCABAS	SAVE ECB ADDRESS FOR CURRENT READ
	CF	A14,DCINP	INPUT FROM DC 
	RB	VDU100
	EJECT
* 
*	READ KEYBOARD WITH NO WAIT
* 
RDKBNW	EQU	*
	LDKL	A8,ECBKB
	ADR	A8,CREBAS
	LDK	A7,1 
	ST	A7,ECBRL,A8	REQ LENGTH = 1
	ST	A7,ECBCW,A8	INDICATE NOT POWER OFF
	ST	A8,ECBBLK+KB,TCABAS 
	RF	DC1I30
* 
*	TEST IF ANY MESSAGE DC
* 
DC1INQ	EQU	*
	LDKL	A8,ECBDC
	ADR	A8,CREBAS
	ST	A8,ECBBLK+DC1,TCABAS
DC1I20	EQU	*
	LDK	A1,0 
	CF	A14,REQTIM
	LDK	A7,0 
DC1I30	EQU	*
	LKM
	DATA	1 
	RTN	A14
DC2INQ	EQU	*
	IFT	DCLIN=2
	LDKL	A8,ECBDC2 
	ADR	A8,CREBAS
	ST	A8,ECBBLK+DC2,TCABAS
	RB	DC1I20
	XIF
	IFT	COPCMD=1 
	EJECT
* 
*	SEND BUFFER TO PRINTER TASK 
* 
BUFCOP	EQU	*
	CM	ECBBLK+ICR,TCABAS 
	LDKL	A3,BVDU	BUFFER
	ADR	A3,TCABAS	  ADDRESS
	IFT	COPL=1 
* 
*	CHECK IF COPY LOCK
* 
	LCR	A2,A3
	ANK	A2,/18 
	XRK	A2,/10 
	RB(Z)	VDU100	DON'T COPY
	XIF
	IFT	COPCMD=1 
	LDK	A4,/8B	ORDER: WRITE ADDRESSED WITH WAIT
	LD	A5,ICWORK,TCABAS	TASK ID
	LDKL	A6,LBVDU	REQ LENGTH 
	CF	A14,ICWRTE
	LD	A1,KBINH,TCABAS 
	ANK	A1,/E	NOT INHIBITED ANY LONGER 
	ST	A1,KBINH,TCABAS 
	RB	VDU100
	XIF
	EJECT
**	KEYBOARD INPUT 
* 
KBINP	EQU	* 
	CM	ECBBLK+KB,TCABAS
	LD	A2,ECBCW,A8 
	RF(Z)	KBIN05	POWER OFF 
	LD	A2,ECBRC,A8 
	RF(0)	KBIN10 
KBIN05	EQU	*
	LDK	A7,4	RESET KEYBOARD BUFFER 
	LKM
	DATA	1 
	RB	VDU100
KBIN10	EQU	*
	LD	A1,KBINH,TCABAS 
	ANK	A1,1	RESETTING BY 'RESET' ALLOWED ?
	RB(NZ)	KBIN05	NO 
	LC*	A2,ECBBA,A8	GET INPUT CHARACTER
	IFF	KB6272=1		=5 
	CF	A14,KEYCNV	CONVERT KEY CODE	=5
	XIF			=5 
	LD	A1,KBINH,TCABAS 
	ANK	A1,6	MUST BE RESET KEY ? 
	RF(Z)	KBIN20	NO
	CWK	A2,RSET	RESET KEY ?
	RB(NE)	KBIN05	NO 
KBIN20	EQU	*
	LDR	A5,A2	COPY INPUT CHARACTER 
	SUK	A5,/20	INDEX 
	RB(N)	VDU100	ILLEGAL CHAR
	CWK	A5,/A7 
	RB(G)	VDU100	ILLEGAL CHAR
	CF	A14,DCABOR	ABORT DC-READ TO ENABLE DC-WRITE 
	LDR	A7,A7
	ABL(NZ)	VDU100	DC COMPLETED, TAKE CARE OF MESSAGE
	ADR	A5,A5	TO KEY TABLE 
* 
	LDKL	A8,ECBVDU 
	ADR	A8,CREBAS
	LD	A1,RDMORE,TCABAS
	RF(Z)	KBIN30 
* 
	CFR	A14,A1 
	ABL	VDU100 
* 
KBIN30	EQU	*
	CFI	A14,KEYTAB,A5	BRANCH TO RESPECTIVE INPUT HANDLER 
	ABL	VDU100 
	EJECT
* 
*	ABORT DC-REQUEST TO ENABLE WRITE
* 
DCABOR	EQU	*
	LDK	A7,0 
	LDKL	A8,ECBDC
	IFT	DCLIN=2
	LD	A1,MAIN,TCABAS
	RF(NZ)	DCAB05
	XIF
	CM	ECBBLK+DC1,TCABAS 
	IFT	DCLIN=2
	RF	DCAB10
DCAB05	EQU	*
	CM	ECBBLK+DC2,TCABAS 
	LDKL	A8,ECBDC2 
DCAB10	EQU	*
	XIF
	ADR	A8,CREBAS
	LKM
	DATA	10
	RTN	A14
	EJECT
* 
*	SET REQUEST TIMER 
*	A1 = TIME OUT VALUE 
*	A8 = ECB ADDRESS
* 
REQTIM	EQU	*
	ST	A1,ECBCW,A8 
	LDK	A7,/B9 
	LKM
	DATA	1 
	RTN	A14
	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 ?? 
	EJECT
********************************************************
	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	* 
	LD	A1,MODE,TCABAS	INSERT MODE ?? 
	ABL(NZ)	ERROR	FUNCTION NOT ALLOWED IN INSERT MODE
	LDK	A2,DUPCH 
	LD	A3,ECBKB+ECBBA,CREBAS	GET KB BUFF. ADDR.
	SCR	A2,A3
	CF	A14,NUM 
	CF	A14,TAB 
	RTN	A14
	EJECT
* 
*********************************************************** 
* 
*       FIELD MARK
* 
*       OPERATION OF THIS KEY CAUSES A UNIQUE CHARACTER CODE
*       TO BE ENTERED IN THE DISPLAY BUFFER IN ADDITION 
*       TO THE DC CHARACTER TRANSMITTED 
* 
**********************************************************
* 
FLDMRK	EQU	*
	LD	A1,MODE,TCABAS	INSERT MODE??
	ABL(NZ)	ERROR	FUNCTION NOT ALLOWED IN INSERT MODE
	LDK	A2,FMCH
	LD	A3,ECBKB+ECBBA,CREBAS	GET KB BUFFER ADDR. 
	SCR	A2,A3
	CF	A14,NUM 
	RTN	A14
	EJECT
* 
**********************************************************
* 
*       RDHOME
* 
*       READY HOME KEY
*       OPERATION OF THIS KEY CAUSES THE CURSOR TOBE
*        POSITIONED AT THE FIRST UNPROTECTED CHARACTER
*       ON THE SCREEN 
* 
********************************************************
* 
RDHOME	LDKL	A4,BVDU 
	ADR	A4,TCABAS	VDU BUFFER ADDRESS 
	LC	A2,1919,A4	GET LAST SCREEN CHARACTER
	ANK	A2,/7F 
	CWK	A2,/20 
	RF(NL)	RDH10 
	ANK	A2,/10 
	ABL(Z)	CRHOME	UNPROTECTED FIELD
RDH10	CM	PCURS,TCABAS 
	CF	A14,TAB	SEARCH 1ST UNPROTECTED FIELD
	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
* 
********************************************************* 
* 
*	CHAR
* 
*	ALPHABETIC AND SPECIAL CHAR UPDATING AND DISPLAYING 
* 
********************************************************* 
* 
LCASPW	EQU	*
	SUK	A2,/50	CONVERT TO LOWER CASE P - W 
	SC*	A2,ECBKB+ECBBA,CREBAS
* 
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
* 
**********
*	UPDATING OF FIELD SEPARATOR 
*				DK4
* 
CHARFS	EQU	*		DK4 
	IFF	KB6272=1		DK4
	LDK	A2,/26	LOAD CHARACTER &	DK4
	SC*	A2,ECBKB+ECBBA,CREBAS	RESTORE CHARACTER IN BUFFER	DK4
	XIF			DK4
	RB	CHAR		DISPLAY CHAR	DK4
* 
	EJECT
*************************************************************** 
* 
*   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 
* 
**********************************************************
* 
*	NUM 
* 
*	DISPLAY AND UPDATE NUMERICS 
* 
**********************************************************
* 
NUMCOM	EQU	*
	LDK	A2,/2C 
	SC*	A2,ECBKB+ECBBA,CREBAS
* 
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	*
	LC*	A4,ECBKB+ECBBA,CREBAS		=1
ANC005	EQU	*
	LDKL	A6,BVDU 
	ADR	A6,TCABAS
	ADR	A6,A2

	LD	A1,MODE,TCABAS	INSERT MODE ?? 
	RF(NZ)	ANC010	YES!!
	SCR	A4,A6	UPDATE VDU BUFF
ANC010	LDR	A7,A6	SAVE CURSOR POSITION 
	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	EQU	*
	IFT	IN:DL=1		=3
	LD	A1,MODE,TCABAS	INSERT MODE ?? 
	RF(Z)	ANC120	NO!!
	LCR	A1,A7	GET CHARACTER AT CURSOR POSITION 
	ANK	A1,/7F 
	CWK	A1,NULL	NULL?? 
	RF(NE)	INS:10	NO!! 
	SCR	A4,A7	STORE INPUT CHARACTER
	XIF			=3 
ANC120	EQU	*

	LDK	A5,/2B	CURSOR NOT MOVED BEFORE DISPLAYING
	LD	A1,ECBVDU+ECBBA,CREBAS	 
	SC	A5,1,A1		=1 
	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 
ANC252	EQU	*
	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
ANC300	EQU	*
	LD	A1,ECBCW,A8	CONTROL WORD
	ANK	A1,X'FF'	LINE POSITION 
	SUK	A1,80	LAST POSITION ON LINE ?? 
	RF(NZ)	ANC350	NO!!!
	CF	A14,SETCUR	POSITION CURSOR TO 1:ST POS. NEXT LINE 
ANC350	EQU	*
	RTN	A14
	IFT	IN:DL=1
	EJECT

*************************************************** 
* 
*   DELETE CHARACTER AT CURSOR POSITION. SHIFT CARACTERS
*   AT SAME LINE ONE POSITION TO THE LEFT 
* 
************************************************************

DELETE	EQU	*
	LDKL	A6,-1 
	LD	A2,PCURS,TCABAS	CURSOR ADDRESS
DEL:10	ADK	A6,80	END OF LINE POINTER
	CWR	A6,A2	LAST POSITION ON CURRENT LINE??
	RB(L)	DEL:10	NO!! TRY NEXT LINE

	CF	A14,S:ATT	SEARCH ATTRIBUTE FORWARD
	SUK	A1,2	ATTRIBUTE FOUND ??
	RF(Z)	DEL:20	NO!!
	CWR	A2,A6	ATTRIBUTE AFTER END OF LINE ?? 
	RF(G)	DEL:20	YES!! 
	SUK	A2,1	SKIP ATTRIBUTE
	LDR	A6,A2
DEL:20	LDR	A2,A6


	LDK	A1,BVDU
	ADR	A1,TCABAS	ABSOLUTE BUFFER ADDRESS
	ADR	A2,A1	END OF FIELD/LINE
	AD	A1,PCURS,TCABAS	CURSOR POSITION 

DEL:30	CWR	A2,A1	ALL CHARACTERS SHIFTED ??
	RF(E)	DEL:40	YES!! 
	LC	A3,1,A1	GET CHARACTER 
	ORK	A3,/80	SET MODIFIED BIT
	SCR	A3,A1	SHIFT CHARACTER 1 POS. LEFT
	ADK	A1,1 
	RB	DEL:30	GET NEXT CHARACTER 


DEL:40	LDK	A3,NULL+/80	NULL CHARACTER 
	SCR	A3,A2	STORE AT END OF FIELD/LINE 
	LD	A3,ATTRIB,TCABAS	ATTRIBUTE
	ORK	A3,1	SET MODIFIED FIELD BIT

	LD	A1,CURATT,TCABAS	CURRENT ATTRIBUTE ADDRESS
	CWK	A1,LBVDU+1	UNFORMATTED SCREEN ???
	RF(E)	INS:60	YES!!!
	ADKL	A1,BVDU 
	ADR	A1,TCABAS	ABSOLUTE ATTRIBUTE ADDRESS 
	SCR	A3,A1	SAVE NEW ATTRIBUTE 
	RF	INS:60	DISPLAY MODIFIED FIELD 
	EJECT

**************************************************************
* 
*   INSERT CHARACTER AT CURSOR POSITION. SHIFT CHARACTERS IN
*   SAME FIELD , EXCEPT NULLS, ONE POSITION TO THE RIGHT
* 
****************************************************

INSERT	EQU	*
	IM	MODE,TCABAS	SET INSERT MODE 
	CF	A14,LIOLON	TURN ON "INSERT MODE" LAMP 
	RTN	A14


INS:10	LDR	A6,A7	 
	LDR	A9,A4	 
	CWK	A5,LBVDU+1	UNFORMATTED SCREEN??
	RF(NE)	INS:20	NO!! 
	LDKL	A2,LBVDU-1
	RF	INS:30


INS:20	CF	A14,S:ATT	SEARCH ATTRIBUTE FORWARD


	SUK	A1,2	ATTRIBUTE FOUND ??
	RF(Z)	INS:30	NO!!
	SUK	A2,1 

INS:30	ADR	A2,TCABAS
	ADK	A2,BVDU	ADD BUFFER DISPLACEMENT IN WORK-BLOCK
	CF	A14,S:NULL	SEARCH FIRST NULL CHARACTER
INS:40	CWR	A2,A6	ALL CHARACTERS SHIFTED ??
	RF(E)	INS:50	YES!! 
	LC	A3,-1,A2	GET CHARACTER
	ORK	A3,/80	SET MODIFIED BIT
	SCR	A3,A2	SHIFT CHAR ONE POS TO RIGHT
	SUK	A2,1 
	RB	INS:40	GET NEXT CHARACTER 


INS:50	ORKL	A9,/80	SET MODIFIED BIT 
	SCR	A9,A6	SAVE INPUT CHARACTER IN BUFFER 
	IM	PCURS,TCABAS	INCREMENT CURSOR POSITION
INS:60	EQU	*
	CF	A14,DISPL	DISPLAY MODIFIED FIELDS 
	LD	A2,PCURS,TCABAS	CURSOR POSITION 
	RB	ANC252
	XIF
	EJECT

**********************************************************
* 
*   SEARCH FIRST NULL CHARACTER AFTER CURSOR POS
* 
******************************************************

S:NULL	EQU	*
	LDR	A1,A6

S:NU10	CWR	A1,A2
	RF(E)	S:NU30 
	LCR	A3,A1	GET CHARACTER
	ANK	A3,/7F	MASK AWAY MODIFIED BIT
	CWK	A3,NULL	NULL CHARACTER 
	RF(E)	S:NU20	YES!! 
	ADK	A1,1 
	RB	S:NU10	CHECK NEXT BUFFER CHARACTER

S:NU20	LDR	A2,A1	ADDRESS OF FIRST NULL
S:NU30	RTN	A14
	EJECT
* 
********************************************************* 
* 
*	CANCEL
* 
*	PROGRAM ATTENTION KEY WHICH CAUSES AN I/O OPERATION 
*	AND GENERATE AN AID CHARACTER 
* 
********************************************************* 
* 
CANCEL	EQU	*
PA2	EQU	* 
	LDK	A2,/2E	CANCEL POS
CAN100	EQU	*
	LC	A2,TASCII,A2	GET ASCII CODE 
CAN200	EQU	*
	CF	A14,LINHON	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 
* 
* 
PAEX	EQU	*
	LDKL	A1,PAEXA
	ST	A1,RDMORE,TCABAS
	RTN	A14
PAEXA	EQU	* 
	CM	RDMORE,TCABAS 
	SUK	A2,/31	CHECK IF NUM.1-3
	RF(L)	PFERR	ILLEGAL CHAR.
	SUK	A2,/2	CHECK IF NUM.1-3 
	IFF	PA49=1		DK3
	RF(G)	PFERR	ILLEGAL CHAR.
	XIF			DK3
	IFT	PA49=1		DK3
	RF(G)	PAEXB	PA 4-9?	DK3
	XIF			DK3
	RF(Z)	PA3
	ADK	A2,1 
	RB(Z)	PA2
	RF	PA1 
	RTN	A14	RETURN TO MAIN READ LOOP 

	XIF
	EJECT

* 
*    PA1    PROGRAM ATTENTION KEY 
* 
* 
PA1	EQU	* 
	LDK	A2,/2C	PA1 POS 
	RB	CAN100
* 
* 
*    PA3   PROGRAM ATTENTION KEY
* 
* 
PA3	EQU	* 
	LDK	A2,/2B	PA3 POS 
	RB	CAN100
* 
*	PA4 - PA10 (ALFASKOP) 
	IFT	PA49=1		DK3
PAEXB	EQU	*		DK3
	SUK	A2,/6		DK3 
	RF(G)	PFERR		DK3 
	ADK	A2,/69	SET PA4-9	DK3 
	RB	CAN200		DK3 
	XIF			DK3
* 
PA410	EQU	* 
	SUK	A2,/20 
	RB	CAN200
	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,/3D	ENTER POS 
ENT100	EQU	*
	LC	A2,TASCII,A2	CONVERT TO ASCII 
	CF	A14,LINHON	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
* 
* 
PFEX	EQU	*
	LDKL	A1,PFEXA
	RF	PFNXT 
PFEXA	EQU	* 
	CM	RDMORE,TCABAS 
	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. 
	LDKL	A1,PF1A 
	RF	PFNXT 
PF1A	EQU	*
	CM	RDMORE,TCABAS 
	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,/3C	PF10-12 POS 
	RB	ENT100

PF0	EQU	* 
	LDKL	A1,PF0A 
PFNXT	EQU	* 
	ST	A1,RDMORE,TCABAS
	RTN	A14
PF0A	EQU	*
	CM	RDMORE,TCABAS 
	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,/39	PF1-9 POS 
	RB	ENT100
	XIF
PFERR	EQU	* 
	CF	A14,ERROR	GO TO ERR-HANDLING RUTIN
	RTN	A14	GO TO MAIN READ MODULE 


PF	EQU	*
	SUK	A2,/5C 
	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,CLEAR 
OFLI05	EQU	*
	CF	A14,RESET 
	IFT	DCLIN=2
	LD	A7,MAIN,TCABAS
	XRK	A7,1 
	ST	A7,MAIN,TCABAS
	CF	A14,DCABOR	ABORT REQUEST NOT CURRENT MF 
	XIF
	IFT	OFLIN=1
	LDK	A1,0	DV ADDRESS ::= 0MESSAGES TO VDU IGNORED 
	LDKL	A8,ECBDC	MF # 1 
	CF	A14,EMULA	TRANSFER PARAMETERS 
	IFT	DCLIN=2
	LDKL	A8,ECBDC2	MF # 2
	CF	A14,EMULA	TRANSFER PARAMETERS 
	XIF
	IFT	OFLIN=1
	CF	A14,LMF1OF
	CF	A14,LMF2OF
	CF	A14,LSAVOF
	CF	A14,LIOLON	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
	IFT	DCLIN=2
	EJECT
*********************************************************** 
* 
*	MAINFRAME CHANGE
*	  THE SWITCH 'MAIN' IS CHANGED, AND THE APPROPRIATE 'SYSTEM' LAMP 
*	      IS TTURNED ON 
* 
********************************************************************* 
* 
MFCHGE	EQU	*
	CF	A14,CLEAR 
MFCH05	EQU	*
	CF	A14,RESET 
	CF	A14,LMF1OF
	CF	A14,LMF2OF
	CF	A14,LSAVOF
	LD	A1,MAIN,TCABAS
	XRK	A1,1 
	RF(NZ)	MFCH10
	CF	A14,LMF1ON
	RF	MFCH90
MFCH10	EQU	*
	CF	A14,LMF2ON
MFCH90	EQU	*
	ST	A1,MAIN,TCABAS
	RTN	A14
	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,/2D	POS FOR 'CLEAR' 
	LC	A2,TASCII,A2
	CF	A14,LINHON	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,LERRON	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
	IFT	KEYLST=1 
	EJECT
******************************************************************
* 
*   KEY LOCK STATUS IS SET IN 'KEYS'
*	ON ENTRY  A2 = KEY LOCK VALUE /70-/77 
* 
******************************************************************
* 
KEYL	EQU	*
	SUK	A2,/78	GET NEG KEY LOCK VALUE
	LD	A3,KEYS,TCABAS	OLD STATUS 
	LDK	A4,/10 
KEYL10	EQU	*
	SRL	A4,1 
	ADK	A2,2	1 = OFF,0 = ON
	RB(N)	KEYL10 
	ANR	A3,A4	CHECK OLD KEY POS
	RF(NZ)	KEYL20	WAS ON 
	LDR	A2,A2	WAS OFF
	RF(NZ)	KEYL99	NOW OFF, NO CHANGE 
	RF	KEYL30	NOW ON 
KEYL20	EQU	*	WAS ON 
	LDR	A2,A2
	RF(Z)	KEYL99	NOW ON, NO CHANGE 
KEYL30	EQU	* 	CHANGE
	LD	A3,KEYS,TCABAS
	XRR	A3,A4	CHANGE STATUS
	ST	A3,KEYS,TCABAS	STORE NEW STATUS 
* 
* KEYLOCK STATUS CHANGED
*   A3 = NEW STATUS, RIGHTMOST BIT = RIGHTMOST LOCK, BIT ON = LOCK ON 
*   A4 = KEYLOCK CHANGED, LAYOUT AS A3
*   A2 = 1, IF CHANGED TO OFF ELSE 0
* 
* INSERT USER ROUTINE BELOW THIS LINE 
* 
KEYL99	EQU	*
	RTN	A14
	XIF
	EJECT
* 
********************************************************
* 
*	LAMPMODULE
* 
* 
********************************************************
* 
LON	EQU	/B7 
LOF	EQU	/B8 
	IFT	KB6272=1 
LMF1	EQU	/20
LMF2	EQU	/10
LIOL	EQU	1		DK2 
LINH	EQU	8		DK2 
LERR	EQU	4		DK2 
LSAV	EQU	/10		DK2 
	XIF
	IFF	KB6272=1 
LMF1	EQU	0		=2
LMF2	EQU	0		=2
LIOL	EQU	1		=2
LINH	EQU	2		=2
LERR	EQU	4		=2
LSAV	EQU	8		=2
	XIF
LMF1ON	LDK	A3,LMF1
	RF	LMPON 
LMF1OF	LDK	A3,LMF1
	RF	LMPOF 
LMF2ON	LDK	A3,LMF2
	RF	LMPON 
LMF2OF	LDK	A3,LMF2
	RF	LMPOF 
LIOLON	LDK	A3,LIOL
	RF	LMPON 
LIOLOF	LDK	A3,LIOL
	RF	LMPOF 
LINHON	LDK	A3,LINH
	RF	LMPON 
LINHOF	LDK	A3,LINH
	RF	LMPOF 
LERRON	LDK	A3,LERR
	RF	LMPON 
LERROF	LDK	A3,LERR
	RF	LMPOF 
LSAVON	LDK	A3,LSAV
	RF	LMPON 
LSAVOF	LDK	A3,LSAV
	RF	LMPOF 
* 
	IFF	KB6272=1		DK2
LMPON	LDK	A7,LON
	RF	SDISP 
LMPOF	LDK	A7,LOF
	RF	SDISP 
	XIF			DK2
	IFT	KB6272+LMPVDU=1		DK5 
LMPON	LDK	A7,LON		DK5 
	RF	SDISP		DK5
LMPOF	LDK	A7,LOF		DK5 
	RF	SDISP		DK5
	XIF			DK5
	IFT	KB6272+LMPVDU=2		DK2+5 
LMPON	ORS	A3,LAMSAV,TCABAS		DK2 
	RF	SDISP		DK2
LMPOF	C1R	A3,A3		DK2
	ANS	A3,LAMSAV,TCABAS		DK2
	RF	SDISP		DK2
	XIF			DK2
	 

* 
********************************************************
* 
*	SDISP 
* 
*	SIGNAL DISPLAY MONITOR REQUEST
* 
********************************************************
* 

SDISP	EQU	*		DK2+5
	LDKL	A8,ECBSD	DK2+5
	ADR	A8,CREBAS		DK2+5 
	IFF	KB6272=1		DK2+5
	ST	A3,ECBCW,A8		DK2+5
	XIF			DK2+5
	IFT	LMPVDU+KB6272=1		DK2+5 
	ST	A3,ECBCW,A8		DK2+5
	XIF			DK2+5
	IFT	LMPVDU+KB6272=2		DK2+5 
	CM*	ECBBA,A8		DK2+5
	LDK	A3,/1C		DK2+5
	SC*	A3,ECBBA,A8		DK2+5 
	LD	A3,LAMSAV,TCABAS		DK2+5 
	ORS*	A3,ECBBA,A8		DK2+5
	LDK	A3,2		DK2+5
	ST	A3,ECBRL,A8		DK2+5
	LDK	A7,/85		DK2+5
	XIF			DK2+5
	LKM			DK2+5
	DATA	1		DK2+5
	RTN	A14		DK2+5 
	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	* 
	EJECT

************************************************* 
	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
* 


S:ATT	EQU	* 
	LD	A7,ATTRIB,TCABAS
	LD	A8,CURATT,TCABAS
	CF	A14,ATMASF	SEARCH ATTRIBUTE FORWARD 
	ST	A7,ATTRIB,TCABAS
	ST	A8,CURATT,TCABAS
	RTN	A14

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
* 
************************************************************
* 
*	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	MODE,TCABAS	RESET INSERT MODE 
	CF	A14,LIOLOF	TURN OFF "INSERT" LAMP 
	CM	KBINH,TCABAS	RESSTORE KEYBOARD
	CF	A14,LERROF	TURN OFF 'ERROR' LAMP
	CF	A14,LINHOF	TURN OFF 'KEYBOARD INHIBIT' LAMP 
	RTN	A14
	EJECT


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

COPY	EQU	*
	LD	A5,COPNO,TCABAS 
	ABL(Z)	ERROR 
	LDKL	A3,BVDU	BUFFER
	ADR	A3,TCABAS	  ADDRESSS 
	LDKL	A6,LBVDU	REQ LENGTH 
	LDK	A4,/8B	ORDER = WRITE ADDRESSED WAIT
	EJECT
* 
*	WRITE INTERTASK COMMUNICATION 
* 
*	A3 = BUFFER ADDRESS 
*	A4 = ORDER
*	A5 = "TO-TID" 
*	A6 = REQ LENGTH 
* 
ICWRTE	EQU	*
	LDKL	A8,ECBICW 
	ADR	A8,CREBAS
	LDKL	A1,-1 
	CF	A14,REQTIM	NO TIME OUT SUPERVISION
	ST	A5,ECBCW,A8	TO TASK ID
	ST	A6,ECBRL,A8	REQ LENGTH
	ST	A3,ECBBA,A8 
	LDR	A7,A4	ORDER
	LKM
	DATA	1 
	RTN	A14
	END

Full view