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

⟦91f7c274e⟧ 

    Length: 42826 (0xa74a)
    Notes: pts_type(SC)
    Names: »DRDY02.SC«

Derivation

└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
    └─⟦this⟧ »MONGEN/DRDY02.SC«

PTS(SC)

	IDENT DRDY02 	REL 11.0 81-05-25 870105041100 

			= 1 ECB-ADDRESS CHECKED IN ERROR-ROUTINE 
			REL 11.0 81-02-03
			= 2 ECB-ADDRESS CHECKED IF LRC-ERROR OCCURED 
			REL 11.0 81-02-13
			= 3 ASS. ERROR IF FAST0=1, TRASPA=1 AND WHATDY=1 
			REL 11.0 81-02-17
			= 4 GREEK CHARACTER SET HANDLING & NEW CONDITIONS
			REL 11.0 81-04-06
* 
************************************************************
* 
* 
* 
*   PHILIPS TERMINAL SYSTEM P T S 
*   DRDY02 = DRIVER VIDEO DISPLAY 
* 
* 
* 
************************************************************
* 
*   THIS DRIVER HANDLES OUTPUT TO THE VIDEO 
*   DISPLAYS PTS 6342, 6344, 6346 AND TO THE
*   DISPLAYS PTS 6351, 6385 AND 6386. 
*   THE DRIVER INCLUDES DEVICE DEPENDENT ECHO-
*   FUNCTIONS WHICH MAKES IT POSSIBLE TO USE
*   THE DISPLAY AS AN ECHO-DEVICE TO ANY KEY- 
*   BOARD.
* 
* 
*   THE FOLLOWING ORDERS ARE TREATED :
* 
*   ORDER  00   TEST STATUS 
*          05   BASIC WRITE 
*          06   STANDARD WRITE
*          0B   SET CURSOR AND WRITE
*          31   ERASE 
* 
* 
*   NORMAL REGISTER USAGE : 
* 
*   REGISTER  A1  =  RETURN CODE
*             A2  =  OUTPUT CHARACTER 
*             A3  =  BUFFER INDEX 
*             A4  =  WORKING REGISTER 
*             A5  =  STACK BASE 
*             A6  =  DWT-ADDRESS
*             A7  =  ORDER
*             A8  =  ECB-ADDRESS
* 
* 
*   ENTRIES 
* 
* 
	ENTRY	DYAD	ADDRESS TO ADDRESSBLOCK 
* 
* 
*   EXTERNALS 
* 
* 
*   TOSS ROUTINES 
* 
	EXTRN	LENDER	I/O-REQUEST ERROR 
	EXTRN	LENDIS	END I/O-REQUEST 
	EXTRN	STABLK	START OF BLOCK
	EXTRN	OUTPUT	SEND
	EXTRN	ENDBLK	END OF BLOCK
	EXTRN	GETCHR	FETCH CHARACTER FROM ECB-BUFFER 
	EXTRN	ECHRTN	RETURN TO KEYBOARD
	EXTRN	TENDIO	END OF I/O
* 
*   DWT DISPLACEMENTS 
* 
	EXTRN	DWTDEV	TERMINAL DEVICE STATUS
	EXTRN	DWTST	DEVICE STATUS
	EXTRN	DWTOR	ORDER
	EXTRN	DWTSB2	STACK BASE
* 
*   ECB DISPLACEMENTS 
* 
	EXTRN	ECBBA	BUFFER ADDRESS 
	EXTRN	ECBRL	REQUESTED LENGTH 
	EXTRN	ECBEL	EFFECTIVE LENGTH 
	EXTRN	ECBRC	RETURN CODE
	EXTRN	ECBCW	CONTROL WORD 
* 
************************************************************
* 
*   CONSTANTS 
* 
************************************************************
* 
*   DWT DISPLACEMENTS 
* 
DWTAP	EQU	/2	HEAD POSITION POINTER
DWTBC	EQU	/1	POSITION COUNTER 
DWTLIN	EQU	/4	LINES 
DWTPOS	EQU	/5	POSITIONS 
DWTBLC	EQU	/6	CHARACTERS IN BLOCK 
* 
*   CHARACTERS
* 
DUMMY	EQU	/3	DUMMY CHARACTER
BACKSP	EQU	/08	NON-DESTRUCTIVE BACKSPACE
LF	EQU	/0A	LINE FEED
HOME	EQU	/0B	CURSOR HOME
CLEHOM	EQU	/0C	CLEAR AND CURSOR HOME
CR	EQU	/0D	CARRIAGE RETURN
CURRIG	EQU	/10	CURSOR RIGHT 
SCADD	EQU	/11	SET CURSOR ADDRESS
ULSTOP	EQU	/13	UNDERLINE STOP 
FASOUT	EQU	/14	FAST OUTPUT
STILL	EQU	/18	CURSOR STEADY 
CTYCOD	EQU	/1B	SET COUNTRY CODE 
LISTOP	EQU	/1F	LOW INTENSITY STOP 
SPACE	EQU	/20	SPACE 
* 
*   RETURN CODES
* 
CCERR	EQU	/4	CODE CHECK ERROR 
* 
*   OTHER 
* 
MINBLK	EQU	6	BLOCK SIZE 
FASTNR	EQU	6	LEAST NUMBER OF CHARS TO SEND WITH FAST OUTPUT 
* 
************************************************************
* 
*   ADDRESS BLOCK 
* 
************************************************************
	DATA	DVBLEN	BUFFER LENGTH
	DATA	2	DEVICE INDEX
DYAD	EQU	*
	DATA	ACDY	DRIVER ACTIVATION ADDRESS
	DATA	ABDY	ABORT ROUTINE
	DATA	0	NO INTERRUPT HANDLER
	DATA	RCDY	RECOVERY ROUTINE 
	DATA	ECHODY	ECHO ROUTINE 
