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

⟦c12a08821⟧ 

    Length: 42836 (0xa754)
    Notes: pts_type(SC)
    Names: »VDUPRT.SC«

Derivation

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

PTS(SC)

	IDENT VDUPRT 	REL 1.2 78-09-15  870150540120 

******************************************************************
* 
*   V D U P R T  :  MODULE HANDLING MESSAGES COMING FROM
*                   MAIN FRAME, AND DISPLAYING THEM ON
*                   THE VDU ( PTS 6344 ) .
* 
********************************************************************
* 
* 
	EJECT
* 
* 
*	ENTRIES 
* 
* 
	ENTRY	TRPF	TRANSMIT, PROGRAM FUNCTION
	ENTRY	TRPA	TRANSMIT, PROGRAM ATTENTION 
	ENTRY	ERASE	ERASE ENTIRE SCREEN
	ENTRY	SETCUR	CURSOR POSITIONING
	ENTRY	ERASUP	ERASE ALL UNPROTECTED 
	ENTRY	DISPL	DISPLAY MODIFIED DATA
	ENTRY	ERASUA	ERASE UNPROTECTED TO ADDRESS
	ENTRY	WCHAR	WRITE ONE CHAR IN CURSOR POS 
	ENTRY	VDTASK 
	ENTRY	DCRED,UPDATE 
	ENTRY	REL:BU	RELEASE RELEASE BUFFER
	ENTRY	GETT:A	GET T:A ADDRESS 
* 
* 
*	EXTERNALS 
* 
* 
	EXTRN	LMP1ON,LMP1OF	START
	EXTRN	ATMASB 
	EXTRN	LMP3ON,LMP3OF
	EXTRN	EMULA
* 
	EXTRN	SNBUSY	PRT 
* 
	EXTRN	I:EVA0	CREDIT EVALUATION TABLE 
* 
	EXTRN	T:ATAB 
	EXTRN	U:BTAB	DEF UWB BASE ADDRESS
	EXTRN	SELTAB	SELECT ADDRESS TABLE
	EJECT
* 
* 
*	EQUATES 
* 
* 
TIMDC	EQU	300	DC TIME OUT VALUE: 30 S 
ESC	EQU	/1B 
SBA	EQU	/11 
NULL	EQU	/7F	NULL CHARACTER 
NEWLIN	EQU	/7E	NEW LINE CHARACTER 
ENDMES	EQU	/7D	END MESSAGE CHAR 
FORMFD	EQU	/7C	FORM FEED CHAR 
* 
* 
*	COMMON EQU FOR ECB HANDLING 
* 

ECBBA	EQU	2 
ECBRL	EQU	4 
ECBEL	EQU	6 
ECBRC	EQU	8 
ECBCW	EQU	10
	EJECT
* 
* 
*	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
	EJECT

* 
* 
*	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	VDU BUSY 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 CHARACTER DISPLAY 
LPAGE	EQU	48	LINES ON ONE PAGE
LLINE	EQU	80	80 CHAR PER DISPLAY LINE 
TID	EQU	-4	TASK IDENTITY T:A DISPLACEMENT 
* 
* 

****************************************************************
* 
*   CONDITIONAL ASSEMBLY PARAMETERS 
* 
**********************************************

COPL	EQU	0	COPY LOCK USED IF SET TO " ONE " 
OFLIN	EQU	0	SHOULD ALWAYS BE SET TO ZERO
	EJECT
* 
* 
*	TABLE FOR CONVERSION OF EBCDIC 6 BIT INTERNAL 
* 
*	CODE TO ASCII 
* 
TASCII	EQU	*
	DATA	/2041,/4243,/4445,/4647	/00-/07 
	DATA	/4849,/5B2E,/3C28,/2B21	/08-/0F 
	DATA	/264A,/4B4C,/4D4E,/4F50	/10-/17 
	DATA	/5152,/5D24,/2A29,/3B5E	/18-/1F 
	DATA	/2D2F,/5354,/5556,/5758	/20-/27 
	DATA	/595A,/7C2C,/255F,/3E3F	/28-/2F 
	DATA	/3031,/3233,/3435,/3637	/30-37
	DATA	/3839,/3A23,/4027,/3D22	/38-3F
	EJECT
* 
* 
*	TABLE FOR CODE CONVERSION FROM ASCII TO EBCDIC
* 
*	USED TO GET BINARY VALUES FROM THE EBCDIC CODE
* 
*	INVALID CODES ARE CONVERTED TO ZEROS
* 
* 
TEBCDIC	EQU	* 
	DATA	0,0,0,0	/00-/07 
	DATA	0,0,0,0	/08-/0F 
	DATA	0,0,0,0	/10-/17 
	DATA	0,0,0,0	/18-1F
	DATA	/404F,/7F7B,/5B6C,/507D	/20-/27 
	DATA	/4D5D,/5C4E,/6B60,/4B61	/28-/2F 
	DATA	/F0F1,/F2F3,/F4F5,/F6F7	/30-/38 
	DATA	/F8F9,/7A5E,/4C7E,/6E6F	/39-/3F 
	DATA	/7CC1,/C2C3,/C4C5,/C6C7	/40-/47 
	DATA	/C8C9,/D1D2,/D3D4,/D5D6	/48-/4F 
	DATA	/D7D8,/D9E2,/E3E4,/E5E6	/50-57
	DATA	/E7E8,/E94A,/005A,/5F6D	/58-/5F 
	DATA	/0081,/8283,/8485,/8687	/60-/67 
	DATA	/8889,/9192,/9394,/9596	/68-/6F 
	DATA	/9798,/99A2,/A3A4,/A5A6	/70-/77 
	DATA	/A7A8,/A900,/6A00,/0000	/78-/7F 
	EJECT
* 
* 
*	GET TRANSMIT BUFFER 
* 
*	ON EXIT A1=RETURN CODE
*	        A7=BUFFER ADDRESS+2 
*	        A8=DC ECB ADDRESS 
*	        A9=2=BUFFER CHARACTER COUNTER 
* 
* 
GTBUF	LDKL	A8,ECBDC 
	ADR	A8,CREBAS
	LDKL	A7,TIMDC
	ST	A7,ECBCW,A8	SET TIME OUT VALUE
	LDK	A7,/B1	GET TRANSMIT BUFFER ORDER 
	LKM
	DATA	1 
	LD	A7,ECBBA,A8	GET TRANSMIT BUFFER 
	ADK	A7,2	SKIP FIRST WORD 
	LDKL	A9,2	SET CHARACTER COUNTER
	LD	A1,ECBRC,A8	GET RETURN CODE 
	RTN	A14
	EJECT