* 
************************************************************
* 
*   CONDITIONAL ASSEMBLY
* 
************************************************************
* 
*   IF THE CONSTANT X:A IS SET TO 1, FAST OUTPUT
*   WILL BE USED IF A NUMBER (SEE THE CONSTANT "FASTNR")
*   OF CONSECUTIVE CHARACTERS IN THE ECB-BUFFER ARE 
*   FOUND EQUAL.
* 
X:A	EQU	0 
FASTO	EQU	1 
* 
* 
*   BY SETTING X:B=1 THE DRIVER HANDLES OTHER DISPLAYS THAN PTS 6344
*   6346, 6385 AND 6386.
* 
X:B	EQU	0 
WHATDY	EQU	0
* 
* 
*    BY SETTING X:C TO 1 LOWER CASE CHAR. GENERATOR 
*    (COLUMNS 6 AND 7) CAN BE USED
X:C	EQU	1 
LOWCHA	EQU	0
* 
* 
*    BY MEANS OF CONDITIONAL ASSEMBLY IT IS POSSIBLE
*    TO SUPPRESS ECHOING OF END OF RECORD CHARACTER.
*    THIS IS ATTAINED BY SETTING THE CONSTANT X:G=0 
* 
X:D	EQU	0 
EORECH	EQU	0
* 
*   BY SETTING THE CONSTANT TRASPA = 1 IT IS
*   POSSIBLE TO SUPPRESS TRAILING BLANKS, /12, /1E AND /1F. 
* 
X:E	EQU	0 
TRASPA	EQU	1
* 
*   BY SETTING X:F = 1, CURSOR WILL BE STEADY 
*   INSTEAD OF BLINKING.
* 
X:F	EQU	1 
STEADY	EQU	1
* 
*   BY MEANS OF CONDITIONAL ASSEMBLY IT IS POS- 
*   SIBLE TO CHOOSE BETWEEN TEN DIFFERENT 
*   CHARACTER SETS, IF PTS 6385 IS USED.
* 
*	CODE	COUNTRY
*	0	GB/NL/B 
*	1	D/A/L/CH
*	2	F/CH/B/L
*	3	E 
*	4	I/CH
*	5	S/SF
*	6	DK/N
*	7	P 
*	8	YU
*	9	US
X:G	EQU	0 
COUNTRY	EQU	0 
* 
*   MEMORY MANAGEMENT BUFFER SIZE 
* 
X:H	EQU	82
DVBLEN	EQU	512
* 
*   MAXIMUM BLOCK SIZE
* 
X:J	EQU	140 
MAXBLK	EQU	X:J
* 
*   X:I SHOULD BE SET TO 1 IF A PTS 6385 OR 86 IS INCLUDED IN SYSTEM	=4 
* 
X:I	EQU	0 
PLASM	EQU	1 
* 
*   IF X:K = 1 IT IS POSSIBLE TO USE GREEK		=4
*   CHARACTER SET		=4 
* 
X:K	EQU	0		=4 
GREECE	EQU	X:K		=4
* 
	EJECT
* 
***************************************************** 
* 
*   A C T I V A T I O N   P A R T 
* 
*   THIS PART MAKES A START OF BLOCK, CHECKS THE
*   REQUESTED ORDER AND BRANCHES TO THE APPROPRIATE 
*   PART OF THE DRIVER. 
* 
******************************************************* 
* 
ACDY	EQU	*
	LDK	A3,0	RESET BUFFER INDEX
	CM	DWTBLC+DWTDEV,A6	CLEAR CHARACTER COUNTER
	LDKL	A2,MAXBLK	MAX. BLOCK SIZE 
	CF	A5,STABLK	START OF BLOCK
	RF(NZ)	DYER10
* 
*   TEST ORDER
* 
	LDR	A7,A7	GET ORDER
	RF(Z)	DY100	ORDER 00, TEST STATUS
* 
	SUK	A7,/5
	RF(Z)	DY200	ORDER 05, BASIC WRITE
* 
	SUK	A7,1 
	RF(Z)	DY300	ORDER 06,STANDARD WRITE
* 
	SUK	A7,/5
	ABL(Z)	DY600	ORDER 0B, SET CURSOR AND WRITE
* 
	SUK	A7,/26 
	ABL(Z)	DY700	ORDER 31, ERASE 
* 
*   I/O-REQUEST ERROR 
* 
REQERR	EQU	*
	CF	A5,ENDBLK	END OF BLOCK
	ABL	LENDER	SET RETURN CODE AND END I/O 
	EJECT
* 
************************************************************
* 
*   ORDER 00, TEST STATUS.
*   THIS PART SENDS A DUMMY CHARACTER TO THE DISPLAY
*   AND SETS BIT 15 IN THE RETURN CODE IF THE DISPLAY 
*   IS NOT OPERABLE.
*   THE CURSOR POSITION IS RETURNED IN CONTROL WORD OF
*   ECB, WITH LINE NUMBER IN LEFT BYTE AND COLUMN IN
*   THE RIGHT.
* 
************************************************************
* 
DY100	EQU	* 
	LDK	A2,DUMMY 
	CF	A5,OUTPUT	SEND DUMMY
	RF(NZ)	DYER10
* 
	LD	A4,DWTAP+DWTDEV,A6	GET CURSOR POSITION
	ST	A4,ECBCW,A8	SAVE CURSOR POSITION IN ECB 
* 
	ABL	ENDIO
	EJECT
* 
************************************************************
* 
*   ORDER 05, BASIC WRITE.
*   THIS ORDER SENDS THE REQUESTED NUMBER OF
*   CHARACTERS TO THE DISPLAY AND SETS THE
*   INTERNAL CURSOR POSITION COUNTER TO HOME
*   POSITION. (/0101) 
* 
************************************************************
* 
DY200	EQU	* 
	IFT	TRASPA=1 
	CF	A15,TRASP	SUPPRESS TRAILING SPACES
	XIF
DY205	EQU	* 
	CF	A15,GETCHR	FETCH CHARACTER FROM ECB-BUFFER
	LDR	A1,A1	IS THERE ANY CHARACTER TO SEND ? 
	RF(NP)	DY210	NO
	IFT	GREECE=1		=4 
	CF	A15,GRCHAR		=4
	XIF
* 
	CF	A5,OUTPUT	YES ! SEND CHARACTER
	RF(NZ)	DYER05
* 
	CF	A15,POSUPD	UPDATE POSITION COUNTER
* 
*   CHECK IF MAX. BLOCKSIZE IS REACHED. START A 
*   NEW BLOCK IF IT IS. 
* 
	IM	DWTBLC+DWTDEV,A6	INCREMENT CHARACTER COUNTER
	LDKL	A2,MAXBLK	GET BLOCKSIZE 
	CW	A2,DWTBLC+DWTDEV,A6	BLOCK FILLED ?
* 
	RB(G)	DY205	NO ! NEXT CHARACTER
* 
	CF	A5,ENDBLK	YES ! END BLOCK 
	RF(NZ)	DYER05
	LDKL	A2,MAXBLK	GET BLOCKSIZE 
	CF	A5,STABLK	START NEW BLOCK 
	RF(NZ)	DYER05
	CM	DWTBLC+DWTDEV,A6	RESET CHARACTER COUNTER
	RB	DY205	NEXT CHARACTER
* 
DY210	EQU	* 
	CF	A15,UPDAPP	RESET POSITION COUNTER 
* 
	LDKL	A4,/0101	SET HEAD POSITION COUNTER
	ST	A4,DWTAP+DWTDEV,A6	TO HOME POSITION. (/0101)
	CM	DWTBLC+DWTDEV,A6	RESET CHARACTERS-IN-BLOCK COUNTER
* 
	ABL	DY493	END REQUEST
* 
DYER05	EQU	*
	CM	DWTBLC+DWTDEV,A6	RESET CHARACTERS-IN-BLOCK COUNTER BEFORE 
	RF	DYER10	ERROR ROUTINE IS ENTERED 
	EJECT