* 
* 
*	STORE CHARACTER IN DC BUFFER
* 
*	A2=CHAR 
*	A7=BUFFER POINTER 
*	A8=ECB ADDRESS
*	A9=BUFFER CHARACTER COUNTER 
*	ECBEL CONTAINS BUFFER LENGTH
* 
* 
PDCCH	CW	A9,ECBEL,A8
	RF(G)	PDCCHR	OVERFLOW
	SCR	A2,A7
PDCCH1	EQU	*
	ADK	A7,1 
	ADKL	A9,1
PDCCHR	RTN	A14
* 
* 
*	STORE ATTENTION ID FROM A2
* 
* 
PAID	CF	A14,PDCCH 
	RTN	A14
* 
* 
*	GET CHARACTER FROM DC BUFFER TO A2
* 
* 
GDCCH	LCR	A2,A7 
	ANK	A2,/FF 
*******************************************  78-08-15 
	RF(NZ)	GDCC:1	NOT NULL CHARACTER 
	LDK	A2,/7F	REPLACE BY PTS NULL 
*******************************************  78-08-15 
GDCC:1	EQU	*
	RB	PDCCH1
	EJECT
* 
* 
*	GET BUFFER ADDRESS TO A1 FROM DC BUFFER 
* 
* 
GETADR	CF	A14,GDCCH 
	LC	A1,TEBCDI,A2
	ANK	A1,/3F 
	SLL	A1,6 
	CF	A14,GDCCH 
	LC	A2,TEBCDI,A2
	ANK	A2,/3F 
	ORR	A1,A2
	RTN	A14
	EJECT
* 
* 
*	WRITE MESSAGE WITH MAIN FRAME 
* 
*	ON EXIT A1 CONTAINS RETURN CODE 
* 
* 
DCEXCH	ST	A9,ECBRL,A8	STORE REQUESTED LENGTH
	LD	A7,KBINH,TCABAS 
	ORK	A7,2	BIT 14 :=1 DISABLE KEYBOARD.RESET ALLOWED 
	ST	A7,KBINH,TCABAS 
	LDK	A7,/86 
DC100	EQU	* 
	LKM
	DATA	1 
DC200	EQU	* 
	LD	A1,ECBRC,A8	GET RETURN CODE 
	LDR	A1,A1
	RF(Z)	DC300
	LD	A7,KBINH,TCABAS 
	ANK	A7,/D	BIT 14:=0 ALLIWE KEYBOARD
	ST	A7,KBINH,TCABAS 
	CF	A14,LMP1OF	TURN OFF "KEYBOARD INHIBIT"" 
	CF	A14,LMP3ON	TURN OFF "SYSTEM AVAILABLE 
* 
	LDK	A7,/04	RESET KEYBOARD ECB BUFFER 
	LDKL	A8,ECBKB
	ADR	A8,CREBAS
	LKM
	DATA	1 
* 
	RTN	A14
DC300	EQU	* 
	CF	A14,LMP3OF	TURN ON 'SYSTEM AVAILABLE' 
	RTN	A14
	EJECT
* 
* 
*	READ MESSAGE FROM DC LINE 
* 
*	ON ENTRY A1 CONTAINS TIME OUT VALUE 
*	ON EXIT  A1 CONTAINS RETURN CODE
* 
* 
DCRED	LDKL	A8,ECBDCT
	ADR	A8,CREBAS	ECBADDRESS 
	ST	A1,ECBCW,A8	SET TIME OUT VALUE
	LDK	A7,/82	READ WITH WAIT
	LKM
	DATA	1 
	LD	A1,ECBEL,A8 
	ST	A1,DCLENG,TCABAS
	LD	A1,ECBRC,A8 
	RTN	A14
	EJECT
* 
* 
*	STORE CURSOR ADDRESS IN DC BUFFER 
* 
* 
CURSA	LD	A1,PCURS,TCABAS
	RF	BUFADR
* 
* 
*	STORE BUFFER ADDRESS IN DC BUFFER 
* 
*	A1=BINARY BUFFER ADDRESS
* 
* 
BUFADR	LDR	A2,A1
	SRL	A2,6 
	ANK	A2,/3F 
	LC	A2,TASCII,A2	CONVERT TO ASCII 
	CF	A14,PDCCH 
	LDR	A2,A1
	ANK	A2,/3F 
	LC	A2,TASCII,A2
	CF	A14,PDCCH 
	RTN	A14
	EJECT
* 
* 
*	GET MODIFIED DATA FROM DISPLAY IMAGE BUFFER 
* 
*	A3=BUFFER POSITION BINARY 
*	A4=BUFFER POINTER 
* 
* 
RDMOD	LDK	A3,0	RESET POSITION 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS	BUFFER POINTER 
************************************************************
	ADKL	A4,1919	LAST SCREEN POSITION
	LCR	A2,A4	GET CHARACTER
	LDKL	A4,BVDU	RELOAD FIRST BUFFER POSITION
	ADR	A4,TCABAS
*******************************************  78-08-15 
	LDR	A1,A2
	ANK	A1,/60	ATTRIBUTE CHARACTER ??
	RF(Z)	RD200	YES!!! 
*******************************************  78-08-15 
************************************************************
RD100	CWK	A3,LBVDU
	RF(NL)	RDMODE	ALL EXAMINED 
	LCR	A2,A4	GET CHAR 
	ADK	A3,1 
	ADK	A4,1 
************************************************************
RD105	EQU	* 
************************************************************
	LDR	A1,A2
	ANK	A1,/60 
	RF(Z)	RD200	ATTRIBUTE CHAR 
RD110	CWK	A2,NULL 
	RB(E)	RD100	DON'T STORE NULL 
	CF	A14,PDCCH	STORE CHAR IN DC BUFFER 
	RB	RD100 
RD200	ANK	A2,1	CHECK MDT BIT
	RF(NZ)	RD300	MODIFIED FIELD
RD210	CWK	A3,LBVDU
	RF(NL)	RDMODE	ALL EXAMINED 
	LCR	A2,A4
	ADK	A3,1 
	ADK	A4,1 
	LDR	A1,A2
	ANK	A1,/60 
	RB(NZ)	RD210	NO ATTRIBUTE CHAR 
********************************************************  78-05-11
	CWK	A3,LBVDU	ALL BUFFER EXAMINED ??? 
	RF(NL)	RDMODE	YES!!
********************************************************  78-05-11
	RB	RD200	ATTRIBUTE FOUND 
RD300	LDK	A2,SBA
	CF	A14,PDCCH	SBA TO DC BUFFER
	LDR	A1,A3	BUFFER POSITION
	CF	A14,BUFADR	TO DC BUFFER 
	RB	RD100 
RDMODE	RTN	A14
	EJECT
* 
* 
*	UPDATE VIDEO DISPLAY BUFFER IMAGE BY THE DATA 
* 
*	RECEIVED FROM THE DC LINE 
* 
* 
*	A7=DC RECEIVE BUFFER POINTER
*	A8=DC ECB ADDRESS 
*	A9=DC BUFFER INDEX, INITIALLY ZERO
* 
*	A3=DISPLAY BUFFER POSITION
*	A4=DISPLAY BUFFER POINTER 
* 
* 
UPDATE	LDKL	A8,ECBDCT 
	ADR	A8,CREBAS	ECB ADDRESS
	LD	A7,ECBBA,A8	DC BUFFER ADDRESS 
	SUR	A9,A9	RESET DC BUFFER INDEX
	CF	A14,GDCCH	GET FIRST CHAR FROM DC BUFFER 
	CWK	A2,ESC	SHOULD BE ESCAPE
	RF(NE)	UPDEND	NOT ESCAPE 
UPD010	EQU	*
	CF	A14,GDCCH	GET COMMAND CODE
	CWK	A2,/31 
	RF(E)	UPD100	WRITE 
	CWK	A2,/35 
	RF(E)	UPD120	ERASE/WRITE 
	CWK	A2,/3F 
	RF(E)	UPD140	ERASE ALL UNPROTECTED 
	CWK	A2,/37 
	ABL(E)	UPD600	COPY 
	RF	UPDEND	INVALID COMMAND CODE 
	EJECT
* 
*	WRITE COMMAND 
* 
UPD100	EQU	*
	CF	A14,PWCC	PROCESS WCC FOR MDT BIT
	LD	A3,PCURS,TCABAS 
	LDR	A4,A3	START IN CURSOR POSITION 
	ADKL	A4,BVDU 
	ADR	A4,TCABAS
	LDK	A5,1	INDICATE WCC, IC OR RA
	RF	UPD220
* 
*	ERASE/WRITE COMMAND 
* 
UPD120	EQU	*
	CF	A14,ERASE	ERASE SCREEN
	RF	UPD200
* 
*	ERASE ALL UNPROTECTED 
* 
UPD140	EQU	*
	CF	A14,ERASUP	ERASE ALL UNPROTECTED
	RF	UPDEND	NO TEXT WITH THIS COMMAND
* 
*	TAKE CARE OF WRITE CONTROL CHARACTER WCC
* 
UPD200	CF	A14,PWCC	PROCESS WCC
	LDK	A5,1	INDICATE WCC, IC OR RA
	EJECT
* 
* 
*	PROCESS DATA FROM DC BUFFER 
* 
* 
UPD210	LDK	A3,0	START FROM POSITION ZERO
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
UPD220	CW	A9,DCLENG,TCABAS
	RF(NL)	UPDEND	ALL RECEIVED CHARS PROCESSED 
	CF	A14,GDCCH	GET CHAR FROM DC BUFFER 
	CWK	A2,/20 
	RF(L)	UPD300	ORDER 
UPD230	EQU	*
	LDK	A5,0	INDICATE NOT WCC, IC OR RA
	ORK	A2,/80	SET DISPLAY BIT 
UPD240	CWK	A3,LBVDU 
	RF(E)	UPD260	END OF VIDEO BUFFER 
UPD250	EQU	*
	SCR	A2,A4	STORE IN VIDEO BUFFER
	ADK	A3,1 
	ADK	A4,1 
	RB	UPD220
UPD260	LDK	A3,0 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
	RB	UPD250
UPD300	EQU	*
*******************************************  78-08-15 
	CWK	A3,LBVDU	END OF DISPLAY BUFFER ??? 
	RF(NE)	UPD302	NO!!!
	SUR	A3,A3	FIRST SCREEN POSITION
	LDKL	A4,BVDU	
	ADR	A4,TCABAS	BUFFER POSITION
UPD302	EQU	*
*******************************************  78-08-15 
	CWK	A2,/1D 
	RF(E)	UPD320	START FIELD 
	CWK	A2,/11 
	RF(E)	UPD340	SET BUFFER ADDRESS
	CWK	A2,/13 
	RF(E)	UPD360	INSERT CURSOR 
	CWK	A2,/09 
	RF(E)	UPD400	PROGRAM TAB 
	CWK	A2,/14 
	RF(E)	UPD500	REPEAT TO ADDRESS 
	CWK	A2,/12 
	RF(E)	UPD540	ERASE UNPROTECTED TO ADDRESS
	CWK	A2,/0C 
	RF(NE)	UPD305
	LDK	A2,FORMFD	FORM FEED
	RB	UPD230
UPD305	CWK	A2,/19 
	RF(NE)	UPD310
	LDK	A2,ENDMES	END MESSAGE
	RB	UPD230
UPD310	EQU	*
	CWK	A2,/0A 
	RF(NE)	UPD315
	LDK	A2,NEWLIN	NEW LINE 
	RB	UPD230
UPD315	EQU	*
	CWK	A2,/18 
***********************************************  78-08-15 
	RF(NE)	UPD317	ILLEGAL ORDER
***********************************************  78-08-15 
	LDK	A2,/30 
	RB	UPD230


***********************************************  78-08-15 
UPD317	CWK	A2,/1B	ESCAPE ???
	RB(E)	UPD010	YES!!!
***********************************************  78-08-15 
	EJECT

UPD318	EQU	*
	CWK	A2,/00	NULL CHARACTER ???
	RF(NE)	UPDEND	NO!!  ILLEGAL ORDER
	LDK	A2,/7F	PTS NULL CHARACTER
	RB	UPD230

************************************************************
* 
*   RELEASE RECEIVE BUFFER
* 
************************************* 

REL:BU	EQU	*
UPDEND	LDK	A7,/A2	RELEASE DC READ BUFFER
	LDKL	A8,ECBDCT 
	ADR	A8,CREBAS
	LKM
	DATA	1 
	RTN	A14
	EJECT
* 
* 
*	START FIELD ORDER 
* 
UPD320	CF	A14,GDCCH	GET ATTRIBUTE CHAR
	LC	A2,TEBCDI,A2
	LDR	A1,A2	COMPOSE PTS ATTRIBUTE CHAR 
	ANK	A1,1 
	SRL	A2,1 
	ANK	A2,/1E 
	ORR	A2,A1
	RB	UPD230
* 
*	SET BUFFER ADDRESS
* 
UPD340	CF	A14,GETADR	GET ADDRESS
	CWK	A1,LBVDU 
	RB(NL)	UPDEND	INVALID ADDRESS
	LDR	A3,A1
	LDR	A4,A3
	ADKL	A4,BVDU 
	ADR	A4,TCABAS
	RB	UPD220