* 
************************************************************
* 
*   ORDER 06, STANDARD WRITE. 
*   THIS PART CHECKS IF THE REQUESTED LENGTH IS ZERO. 
*   IF IT IS, CARRIAGE RETURN AND LINE FEED ARE SENT, AND 
*   THE REQUEST IS COMPLETED. 
*   ELSE THIS PART LOOKS FOR A CONTROL CHARACTER IN THE FIRST WORD
*   IN THE ECB-BUFFER AND CARRIES OUT THE DESIRED FUNCTION. 
*   THEN IT CHECKS AND SENDS THE REST OF THE CHARACTERS 
*   IN THE ECB-BUFFER TO THE DISPLAY UNLESS A SPECIAL 
*   CHARACTER ( /07, /11, /12, /13, /14, /1E, /1F, /AE ) IS RECOGNIZED. 
*   IF A SPECIAL CHARACTER IS FOUND, THE APPROPRIATE FUNCTION 
*   IS CARRIED OUT BEFORE NEXT CHARACTER IS SENT. 
*   WHEN ALL CHARACTERS ARE SENT, THE CURSOR POSITION IS
*   SAVED IN THE CONTROL WORD OF ECB. 
* 
************************************************************
* 
DY300	EQU	* 
* 
*   TEST REQUESTED LENGTH 
* 
	LD	A2,ECBRL,A8	GET REQUESTED LENGTH. IS IT ZERO ?
	RF(Z)	DY307	YES !
* 
*   TEST CONTROL CHARACTER
* 
DY305	EQU	* 
	LD	A2,ECBBA,A8	GET BUFFER ADDRESS
	LC	A2,1,A2	GET CONTROL CHARACTER 
	ANK	A2,/FF 
	ADK	A3,2	INCREMENT BUFFER INDEX
* 
	SUK	A2,/2B 
	RF(Z)	DY335	NO MOVING OF CURSOR
DY307	EQU	* 
* 
	LDK	A4,1	FIRST POSITION AND ONE LINE FEED. 
	SC	A4,DWTAP+DWTDEV+1,A6	RESET HEAD POSITION COUNTER
* 
	SUK	A2,/5	TWO LINE FEED ?
	RF(NZ)	DY310	NO !
	LDK	A4,2	YES ! INDICATE TWO LINE FEED
* 
DY310	EQU	* 
	SUK	A2,1	ERASE ? 
	RF(Z)	DY330	YES ! CONTROL CHARACTER MEANS ERASE
* 
	LDK	A2,CR	CARRIAGE RETURN
* 
DY320	EQU	* 
	CF	A5,OUTPUT	SEND
DYER10	RF(NZ)	DYER15
* 
	SUK	A4,1	READY ? 
	RF(N)	DY335	YES ! START WRITING ON DISPLAY 
* 
	LC	A1,DWTLIN+DWTDEV,A6	MAX. NUMBER OF LINES ON DISPLAY 
	CC	A1,DWTAP+DWTDEV,A6	ALREADY ON LAST LINE ? 
	RF(NG)	DY325	YES ! 
* 
	LDKL	A2,/100	NO ! INCREMENT LINE COUNTER 
	ADS	A2,DWTAP+DWTDEV,A6 
DY325	EQU	* 
	LDK	A2,LF	LINE FEED CHARACTER
	RB	DY320	SEND NEXT LINE FEED 
* 
DY330	EQU	* 
	SC	A4,DWTAP+DWTDEV,A6	RESET LINE COUNTER 
	LDK	A2,CLEHOM	CLEAR AND CURSOR HOME
	LDK	A4,0	INDICATE ONLY ONE CHARACTER TO SEND 
	RB	DY320	SEND
	EJECT
* 
* 
*   WRITING PART, ORDER 06 (ALSO USED BY ORDER 0B). 
* 
* 
DY335	EQU	* 
	IFT	TRASPA=1 
	CF	A15,TRASP	SUPPRESS TRAILING SPACES
	XIF
DY340	EQU	* 
	CF	A15,GETCHR	GET CHARACTER FROM ECB-BUFFER
* 
	LDR	A1,A1	LAST CHARACTER ? 
	ABL(NP)	DY405	YES !
	IFT	GREECE=1		=4 
	CF	A15,GRCHAR		=4
	XIF
* 
	LDR	A4,A2	CHECK CODE LIMITS
	SUK	A4,/20 
	RF(N)	DY380	TEST IF SPECIAL CHARACTER
	SUK	A4,/5F 
	RF(P)	DY380	TEST IF SPECIAL CHARACTER
	IFT	FASTO=1
	IFT	WHATDY=1 
	LDK	A4,0	RESET A4 BEFORE ENTERING THE OUTPUT SEQ.
	LD	A1,DWTDEV,A6	6344, 6385 OR 6386 ? 
	ANKL	A1,/1000
	RF(NZ)	FAST80	NO ! 
	XIF
	IFT	FASTO=1
* 
* 
*   FAST OUTPUT SHOULD BE USED IF A NUMBER OF 
*   CHARACTERS ARE FOUND EQUAL. 
* 
* 
	LD	A1,ECBBA,A8	GET BUFFER ADDRESS
	ADR	A1,A3	ADD BUFFER INDEX 
* 
* 
	LC	A4,DWTBC+DWTDEV,A6	GET POSITION ON THE LINE 
	AD	A4,DWTAP+DWTDEV,A6
	ANK	A4,/FF 
* 
FAST10	EQU	*
	ADK	A4,1	INCREMENT CHARACTER COUNTER 
	CCR	A2,A1	NEXT CHAR. IN BUFFER EQUAL TO CURRENT ?
	RF(NE)	FAST40	NO ! 
* 
	CC	A4,DWTPOS+DWTDEV,A6	MAX. POSITIONS ?
	RF(NL)	FAST40	YES !
* 
	CW	A3,ECBRL,A8	REQUESTED LENGTH ?
	RF(NL)	FAST40	YES !
* 
	ADK	A1,1	INCREMENT COUNTERS
	ADK	A3,1 
	RB	FAST10	CHECK NEXT CHARACTER 
* 
FAST40	EQU	*
	LD	A1,DWTAP+DWTDEV,A6	GET NUMBER OF EQUAL CHARACTERS 
	AD	A1,DWTBC+DWTDEV,A6
	ANK	A1,/FF 
	SUR	A4,A1
* 
	CWK	A4,FASTNR	COND. FOR FAST OUTPUT FULLFILLED ? 
	RF(L)	FAST80	NO !
* 
*   YES ! SEND CHARACTERS WITH FAST OUTPUT
* 
	ADS	A4,DWTBC+DWTDEV,A6	UPDATE POSITION COUNTER 
* 
	SLC	A3,8	SAVE BUFFER POINTER 
	ADR	A4,A3
* 
	IFT	LOWCHA=0 
	LDR	A3,A2
	SUK	A3,/5F 
	RF(NP)	FAST30
	SUK	A2,/20 
FAST30	EQU	*
	XIF
	IFT	FASTO=1
	LDR	A3,A2	PUT CHARACTER INTO A3
* 
	CF	A5,FASTER 
* 
	LDR	A3,A4	RESTORE BUFFER POINTER 
	SRL	A3,8 
* 
	LC	A4,DWTBC+DWTDEV,A6	GET CURSOR POSITION
	ANK	A4,/FF 
	AD	A4,DWTAP+DWTDEV,A6
* 
	CF	A5,CURPOS	SET CURSOR
	RB	DY340	NEXT CHARACTER
FAST80	EQU	*
	XIF
* 
	IFT	LOWCHA=0	LOWER CASE NOT USED 
	LDR	A1,A2
	SUK	A1,/5F 
	RF(NP)	DY360 
	SUK	A2,/20 
DY360	EQU	* 
	XIF
DY370	EQU	* 
	CF	A5,OUTPUT	SEND CHARACTER