* 
*	INSERT CURSOR 
* 
UPD360	ST	A3,PCURS,TCABAS	SET NEW CURSOR POS
	LDK	A5,1	INDICATE WCC, IC OR RA
	RB	UPD220
	EJECT
* 
*	PROGRAM TAB 
* 
UPD400	LDR	A5,A5
	RF(NZ)	UPD430	PT AFTER WCC, IC OR RA 
	LDK	A1,NULL+/80	FILL CURRENT FIELD BY NULLS
UPD410	EQU	*
	LDK	A5,0 
	CWK	A3,LBVDU 
	RB(NL)	UPD210	END OF BUFFER
	LCR	A2,A4
	ADK	A3,1 
	ANK	A2,/7F 
	CWK	A2,/20 
	RF(L)	UPD415 
	SCR	A1,A4	STORE NULL 
	ADK	A4,1 
	RB	UPD410
UPD415	EQU	*
	ADK	A4,1 
UPD420	ANK	A2,/10 
	RB(Z)	UPD220	UNPROTECTED FIELD 
UPD430	EQU	*
	LDK	A5,0 
	CWK	A3,LBVDU 
	ABL(NL)	UPD210	END OF DISPLAY BUFFER 
	LCR	A2,A4
	ADK	A3,1 
	ADK	A4,1 
	ANK	A2,/7F 
	CWK	A2,/20 
	RB(L)	UPD420 
	RB	UPD430
	EJECT
* 
*	REPEAT TO ADDRESS 
* 
UPD500	CF	A14,GETADR	GET END ADDRESS
	CWK	A1,LBVDU 
	RB(NL)	UPDEND	INVALID ADDRESS
	CF	A14,GDCCH	GET CHAR TO BE REPEATED 
	LDK	A5,1	INDICATE WCC, IC OR RA
	ORK	A2,/80	INDICATE MODIFIED 
***********************************************  78-08-15 
	CWR	A3,A1	NULLS TO ALL SCREEN POSITIONS ???
	RF(E)	UPD530	YES!!!
***********************************************  78-08-15 
UPD510	CWK	A3,LBVDU 
	RF(L)	UPD520	NOT END OF SCREEN 
	LDK	A3,0 
	LDKL	A4,BVDU	WRAP AROUND 
	ADR	A4,TCABAS
UPD520	CWR	A3,A1
	ABL(E)	UPD220	ALL CHAR REPEATED
***********************************************  78-08-15 
UPD530	EQU	*
***********************************************  78-08-15 
	SCR	A2,A4
	ADK	A3,1 
	ADK	A4,1 
	RB	UPD510	NEXT POSITION
* 
*	ERASE UNPROTECTED TO ADDRESS
* 
UPD540	CF	A14,GETADR	GET END ADDRESS
	CWK	A3,LBVDU 
	RB(NL)	UPDEND	INVALID ADDRESS
	CF	A14,ERASUA	ERASE UNPROTECTED TO ADDRESS 
	ABL	UPD220 
	EJECT
* 
* 
*	COPY COMMAND
* 
* 
*	A3=DISPLAY BUFFER POINTER 
*	A4=DISPLAY BUFFER POINTER 
*	A7=PRINTER BUFFER POINTER 
* 
* 
UPD600	EQU	*
	CF	A14,GDCCH	GET COPY CONTROL CHAR CCC 
	LC	A2,TEBCDI,A2	IN EBCDIC CODE 
	ST	A2,WCC,TCABAS	SAVE IT 
	CF	A14,GDCCH	GET "FROM" DEVICE 
	LC	A2,TEBCDI,A2	TRANSLATE IT BACK TO EBCDIC
* 
*	CREDIT SEQUENCE UNTIL: /LDR/A12,A4
* 
	LDKL	A1,U:BTAB	DEFINE UWB BASE ADDR
	LD	A3,4,A1	LOAD MAXINDEX 
	LDR*	A4,A1 
	LD	A7,2,A1	NEXT UWB
	RF	UPD615
UPD610	LDR	A4,A7
	AD	A7,6,A1 
UPD615	SUK	A3,1	COUNT 
	RB(N)	UPDEND	NOT FOUND 
	CW	A2,DCADDR,A4
	RB(NE)	UPD610	CHECK NEXT UWB 
	LDR	A12,A4	COPY
	LDK	A3,0	RESET DISPLAY BUFFER POSITION 
	ADKL	A4,BVDU	DISPLAY BUFFER POINTER
	LDKL	A7,BVDU	PRINTER BUFFE 
	ADR	A7,TCABAS


	IFT	COPL=1 

*************************************************************** 
* 
*   CHECK IF COPY LOCK IS SET !!! ??? 
* 
***************************************************** 

	LCR	A2,A4	GET FIRST SCREEN CHARACTER 
	ANK	A2,X'18' 
	XRK	A2,X'10'	COPY LOCK ??? 
	RF(NZ)	UPD620	NO!!!
	IM	LOCK,TCABAS	INDICATE COPY LOCK
	ABL	REL:BU	RELEASE RECEIVE BUFFER

	XIF
	EJECT
* 
*	FIRST COPY THE ENTIRE BUFFER
* 
UPD620	CWK	A3,LBVDU 
	RF(NL)	UPD630	ALL COPIED 
	LCR	A2,A4
	CCR	A2,A7
	RF(E)	UPD625	SAME TEXT AGAIN 
	ORK	A2,/80	NEW TEXT: SET DISPLAY BIT 
	SCR	A2,A7
UPD625	EQU	*
	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	RB	UPD620
UPD630	LDK	A3,0	RESET BUFFER INDEX
	SUKL	A4,LBVDU
	SUKL	A7,LBVDU
	LDK	A6,NULL+/80	NULL CONSTANT, MODIFIED
	EJECT
* 
* 
*	CHECK THE ART OF COPYING
* 
* 
	LD	A2,WCC,TCABAS	GET CCC 
	LD	A1,KBINH,A12
	ANK	A1,/E	BIT 15:=0 KEYBOARD NOT TOTALLY INHIBITED 
*			ANY LONGER
	ST	A1,KBINH,A12
	LDK	A1,/FC	RESET BIT CORRESPONDING 
	ANS	A1,WCC,TCABAS	TO KEYBOARD RESTORE
	ANK	A2,3 
	RF(Z)	UPD650	ATTRIBUTES ONLY 
	CWK	A2,2 
	RF(L)	UPD700	ATTRIBUTES AND UNPROTECTED ALPHA
	RF(E)	UPD750	ATTRIBUTES ADN PROTECTED ALPHA
	ABL	UPDEND	ENTIRE DISPLAY
	EJECT