DYER15	ABL(NZ)	DYER20 
	CF	A15,POSUPD	POSITION COUNTER UPDATE
	IFT	FASTO=1
	IFT	WHATDY=1 
	LD	A1,DWTDEV,A6	6344, 6385 OR 6386 ? 
	ANKL	A1,/1000
	RF(NZ)	FAST90	NO ! 
	XIF
	IFT	FASTO=1
	SUK	A4,1	DECREMENT CHARACTER COUNTER 
	RB(NP)	DY340	ALL CHECKED CHARS. SENT ! NEXT !
	LD	A2,ECBBA,A8	GET CHARACTER TO SEND AGAIN 
	ADR	A2,A3
	LC	A2,-1,A2
	ANK	A2,/7F	MASK CHARACTER
	RB	FAST80
FAST90	EQU	*
	XIF
	RB	DY340	NEXT CHARACTER
* 
*   TEST IF SPECIAL CHARACTER 
* 
DY380	EQU	* 
	LDK	A4,0	RESET A4
	LDR	A1,A2	CHARACTER
* 
	SUK	A1,/07	BELL ( /07 ) ?
	RF(Z)	DY467	YES ! SEND 
* 
	SUK	A1,/A	TABULATION ( /11 ) ? 
	ABL(Z)	ADY140	YES ! GO TO TABULATION ROUTINE 
* 
	SUK	A1,/3	FAST OUTPUT ( /14 ) ?
	RF(Z)	DY390	YES ! GO TO THAT ROUTINE 
* 
	SUK	A1,/9A	POINT ( /AE ) ? 
	RF(Z)	DY410	YES ! LOAD AND SEND
	IFF	WHATDY+PLASM=0		=4 
*   IF PTS 6344 IS USED 
	LD	A4,DWTDEV,A6	CHECK IF PTS 6344 IS USED
	ANKL	A4,/3000
	RF(NZ)	DY385	NO !
	XIF
* 
	ADK	A1,/9C	UNDERLINE START ( /12 ) ? 
	RF(Z)	DY467	YES !
* 
	SUK	A1,/1	UNDERLINE STOP ( /13 ) ? 
	RF(Z)	DY467	YES !
* 
	SUK	A1,/B	LOW INTENSITY START ( /1E) ? 
	RF(Z)	DY467	YES !
* 
	SUK	A1,/1	LOW INTENSITY STOP ( /1F ) ? 
	RF(Z)	DY467	YES !
* 
*   ILLEGAL CHARACTER 
* 
DY385	EQU	* 
	LDK	A1,CCERR	CODE CHECK ERROR
	ORS	A1,ECBRC,A8	SET RETURN CODE OF ECB 
	RB	DY340	NEXT CHARACTER
	EJECT
* 
*   ROUTINE FOR FAST OUTPUT 
* 
DY390	EQU	* 
	IFT	TRASPA=1 
	LD	A4,ECBCW,A8	RESTORE OLD REQ. LEN. 
	ST	A4,ECBRL,A8 
	XIF
	CF	A15,GETCHR	GET OUTPUT CHARACTER 
* 
	LD	A4,ECBRL,A8	REQUESTED LENGTH
	SUR	A4,A3	GET NUMBER OF CHARACTERS TO SEND 
	RF(NP)	DY400	NONE !
	IFT	GREECE=1		=4 
	CF	A15,GRCHAR		=4
	XIF
* 
	LDR	A3,A2	LOAD CHARACTER IN A3 
* 
	CF	A5,FASTER	SEND WITH FAST OUTPUT 
* 
DY400	EQU	* 
	LD	A3,ECBRL,A8	GET REQ. LEN. TO STORE IN EFF. LEN
* 
DY405	RF	DY470	GO TO COMMON END 
* 
*   SEND A POINT
* 
DY410	EQU	* 
	LDK	A2,/2E	GET CODE FOR POINT
	RB	DY370	SEND POINT
* 
DY467	EQU	* 
	CF	A5,OUTPUT	SEND SPECIAL CHARACTER
	RF(NZ)	DYER20	NOT OK ! 
	ABL	DY340	NEXT CHARACTER ! 
	EJECT
************************************************************
* 
*    TABULATION 
* 
************************************************************
ADY140	EQU	*
	CF	A15,GETCHR	GET FIRST ASCII CHARACTER
	LDR	A4,A2
	CF	A15,GETCHR	GET SECOND ASCII CHARACTER 
	ANK	A2,/F
	ANK	A4,/F
	RF(E)	ADY144 
ADY143	ADK	A2,/A	FROM DECIMAL TO HEXADECIMAL
	SUK	A4,1 
	RB(NE)	ADY143
ADY144	LC	A4,DWTAP+DWTDEV+1,A6
	SUR	A2,A4	SUBTRACT HEAD POSITION POINTER 
	LC	A4,DWTBC+DWTDEV,A6
	SUR	A2,A4	AND REQUESTS POSITION COUNTER
			TO GET NUMBER OF SPACES TO SEND
	ABL(NP)	DY340	NEXT CHARACTER 
	LDR	A4,A2
ADY145	LDK	A2,CURRIG	CURSOR RIGHT 
	CF	A5,OUTPUT 
	RF(NZ)	DYER20
	CF	A15,POSUPD	POSITION COUNTER UPDATING
	SUK	A4,1	READY ? 
	RB(NE)	ADY145	NO 
	ABL	DY340	NEXT CHARACTER 
	EJECT
**************************************************************
* 
*   COMMON END. ALL CHARACTERS ARE SENT. RESET MODES WHICH
*   HAS BEEN SET UP BY SPECIAL CHARACTERS.
* 
************************************************************* 
* 
DY470	EQU	* 
	LDK	A2,ULSTOP	UNDERLINE STOP 
	CF	A5,OUTPUT	SEND
DYER20	RF(NZ)	DYER30
* 
	LDK	A2,LISTOP	LOW INTENSITY STOP 
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER30
* 
	CF	A15,UPDAPP	UPDATE HEAD POSITION COUNTER 
* 
DY493	EQU	* 
	IFT	TRASPA=1 
	LD	A2,ECBCW,A8 
	ST	A2,ECBRL,A8	RESTORE OLD REQUESTED LENGTH
	XIF
	ST	A3,ECBEL,A8	STORE EFF. LENGTH IN ECB
	LD	A2,DWTAP+DWTDEV,A6	SET HEAD POSITION POINTER
	ST	A2,ECBCW,A8	IN CONTROL WORD OF ECB
ENDIO	EQU	* 
	CF	A5,ENDBLK	END OF BLOCK
	RF(NZ)	DYER30
	ABL	LENDIS	END I/O 
	EJECT
************************************************************
* 
*   ORDER 0B, SET CURSOR AND WRITE. 
*   THIS ORDER SETS CURSOR TO THE POSITION GIVEN IN 
*   THE CONTROL WORD OF ECB AND SENDS THE CHARACTERS
*   TO THE DISPLAY, CHECKING THE SAME SPECIAL CHARAC- 
*   TERS AS ORDER 06. 
* 
************************************************************
* 
DY600	EQU	* 
	IFT	WHATDY=1 
	LD	A4,DWTDEV,A6	6344, 6346, 6385 OR 6386 ? 
	ANKL	A4,/1000
	RF(Z)	DY610	YES !
*    GET LINE 
	LC	A4,ECBCW,A8	GET REQUESTED LINE
	CC	A4,DWTLIN+DWTDEV,A6	OUTSIDE SCREEN? 
	RF(NG)	ADY207	NO!
	LC	A4,DWTLIN+DWTDEV,A6	YES! SET CURSOR AT END OF LINE
ADY207	EQU	*
	LC	A3,DWTAP+DWTDEV,A6	GET ACTUAL LINE
ADY210	CWR	A4,A3
	RF(N)	ADY250	REQUESTED LINE ABOVE ACTUAL 
	RF(E)	ADY300	SAME LINE 
	LDK	A2,LF	LINE FEED
	ADK	A3,1	INCREMENT ACTUAL LINE NUMBER
ADY230	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER30
	LDR	A4,A4	REQUESTED LINE 
	RB(NZ)	ADY210	NOT EQUAL ZERO 
	LDK	A4,1 
	RF	ADY300
ADY250	LDK	A2,HOME	HOME 
	LDK	A3,1	RESET ACTUAL LINE NUMBER
	ST	A3,DWTAP+DWTDEV,A6	RESET POSITION 
	RB	ADY230
* 
* 
*    GET POSITION 
* 
ADY300	SC	A4,DWTAP+DWTDEV,A6	UPDATE HEAD LINE COUNTER 
	LC	A4,ECBCW+1,A8	GET REQUESTED POSITION
	CC	A4,DWTPOS+DWTDEV,A6	OUTSIDE SCREEN? 
	RF(NG)	ADY303	NO!
	LC	A4,DWTPOS+DWTDEV,A6	SET LAST LINE 
ADY303	EQU	*
	CWK	A4,1	FIRST POSITION ?
	RF(NE)	ADY305	NO 
	CWR	A4,A3	FIRST LINE ? 
	RF(NE)	ADY305	NO 
	LDK	A2,HOME	CURSOR GO HOME 
	RF	ADY330
ADY305	RF(NL)	ADY307	REQ. POS NOT ZERO
	LDK	A4,1 
ADY307	LC	A3,DWTAP+DWTDEV+1,A6	GET ACTUAL POSITION
	CC	A3,DWTPOS+DWTDEV,A6	MAX-POS?
	RF(NG)	ADY310	NO!
	SUK	A3,1 
ADY310	CWR	A4,A3	FORWARDS OR BACKWARDS
	RF(E)	ADY370	POSITION FOUND
	RF(N)	ADY340	BACK
	LDK	A2,CURRIG	CURSOR RIGHT 
	ADK	A3,1	UPDATE POSITION COUNTER 
ADY330	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER30
	RB	ADY310
ADY340	SUR	A3,A4	ACTUAL POS. - WANTED POS.
	CWR	A3,A4	COMPARE BACKSTEPS WITH CR-WAY
	RF(L)	ADY345	BACKSPACE WAY 
	LDK	A2,CR	CARRIAGE RETURN
	LDK	A3,1	INDICATE FIRST POSITION 
	RB	ADY330
ADY345	LDK	A2,BACKSP	BACKSPACE
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER30
	SUK	A3,1	LAST BACKSPACE ?
	RB(NE)	ADY345
ADY370	SC	A4,DWTAP+DWTDEV+1,A6	UPDATE HEAD POSITION POINTER 
	RF	DY620 
DY610	EQU	* 
	XIF
	LD	A4,ECBCW,A8	GET REQUESTED CURSOR POSITION 
	ST	A4,DWTAP+DWTDEV,A6	UPDATE HEAD POSITION COUNTER 
	CF	A5,CURPOS	SET CURSOR ON DISPLAY 
* 
DY620	EQU	* 
	LDK	A3,2	START BUFFER INDEX
	ABL	DY335	SEND CHARACTERS WITH STANDARD WRITE
	EJECT
************************************************************
* 
*    CURPOS = SUBROUTINE TO SET CURSOR
*             AT ENTRY A4 = CURSOR POS (POSITION AND LINE)
* 
************************************************************
CURPOS	EQU	*
	LDK	A2,SCADD	SET CURSOR ADDRESS
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER30
* 
	LDR	A2,A4	GET POSITIONS
	CC	A4,DWTPOS+DWTDEV,A6	MORE THAN MAX. POSITIONS ?
	RF(NG)	CURR10	NO ! 
	LC	A2,DWTPOS+DWTDEV,A6	YES ! SET MAX. POSITIONS
* 
CURR10	ADK	A2,/1F	CONVERT 
	CF	A5,OUTPUT	SEND
DYER30	RF(NZ)	DYER40
* 
	LDR	A2,A4
	SRL	A2,8	GET LINES 
	CC	A2,DWTLIN+DWTDEV,A6	MORE THAN MAX. LINES ?
	RF(NG)	CURR20	NO ! 
	LC	A2,DWTLIN+DWTDEV,A6	YES ! SET MAX LINES 
* 
CURR20	EQU	*
	ADK	A2,/1F	CONVERT 
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER40
	RTN	A5 
	EJECT
************************************************************
* 
*   ORDER 31, ERASE.
*   SENDS THE NUMBER OF SPACES THAT IS GIVEN IN CONTROL 
*   WORD OF ECB. THE CURSOR IS NOT MOVED. 
* 
************************************************************
* 
DY700	EQU	* 
	LD	A4,ECBCW,A8	GET NUMBER OF CHARACTERS TO ERASE 
	IFT	WHATDY=1 
	LD	A1,DWTDEV,A6	PTS 6344,6385 OR 6386 ?
	ANKL	A1,/1000
	RF(Z)	DY750	YES !
* 
	LD	A2,DWTPOS+DWTDEV,A6	MAX. CHARACTERS 
	ANK	A2,/FF 
	LC	A3,DWTAP+DWTDEV+1,A6	CURRENT POSITION 
	ANK	A3,/FF 
	SUR	A2,A3	NR OF CHARS. TO END OF SCREEN
	LDR	A3,0	ADJUST
	ADK	A2,1	ADJUST LENGTH 
	CWR	A4,A2	OUTSIDE SCREEN ? 
	RF(L)	DY710	NO ! 
	LDR	A4,A2	YES ! MODIFY LENGTH
	LDR	A3,1	ADJUST
DY710	EQU	* 
	ADR	A3,A4	CHARACTERS TO ERASE
	LDK	A2,/20	SPACE 
DY720	EQU	* 
	SUK	A4,1	DECREMENT NUMBER OF CHARACTERS
	RF(N)	DY730	ERASE READY
* 
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER40
	RB	DY720 
* 
DY730	EQU	* 
	CF	A5,ENDBLK	END OF BLOCK
	RF(NZ)	DYER40
	LDKL	A2,MAXBLK	BLOCK SIZE
	CF	A5,STABLK	START OF NEW BLOCK
	RF(NZ)	DYER40
	LDR	A4,A3	RESET COUNTER
	LDR	A2,BACKSP	CURSOR LEFT