* 
* 
*	COPY ATTRIBUTE CHARACTERS ONLY
* 
* 
UPD650	CWK	A3,LBVDU 
	ABL(NL)	UPDEND	ALL COPIED
	LCR	A2,A4
	ANK	A2,/60 
	RF(Z)	UPD660	ATTRIBUTE: KEEP IT
	SCR	A6,A7	DESTROY OTHER THAN ATTRIBUTE 
UPD660	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	RB	UPD650
	EJECT
* 
* 
*	COPY ATTRIBUTES AND UNPROTECTED ALPHAMERIC FIELDS 
* 
* 
UPD700	CWK	A3,LBVDU 
	ABL(NL)	UPDEND	ALL COPIED
	LCR	A2,A4
	ANK	A2,/7F 
	CWK	A2,/20 
	RF(L)	UPD720	ATTRIBUTE CHAR
UPD710	ADK	A3,1	UNPROTECTED 
	ADK	A4,1 
	ADK	A7,1 
	RB	UPD700
UPD720	ANK	A2,/18 
	RB(Z)	UPD710	UNPROTECTED ALPHAMERIC
UPD730	ADK	A3,1 
	ADK	A4,1	PROTECTED OR NUMERIC OR BOTH
	ADK	A7,1 
	CWK	A3,LBVDU 
	ABL(NL)	UPDEND	ALL COPIED
	LCR	A2,A4
	ANK	A2,/7F 
	CWK	A2,/20 
	RB(L)	UPD720	ATTRIBUTE 
	SCR	A6,A7	STORE NULL CHAR
	RB	UPD730
	EJECT
* 
* 
*	COPY ATTRIBUTES AND PROTECTED ALPHAMERIC FIELDS 
* 
* 
UPD750	CWK	A3,LBVDU 
	ABL(NL)	UPDEND	ALL COPIED
	LCR	A2,A4
	ANK	A2,/7F 
	CWK	A2,/20 
	RF(L)	UPD770	ATTRIBUTE 
	SCR	A6,A7	UNPROTECTED: WRITE NULL
UPD760	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	RB	UPD750
UPD770	ANK	A2,/18 
	XRK	A2,/10 
	RB(NZ)	UPD760	PROTECTED ALPHAMERIC 
UPD780	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	CWK	A3,LBVDU 
	ABL(NL)	UPDEND	ALL COPIED
	LCR	A2,A4
	ANK	A2,/7F 
	CWK	A2,/20 
	RB(L)	UPD770	ATTRIBUTE 
	RB	UPD780
	EJECT
* 
* 
*	PROCESS WRITE CONTROL CHARACTER 
* 
*	ONLY RESET MDT BIT IS TAKEN CARE OF 
* 
* 
PWCC	CF	A14,GDCCH	GET WCC 
	LC	A2,TEBCDI,A2	IN EBCDIC
	ST	A2,WCC,TCABAS	SAVE IT 
	ANK	A2,/04 
	RF(Z)	PWCC1
	LD	A2,PRINTER,TCABAS 
	RF(NZ)	PWCC1 
	LDR	A10,A7 
	LDKL	A8,ECBVDU 
	ADR	A8,CREBAS
	LD	A2,ECBBA,A8 
	LDK	A7,/2B 
	ST	A7,0,A2 
	LDKL	A7,/0707	BELL BELL
	ST	A7,2,A2 
	LDK	A7,4 
	ST	A7,ECBRL,A8 
	LDK	A7,/86 
	LKM
	DATA	1 
	LDKL	A8,ECBDCT 
	ADR	A8,CREBAS
	LDR	A7,A10 
PWCC1	EQU	* 
	LD	A2,WCC,TCABAS	
	ANK	A2,1 
	RF(NZ)	RESMDT	RESET ALL MDT
PWCC10	RTN	A14	NO ACTION
* 
* 
*	RESET ALL MDT BITS
* 
* 
RESMDT	LDK	A3,0 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
RESM10	CWK	A3,LBVDU 
	RB(NL)	PWCC10	ALL DONE 
	LCR	A2,A4	GET CHAR 
	ANK	A2,/60 
	RF(NZ)	RESM20	NO ATTRIBUTE 
	LCR	A2,A4
	ANK	A2,/FE	RESET MDT 
	SCR	A2,A4
RESM20	ADK	A3,1 
	ADK	A4,1 
	RB	RESM10
	EJECT
* 
* 
*	ERASE ENTIRE SCREEN 
* 
* 
ERASE	LDK	A3,0
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
	LDK	A2,NULL
ERAS20	CWK	A3,LBVDU 
	RF(NL)	ERAS25	ALL ERASED 
	SCR	A2,A4
	ADK	A3,1 
	ADK	A4,1 
	RB	ERAS20
ERAS25	CM	PCURS,TCABAS	RESET CURSOR POS 
	LD	A1,PRINTER,TCABAS	CHECK DEVISE TYPE 
	RF(NZ)	ERAEND	PRINTER, NOT DISPLAY 
	STR	A7,A14	SAVE A7 AND A8 ON STACK 
	ST	A8,-2,A14 
	LDKL	A8,ECBVDU 
	ADR	A8,CREBAS	VDUECB 
	LDK	A7,'1'	ERASE CONTROL CHAR
	ST*	A7,ECBBA,A8	TO VDU BUFFER
	LDK	A7,2 
	ST	A7,ECBRL,A8	REQ LENGTH = 2
	LDK	A7,/86	WRITE 
	LKM
	DATA	1 
	LD	A8,-2,A14 
	LDR*	A7,A14	RESTORE A7 AND A8
ERAEND	RTN	A14
	EJECT
* 
* 
*	ERASE ALL UNPROTECTED 
* 
* 
ERASUP	LDK	A2,2 
	ST	A2,WCC,TCABAS	SET KEYBOARD RESTORE BIT
	SUR	A1,A1	INDICATE ATT. IN LAST SCREEN POS.
	LDK	A3,0 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
	CM	PCURS,TCABAS	FIND FIRST UNPROTECTED POS 
********************************************************************
	LC	A2,1919,A4	GET LAST SCREEN CHARACTER
	ANK	A2,/7F 
	CWK	A2,/20	ATTRIBUTE ??? 
	RF(L)	ERU:01	YES!! WE GOT IT!! 
	LDK	A1,1	ATTRIBUTE NOT IN LAST SCREEN POS. 
********************************************************
ERASU1	CWK	A3,LBVDU 
	RF(NL)	ERASU2
	LCR	A2,A4	GET CHAR 
	ANK	A2,/7F 
	ADK	A3,1 
	ADK	A4,1 
	CWK	A2,/20 
	RB(NL)	ERASU1	NO ATTRIBUTE 
ERU:01	EQU	*
	ANK	A2,/10 
	RB(NZ)	ERASU1	PROTECTED
	ST	A3,PCURS,TCABAS	SET NEW CURSOR POS
	LDR	A1,A1
	RF(Z)	ERASU3	ATTRIBUTE IN LAST SCREEN POS. 