DY740	EQU	* 
	SUK	A4,1	CURSOR IN ORIGINAL POSITION ? 
	ABL(N)	ENDIO	YES ! 
	CF	A5,OUTPUT	NO ! SEND ANOTHER BACKSPACE 
	RF(NZ)	DYER40
	RB	DY740 
DY750	EQU	* 
	XIF
	LDK	A3,/20	SPACE 
	CF	A5,FASTER	SEND WITH FAST OUTPUT 
	ABL	ENDIO
	EJECT
************************************************************
* 
*   ECHODY, DEVICE-DEPENDENT ECHO-ROUTINE 
*   THIS ROUTINE CHECKS IF THE ECHO-CHARCTER
*   IS A BACKSPACE, CLEAR OR EOR-KEY ( IF 
*   "SUPPRESS ECHOING OF EOR" IS REQUESTED
*   AT SYSGEN ). ELSE THE CHARACTER WILL BE 
*   SENT TO THE DISPLAY.
* 
************************************************************
* 
ECHODY	EQU	*
	LDR	A7,A7	END OF ECHOING ? 
	RF(NN)	EDY110	NO ! 
* 
* 
	CF	A15,UPDAPP	UPDATE HEAD POSITION COUNTER 
	CF	A15,TENDIO	END I/O
	LD	A1,DWTBLC+DWTDEV,A6	BLOCK RESERVED ?
	RF(Z)	EDY130	NO, RETURN TO KEYBOARD
	RF	EDY120
* 
EDY110	EQU	*
	LDR	A4,A1	SAVE "MORE CHARACTERS" INDICATION
	IFT	GREECE=1		=4 
	CF	A15,GRCHAR		=4		=4
	XIF			=4 
	LDR	A3,A2	SAVE CHARACTER 
* 
	IFT	EORECH=0 
	SUK	A3,/80 
	RF(NN)	EDY130	NOT TO BE ECHOED 
	ADK	A3,/80 
	XIF
	LD	A1,DWTBLC+DWTDEV,A6	BLOCK RESERVED ?
	RF(Z)	EDY116	NO !
	CWK	A1,MINBLK	YES ! IS IT FULL ? 
	RF(L)	EDY118	NO !
	CM	DWTBLC+DWTDEV,A6	YES ! CLEAR CHARACTER COUNTER
	CF	A5,ENDBLK	FINISH BLOCK
	RF(NZ)	DYER40
EDY116	EQU	*
	LDK	A2,MINBLK
	CF	A5,STABLK	DECLARE BLOCK 
	RF(NZ)	DYER40
EDY118	EQU	*
	LDR	A2,A3	RELOAD CHARACTER 
* 
	SUK	A3,/18	CLEAR ? 
	RF(Z)	DY850	YES !
	ADK	A3,/10	BACKSPACE ? 
	RF(Z)	DY800	YES !
* 
* 
*   SEND CHARACTER TO ECHO-DEVICE 
* 
	IM	DWTBLC+DWTDEV,A6	INCREMENT COUNTER
	CF	A5,OUTPUT	SEND
DYER40	RF(NZ)	DYER45
	CF	A15,POSUPD	POSITION COUNTER UPDATING
	SUK	A4,1	MORE CHARACTERS ? 
	RF(Z)	EDY130	YES ! 
* 
EDY120	EQU	*
	CF	A5,ENDBLK	END OF BLOCK
	RF(NZ)	DYER45
	CM	DWTBLC+DWTDEV,A6	RESET COUNTER
EDY130	ABL	ECHRTN	RETURN TO KEYBOARD
	EJECT
************************************************************
* 
*   BACKSPACE 
*   CHECKS CURSOR POSITION, MOVES CURSOR ONE STEP 
*   BACKWARDS, SENDS A SPACE AND MOVES CURSOR ONE 
*   STEP BACKWARDS AGAIN. 
* 
************************************************************
* 
DY800	EQU	* 
	LC	A3,DWTBC+DWTDEV,A6	GET POSITION COUNTER 
	ANK	A3,/FF 
	RB(Z)	EDY120	FIRST POSITION
* 
	CF	A5,ENDBLK	FINISH OLD BLOCK
	RF(NZ)	DYER45
	LDK	A2,MINBLK
	CF	A5,STABLK	START A NEW BLOCK 
	RF(NZ)	DYER45
* 
	LDK	A4,2	SET "SEND AGAIN" FLAG 
	SUK	A3,1	INDICATE ONE BACKSTEP 
	SC	A3,DWTBC+DWTDEV,A6	SET POSITION COUNTER 
	ADK	A3,1	GET POSITION ON LINE
	AD	A3,DWTAP+DWTDEV,A6
	CC	A3,DWTPOS+DWTDEV,A6	LAST POSITION ON LINE ? 
	RF(L)	DY810	NO ! 
	RB(G)	DY800	NO, OUTSIDE !
* 
* 
DY805	EQU	* 
* 
	LDK	A2,SPACE	SPACE 
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER45
* 
DY810	EQU	* 
	LDK	A2,BACKSP	NON-DESTRUCTIVE BACKSPACE
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER45
* 
	SUK	A4,1	SEND AGAIN ?
	RB(NZ)	DY805	YES ! 
*			NO, BACKSPACE FINISHED
	RB	EDY120
	EJECT
********************************************************
* 
*   CLEAR 
*   CHECKS CURSOR POSITION, SETS CURSOR WHERE LAST
*   REQUEST ENDED AND SENDS SPACES TO ERASE THE 
*   CHARACTERS WRITTEN DURING CURRENT REQUEST.
* 
************************************************************
* 
DY850	EQU	* 
	CF	A5,ENDBLK	FINISH OLD BLOCK
	RF(NZ)	DYER45
	LDKL	A2,MAXBLK	GET BLOCKSIZE 
	CF	A5,STABLK	START OF BLOCK
DYER45	RF(NZ)	DYER48
	LC	A3,DWTBC+DWTDEV,A6	GET POSITION COUNTER 
	ANK	A3,/FF 
	RB(Z)	EDY120	FIRST POSITION
* 
	IFT	WHATDY=1 
	LD	A1,DWTDEV,A6	PTS 6344, 6385 OR 6386 ? 
	ANKL	A1,/1000
	RF(Z)	DY860	YES !
	CF	A5,BACCAN	ERASE CURRENT REQUEST 
	RB	EDY120
	XIF
DY860	EQU	* 
	LD	A4,DWTAP+DWTDEV,A6	GET HEAD POSITION COUNTER
	CF	A5,CURPOS	SET CURSOR
* 
	LDR	A4,A3	GET POSITION COUNTER 
	ADK	A4,1	UPDATE POSITION COUNTER 
	LDK	A3,SPACE	GET SPACE TO SEND 
	CF	A5,FASTER	SEND WITH FAST OUTPUT 
* 
	SC	A1,DWTBC+DWTDEV,A6	RESET POSITION COUNTER 
	RB	EDY120
	IFT	WHATDY=1 
	EJECT