ERASU2	LDK	A3,0 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
	RF	ERASU4
ERASU3	EQU	*
	LDR	A3,A3
	RF(Z)	ERASU4	UNPROTECTED ATT. IN LAST SCREEN POS.
	SUK	A3,1	GET BACK TO ATTRIBUTE 
	SUK	A4,1	       - " -
ERASU4	EQU	*
	LDK	A1,0 
	LDK	A6,NULL+/80	ERASE CHAR 
	RF	ERAS35
	EJECT
* 
* 
*	ERASE UNPROTECTED TO ADDRESS GIVEN IN A1
* 
* 
ERASUA	LDK	A6,NULL+/80	ERASE CHARACTER
			******************* 78-09-11 
	CWK	A3,LBVDU	WRAP AROUND ??? 
	RF(L)	ERAS:1	NO!!
	LDK	A3,0	BUFFERINDEX 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS	ABSOLUTE BUFFER  ADDRESS 

ERAS:1	LDR	A3,A3	START IN FIRST SCREEN POSITION ??? 
	RF(NZ)	ERAS35	NO!! 
	LC	A2,1919,A4	LAST BUFFER CHARACTER
	ANK	A2,/7F 
	CWK	A2,/20	ATTRIBUTE CHARACTER ??? 
	RF(NL)	ERAS35	NO!!!
	ANK	A2,/10 
	RF(NZ)	ERAS70	PROTECTED FIELD
	LC	A2,1919,A4
	ANK	A2,/FE 
	SC	A2,1919,A4	RESET MDT BIT
	RF	ERAS35
			******************** 78-09-11
ERAS30	CWK	A3,LBVDU 
	RF(L)	ERAS33	NOT END OF SCREEN 
	LDK	A3,0 
	LDKL	A4,BVDU	WRAP AROUND 
	ADR	A4,TCABAS
ERAS33	EQU	*
	CWR	A3,A1
	RB(E)	ERAEND	ALL UNPROTECTED ERASED
ERAS35	LCR	A2,A4	GET CHAR FROM VDU BUFFER 
	ANK	A2,/7F 
	CWK	A2,/20 
	RF(L)	ERAS50	ATTRIBUTE CHAR
	XRK	A2,NULL
	RF(Z)	ERAS40	ALREADY NULL
	SCR	A6,A4	STORE MODIFIED NULL
ERAS40	ADK	A3,1 
	ADK	A4,1 
	RB	ERAS30
ERAS50	ADK	A3,1 
	ADK	A4,1 
	ANK	A2,/10 
	RF(NZ)	ERAS60	PROTECTED FIELD
	LC	A2,-1,A4
	ANK	A2,/FE	RESET MDT BIT 
	SC	A2,-1,A4
	RB	ERAS30
ERAS60	CWK	A3,LBVDU 
	RF(L)	ERAS65 
	LDK	A3,0 
	LDKL	A4,BVDU	WRAP AROUND 
	ADR	A4,TCABAS
ERAS65	CWR	A3,A1
	RB(E)	ERAEND	ALL UNPROTECTED ERASED
ERAS70	EQU	*
	LCR	A2,A4
	ANK	A2,/7F 
	CWK	A2,/20 
	RB(L)	ERAS50	ATTRIBUTE FOUND 
	ADK	A3,1 
	ADK	A4,1 
	RB	ERAS60
	EJECT
* 
* 
*	TRANSMIT PROGRAM ATTENTION
* 
*	A2=AID
* 
* 
TRPA	CF	A14,GTBUF	GET TRANSMIT BUFFER 
	LDR	A1,A1
	RF(Z)	TRPA10	BUFFER OBTAINED 
	RTN	A14	NO BUFFER
TRPA10	CF	A14,PAID	STORE AID
TRANS	CF	A14,DCEXCH	EXCHANGE MESSAGE WITH MAIN FRAME
TR050	EQU	* 
	RTN	A14	TRANSMISSION TROUBLE 
TRRTN	RTN	A14 
	EJECT
* 
* 
*	TRANSMIT PROGRAM FUNCTION 
* 
*	A2=AID
* 
* 
TRPF	CF	A14,GTBUF	GET TRANSMIT BUFFER 
	LDR	A1,A1
	RF(Z)	TRPF10	BUFFER OBTAINED 
	RTN	A14
TRPF10	CF	A14,PAID	STORE AID
	CF	A14,CURSA	STORE CURSOR ADDRESS
	CF	A14,RDMOD	READ MODIFIED 
	RB	TRANS	SEND MODIFIED FIELDS
	EJECT
* 
* 
*	DISPLAY MODIFIED FIELDS ON VDU
* 
* 
*	A3=VDU POSITION 
*	A4=VDU IMAGE POINTER
*	A5=MODIFIED INDICATOR 
*	A7=VDU LINE OUTPUT POINTER
*	A8=VDU ECB
*	A9=VDU OUTPUT CHAR COUNTER
* 
* 
DISPL	LDKL	A8,ECBVDU
	ADR	A8,CREBAS
	LDKL	A1,/101	START FROM LINE 1 POS 1 
	ST	A1,ECBCW,A8 
	SUR	A10,A10	RESET COUNT FOR INTENSIFIED DISPLAYING 
	LDK	A3,0 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
	CF	A14,SPACES	PUT SPACES IN LINE BUFFER
****************************************************************
	LC	A2,1919,A4	CHECK IF ATTRIBUTE IN LAST POSITION
	ANK	A2,/7F 
	CWK	A2,/1F	ATTRIBUTE ??? 
	RF(G)	DIS100	NO!!! 

	ANK	A2,6 
	XRK	A2,6 
	ST	A2,INTATT,TCABAS	CHECK DISPLAY/NONDISPLAY INFORMATION 
	RF(Z)	DIS210	NON DISPLAY 
	CF	A14,INTCHK	INSERT HIGH/LOW INTENS. IN BUFFER
******************************************************************* 
DIS100	EQU	*
	CWK	A9,LLINE 
	RF(L)	DIS110	NOT END OF LINE 
	CF	A14,DISLIN	DISPLAY THIS LINE
	CF	A14,INTCHK	CHECK IF LOW/HIGH INTENSITY
DIS110	EQU	*
	CWK	A3,LBVDU 
	RF(NL)	DIS900	ALL SCANNED
	LCR	A2,A4	GET CHAR 
***********************************************  78-08-15 
	CF	A14,SET:M	SET MODIFIED BIT