************************************************************
* 
*    BACCAN = SUBROUTINE TO POSITION CURSOR 
*             AT THE PLACE BEFORE REQUEST IF
*             CLEAR.
* 
************************************************************
BACCAN	EQU	*
	CM	DWTBLC+DWTDEV,A6	RESET CHARACTER COUNTER
	LDR	A4,A3
	LC	A2,DWTBC+DWTDEV,A6	GET POSITION COUNTER 
	ANK	A2,/FF 
	AD	A2,DWTAP+DWTDEV,A6	ADD HEAD POSITION COUNTER
	ANK	A2,/FF 
	CC	A2,DWTPOS+DWTDEV,A6	LAST POSITION 
	RF(NP)	BACA10	NO 
	LDK	A2,SPACE	DESTRUCTIVE SPACE 
	RF	BACA20
BACA10	EQU	*
	IM	DWTBLC+DWTDEV,A6	INCREMENT CHARACTER COUNTER
	LDKL	A2,MAXBLK-3	GET BLOCKSIZE - 3 
	CW	A2,DWTBLC+DWTDEV,A6	WILL IT BE OVERFLOW IN BLOCK ?
	RF(G)	BACA30	NO !
* 
	CF	A5,ENDBLK	YES ! END OLD BLOCK 
	RF(NZ)	DYER50
	LDKL	A2,MAXBLK	BLOCK SIZE
	CF	A5,STABLK	START A NEW BLOCK 
	RF(NZ)	DYER50
	CM	DWTBLC+DWTDEV,A6	RESET CHARACTER COUNTER
BACA30	EQU	*
	LDK	A2,BACKSP	BACKSPACE
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER50
	LDK	A2,SPACE	DESTRUCTIVE SPACE 
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER50
	LDK	A2,BACKSP	BACKSPACE
BACA20	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER50
	SUK	A4,1 
	RB(NE)	BACA10
	NGR	A3,A3	NEGATE REGISTER
	ADS	A3,DWTBC+DWTDEV,A6	UPDATE POSITION COUNTER 
	RTN	A5 
	XIF
	EJECT
************************************************************
* 
*    FASTER = SUBROUTINE FOR FAST OUTPUT
*             AT ENTRY A4 = NUMBER OF CHARACTERS
*                      A3 = CHARACTER TO SEND 
* 
************************************************************
FASTER	EQU	*
	IFT	WHATDY=1 
	LD	A2,DWTDEV,A6	PTS
	ANKL	A2,/1000	6342 OR 6351 ? 
	RF(Z)	FAS005	NO !
* 
*   SIMULATED "FAST OUTPUT" FOR PTS 6342 AND 6351 
* 
	LC	A2,DWTBC+DWTDEV,A6
	AD	A2,DWTAP+DWTDEV,A6	GET POSITION 
	ANK	A2,/FF 
	ADR	A2,A4	ADD NUMBER OF CHARACTERS 
* 
	LD	A1,DWTPOS+DWTDEV,A6	GET MAX. POSITIONS
	ANK	A1,/FF 
	SUR	A1,A2	COMPARE
	RF(NN)	FAS002	LENGTH OK
	ADR	A4,A1	ADJUST LENGTH
	ADK	A4,1	ADJUST NUMBER OF CHARACTERS 
* 
FAS002	EQU	*
* 
	LDR	A2,A4	PUT TWO COUNTERS IN A4 
	SLL	A2,8 
	ORR	A4,A2
* 
FAS004	EQU	*
	LDR	A2,A3	GET CHARACTER TO SEND
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER50
	SUK	A4,1	DECREMENT COUNTER 
	LDK	A2,/FF 
	ANR	A2,A4
	RB(P)	FAS004	NEXT CHARACTER
* 
	CF	A5,ENDBLK	START A NEW BLOCK TO
	RF(NZ)	DYER50	AVOID OVERFLOW IN
	LDKL	A2,MAXBLK	THE OLD ONE 
	CF	A5,STABLK 
	RF(NZ)	DYER50
* 
	SRL	A4,8	GET LENGTH COUNTER
FAS003	EQU	*
	LDK	A2,BACKSP
	CF	A5,OUTPUT	SEND BACKSPACE
	RF(NZ)	DYER50
	SUK	A4,1	DECREMENT COUNTER 
	RB(P)	FAS003	NEXT
	RTN	A5 
FAS005	EQU	*
	XIF
	CC	A4,DWTPOS+DWTDEV,A6	TEST NUMBER OF CHARACTERS 
	RF(L)	FAS010	NUMBER OF CHAR NOT TOO LONG 
	LC	A4,DWTPOS+DWTDEV,A6	GET MAX. POSITIONS ON DISPLAY 
FAS010	EQU	*
	ADK	A4,/20	ADD CONSTANT
	LDK	A2,FASOUT	FAST OUTPUT
	CF	A5,OUTPUT	SEND
DYER48	RF(NZ)	DYER50
	LDR	A2,A4	NO OF CHAR 
	ANK	A2,/FF 
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER50
	LDR	A2,A3
	CF	A5,OUTPUT	SEND
	RF(NZ)	DYER50
	RTN	A5 
	EJECT
****************************************************
* 
*   ERROR ROUTINE. ENTERED WHEN RETURN CODE IS SET
*   AFTER STABLK, OUTPUT OR ENDBLK. 
* 
******************************************************
DYER50	EQU	*
	LD	A7,DWTST,A6 
	SLC	A7,2	ECHO ?
	ABL(N)	ECHRTN	YES ! RETURN FROM ECHO 
* 
	SRC	A1,5	OUTPUT ERROR (HER) ?
	RF(N)	RCDY	YES ! GO TO RECOVERY
	SLC	A1,5	NO ! RESTORE A1 
* 
	LD	A7,DWTOR,A6	GET ORDER. ORDER 00 ? 
	ANK	A7,/FF 
	RF(Z)	DYER52	YES ! 
	SUK	A7,5	ORDER 5 ? 
	RF(Z)	DYER52	YES ! 
	SUK	A7,/2B	ORDER 31 ?
	RF(Z)	DYER52	YES ! 
* 
	SRC	A1,2	LRC-ERROR ? 
	RF(N)	DYER70	YES ! 
	SLC	A1,2 
DYER52	SRC	A1,3	LINK ERROR ?
	RF(NN)	DYER55	NO ! 
	LDKL	A1,/2000	YES ! SET SHIFTED "NOT OPERABLE" BIT 
DYER55	SLC	A1,3	SHIFT BACK
* 
	LDR	A8,A8			=1 
	RF(Z)	DYER60	NO ECB-ADDRESS (SYSTEM START)	=1
	CM	ECBCW,A8	CLEAR INSIGNIFICANT CONTROL WORD 
DYER60	EQU	*			=1 
	ABL	LENDIS	COMPLETE REQUEST
* 
*   LRC-ERROR 
* 
DYER70	EQU	*
	LDKL	A5,DWTSB2	INITIALIZE A5 STACK 
	ADR	A5,A6
	LDR	A8,A8	ECB-ADDRESS = ZERO ?	= 2 
	ABL(Z)	ENDIO	YES, DON'T SEND AGAIN	= 2 
	IFT	WHATDY=1 
	LD	A4,DWTDEV,A6	6344,6385 OR 6386 ?
	ANKL	A4,/1000
	RF(Z)	DYER90	YES ! 
	LC	A4,DWTBC+DWTDEV,A6	GET NUMBER OF POS. TO BACK 
	ANK	A4,/FF 
	RF(Z)	DYER80 
	CF	A5,BACCAN	SEND BACKSPACES AND RUB OUT 
	LDK	A3,2	SET BUFFER INDEX
DYER80	ABL	DY335	SEND AGAIN 
DYER90	EQU	*
	XIF
* 
	LD	A4,DWTAP+DWTDEV,A6	GET HEAD POS. COUNTER
	CF	A5,CURPOS	SET CURSOR ON DISPLAY 
	LDK	A3,0	RESET BUFFER INDEX
	LD	A7,DWTOR,A6	GET ORDER 
	ANK	A7,/FF 
	ABL	ACDY 
	EJECT
************************************************************
* 
*    UPDAPP = SUBROUTINE TO UPDATE HEAD 
*             POSITION POINTER WHEN END 
*             OF REQUEST IS REACHED 
* 
************************************************************
UPDAPP	EQU	*
	LC	A2,DWTBC+DWTDEV,A6	GET POSITION COUNTER 
	ANK	A2,/FF 
	ADS	A2,DWTAP+DWTDEV,A6	UPDATE HEAD POSITION POINTER
	LDK	A2,0 
	SC	A2,DWTBC+DWTDEV,A6	RESET  POSITION COUNTER
	RTN	A15
************************************************************
* 
*    POSUPD = SUBROUTINE TO UPDATE ACTUAL POSITION
*             COUNTER WHEN REQUEST RUNNING. 
*             A CHECK THAT POINTER NOT EXCEEDS THE LIMIT IS DONE
* 
************************************************************
POSUPD	EQU	*
	LC	A2,DWTBC+DWTDEV,A6	GET POSITION COUNTER 
	AD	A2,DWTAP+DWTDEV,A6	INCLUDE HEAD POSITION POINTER
	ANK	A2,/FF 
	CC	A2,DWTPOS+DWTDEV,A6	END OF ROW ?
	RF(G)	POSU10 
	IM	DWTBC+DWTDEV,A6	POSITION COUNTER
POSU10	RTN	A15
	IFT	GREECE=1		=4 
	EJECT			=4 
***************************************************	=4
* 
*   GRCHAR = SUBROUTINE TO CONVERT GREEK CHARACTERS	=4
*            BEFORE THEY ARE SENT TO THE DISPLAY	=4 
* 
***************************************************	=4
GRCHAR	EQU	*		= 
	LDR	A1,A2	IS IT A GREEK CHARACTER ?	=4 
	SUK	A1,/B9		=4 
	RF(P)	GRCH10	NO	=4 
	ADK	A1,9		=4 
	RF(N)	GRCH10	NO	=4 
*				=4 
	ADKL	A1,GRTAB	GET THE CORRECT CODE FROM	=4 
	LCR	A2,A1	THE CHARACTER TABLE	=4 
*				=4 
GRCH10	EQU	*		=4
	RTN	A15		=4
*				=4 
GRTAB	EQU	*		=4 
	DATA	/2223,/263B,/405B,/5C5D,/5E5F		=4 
	XIF			=4 
	IFT	TRASPA=1 
	EJECT
**************************************************
* 
*   TRASP = SUBROUTINE THAT ELIMINATES TRAILING 
*           SPACES FROM ECB-BUFFER. IT ALSO DE- 
*           LETES LOW INTENSITY START, HIGH 
*           INTENSITY START.
*   AND TABULATIONS 
* 
**************************************************
* 
TRASP	EQU	* 
	LD	A1,ECBBA,A8	GET BUFFER ADDRESS (BA) 
	LD	A2,ECBRL,A8	GET REQUESTED LENGTH(RL)
	ADR	A1,A2	GET END OF BUFFER
SKIP05	CWK	A2,2 
	RF(NG)	SKIP30	RL < 3 
	SUK	A1,1	DECR. BA
	LCR	A4,A1	GET CHAR 
	ANK	A4,/FF 
	SUK	A4,/20	SPACE ? 
	RF(Z)	SKIP07	YES 
	ADK	A4,1	LOW INT. STOP ? 
	RF(Z)	SKIP07	YES ! 
	ADK	A4,1	LOW INT. START ?
	RF(Z)	SKIP07	YES ! 
	CWK	A2,4 
	RF(NG)	SKIP30	REQ, LENGTH < 5
	LC	A4,-2,A1	GET CHARACTER
	SUK	A4,/11	TABULATION CHARACTER ?
	RF(NZ)	SKIP30	YES !
SKIP07	SUK	A2,1	DECR RL 
	RB	SKIP05	GET NEXT 
SKIP30	EQU	*
	LD	A4,ECBRL,A8 
	ST	A4,ECBCW,A8	SAVE OLD REQ. LENGTH
* 
	ST	A2,ECBRL,A8	STORE NEW RL
* 
	RTN	A15
	XIF
	EJECT
************************************************************
* 
*   RCDY = RECOVERY ROUTINE 
*   CLEARS DISPLAY AND SETS CURSOR & HEAD POSITION
*   COUNTER TO HOME POSITION ( /0101 ). 
* 
************************************************************
* 
RCDY	EQU	*
	LDKL	A2,/7FFF
	ANS	A2,DWTST,A6	INDICATE BUSY
* 
	LDKL	A2,MAXBLK	MAX. BLOCK SIZE 
	CF	A5,STABLK	START OF BLOCK
RCER	RB(NZ)	DYER50
	IFT	PLASM=0		=4
	IFF	STEADY+COUNTRY=0 
	LD	A2,DWTDEV,A6	GET DEVICE STATUS
	ANKL	A2,/2000	PTS 6385 OR 6386 ? 
	RF(Z)	RCDY20	NO !
	LDK	A3,/40	SET UP TRANSFER COUNTER 
* 
RCDY10	LDK	A2,STILL-1	SET UP CURSOR BLINKING
	ADK	A2,STEADY	ADJUST TO STEADY IF SO 
	CF	A5,OUTPUT	SEND CURSOR INFORMATION 
	RB(NZ)	RCER
	SUK	A3,1	DECREMENT TRANSFER COUNTER
	RB(P)	RCDY10	NOT ENOUGH TRANSFERS
	LDK	A2,CTYCOD	SEND "SET COUNTRY CODE"
	CF	A5,OUTPUT 
	RB(NZ)	RCER
	LDK	A2,COUNTRY	SEND "COUNTRY CODE" 
	ORK	A2,/30	MAKE ASCII DIGIT
	CF	A5,OUTPUT 
	RB(NZ)	RCER
RCDY20	EQU	*
	XIF
* 
	LDK	A2,CLEHOM	CLEAR AND CURSOR HOME
	CF	A5,OUTPUT	SEND
	RB(NZ)	RCER
* 
	LDKL	A2,/0101	HOME POSITION
	ST	A2,DWTAP+DWTDEV,A6	SET HEAD POSITION COUNTER
	LDK	A2,0 
	SC	A2,DWTBC+DWTDEV,A6	RESET CURRENT POSITION COUNTER 
* 
	ABL	ENDIO
* 
****************************************
* 
*   ABORT ROUTINE 
* 
****************************************
* 
ABDY	EQU	*
	CF	A15,UPDAPP	UPDATE HEAD POS. POINTER 
	ABL	LENDIS	END I/O 
	END

Full view