***********************************************  78-08-15 
	ANK	A2,/7F	RESET DISPLAY BIT 
	SCR	A2,A4
	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	ADKL	A9,1
	CWK	A2,/20 
	RF(L)	DIS200	ATTRIBUTE CHAR
	CWK	A2,NULL
	RB(E)	DIS100	NULL EQUALS SPACE AT DISPLAY
	CWK	A2,/7D 
	RF(NE)	DIS120
	LDK	A2,/39 
DIS120	CWK	A2,/7E 
	RF(NE)	DIS121
	LDK	A2,/35 
DIS121	CWK	A2,/7C 
	RF(NE)	DIS122
	LDK	A2,/3C 
DIS122	EQU	*
	SC	A2,-1,A7	STORE CHAR IN DISPLAY OUTPUT BUFFER
	RB	DIS100
DIS200	ANK	A2,6 
	XRK	A2,6	CHECK IF NONDISPLAY 
	ST	A2,INTATT,TCABAS	SAVE ATTRIBUTE CHARACTER 
	RF(Z)	DIS210	NON DISPLAY 
	ANK	A2,4 
	RF(Z)	DIS205	HIGH INTENSITY
	LDK	A2,/1E	LOW INTENSITY 
	RF	DIS206
DIS205	EQU	*
	LDK	A2,/1F	HIGH
DIS206	EQU	*
	SC	A2,-1,A7	STORE INTENSITY CHARACTER
	ADKL	A10,1	INCREMENT COUNTER 
	ADK	A7,1 
	RB	DIS100
DIS210	EQU	*
	CWK	A9,LLINE 
	RF(L)	DIS220 
	CF	A14,DISLIN	DISPLAY THIS LINE
DIS220	EQU	*
	CWK	A3,LBVDU 
	RF(NL)	DIS900	ALL DISPLAYED
	LCR	A2,A4
***********************************************  78-08-15 
	CF	A14,SET:M	SET MODIFIED BIT
***********************************************  78-08-15 
	ANK	A2,/7F	RESET DISPLAY BIT 
	SCR	A2,A4
	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	ADKL	A9,1
	CWK	A2,/20 
	RB(L)	DIS200	ATTRIBUTE FOUND 
	RB	DIS210
	EJECT
* 
* 
*	POSITION THE CURSOR 
* 
* 
SETCUR	EQU	*
DIS900	LDK	A1,2	REQ LENGTH
DIS905	ST	A1,ECBRL,A8 
	LD	A1,PCURS,TCABAS	GET CURSOR POS
	LDKL	A2,/101	START ON LIN 1 POS 1
	ST	A2,ECBCW,A8 
	LDKL	A2,/100 
DIS910	CWK	A1,LLINE 
	RF(L)	DIS920 
	ADS	A2,ECBCW,A8
	SUKL	A1,LLINE
	RB	DIS910
DIS920	ADS	A1,ECBCW,A8
	LDK	A7,/8B	SET CURSOR AND WRITE
	LKM
	DATA	1 
	CM	INTATT,TCABAS	CLEAR INTENSITY ATTRIBUTE 
	RTN	A14
	EJECT
* 
* 
*	WRITE ONE CHAR FROM A2 IN CURSOR POSITION 
* 
* 
WCHAR	LD	A1,ECBBA,A8
	CWK	A2,/7B 
	RF(NE)	WCHAR1
	LDK	A2,/2A 
WCHAR1	EQU	*
	SC	A2,3,A1	STORE CHAR IN VDU OUTPUT BUFFER 
	LDK	A1,4 
	RB	DIS905	REQ LENGTH = 3 
	EJECT
* 
* 
*	PUT SPACES TO DISPLAY LINE BUFFER 
* 
* 
SPACES	LD	A7,ECBBA,A8 
	ADK	A7,2	BUFFER ADDRESS
	LDKL	A9,LLINE	LINE LENGTH
	ADR	A9,A9	DOUBLE IT
	LDKL	A2,'  '	SPACES
SPAC10	STR	A2,A7
	ADK	A7,2 
	SUKL	A9,2
	RB(P)	SPAC10 
	LDK	A2,0	CLEAR A2=CHAR REGISTER
	LDK	A5,0	RESET MODIFIED INDICATOR
	LD	A7,ECBBA,A8 
	ADK	A7,2	BUFFER ADDRESS
	SUR	A9,A9	RESET LINE CHAR COUNTER
	RTN	A14
	EJECT
* 
* 
*	DISPLAY LINE IF ANY MODIFICATIONS 
* 
* 
***********************************************  78-08-15 
DISLIN	EQU	*
	LDR	A7,A5
	ANK	A5,/80	ANY MODIFICATIONS ??
	RF(Z)	DISL10	NO MODIFICATIONS
	LDK	A1,2 
	XRK	A7,/A0	ONLY SPACES IN BUFFER ??
	RF(Z)	DIS:10	YES!! 
	LDKL	A1,LLINE+2
	ADR	A1,A10	ADD NR OF INTENSITY CHARACTERS
DIS:10	EQU	*
*********************************************** ERROR IN DISPLAY DRIVER 
	ST	A1,ECBRL,A8	SET REQ LENGTH


	LDK	A7,/8B	SET CURSOR AND WRITE
	LKM
	DATA	1 
***********************************************  78-08-15 
	EJECT

********************************************************************
* 
*	EXECUTE FAST OUTPUT TO BLANK REMAINIG PART
*	OF THE LINE 
* 
******************************************************************* 

	LD	A1,ECBCW,A8	CURSOR POSITION 
	ANK	A1,X'FF'	COLUMN NUMBER 
	SUK	A1,81	LAST POSITION ???
	RF(Z)	DISL10	YES!! NO FAST OUTPUT ON THIS LINE 

	LD	A1,ECBBA,A8	BUFFER ADRESS 
	LDK	A2,X'2B'	DONT MOVE CURSOR ONE LINE 
	STR	A2,A1	SAVE IT IN BUFFER
	LDKL	A2,X'1420'	FAST OUTPUT OF SPACES
	ST	A2,2,A1	LOAD BUFFER 
***********************************************  478-08-15
	LDK	A2,84	REQUESTED LENGTH 
***********************************************  78-08-15 
	ST	A2,ECBRL,A8 
	LDK	A7,X'86'	WRITE ORDER 
	LKM
	DATA	1 

DISL10	EQU	*
	LDK	A2,1 
	SC	A2,ECBCW+1,A8	POS 1 ON NEXT LINE
	LDKL	A2,/100 
	ADS	A2,ECBCW,A8	INCREMENT LINE NUMBER
	RB	SPACES	PUT SPACES TO BUFFER 


* 
* 
*	DISPLAY TASK
* 
* 

VDTASK	EQU	*
	CF	A14,I:EVA0
	LDR	TCABAS,A9	LOAD ASSEM TCA BASE


******************************************************
* 
* 
*   ASSIGN VDU-KEYBOARD ECB:S TO VDU-TASK 
* 
*********** 

	LD	A7,TID,CREBAS	GET TASK IDENTITY 
	ANK	A7,X'FF'	MASK TASK INDEX 
	ORKL	A7,X'4B00'	FORM VDU-KEYBOARD TASK ID. 

	CF	A14,GETT:A	GET T:A ADDRESS
	LDR	CREBAS,A1	T:A BASE ADDRESS 
LOOPEND	EQU	* 
	LD	A4,TID,CREBAS	GET TASK IDENTITY 
	ANK	A4,X'0F'	MASK TASK NUMBER
	ADR	A4,A4
	LD	A1,SELTAB,A4	GET SELECT ADDRESS 
	EJECT


* 
*   DELAY VDU-TRANSFER PARAMETER REQUEST IN ORDER 
*   TO GET VDU-DWT AFTER KEYBOARD DWT IN DC:TAB 
*   !!!!!!  SELECT WOULD NOT WORK OTHERWISE  !!!! 
* 

LOOP:1	CW	A1,DCADDR,TCABAS	HAS KB-TASK MADE TRANS PAR ??? 
	RF(E)	LOOP:2	YES!! THEN CONTINUE 

	LDKL	A8,1	DELAY TRANSFER PARAMETER 
	LKM
	DATA	6 
	RB	LOOP:1
LOOP:2	EQU	*
	ST	A1,DCADDR,TCABAS
	CF	A14,EMULA 
	CF	A14,ERASE 
VDTASX	LDK	A1,0 
	CF	A14,DCRED 

	IFT	OFLIN=1
	LD	A1,OFFFLG,TCABAS	ONLINE/OFFLINE FLAG
	RF(Z)	ON:LIN	STILL ONLINE
	CF	A14,REL:BU	RELEASE RECEIVE BUFFER 
	CF	A14,SNBUSY	SET DEVICE FREE FOR DC-LINE
	RB	VDTASX	READ AGAIN 
ON:LIN	EQU	*
	XIF

	LD	A5,KBINH,TCABAS 
	ORK	A5,3	BIT 14,15:= 1. TOTALLY DISABLED 
*			KEYBOARD. BIT 15 = 0 AFTER DISPLAYING.
	ST	A5,KBINH,TCABAS 
	CF	A14,LMP1ON	TURN ON 'KEYBOARD INHIBIT' 
	CF	A14,LMP3OF	TURN ON "SYSTEM AVAILABLE" 

****************************************************************
* 
*   CHECK IF HARDCOPY OF VDU BUFFER IS BEEING EXECUTED
* 
*   IF SO, WAIT UNTIL HARDCOPY IS FINISHED
* 
************************************************************

VDTAS2	LD	A1,VDUBSY,TCABAS	HARDCOPY OF VDU BUFFER IN PROG.? 
	RF(Z)	VDTAS3	NO! PROCEED 

	LDKL	A8,10	1 SEK. DELAY
	LKM
	DATA	6 
	RB	VDTAS2	HARDCOPY FINISHED ?? 




VDTAS3	EQU	*
	CF	A14,UPDATE
	CF	A14,DISPL 
	LD	A2,PCURS,TCABAS 
	CF	A14,ATMASB


	CF	A14,SNBUSY
	LD	A2,KBINH,TCABAS 
	ANK	A2,1	BIT 15 = 0? 
	RF(Z)	VDTAS1	YES 
	LD	A2,KBINH,TCABAS 
	ANK	A2,/E	BIT 15:=0 KEYBOARD NOT TOTALLY 
*			INHIBITED ANY LONGER
	ST	A2,KBINH,TCABAS 
	LD	A2,WCC,TCABAS 
	ANK	A2,2 
	RB(Z)	VDTASX	NO KB RESTORE 
VDTAS1	EQU	*
	CF	A14,LMP1OF	TURN OFF 'KEYBOARD INHIBIT'
	LD	A2,KBINH,TCABAS 
	ANK	A2,4	BITS 14,15:=0 RESTORE KEYBOARD
	ST	A2,KBINH,TCABAS 
	RB	VDTASX
* 
	EJECT


****************************************************************
* 
*   I N T C H K       CHECK IF LINE SHOULD BE PRINTED WITH
*                     HIGH OR LOW INTENSITY 
* 
**********************************************************************

INTCHK	SUR	A10,A10	RESET INTENSITY COUNT
	LD	A2,INTATT,TCABAS	GET INTENSITY ATTRIBUTE
	RF(Z)	INTRTN	NON DISPLAY 
	ANK	A2,X'4'	HIGH INTENSITY ??? 
	RF(Z)	INT:10	YES 

	LDK	A2,X'1E'	LOW INTENSITY 
	RF	INT:20	HIGH INTENSITY 

INT:10	LDK	A2,X'1F'	HIGH INTENSITY

INT:20	SCR	A2,A7	SAVE INTENSITY CHARACTER IN BUFFER 
	ADK	A7,1	INCREMENT BUFFER POINTER
	ADKL	A10,1	          INTENSITY COUNT 
INTRTN	RTN	A14	RETURN 
* 
	EJECT




************************************************************* 
* 
*   G E T T : A     GET T:A ADDRESS 
* 
*   ENTRY   :       A7 = TASK IDENTITY
* 
*   EXIT    :       A1 = TCA-ADDRESS
* 
**********************************************

GETT:A	LD	A3,T:ATAB	T:ATAB ADDRESS
	LDR*	A4,A3	NUMBER OF ENTRIES 

***********************************************  78-08-15 
GETLOP	ADK	A3,2 
***********************************************  78-08-15 
	LDR*	A1,A3	T:A ADDRESS 
	CW	A7,-4,A1	SAME IDENTITY ?? 
	RF(E)	GETEND	YES 
	SUK	A4,1	ALL T:AS CHECKED ???
	RB(NZ)	GETLOP	NO. TRY NEXT 
	LDKL	A7,-1	TASK NOT DEFINED ON CREDIT CASSETTE 
GETEND	RTN	A14	RETURN 
	EJECT

****************************************************************
* 
*   SET:M   SET MODIFIED BIT IF CHARACTER HAS BEEN MODIFIED 
* 
******************************************************************

SET:M	CWK	A2,/20
	RF(L)	SET:M2	ATTRIBUTE CHARACTER 
	CWK	A2,/7F 
	RF(E)	SET:M2	UNMODIFIED ATTRIBUTE
	CWK	A2,/FF 
	RF(NE)	SET:M1	NOT NULL OR ATTRIBUTE
	ORK	A5,/A0	MODIFIED NULL CHARACTER 
	RTN	A14
SET:M1	ORR	A5,A2	SET MODIFIED BIT 
SET:M2	RTN	A14
	END

Full view