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

⟦154d579af⟧ 

    Length: 71518 (0x1175e)
    Notes: pts_type(SC)
    Names: »DRDC15.SC«

Derivation

└─⟦173d42e04⟧ Bits:30009663 Philips computer tape "600105"
    └─⟦this⟧ »TOSSWORK/DRDC15.SC«

PTS(SC)

	IDENT DRDC15 	PRR 10.0 80-05-07  870105041000

			=11, DC:MIN HEADER LENGTH
			REL 10.1 80-01-25
			=10,WRONG LABEL IF SALCUZ
			REL 10.1 79-12-04
			=9, OLLES POWER UP+MODEM NOT OP
			REL 10.1 79-10-26

			REL 10.1 ADAPTATION
			REL 9.1 79-08-16 
			=8, ASCII-MODE FOR SALCUZ
			REL 9.1 79-07-19 
			=7, ACK IN CONVERSATIONAL MODE 
			REL 9.1 79-07-19 
			=6, DCTASK BUFFER ADDRESS DESTROYED
			REL 9.1 79-05-23 
			=5, INCOMPLETE POLL SEQUENCE 
			REL 9.1 79-05-23 
			=3, TRANSFER PARAMETER 
			PRR 9.1 79-04-06 
			=4, ANY MESSAGE ORDER
			PRR 9.1 79-04-06 
			=2, ABORT HANDLING 
			PRR 9.1 78-11-29 
			=1, MSR-INSTRUCTION
			PRR 9.1 78-11-14 
			REL 8.2 78-11-14 

* 
* 
********************************************* 
* 
*   PHILIPS TERMINAL SYSTEM PTS 
* 
*   DRDC15: DRIVER DATA COMMUNICATION 
*           BSC MULTIPOINT LINE PROCEDURE 
*           OR SIEMENS MSV1 
* 
* 
* 
* 
* 
****************************************************
	EJECT
* 
* 
*	ENTRY POINTS
* 
	ENTRY	DC15AD	ADDRESS BLOCK TERMINAL REQUESTS 
	ENTRY	IH1501	INPUT INTERRUPT 
	ENTRY	IH1502	OUTPUT INTERRUPT
	ENTRY	DC15ON	POWER ON ROUTINE
	ENTRY	DW1500	DWT FOR DC TASK 
* 
* 
*	EXTERNAL REFERENCES 
* 
* 
	EXTRN	TDISP	DISPATCHER ENTRY 
	EXTRN	SAVE8	SAVE A1-A8 ON A15 STACK
	EXTRN	TENDIO	COMPLETE I/O EVENT
	EXTRN	DISIOE	REQUEST ERROR 
	EXTRN	SETIME	SET TIMER 
	EXTRN	DWTST	DWT STATUS 
	EXTRN	DWTOR	DWT ORDER
	EXTRN	DWTECB	DWT ECB 
	EXTRN	INTSAV	SAVE AREA LAST INTERRUPT
	EXTRN	TEBCDIC	ASCII TO EBCDIC TABLE
	EXTRN	TASCII	EBCDIC TO ASCII TABLE 
	EXTRN	ECBBA	ECB BUFFER ADDRESS 
	EXTRN	ECBRL	ECB REQUESTED LENGTH 
	EXTRN	ECBEL	ECB EFFECTIVE LENGTH 
	EXTRN	ECBRC	ECB RETURN CODE
	EXTRN	ECBCW	ECB CONTROL WORD 
	EXTRN	DC:MIN	MOVE DATA TO USER BUFFER
	EXTRN	DC:MOT	MOVE DATA FROM USER BUFFER
	EXTRN	DISEND	COMPLETE REQUEST AND DISPATCH 
	EXTRN	PFPOST	WAIT FOR POWER UP IF SET
	EJECT
* 
* 
* 
* 
*   STANDARD INTERFACE PART FOR DATA COMMUNICATION
* 
* 
* 
* 
*	DWT CONTENTS
* 
*	DWTCHP	TERMINAL ADDRESS AS GIVEN AT PARAMETER TRANSFER (BIT #08-#15)
* 
	EJECT
******************************************************* 
* 
*	PARAMETERS FOR CONDITIONAL ASSEMBLY 
* 
* 
X:A	EQU	2000	RECEIVE BUFFER LENGTH
RBUFL	EQU	X:A 
X:B	EQU	/60	DCTASK FILE CODE
DC15FC	EQU	/60
X:C	EQU	1	IF 1 INTERRUPT LOGGING
LOGG	EQU	X:C
X:D	EQU	600	POLL TIMEOUT VALUE
TIMPOL	EQU	X:D
X:E	EQU	1	STATUS AND RVI HANDLING IF=1
STAT	EQU	X:E
X:F	EQU	1	READ COMMAND HANDLING IF=1
RCOM	EQU	X:F
X:G	EQU	254	TRANSMIT BLOCK LENGTH 
TBLEN	EQU	X:G 
X:H	EQU	0	CODE , 0=ASCII , 1=EBCDIC 
CODE	EQU	X:H
X:I	EQU	0	IF 1 SPECIFIC POLL HANDLING 
SPECP	EQU	X:I 
X:J	EQU	1	IF = 1  LINE SPEED SET TO HIGH
			IF = 0  LINE SPEED IS SET TO LOW 
SPEED	EQU	X:J 
X:K	EQU	0	IF 1 SIEMENS MSV1 PROCEDURE 
MSV1	EQU	X:K
X:L	EQU	2	NUMBER OF RECEIVE BUFFERS (2-5) 
RBUFNR	EQU	X:L
X:M	EQU	1	IF = 1  PTS 6805 ADAPTION	SALCUZ
P6805	EQU	X:M 
X:N	EQU	/02 
	IFT	P6805=0
LCUIN	EQU	X:N	DEVICE ADDRESS OF RECEIVER
	XIF
	IFT	P6805=1
LCUIN	EQU	/0A	DEVICE ADDRESS OF RECEIVER
	XIF
X:O	EQU	0 
IBMCHR	EQU	X:O	IF 1 IBM CHARACTER HANDLING
X:P	EQU	0	IF 1 MESSAGE PASSING TO DC TASK 
MESPAS	EQU	X:P
X:Q	EQU	0	IBM-3270 EMULATION PACKAGE, IF NOT = 0
EM3270	EQU	X:Q
X:R	EQU	1000
TBUFL	EQU	X:R	MMU BUFFER LENGTH 
BINTRM	EQU	0	IF 1 BINARY TRANSMISSION 
TSTREQ	EQU	0	IF 1 TEST REQUEST HANDLING 
DMRK	EQU	0	SPECIAL CONDITION FOR DENMARK
NOWACK	EQU	0	WHEN WORKING WITH A MAIN-FRAME THAT
			DOESN'T ACCEPT WACK RESPONSE TO A SELECT 
			SEQUENCE, NOWACK SHOULD BE SET TO "ONE". 
			ONLY WORKING IF STAT IS SET TO "ONE".
	IFT	P6805=0		SALCUZ
LCUUT	EQU	LCUIN+/10	DEVICE ADDRESS OF TRANSMITTER	SALCUZ
	XIF			SALCUZ 
	IFT	P6805=1
LCUUT	EQU	LCUIN+/01	DEVICE ADDRESS OF TRANSMITTER	SALCUZ
	XIF			SALCUZ 
TPMODE	EQU	0	TRANSPARENT MODE IF = 1
* 
	EJECT
* 
* 
***************************************** 
* 
*	CONDITIONAL ASSEMBLY
* 
***************************************** 
* 
*	A PROGRAM VERSION USING TOSS MMU PAGING 
*	IS OBTAINED BY SETTING MMUPAG EQU 1.
* 
MMUPAG	EQU	0
* 
* 
*	A PROGRAM VERSION USING THE EXTENDED INSTRUCTION
*	SET IS OBTAINED BY SETTING CPU852 EQU 0.
* 
CPU852	EQU	1
* 
DEVIND	EQU	-2	DEVICE INDEX DATA COMMUNICATION 
BUFLEN	EQU	TBUFL+TBUFL	MMU BUFFER SIZE
* 
	EJECT
* 
*	DWT DISPLACEMENTS 
* 
DWTDRD	EQU	/10	START OF DRIVER DEFINED PART 
* 
	IFT	MMUPAG=0 
START	EQU	DWTDRD
	XIF
* 
	IFT	MMUPAG=1 
START	EQU	DWTDRD+4
	XIF
* 
DWTTP	EQU	START+/00	TIMER POINTER ORDER PROCESS 
DWTWQ	EQU	START+/02	WRITE/GET BUFFER QUEUE
DWTSQ	EQU	START+/04	STATUS QUEUE
DWTRQ	EQU	START+/06	RECEIVE QUEUE 
DWTBUF	EQU	START+/08	DEVICE BUFFER ADDRESS
DWTCUR	EQU	START+/0A	CURSOR ADDRESS 
DWTTIM	EQU	START+/0C	REQUEST TIMER VALUE
* 
	EJECT
* 
*	REQUEST HANDLING
* 
* 
* 
*	A7=ORDER
* 
*	/02: READ 
*	/06: WRITE
*	/37: TRANSFER PARAMETERS
*	/38: SET STATUS 
*	/39: SET REQUEST TIMEOUT VALUE
* 
* 
*	CONSTANTS AND WORK AREAS
* 
* 
DCONOF	DATA	0	ON- / OFFLINESWITCH 
DCSTOL	DATA	0	OLD DC EQUIPMENT STATUS 
DCSTCU	DATA	0	CURRENT STATUS
DCWRQ	DATA	0	WRITE REQUEST QUEUE
DCTPGP	DATA	0	TIMER POINTER GENERAL POLL
DCLCI	DATA	0	DC UNIT INPUT STATUS 
	EJECT
* 
*	DC TASK ADDRESS BLOCK 
* 
	DATA	0	INDICATES NO MMU BUFFER 
	DATA	DEVIND	DEVICE INDEX 
DC15DC	DATA	DCACTD	ACTIVATION ADDRESS 
	DATA	ABORT	ABORT ROUTINE ADDRESS 
	DATA	DCRBUF	REC. BUFFER ANCHOR 
	DATA	6	HEADER LENGTH	=11 
* 
*	DRIVER ADDRESS BLOCK
* 
	DATA	BUFLEN	MMU BUFFER SIZE
	DATA	DEVIND	DEVICE INDEX 
DC15AD	DATA	DCACT	ACTIVATION ADDRESS
	DATA	ABORT	ABORT ROUTINE	ABORT ROUTINE ADDRESS 
	DATA	DCRBUF	REC. BUFFER ANCHOR 
	DATA	6	HEADER LENGTH	=11 
* 
	RES	15	SUBROUTINE STACK FOR INTERRUPTS 
STB	RES	1 
	RES	1	AND FOR TRANSFER PARAM 
STB2	RES	1

	IFT	SPEED=1
LSPEED	EQU	/0200
	XIF
	IFT	SPEED=0
LSPEED	EQU	0
	XIF
	EJECT
* 
* 
*	ACTIVATION FROM TERMINAL TASKS
* 
DCACT	EQU	* 
	LDK	A1,0	PRESET RETURN CODE
	IFT	EM3270=1		=4 
	LDR	A7,A7		=4
	RF(Z)	ANYMSG	ANY MESSAGE ORDER	=4
	XIF
	SUK	A7,/02 
	RF(Z)	DCRD	READ SPECIFIC 
	SUK	A7,/06-/02 
	RF(Z)	DCWR 
	SUK	A7,/37-/06 
	RF(Z)	DCTP	TRANSFER PARAMETERS 
	IFF	STAT=0 
	SUK	A7,/38-/37 
	RF(Z)	DCSS	SET STATUS
	SUK	A7,/39-/38 
	ABL(Z)	REQTIM	SET REQUEST TIMER
	XIF

	IFT	STAT=0 
	SUK	A7,/39-/37 
	RF(Z)	REQTIM	SET REQUEST TIMER 
	XIF
	RF	DCA100
	EJECT
* 
* 
*	ACTIVATION FROM DCTASK
* 
* 
DCACTD	EQU	*
	SUR	A1,A1	PRESET RETURN CODE	=4
	IFT	EM3270=1		=4 
	LDR	A7,A7		=4
	RF(Z)	ANYMSG	ANY MESSAGE ORDER	=4
	XIF
	SUK	A7,/02 
	RF(E)	DCRDDC	READ
	SUK	A7,/37-/02 
	RF(E)	DCTP	TRANSFER PARAMETERS 

DCA100	EQU	*	REQUEST ERROR
	ABL	DISIOE	INVALID ORDER 
* 
* 
*	READ FROM DCTASK
* 
* 
*	REQUEST FROM DC-TASK
*	COMPLETE WHEN:
*	  STATUS CHANGE ON DC EQUIPMENT 
*	  SPONTANOUS MESSAGE RECEPTION
* 
DCRDDC	EQU	*
	CF	A15,CKMESS	CHECK IF MESSAGE RECEIVED
DCRTN	EQU	* 
	ABL	TDISP	GO TO DISPATCHER 
	IFT	EM3270=1		=4 
	EJECT
***************************************** 
* 
*   ANY MESSAGE ORDER 
* 
***************************** 

ANYMSG	LD	A4,DWTRQ,A6	ANY QUEUED MESSAGE ??	=4
	RF(Z)	DCRD10	NO!!	=4 
	RF	ENDIO	YES!! COMPLETE REQUEST	=4 
	XIF
	EJECT
* 
* 
*	TRANSFER PARAMETERS 
* 
* 
*	REQUEST FROM DC-TASK: TRANSFER TERMINAL COMPUTER ADDRESS
*	        FROM TERMINALS: TRANSFER TERMINAL ADDRESSES 
* 
* 
	IFF	CODE=1 
DCTP	LD	A2,ECBCW,A8	GET PARAMETER 
	XIF
	IFT	CODE=1 
DCTP	LC	A2,ECBCW,A8	GET TCS IF ANY
	ANK	A2,/FF 
	RF(Z)	DCTP10 
	LC	A2,TASCII,A2	TRANSLATE TO ASCII 
	SLL	A2,8 
DCTP10	EQU	*
	LC	A3,ECBCW+1,A8	GET TCP OR DV 
	ANK	A3,/FF 
	LC	A2,TASCII,A3	TRANSLATE TO ASCII 
	XIF
	STR	A2,A6	SAVE IN FIRST WORD OF DWT

	IFT	RCOM=1 
	LD	A3,ECBBA,A8	DEVICE BUFFER ADDRESS 
	ST	A3,DWTBUF,A6
	LD	A3,ECBRL,A8	CURSOR ADDRESS WORD 
	ST	A3,DWTCUR,A6
	XIF
	CWK	A6,DW1500	DCTASK DWT ??? 
	RF(E)	DCTP30	YES!!!  SHOULD NOT BE IN DC:TAB 
	LD	A1,DC:IN	GET DC:TAB INPUT POINTER 
	CWK	A1,DC:END	TABLE ALREADY FULL ????
	ABL(E)	DISIOE	YES!! REQUEST ERROR
	EJECT


DCTP20	EQU	*
	LD	A4,DCTAB	DC:TAB ADDRESS	=3
	AD*	A4,DCTAB	LAST TABLE POS.	=3
DCTP22	SUK	A4,2	ADDR. TO NEXT ENTRY	=3
	CW	A4,DCTAB	ALL ENTRIES CHECKED??	=3 
	RF(E)	DCTP25	YES.DWT NOT IN TABLE	=3 
	CWR*	A6,A4	IN TABLE ??	=3
	RF(E)	DCTP30	YES!!	=3
	RB	DCTP22	CHECK NEXT ENTRY	=3
DCTP25	EQU	*		=3

	STR	A6,A1	INSERT DWT IN DC:TAB 
	LDK	A1,2 
	ADS	A1,DC:IN	UPDATE DC:TAB IN POINTER

	ADS	A1,DC:TAB	INCREMENT DC:TAB LENGTH
	IFT	STAT=1 
	LDK	A1,4	DEVICE END
	ORS	A1,DWTST,A6
	CF	A15,INSSQ	INSERT IN STATUS QUEUE
	XIF
DCTP30	EQU	*
	SUR	A1,A1	RETURN CODE ::= 0
ENDIO	EQU	* 
	CF	A15,TENDIO	COMPLETE REQUEST 
	RB	DCRTN 
	EJECT
* 
* 
*	WRITE 
* 
* 
*	COMPLETE WHEN:
*	  SUCCESFUL TRANSMISSION
*	  TIME OUT
* 
* 
DCWR	EQU	*
	IFT	MMUPAG=1 
	LD	A1,ECBRL,A8	REQUESTED LENGTH
	CWK	A1,BUFLEN	ILLEGAL LENGTH?
	RF(G)	IL:LEN	YES!! 
	XIF
	CF	A15,TIMEWR	SET TIMER
	CF	A15,INSWQ 	QUEUE REQUEST
	RB	DCRTN 
* 
* 
* 
*	READ
* 
* 
*	COMPLETE WHEN:
*	  MESSAGE RECEIVED
*	  TIME OUT
* 
* 
DCRD	EQU	*
	LD	A8,DWTECB,A6	GET ECB
	LD	A4,DWTRQ,A6	AND RECEIVE MESSAGE QUEUE 
	RF(Z)	DCRD10	NOTHING IN QUEUE



	LDR*	A2,A4	TAKE THE FIRST IN QUEUE 
	ST	A2,DWTRQ,A6 
	ADK	A4,6 
	LD	A3,-4,A4	EFFECTIVE LENGTH 
	ST	A3,ECBEL,A8 

	LDK	A1,0	RESET RETURN CODE 
	CF	A15,DC:MIN	MOV DATA TO USER BUFFER
	RB	DCRTN 

DCRD10	CF	A15,TIMERE	START TIMER
	RB	DCRTN 
	EJECT
* 
* 
*	SET STATUS
* 
* 
	IFF	STAT=0 
DCSS	EQU	*
	LD	A1,ECBCW,A8	GET STATUS INFORMATION
	ANK	A1,3	MASK DB,IR
	RF(Z)	DCSS20	DEVICE END
DCSS10	EQU	*
	ST	A1,DWTST,A6 
	RB	DCTP30	COMPLETE REQUEST 
DCSS20	EQU	*
	LD	A1,DWTST,A6 
	ANK	A1,9 
	RB(Z)	DCSS10	WACK HAS NOT BEEN SENT
DCSS30	EQU	*
	CF	A15,INSSQ	INSERT DWT IN STATUS QUEUE
	LDK	A1,4	SET DE
	RB	DCSS10
	XIF
	EJECT

* 
*   SET REQUEST TIMEOUT VALUE 
* 
* 

REQTIM	EQU	*
	LD	A2,ECBCW,A8	TIMEOUT VALUE 
	ST	A2,DWTTIM,A6	SAVE IT IN DWT 
	RB	DCTP30	TENDIO & DISPATCH

* 
*   ILLEGAL APPLICATION BUFFER SIZE 
* 

IL:LEN	LDKL	A1,/8008	REQUEST ERROR + ILLEGAL LENGTH 
	ABL	DISEND	COMPLETE REQUEST
	EJECT
* 
* 
* 
*	TIMER HANDLING PART 
* 
* 
* 
*	READ TIMER=TIMERR 
* 
TIMERE	EQU	*
	LDR	A1,A6
	LD	A2,DWTTIM,A6	GET REQUEST TIMEOUT VALUE
	RF(Z)	TIME10	NO TIMING 
	ST	A2,TIMERR 
	CF	A15,SETIME
	DATA	TOUTRE
TIMERR	DATA	0 
	ST	A4,DWTTP,A6	STORE TIMER POINTER 
TIME10	EQU	*
	RF	GBUF10	RETURN 
* 
*	TIMEOUT READ TIMER
* 
TOUTRE	EQU	*
	LDR	A6,A1	FETCH DWT
	CM	DWTTP,A6
TOUTR1	EQU	*
	LDK	A1,/40	INDICATE TIME OUT 
TOUTR2	RB	ENDIO	COMPLETE REQUEST
* 
*	WRITE TIMER=TIMWR 
* 
TIMEWR	LDR	A1,A6
	LD	A2,DWTTIM,A6	GET REQUEST TIMEOUT VALUE
	RB(Z)	TIME10	NO TIMING 
	ST	A2,TIMWR
	CF	A15,SETIME
	DATA	TOUTWR
TIMWR	DATA	0
	ST	A4,DWTTP,A6 
	RB	TIME10
	EJECT
* 
*	TIMEOUT WRITE TIMER 
* 
TOUTWR	EQU	*
	LDR	A6,A1	FETCH DWT
	CM	DWTTP,A6
	CF	A15,REMOVW	REMOVE FROM WRITE QUEUE
* 
*	THIS INSTRUCTION DOES NOT BELONG
*	TO THE STANDARD INTERFACE 
	LD	A2,FDWTUT 
	CWR	A2,A6
	RB(NE)	TOUTR1	THIS DWT IS NOT WRITING
	CM	XACK	INDICATE 'ACK NOT EXPECTED'
	CM	FDWTUT
* 
* 
	RB	TOUTR1
	EJECT
* 
* 
*	STOP REQUEST TIMING 
* 
*	REMAINING TIME IS RETURNED IN A2
* 
* 
CTIME	EQU	* 
	LD	A2,DWTTP,A6	GET TIMER POINTER 
	RF(Z)	CTIM10	NOT RUNNING 
	LDR*	A2,A2 
	NGR	A2,A2	GET REMAINING TIME 
	CM*	DWTTP,A6	STOP TIMER
	CM	DWTTP,A6
CTIM10	EQU	*
	RF	GBUF10
	EJECT
* 
*	GET RECEIVE BUFFER
* 
*	CALLING SEQUENCE: CF A15,GRBUF
*	A4=0 IF NO BUFFER IS FREE 
*	ELSE A4 CONTAINS BUFFER ADDRESS 
*	A2 AND A3 ARE DESTROYED 
* 
* 
GRBUF	LDKL	A2,DCRBUF	RECEIVE BUFFERS
GBUF	INH
	LDR*	A4,A2 
	RF(Z)	GBUF10	NO BUFFER FREE
	LDR*	A3,A4	REMOVE BUFFER FROM FREE CHAIN 
	STR	A3,A2
GBUF10	ADKL	A15,4	ADJUST STACK POINTER
	ABR*	A15	RETURN TO CALLER
	EJECT
* 
* 
*	INSERT DWT IN WRITE REQUEST QUEUE 
* 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
INSWQ	LDKL	A2,DCWRQ	GET QUEUE ANCHOR
INSWQ1	LDK	A4,DWTWQ 
INSWQ2	LDR*	A3,A2 
	RF(Z)	INSWQ3	END OF QUEUE FOUND
	LDR	A2,A3
	RB	INSWQ2
INSWQ3	ADR	A4,A6
	STR	A4,A2	INSERT IN QUEUE
	CMR	A4	INDICATE END OF QUEUE 
	RB	GBUF10	RETURN 
* 
* 
*	REMOVE DWT FROM WRITE REQUEST QUEUE 
* 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
REMOVW	LDKL	A2,DCWRQ	GET QUEUE ANCHOR 
REM05	LDK	A4,DWTWQ	GET DWT-LINK TO BE REMOVED 
REM06	EQU	* 
	ADR	A4,A6	 
REM10	LDR*	A3,A2
	RB(Z)	GBUF10	NOT ON QUEUE: RETURN
	CWR	A3,A4
	RF(E)	REM15
	LDR	A2,A3	GET NEXT 
	RB	REM10 
REM15	LDR*	A3,A4	REMOVE 
	STR	A3,A2
	RB	GBUF10	RETURN 
	EJECT
* 
* 
*	INSERT DWT IN STATUS QUEUE
* 
	IFF	STAT=0 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
INSSQ	LDKL	A2,DCSTQ	GET QUEUE ANCHOR
	LDK	A4,DWTSQ 
	RB	INSWQ2
* 
* 
*	REMOVE DWT FROM STATUS QUEUE
* 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
REMOVS	LDKL	A2,DCSTQ	GET QUEUE ANCHOR 
	LDK	A4,DWTSQ 
	RB	REM06 
	XIF
	EJECT
* 
* 
*	QUEUE ALLOCATED RECEIVE BUFFER
* 
*	A4=BUFFER ADDR
*	A2,A3 DESTROYED 
* 
QRBUF	EQU	* 
	IFT	MESPAS=1 
	LDKL	A2,DW1500	QUEUE ON DC-TASK DWT
	XIF
	IFT	MESPAS=0 
	LDR	A2,A6	QUEUE ON TERMINAL DWT
	XIF
	ADK	A2,DWTRQ	BEGINNING OF RECEIVE QUEUE
QR100	EQU	* 
	LDR*	A3,A2 
	RF(Z)	QR200	END OF QUEUE FOUND 
	LDR	A2,A3
	RB	QR100 
QR200	STR	A4,A2	INSERT INTO QUEUE 
	CMR	A4	INDICATE END OF QUEUE 
	RTN	A5 
	EJECT
* 
* 
*	CHECK IF UNEXPECTED MESSAGE OR STATUS CHANGE
* 
*	REGISTERS A1,A2,A3,A4,A6 AND A8 ARE DESTROYED 
* 
CKMESS	LDKL	A6,DW1500 
	LD	A1,DWTST,A6 
	RF(N)	CKM110	NO REQUEST
	LDK	A1,2	READ REQUEST ?
	CW	A1,DWTOR,A6 
	RF(NE)	CKM110	NO 
	LD	A8,DWTECB,A6	ECB ADDR TO A8 
	LD	A3,DWTRQ,A6	A3=ADDR TO READ QUEUE 
	RF(Z)	CKM200	NO READ IN QUEUE


	LDR*	A2,A3	A2=ADDR TO NEXT READ BUFFER 
	ST	A2,DWTRQ,A6	STORE THIS ADDR INTO QUEUE
	ADK	A3,6	MOVE POINTER TO TEXT
			DONT DESTROY BUFFER ADDRESS	=6 
	LD	A4,-4,A3
	ST	A4,ECBEL,A8	STORE NUMBERS OF CHARACTERS 
	LD	A4,-2,A3
	ST	A4,ECBCW,A8	STORE LINE DEVICE ADDRESS 

	LDK	A1,0	RESET RETURN CODE 
	LDR	A4,A3	RECEIVE BUFFER ADDRESS 
	CF	A15,DC:MIN	MOVE DATA TO USER BUFFER 
CKM110	ADKL	A15,4	ADJUST STACK POINTER
	ABR*	A15	RETURN
CKM200	LD	A1,DCSTCU	NO MESSAGE RECEIVED,CHECK STATUS
	OR	A1,DCONOF	TAKE CARE OF POLL TIME OUT
	CW	A1,DCSTOL 
	ST	A1,DCSTOL 
	RB(E)	CKM110	NO CHANGE OF STATUS 
	ORKL	A1,/2000	INDICATE STATUS CHANGE 
	CF	A15,TENDIO	COMPLETE READ GENERAL REQUEST
	RB	CKM110
	EJECT

************************************************************
* 
*    ABORT ROUTINE
* 
************************

ABORT	LD	A1,DWTTP,A6	TIMER POINTER
	RF(Z)	AB:10	NO TIMER RUNNING 
	CM*	DWTTP,A6	KILL TIMER
	CM	DWTTP,A6

AB:10	LD	A1,DWTOR,A6	ORDER CODE 
	SUK	A1,2 
	RF(Z)	AB:RTN	READ REQUEST. NO ACTION 
	SUK	A1,4 
	RF(NZ)	AB:RTN	NO ACTION IF NOT READ/WRITE

	CF	A15,REMOVW	REMOVE DWT FROM WRITE QUEUE
	LD	A2,FDWTUT	WRITING DWT ADDRESS 
	CWR	A2,A6
	RF(NE)	AB:RTN	NOT THIS DWT 
	CM	XACK	RESET ACK EXPECTED 
	CM	FDWTUT	RESET WRITING DWT

AB:RTN	EQU	*
	IFT	CPU852=1 
	ADKL	A15,4 
	ABR*	A15	RETURN IN INHIBIT MODE
	XIF
	IFF	CPU852=1 
	RTN	A15
	XIF
	EJECT

	EJECT
* 
* 
*	STORE REGISTER A3-A8
*	CALLING SEQUENSE: CF A15,STREG
* 
*	RESTORE 
*	CALLING SEQUENCE: CF A15,LDREG
* 
* 
STREG	ST	A3,LCA3
	ST	A4,LCA4 
	ST	A5,LCA5 
	ST	A6,LCA6 
	ST	A7,LCA7 
	ST	A8,LCA8 
	RF	RTNA15	RETURN 
	EJECT
LDREG	LDKL	A3,0 
LCA3	EQU	*-2
	LDKL	A4,0
LCA4	EQU	*-2
	LDKL	A5,0
LCA5	EQU	*-2
	LDKL	A6,0
LCA6	EQU	*-2
	LDKL	A7,0
LCA7	EQU	*-2
	LDKL	A8,0
LCA8	EQU	*-2
RTNA15	EQU	*
	ADKL	A15,4 
	ABR*	A15 
	EJECT
* 
* 
*	TIMER VALUES
* 
* 
TIMPRO	EQU	30	PROCEDURE TIMER 3 SEC 
* 
* 
*	CHARACTER EQUATES 
* 
SF	EQU	X'1D'	START FIELD CHARACTER
SYN	EQU	/16 
STX	EQU	/02 
ETX	EQU	/03 
ETB	EQU	/17 
ITB	EQU	/1F 
SOH	EQU	/01 
ENQ	EQU	/05 
DLE	EQU	/10 
EOT	EQU	/04 
NAK	EQU	/15 
ESC	EQU	/1B 
SBA	EQU	/11 
GP	EQU	/22
RDBCOM	EQU	/32
RDMCOM	EQU	/36
	IFT	CODE=0 
PAR	EQU	/80 
RVI	EQU	/3C 
ACK0	EQU	/30
ACK1	EQU	/31
DC1	EQU	/11 
	IFT	MSV1=0 
WACK	EQU	/3B
	XIF
	IFT	CODE=0 
	IFT	MSV1=1 
WACK	EQU	/BF	=WABT - SIEMENS MSV1 PROCEDURE 
	XIF
	IFT	CODE=1 
PAR	EQU	/00 
WACK	EQU	/2C
RVI	EQU	/40 
ACK0	EQU	/18
ACK1	EQU	/2F
SYNEBC	EQU	/32
ENQEBC	EQU	/2D
ETBEBC	EQU	/26
	XIF
	EJECT
* 
* 
*	PROCEDURE WORK AREAS
* 
* 
FDWTIN	RES	1	CURRENT DWT FOR RECEPTION
FDWTUT	RES	1	CURRENT DWT FOR TRANSMISSION 
XACK	DATA	0	ACK EXPECTED
XSEL	DATA	0	SELECTED
XETX	DATA	0	ETX SENT
XSTA	DATA	0	STATUS SENT / MESSAGE INPUT RESULT
XRB	DATA	0	READ BUFFER SWITCH 
CACK	DATA	0	ACK COUNTER 
SYNSW	DATA	0	0=SKIP SYNS, 1=DON'T SKIP
TPM	DATA	0	IF =1 TRANSPARENT TEXT 
* 
FECB	RES	1	WRITING ECB
FECBBA	RES	1	WRITING BUFFER ADDRESS 
FECBRL	RES	1	WRITING BUFFER LENGTH
FBAX	DATA	0	BUFFER INDEX
FBLST	DATA	0	START OF LAST TRANSMITTED BLOCK
DCSTQ	DATA	0	STATUS QUEUE ANCHOR
DCTPP	DATA	0	POINTER FOR PROCEDURE TIMING 
RESEND	DATA	0	CONTROL SEQUENCE SAVE AREA
* 
* 
*	3270 SENSE/STATUS INFORMATION 
* 
* 
	IFF	STAT=0 
SSTAB	EQU	*	S/S 0 : NO STATUS,DB,DE,DB+DE 
* 
* 
	DATA	/4248 
	DATA	/4242 
* 
NOIR	EQU	/20	S/S 1 : NO INTERVENTION REQUIRED 
IR	EQU	/26	S/S 1 : INTERVENTION REQUIRED
	XIF
	EJECT
* 
* 
*		LINE CONTROL UNIT  FUNCTION CONTROL
* 
	IFT	CODE=0 
SYNC	EQU	/16
	XIF
	IFT	CODE=1 
SYNC	EQU	/32
	XIF
	IFT	P6805=0
CBCARR	EQU	/100+LSPEED
	XIF
	IFT	P6805=1
CBSTOP	EQU	/00
	IFT	CODE=0 
PARITY	EQU	/0C
	XIF
	IFT	P6805=1
	IFT	CODE=1 
PARITY	EQU	/00
	XIF
	EJECT
* 
* 
*		LINE CONTROL UNIT SST STATUS BITS
* 
SBNOOP	EQU	/01	NOT OPERABLE 
SBTHRU	EQU	/02	THROUGHPUT ERROR 
SBCARR	EQU	/20	CARRIER OFF
	IFT	P6805=0
SBERR	EQU	/23	SBNOOP+SBTHRU+SBCARR
	XIF
	IFT	P6805=1
SBPARI	EQU	/04
SBERR	EQU	/27	SBNOOP+SBTHRU+SBPARI+SBCARR 
	XIF
	EJECT
* 
* 
*	BASIC RECEIVE MODE
* 
*	ENTERED EVERY TIME A MESSAGE
*	IS EXPECTED FROM THE MASTER SIDE
* 
* 
BRM	EQU	* 
	LDKL	A5,STB	LOAD STACKBASE 
	CM	SYNSW	CLEAR SYN-SWITCH
	CM	TPM	CLEAR TRANSPARENT TEXT
	CF	A5,CSYNCI	START INPUT WITH SYNC DEF 
* 
* 
* 
	CF	A5,READP	READ CHARACTER 
	RF(NZ)	BRM150	PARITY ERROR 
* 
* 
*		CHECK IF IT IS A CONTROL CHARACTER 
* 
	LDR	A1,A2
	SUK	A1,STX 
	RF(Z)	BRM300	STX RECEIVED
	SUK	A1,EOT-STX 
	RF(Z)	BRM200	EOT RECEIVED
	SUK	A1,ENQ-EOT 
	ABL(Z)	BRM400	ENQ RECEIVED 
	SUK	A1,DLE-ENQ 
	ABL(Z)	BRM600	DLE RECEIVED 
	SUK	A1,NAK-DLE 
	ABL(Z)	BRM500	NAK RECEIVED 
	EJECT
* 
* 
*		CHECK IF IT IS A POLL OR A SELECT SEQUENCE 
* 
	IFT	MSV1=0 
	LDR	A8,A2
	CF	A5,READP	READ CHARACTER 
	CWR	A2,A8
	RF(NE)	BRM150	INVALID SEQUENCE 
	XIF
	LDK	A3,0 
	CC	A2,DW1500+1 
	RF(E)	BRM110	POLLING 
	LDK	A3,2 
	CC	A2,DW1500 
	RF(NE)	BRM150	INVALID SEQUENCE 
BRM110	EQU	*
	CF	A5,READP	READ 1:ST STA
	RB(NZ)	BRM	PARITY ERROR
	LDR	A8,A2
	IFT	MSV1=0 
	CF	A5,READP	READ 2:ND STA
	CWR	A2,A8
	RF(NE)	BRM150	INVALID SEQUENCE 
	XIF
	CF	A5,READP	READ ENQ 
	SUK	A2,ENQ 
	RF(NE)	BRM150	INVALID SEQUENCE 
* 
* 
*		YES SEQUENCE OK - HALT INPUT 
* 
	CF	A5,CHALTI 
	EJECT
* 
* 
*		CHECK IF IT IS A SELECT OR A POLL ADDRESS
* 
	LDK	A1,1 
	ST	A1,CACK	LOAD ACK-COUNTER
	LDR	A2,A8
	SUK	A3,2 
	RF(Z)	BRM120	SELECTING 
* 
* 
*		POLLING
* 
	CWK	A8,GP
	ABL(E)	GPOLL	GENERAL POLL
	CF	A5,FINTEP	CHECK IF STA PRESENT (POLL ADDRESS) 
	LDR	A6,A3	LOAD DWT TO A6 
	ABL(NZ)	SPOLL	SPECIFIC POLL
	RB	BRM	INVALID POLL
* 
* 
*		SELECTING
* 
BRM120	EQU	*
	CF	A5,FINTER	CHECK IF STA PRESENT
	LDR	A6,A3	LOAD DWT TO A6 
	RF(NZ)	BRM130	STA FOUND
	IFT	MSV1=1 
	RB	BRM	INVALID ADDRESS 
	XIF
	IFT	MSV1=0 
	LDKL	A6,DW1500	SELECT TO DCTASK
	XIF
BRM130	EQU	*
	ABL	SELECT 
	EJECT
* 
* 
*		THROUGHPUT ERROR 
* 
BRM140	EQU	*
	CM	XSTA	INDICATE "INVALID MESSAGE" 
	LDKL	A5,STB	LOAD STACKBASE TO A5 
	CF	A5,CSYNCI	START INPUT WITH SYNC DEF 
* 
* 
*		WAIT FOR MARK HOLD TO RESYNC.
* 
BRM150	EQU	*
	CF	A5,READ	READ CHARACTER
	LD	A1,DCSTCU	ANY STATUS FROM CONTROL UNIT ?
	RF(NZ)	BRM160	YES
	ANK	A2,/7F 
	SUK	A2,/7F 
	RB(NZ)	BRM150	NO 
BRM160	EQU	*
	CF	A5,CHALTI	HALT INPUT
	RB	BRM 
	EJECT
* 
* 
*	EOT HAS BEEN RECEIVED 
* 
* 
BRM200	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	IFT	RCOM=1 
	CM	XRB	RESET READ BUFFER 
	XIF
	LD	A1,XACK 
	RF(Z)	BRM220	ACK IS NOT EXPECTED 
	LD	A6,FDWTUT	GET WRITING DWT 
	RF(Z)	BRM210	NO ONE WRITING
	LDK	A1,2	SET RC=2
	CF	A5,CWRITE	COMPLETE WRITE REQUEST
BRM210	EQU	*
	CM	XACK	RESET 'ACK EXPECTED' 
BRM220	EQU	*
	CM	XSEL	RESET 'SELECTED' 
	RB	BRM 
	EJECT
* 
* 
*	STX HAS BEEN RECEIVED 
* 
* 
BRM300	EQU	*
	CF	A5,HPTIM
	IFT	TPMODE=1 
	RB	BRM150	INVALID SEQENCE
BRM302	EQU	*
	XIF
	LD	A1,XSEL 
	RF(Z)	BRM315	NOT SELECTED
	LD	A1,DCRBUF 
*********************CHAINED COMMAND
	RB(Z)	BRM150	NO BUFFER AVAILABLE 
********************* 
BRM305	EQU	*
	CF	A5,RDMESS	READ MESSAGE
	SUK	A7,1 
	RF(NZ)	BRM320	MESSAGE OK 
BRM310	EQU	*
	CM	XSTA	INDICATE 'INVALID MESSAGE' 
BRM312	EQU	*
	CF	A5,TRNAK	SEND NAK 
	ABL	BRM
BRM315	EQU	*
	IFT	RCOM=1 
	LD	A1,XACK 
	RF(Z)	BRM316	ACK IS NOT EXPECTED 
	LD	A1,DCRBUF 
	RF(Z)	BRM316	NO BUFFER AVAILABLE 
	LD	A6,FDWTUT	GET WRITING DWT 
	ABL(Z)	BRM150	NO ONE WRITING. RESYNCHRONIZE
	LDR*	A2,A6	GET STA 
	XIF
	IFT	RCOM=1 
	CF	A5,PRREC	PREPARE FOR TEXT RECEPTION 
	LDK	A1,0	SET RC=0
	CF	A5,CWRITE	COMPLETE WRITE REQUEST
	CM	CACK	PRESET ACK-1	=7
	RB	BRM305	READ THE MESSAGE 
	XIF
BRM316	CF	A5,READ	READ ONE CHARACTER
	IFF	P6805=1		=8
	SUK	A2,ENQ+PAR 
	XIF			=8 
	IFT	P6805=1		=8
	SUK	A2,ENQ		=8 
	XIF			=8 
	RB(Z)	BRM312	FORWARD ABORT SEQUENCE
	RB	BRM220
BRM320	EQU	*
	IM	XSTA	INDICATE MESSAGE OK
	LD	A4,DCRBUF	GET BUFFER ADDRESS
	ADK	A4,6 
	CW	A4,FBLST
	RF(NE)	BRM325	NOT FIRST BLOCK
	IFF	RCOM=0 
	LDK	A1,ESC 
	CCR	A1,A4
	RB(NE)	BRM310	ESC NOT FOUND
	ADK	A4,1 
	LCR	A1,A4	GET COMMAND CODE 
	SUK	A4,1 
	SUK	A1,RDBCOM
	RF(Z)	RDBUF	READ MODIFIED RECEIVED 
	SUK	A1,RDMCOM-RDBCOM 
	RF(Z)	RDMOD	READ BUFFER RECEIVED 
	XIF
BRM325	EQU	*
	SUK	A7,1 
	RF(Z)	BRM340	MESSAGE ENDED BY ETB
	CM	FBAX
	CF	A15,GRBUF	ALLOCATE RECEIVE BUFFER 
	ADK	A4,6 
	LD	A6,FDWTIN	GET INPUT DWT 
* 
*	PREPARE FOR CHAINED COMMAND 
* 
	IFT	RCOM=1 
	LDR*	A2,A6 
	LC	A2,TEBCDIC,A2 
	LD	A1,DCRBUF 
	RF(Z)	BRM326 
	ST	A2,+4,A1
	XIF
BRM326	EQU	*
	CWK	A6,DW1500
	RF(E)	BRM330	MESSAGE IS MENT FOR DCTASK
	LD	A2,DWTST,A6	GET STATUS
	RF(N)	BRM330	NO REQUEST
	IFT	EM3270=1		=4 
	LD	A2,DWTOR,A6	ORDER	=4
	RF(Z)	BRM327	ANY MESSAGE ORDER	=4
	XIF			=4 
	LDK	A2,2 
	CW	A2,DWTOR,A6 
	RF(NE)	BRM330	NO READ REQUEST
BRM327	EQU	*
	LDK	A1,0	SET RC=0
	LD	A8,DWTECB,A6	GET ECB ADDRESS
	LD	A3,-4,A4	GET LENGTH 
	ST	A3,ECBEL,A8	STORE EFFECTIVE LENGTH
	CF	A15,CTIME	STOP REQUEST TIMING 
	ST	A2,ECBCW,A8	STORE REMAINING TIME
	EJECT
* 
* 
*	CHECK IF START PRINTER BIT SET IN CCC/WCC 
* 
* 
	IFT	STAT=1 
	LC	A2,+2,A4	GET WCC/CCC
	ANK	A2,/FF 
	LC	A2,TEBCDI,A2	TRANSLATE
	ANK	A2,8 
	RF(Z)	BRM328 
	LD	A2,DWTST,A6	GET STATUS
	ORK	A2,/A
	ST	A2,DWTST,A6 
BRM328	EQU	*
	XIF
	IFT	EM3270=1		=4 
	LD	A2,DWTOR,A6	ORDER	=4
	RF(NZ)	BRM329	NOT ANY MESSAGE ORDER	=4 
	SUK	A4,6	ADJUST BUFFER ADDRESS	=4
	CF	A5,QRBUF	QUEUE MESSAGE ON DWT	=4
	RF	BRM32A		=4
	XIF		=4
BRM329	EQU	*		=4

	LDK	A1,0	RESET RETURN CODE 
	CF	A15,DC:MIN	MOVE TO USER BUFFER
	RF	BRM345
BRM32A	EQU	*		=4

	CF	A15,TENDIO	COMPLETE REQUEST 
	RF	BRM345
	EJECT
BRM330	EQU	*
	IFT	EM3270=1		=4 
	LD	A1,DWTST,A6	STATUS	=4 
	RF(N)	BRM335	NO REQUEST	=4 
	LD	A1,DWTOR,A6	ORDER	=4
	RF(NZ)	BRM335	NOT ANY MESSAGE ORDER	=4 
	CF	A15,TENDIO	COMPLETE REQUEST	=4
BRM335	EQU	*		=4
	XIF			=4 
	SUK	A4,6	GET BUFFER BASE 
	CF	A5,QRBUF	QUEUE BUFFER FOR DCTASK
	CF	A15,CKMESS	COMPLETE DCTASK READ IF ANY
BRM340	EQU	*
	CF	A5,TRACK	SEND ACK 0/1 
	ABL	BRM
BRM345	EQU	*
	IFT	STAT=1 
	LD	A1,DWTST,A6 
	ANK	A1,8 
	RB(Z)	BRM340	ACK SHOULD BE SENT
	CF	A5,TRWACK	SEND WACK 
	RF	BRM410
	XIF
	IFF	STAT=1 
	RB	BRM340
	XIF
	EJECT
* 
* 
*	READ MODIFIED OR READ BUFFER RECEIVED 
* 
* 
	IFF	RCOM=0 
RDBUF	EQU	*	READ BUFFER COMMAND 
RDMOD	EQU	* 
	CM	XSEL	RESET SELECT EXPECTED
	LD	A6,FDWTIN	DWT-ADDRESS FOR ADDRESSED TERMINAL
	LD	A4,DWTBUF,A6	BUFFER ADDRESS 
	SUK	A4,2	SDJUST BUFFER ADDRESS 
	LDKL	A3,1922	REQUESTED LENGTH
	IM	XRB	SET READ BUFFER SWITCH
	CM	FDWTUT
	LDK	A1,1 
	XRS	A1,CACK	INCREMENT ACK COUNTER
	ABL	POL127 
	XIF
	EJECT
* 
* 
*	ENQ HAS BEEN RECEIVED 
* 
* 
BRM400	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	LD	A1,XACK 
	RF(NZ)	BRM510	RETRANSMISSION OF MESSAGE
	OR	A1,XSEL 
	RF(Z)	BRM410	IN CONTROL STATE
	CF	A5,TRREP	REPEAT LAST CONTROL SEQUENCE 
BRM410	EQU	*
	ABL	BRM
	EJECT
* 
* 
*	NAK HAS BEEN RECEIVED 
* 
* 
BRM500	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	LD	A1,XACK 
	RF(NZ)	BRM510	ACK EXPECTED 
	OR	A1,XSEL 
	RB(Z)	BRM410	IN CONTROL STATE
	RF	BRM636
BRM510	EQU	*
	LD	A6,FDWTUT	GET WRITING DWT 
	IFF	STAT=0 
	LD	A1,XSTA 
	ABL(NZ)	POL050	STATUS HAS BEEN TRANSMITTED 
	XIF
	LD	A1,FBLST	GET START POINT FOR LAST BLOCK 
	SU	A1,FECBBA	COMPUTE BUFFER INDEX
	ST	A1,FBAX 
	ABL	POL130 
	EJECT
* 
* 
*	DLE HAS BEEN RECEIVED 
* 
* 
BRM600	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	LD	A1,XACK 
	RF(NZ)	BRM605
	IFT	TPMODE=1 
	CF	A5,READ 
	CWK	A2,STX 
	ABL(Z)	BRM302	YES - TRANSPARENT TEXT 
	XIF
	RB	BRM410
BRM605	EQU	*
	CF	A5,READ	READ SECOND CHARACTER 
	IFF	P6805=1		=8
	CWK	A2,ACK0+PAR
	XIF			=8 
	IFT	P6805=1		=8
	CWK	A2,ACK0		=8
	XIF			=8 
	RF(NE)	BRM620
* 
*	ACK , 0 RECEIVED
* 
	LD	A1,CACK	GET ACKCOUNTER
	RF(Z)	BRM630	ACK,0 EXPECTED
BRM610	EQU	*
	CF	A5,TRENQ	SEND ENQ 
	CF	A5,SPTIM	START PROCEDURE TIMER
	RB	BRM410
BRM620	EQU	*
	CWK	A2,ACK1
	RF(NE)	BRM650
* 
*	ACK , 1 RECEIVED
* 
	LD	A1,CACK	GET ACK COUNTER 
	RB(Z)	BRM610	ACK,1 NOT EXPECTED
BRM630	EQU	*
	LD	A1,XETX 
	RF(Z)	BRM640	ETX NOT SENT
	EJECT
* 
*	ACK HAS BEEN RECEIVED TO AN ETX BLOCK 
* 
	LDK	A1,0	SET RC=0
BRM635	EQU	*
	IFF	STAT=0 
	LD	A2,XSTA 
	RF(NZ)	BRM670	STATUS HAS BEEN TRANSMITTED
	XIF
	CF	A5,CWRITE	COMPLETE WRITE REQUEST
BRM636	EQU	*
	CF	A5,TREOT	SEND EOT 
	IFT	RCOM=1 

	CM	XRB	RESET READ BUFFER 
	XIF
	RB	BRM410
BRM640	EQU	*
	LDK	A1,1 
	XRS	A1,CACK	INCREMENT ACK COUNTER
	ABL	POL130 
BRM650	EQU	*
	IFF	P6805=1		=8
	CWK	A2,RVI+PAR 
	XIF			=8 
	IFT	P6805=1		=8
	CWK	A2,RVI		=8 
	XIF			=8 
	RB(NE)	BRM610	INVALID DLE SEQUENCE 
	CM	XACK	RESET 'EXPECTING ACK'
	LD	A1,XETX 
	RF(NZ)	BRM660	ETX HAS BEEN SENT
	LDK	A1,2	SET RC=2
	RB	BRM635
BRM660	EQU	*
	LDK	A1,0	SET RC=0
	RB	BRM635
	IFF	STAT=0 
	EJECT
* 
* 
*	STATUS HAS BEEN TRANSMITTED 
* 
* 
BRM670	EQU	*
	LD	A6,FDWTUT	GET DWT ADDRESS 
	CF	A15,REMOVS	REMOVE FROM STATUS QUEUE 
	CM	XSTA	CLEAR 'STATUS SENT'
	CM	XACK	CLEAR 'ACK EXPECTED' 
	LD	A1,DWTST,A6	GET STATUS
	ANK	A1,4 
	RB(Z)	BRM636	NOT DE
	LDKL	A1,/8000
	ANS	A1,DWTST,A6	CLEAR STATUS 
	RB	BRM636
	XIF
	EJECT
* 
* 
*	SELECT HAS BEEN RECEIVED
* 
* 
SELECT	EQU	*
	LD	A1,XACK		=5 
	RF(NZ)	POL010	ERROR. ACK EXPECTED	=5 
	IFF	STAT=0 
	LD	A1,DWTST,A6	GET STATUS
	LDR	A3,A1
	ANK	A1,1 
	RF(Z)	SEL110	NO PENDING STATUS 
	CF	A5,TRRVI	SEND RVI 
	XIF
	IFF	STAT=1 
	RF	SEL110
	XIF
SEL100	EQU	*
	ABL	BRM
SEL110	EQU	*
	IFT	STAT+NOWACK=1
	ANK	A3,8 
	RF(NZ)	SEL115	BUSY 
	XIF
	IFT	STAT+NOWACK=2
	ANK	A3,8 
	RF(Z)	SEL111	DEVICE NOT BUSY 
	CF	A5,TRWACK	TRANSMIT WACK 
	ABL	BRM
SEL111	EQU	*
	XIF
	LD	A1,DCRBUF 
	RF(NZ)	SEL120	BUFFER AVAILABLE 
SEL115	EQU	*
	IFF	STAT+NOWACK=2
	CF	A5,TRWACK	SEND WACK 
	XIF
	RB	SEL100
SEL120	EQU	*
	CF	A5,PRREC	PREPARE FOR TEXT RECEPTION 
	ADK	A1,6 
	ST	A1,FBLST
	CF	A5,TRACK	SEND ACK,0 
	RB	SEL100
	EJECT
* 
* 
*	PREPARE FOR TEXT RECEPTION
* 
* 
PRREC	EQU	* 
	IM	XSEL	SET 'SELECTED' 
	CM	FBAX	RESET BUFFER INDEX 
	IFT	CODE=1 
	LC	A2,TEBCDIC,A2	TRANSLATE STA TO EBCDIC 
	XIF
	ST	A2,+4,A1	SAVE STA IN BUFFER 
	IM	XSTA
	ST	A6,FDWTIN	STORE INPUT DWT 
	RTN	A5 
	EJECT
* 
* 
*	GENERAL POLL HAS BEEN RECEIVED
* 
* 
GPOLL	EQU	* 
	LD	A1,XACK		=5 
	RF(Z)	POL020	ACK NOT EXPECTED	=5 
POL010	CF	A5,TRENQ	SEND ENQ	=5
	CF	A5,SPTIM	START PROCEDURE TIMER	=5 
	ABL	BRM	WAIT FOR RESPONSE	=5 
POL020	EQU	*		=5
	CF	A5,CPTIM	CHECK POLL TIMER 
	IFF	STAT=0 
	LD	A6,DCSTQ	 
	RF(Z)	POL110	NO STATUS TO BE SENT
	SUK	A6,DWTSQ	GET DWT ADDRESS 
POL050	EQU	*
	CF	A5,TRSTA	SEND STATUS
	CF	A5,SPTIM	START PROCEDURE TIMER
	IM	XACK	SET 'ACK EXPECTED' 
	XIF
	IFF	STAT=1 
	RF	POL110
	XIF
POL100	EQU	*
	ABL	BRM
POL110	EQU	*
	LD	A6,DCWRQ
	RF(NZ)	POL120	WRITE ON QUEUE 
POL115	EQU	*
	CF	A5,TREOT	SEND EOT 
	RB	POL100
POL120	EQU	*
	SUK	A6,DWTWQ	GET DWT ADDRESS 
POL125	EQU	*
	LD	A8,DWTECB,A6	GET ECB ADDRESS
	RF(NZ)	POL126
	CF	A15,REMOVW
	RB	POL115
POL126	EQU	*
	ST	A8,FECB	SAVE ECB ADDRESS
	ST	A6,FDWTUT	SAVE A6 

	IFF	MMUPAG=0 
	LDKL	A4,MMUBUF	MMU WORK BUFFER 
	ST	A4,ECBBA,A8 
	CF	A15,DC:MOT	MOVE DATA FROM USER BUFFER 
	XIF
	LD	A4,ECBBA,A8	GET BUFFER ADDRESS
	LD	A3,ECBRL,A8	GET LENGTH
POL127	EQU	*
	ST	A4,FECBBA	SAVE BUFFER ADDRESS 
	SUK	A3,2	SKIP FIRST WORD OF BUFFER 
	ST	A3,FECBRL	SAVE LENGTH 
	CM	FBAX	RESET BUFFER INDEX 
POL130	EQU	*
	CM	XETX	RESET 'ETX SENT' 
	CM	XSTA
	CF	A5,TRTEXT	SEND ONE BLOCK
	CF	A5,SPTIM	START PROCEDURE TIMER
	IM	XACK	SET 'ACK EXPECTED' 
	RB	POL100
	EJECT
* 
* 
*	SPECIFIC POLL HAS BEEN RECEIVED 
* 
* 
SPOLL	EQU	* 
	IFF	STAT+SPECP=0 
	LD	A1,XACK		=5 
	RB(NZ)	POL010	ACK EXPECTED	=5
	LDR	A7,A6	SAVE A6
	CF	A5,CPTIM	CHECK POLLTIMER
	LDR	A6,A7	RESTORE A6 
	IFT	STAT=1 
	LD	A1,DWTST,A6	GET STATUS
	ANK	A1,7 
	RB(NZ)	POL050	PENDING STATUS 
	XIF
	IFF	STAT+SPECP=0 
	LD	A1,DWTST,A6 
	RB(N)	POL115	NO REQUEST
	LD	A1,DWTOR,A6	GET ORDER 
	SUK	A1,6 
	RB(Z)	POL125	WRITE REQUEST 
	SUK	A1,2 
	RB(Z)	POL125	EXCHANGE REQUEST
	XIF
	RB	POL115	SEND EOT 
	EJECT
* 
* 
*	CHECK IF THERE IS A WRITE REQUEST TO BE COMPLETED 
* 
*	A1 CONTAINS RETURN CODE 
* 
* 
CWRITE	LD	A6,FDWTUT 
	RF(Z)	CWR900	NO WRITE GOING ON 
	LD	A2,DWTST,A6 
	RF(N)	CWR900	NO REQUEST
	LD	A2,DWTOR,A6	GET ORDER 
	SUK	A2,6 
	RF(Z)	CWR100	WRITE REQUEST 
	SUK	A2,2 
	RF(NZ)	CWR900	NOT EXCHANGE REQUEST 
	LDR	A1,A1
	RF(NZ)	CWR100	TRANSMISSION ERROR, RC NOT ZERO
	LDK	A2,2	TRANMISSION OK
	ST	A2,DWTOR,A6	INDICATE READ ORDER 
	RF	CWR150
CWR100	LD	A8,FECB	GET ECB ADDRESS 
	CF	A15,CTIME	STOP TIMING 
	LDR	A8,A8
	RF(Z)	CWR150 
	ST	A2,ECBCW,A8 
	CF	A15,TENDIO	COMPLETE REQUEST 
CWR150	EQU	*
	CF	A15,REMOVW	REMOVE FROM WRITE QUEUE
CWR200	EQU	*
CWR900	EQU	*
	CM	XACK	RESET 'ACK EXPECTED' 
	CM	FDWTUT
	RTN	A5 
	EJECT
* 
* 
*	READ ONE TEXT BLOCK 
* 
*	ON EXIT A3 CONTAINS : 
*	0 : IF CORRECT ETX BLOCK RECEIVED 
*	1 : IF LRC OR PARITY ERROR , BUFFER OVERFLOW
*	2 : IF CORRECT ETB BLOCK RECEIVED 
* 
RDMESS	EQU	*
	LD	A4,DCRBUF	GET BUFFER ADDRESS
	ADK	A4,6	RESERVE HEADER
	LDK	A3,0 
	LD	A1,XSTA 
	RF(NZ)	RDM050	LAST INPUT WAS OK
	LD	A1,FBLST	COMPUTE NEW INDEX
	SUR	A1,A4
	ST	A1,FBAX 
RDM050	EQU	*
	AD	A4,FBAX	ADD BUFFER INDEX
	ST	A4,FBLST	REMEMBER START OF BLOCK
RDM075	EQU	*
	CM	XSTA
	LDK	A7,0	RESET LRC 

	IFT	IBMCHR=1 
	IFF	TPMODE=1 
	LD	A1,FBAX 
	RF(NZ)	RDM100	NOT FIRST BLOCK
	CF	A5,READP
	RF(NZ)	RDM120	PARITY ERROR 
	CWK	A2,ESC 
	RF(NE)	RDM110
	CF	A5,READP	SKIP NEXT TWO CHARACTERS 
	CF	A5,READP
	XIF
	IFF	TPMODE=1 
RDM100	EQU	*
	CF	A5,READP	READ ONE CHARACTER 
	RF(NZ)	RDM120	PARITY ERROR 
RDM110	EQU	*
	XIF
	IFT	TPMODE=1 
	IM	TPM	INDICATE TRANSPARENT TEXT 
RDM100	CF	A5,READ 
	CWK	A2,DLE	CHECK IF DLE
	RF(NE)	RDM112	NO 
	CF	A5,READ	SKIP DLE AND READ NEXT CHARACTER
	CWK	A2,SYNEBC	CHECK IF SYN 
	RB(E)	RDM100	SKIP SYN
	CF	A5,CRCCAL	CALCULATE CRC 
	CWK	A2,DLE	CHECK IF 2:ND DLE 
	RF(E)	RDM115	YES - STORE DLE AS DATA 
	CWK	A2,ETX	CHECK IF ETX
	RF(E)	RDM130	YES 
	CWK	A2,ETBEBC	CHECK IF ETB 
	RF(E)	RDM160	YES 
	CWK	A2,ITB	CHECK IF ITB
	RF(E)	RDM175	YES 
	CWK	A2,ENQEBC	CHECK IF ENQ 
	RF(E)	RDM135	YES SEND NAK
* 
* 
*	GET END OF BLOCK
* 
RDM105	EQU	*
	CF	A5,READ 
	CWK	A2,DLE 
	RB(NE)	RDM105
	CF	A5,READ 
	CWK	A2,ETX 
	RF(E)	RDM110	YES - END OF BLOCK
	CWK	A2,ETBEBC
	RF(E)	RDM110	YES - END OF BLOCK
	RB	RDM105
RDM110	EQU	*
	CM	TPM	OUT OF TRANSPARENT TEXT 
	CF	A5,RDCRC
	RF	RDM140	INDICATE INVALID MESSAGE 
RDM112	CF	A5,CRCCAL	CALCULATE CRC 
	XIF
	IFF	TPMODE=1 
	CWK	A2,ETX 
	RF(E)	RDM130	ETX RECEIVED
	CWK	A2,ETB 
	RF(E)	RDM160	ETB RECEIVED
	CWK	A2,ITB 
	RF(E)	RDM170	ITB RECEIVED
	CWK	A2,ENQ 
	RF(E)	RDM120	SKIP IF ENQ EMBEDDED IN MESSAGE 
	CWK	A2,/FF 
	RF(E)	RDM140	MARK HOLD RECEIVED

	IFT	CODE=0 
	IFT	BINTRM=1 

	LDR	A1,A2
	SUK	A1,DC1+3 
	RF(P)	RDM115	NOT DC1-DC3 
	ADK	A1,3 
	RF(N)	RDM115	NOT DC1-DC3 
	SLL	A1,6 
	LDR	A8,A1
	CF	A5,READP	8-BIT CHAR GET NEXT PART 
	RF(NZ)	RDM120	PARITY ERROR 
	SUK	A2,/20	ASSEMBLE TO ONE CHARACTER 
	ORR	A2,A8
	XIF
RDM115	EQU	*

	SCR	A2,A4	STORE CHARACTER
	ADK	A4,1	INCREMENT POINTER 
	IM	FBAX	INCREMENT BUFFER INDEX 
	LD	A1,FBAX 
	CWK	A1,RBUFL+RBUFL 
	RB(NG)	RDM100	NOT OVERFLOW 
	IFT	TPMODE=1 
	RF	RDM135
	XIF
* 
*	BUFFER OVERFLOW 
* 
	RF	RDM140	ABORT INPUT
RDM120	EQU	*
	LDK	A3,1	INDICATE INVALID MESSAGE
	SUK	A2,/7F 
	RF(Z)	RDM150	MARK HOLD RECEIVED
	RB	RDM100
* 
*	ETX RECEIVED
* 
RDM130	EQU	*
	LD	A1,DCRBUF	GET BUFFER ADDRESS
	LD	A2,FBAX	GET BUFFER INDEX
	ST	A2,+2,A1	STORE EFFECTIVE LENGTH IN HEADER 
	IFF	CODE=1 
	CF	A5,RDLRC
	RF(Z)	RDM150	LRC WAS OK
	XIF
	IFT	TPMODE=1 
	CM	TPM	OUT OF TRANSPARENT TEXT 
	XIF
	IFT	CODE=1 
	CF	A5,RDCRC	READ CRC AND CHECK IT
	RF(E)	RDM150	CRC WAS OK
	XIF
	IFT	TPMODE=1 
RDM135	CM	TPM	OUT OF TRANSP TEXT
	XIF
RDM140	EQU	*
	LDK	A3,1	INDICATE INVALID MESSAGE
RDM150	EQU	*
	LDR	A7,A3	SAVE RESULT REGISTER 
	CF	A5,CHALTI	HALT INPUT
	IFT	P6805=1
	IFT	CODE=0 
	ANK	A2,SBPARI
	RF(Z)	RDM155 
	LDK	A7,1	PARITY ERROR
RDM155	EQU	*
	XIF
	RTN	A5 
* 
*	ETB RECEIVED
* 
RDM160	EQU	*
	LDR	A3,A3
	RB(NZ)	RDM130	ALREADY INVALID
	LDK	A3,2	INDICATE CORRECT ETB
	RB	RDM130
* 
*	ITB RECEIVED
* 
RDM170	EQU	*
	IFF	CODE=1 
	CF	A5,RDLRC
	RB(NZ)	RDM120	LRC WAS NOT OK 
	XIF
	IFT	CODE=1 
	CF	A5,RDCRC	READ CRC AND CHECK IT
	RB(NE)	RDM120	CRC WAS NOT OK 
	IFT	TPMODE=1 
RDM175	CM	TPM	OUT OF TRANSPARENT TEXT 
	CF	A5,RDCRC	READ AND CHECK CRC 
	IM	TPM 
	RB(NE)	RDM105	CRC WAS NOT OK 
RDM180	CF	A5,READ 
	CWK	A2,SYNEBC
	RB(E)	RDM180	SKIP SYN
	CWK	A2,DLE 
	RB(NE)	RDM105	ILLEGAL CHARACTER
	CF	A5,READ 
	CWK	A2,STX 
	RB(NE)	RDM105	ILLEGAL CHARACTER
	XIF
	RB	RDM100
	EJECT
* 
*	TRANSMIT ACK 0 OR 1 
* 
TRACK	LDK	A2,1
	LDK	A3,ACK1	PRELOAD ACK1 
	XRS	A2,CACK	INCREMENT ACK COUNTER
	RF(NZ)	TRDLE 
	LDK	A3,ACK0	LOAD ACK0
	RF	TRDLE 
* 
*	TRANSMIT WACK 
* 
TRWACK	LDK	A3,WACK	LOAD WACK
	RF	TRDLE 
* 
*	TRANSMIT RVI
* 
	IFF	STAT=0 
TRRVI	LDK	A3,RVI	LOAD RVI 
	XIF
* 
*	TRANSMIT DLE
* 
TRDLE	LDK	A2,DLE	LOAD DLE 
	SC	A2,RESEND	PUT INSAVE AREA 
	SC	A3,RESEND+1	
	RF	TRREP 
	EJECT
* 
*	TRANSMIT NAK
* 
TRNAK	LDK	A3,NAK	LOAD NAK 
	RF	TREN10
* 
*	TRANSMIT EOT
* 
TREOT	LDK	A3,EOT	LOAD EOT 
	RF	TREN10
* 
*	TRANSMIT ENQ
* 
TRENQ	LDK	A3,ENQ	LOAD ENQ 
* 
TREN10	SC	A3,RESEND	PUT IN SAVE AREA
	LDK	A2,/FF 
	SC	A2,RESEND+1 
TRREP	CF	A5,TRSYNC	START OUTPUT 
	LC	A2,RESEND	GET FIRST CHARACTER 
	CF	A5,WRITEP	SEND IT 
	LC	A2,RESEND+1	GET NEXT CHARACTER
	CF	A5,WRITEP	SEND IT 
TRRE10	LDK	A2,/FF 
	CF	A5,WRIT05	SEND PAD
	LDK	A2,/FF 
	CF	A5,WRIT05 
	CF	A5,CHALTO	HALT OUTPUT 
	IFF	LOGG=0 
	CF	A5,LOGSST	LOG TRANSMITTER STATUS
	XIF
	RTN	A5 
	EJECT
* 
* 
*	TRANSMIT ONE TEXT BLOCK 
* 
* 
TRTEXT	EQU	*
	CF	A5,TRSYNC	START OUTPUT
	IFF	TPMODE=1 
	IFT	TSTREQ=1 
* 
* 
*	TEST REQUEST HANDLING 
* 
* 
	LD	A4,FBAX 
	RF(NZ)	TRT050	NOT START OF MESSAGE 

	LD	A1,XRB	READ BUFFER COMMAND IN PROCESS ??? 
	RF(NZ)	TRT050	YES !! 

	LD	A4,FECBBA 
	LC	A3,+2,A4	GET AID CHARACTER
	SUK	A3,/30 
	RF(NZ)	TRT050	NOT TEST REQUEST 
	LDK	A2,SOH 
	CF	A5,WRITE	SEND SOH 
	LDK	A7,0	RESET BCC 
	LDK	A2,'%' 
	CF	A5,WRITE	SEND % 
	LDK	A2,'/' 
	CF	A5,WRITE	SEND / 
	LDK	A2,STX 
	CF	A5,WRITE	SEND STX 
	ST	A4,FBLST	REMEMBER START OF BLOCK
	ADK	A4,5	SKIP AID + CURSOR ADDRESS 
	LDK	A3,5	ADJUST LENGTH 
	LDK	A2,3 
	ST	A2,FBAX 
	RF	TRT100
TRT050	EQU	*
* 
* 
* 
	XIF
	IFT	TPMODE=1 
	LDK	A2,DLE 
	CF	A5,WRIDLE	SEND DLE
	XIF
	LDK	A2,STX 
	CF	A5,WRITE	SEND STX 
	LDK	A7,0	RESET LRC 
	LD	A4,FECBBA	GET BUFFER ADDRESS
	AD	A4,FBAX	ADD BUFFER INDEX
	ST	A4,FBLST	REMEMBER START OF BLOCK
	ADK	A4,2	SKIP FIRST WORD OF BUFFER 
	LDK	A3,0	RESET CHARACTER COUNTER 
	LD	A1,FBAX	GET BUFFER INDEX
	RF(NZ)	TRT100	NOT FIRST BLOCK
	LC	A2,DW1500+1	GET TCA 
	CF	A5,WRITEP	SEND TCA
	LDR*	A2,A6	GET STA 
	CF	A5,WRITEP	SEND STA
	IFT	IBMCHR=1 
	IFF	RCOM=1 
	LDK	A2,/27	SEND ENTER AS AID 
	CF	A5,WRITEP 
	LDK	A2,/20	AND CURSOR ADDRESS
	CF	A5,WRITEP 
	LDK	A2,/20 
	CF	A5,WRITEP 
	XIF
	IFT	RCOM=1 

	LD	A1,XRB	READ BUFFER COMMAND ???
	RF(Z)	TRT070	NO!!

			******************** 
	LDK	A2,X'2D'	AID FOR DISPLAY 
TRT060	CF	A5,WRITEP	SEND AID

	LD*	A3,DWTCUR,A6	CURSOR ADDRESS
	CF	A5,LINCOL	SEND LINE AND COLUMN NUMBER 
	LDK	A3,5	SET BLOCK COUNT 
	RF	TRT100
TRT070	EQU	*
	XIF

	LDK	A3,2 
TRT100	EQU	*
	IFT	TPMODE=1 
	IM	TPM	TRANSPARENT TEXT
TRT105	EQU	*
	XIF
	LCR	A2,A4	GET ONE CHARACTER
	ADK	A4,1	INCREMENT POINTER 
	ANK	A2,/7F 
	IFT	RCOM=1 
	LD	A1,XRB	READ BUFFER COMMAND ???
	RF(Z)	TRT105	NO!!

************************************************************
* 
*   CHECK IF ATTRIBUTE CHARACTER OR NULL
* 
*********************************************** 

	CWK	A2,X'20'	ATTRIBUTE CHARACTER 
	RF(L)	TRT101	YES!!!
	XIF
	IFT	DMRK=1 
	CWK	A2,/7E	LINE FEED ? 
	RF(NE)	TRT102	NO,GO TO TRT102
	LDK	A2,/0A 
TRT102	EQU	*
	CWK	A2,/7D	END OF MESSAGE ?
	RF(NE)	TRT103	NO,GO TO TRT103
	LDK	A2,/19 
TRT103	EQU	*
	CWK	A2,X'7F'	NULL ?? 
	RF(NE)	TRT105
	SUK	A2,1 
	XIF
	IFT	RCOM=1 
	RF	TRT105

TRT101	EQU	*

	LDK	A2,SF
	CF	A5,WRITEP	SEND START FIELD

	LC	A2,-1,A4	GET ATTRIBUTE CHARACTER
	ANK	A2,X'7F' 
	LDR	A1,A2	CONVERT TO IBM ATTRIBUTE 
	ANK	A1,1 
	ANK	A2,/1E	MASK
	SLL	A2,1 
	ORR	A2,A1	IBM ATTRIBUTE COMPOSED 
	ORK	A2,/40	BIT ALWAYS SET ONE
	LC	A2,TASCII,A2
	CWK	A2,/18	CHECK SPECIAL ATTRIBUT
	RF(NE)	TRT104
	LDK	A2,/30 
TRT104	EQU	*
	CF	A5,WRITEP	SEND ATTRIBUTE
	ADK	A3,1 
	RF	TRT110
TRT105	EQU	*
	XIF
	EJECT
	IFF	TPMODE=1 
	CWK	A2,/07 
	RF(L)	TRT110	ILLEGAL CODE : SKIP IT
	XIF
	CF	A5,WRITEP	SEND CHARACTER
TRT110	EQU	*
	IM	FBAX	INCREMENT BUFFER INDEX 
	LD	A1,FECBRL	GET REQUESTED LENGTH
	CW	A1,FBAX 
	RF(NG)	TRT130	END OF MESSAGE 
	ADK	A3,1	INCREMENT CHARACTER COUNTER 
	CWK	A3,TBLEN 
	IFT	TPMODE=1 
	RB(L)	TRT105	NOT FULL BLOCK
	XIF
	RB(L)	TRT100	NOT FULL BLOCK
	IFT	RCOM=1 
	LDK	A1,SBA	CHECK IF SBA AT END OF BLOCK
	CC	A1,-2,A4
	RF(E)	TRT115	YES 
	CC	A1,-1,A4
	RF(NE)	TRT116	NO SEND ETB
	LCR	A2,A4	GET FIRST BYTE AFTER SBA 
	ADK	A4,1	INREMENT POINTER
	CF	A5,WRITEP	SEND IT 
	IM	FBAX	INCREMENT INDEX
TRT115	LCR	A2,A4	GET SECOND BYTE AFTER SBA
	CF	A5,WRITEP	SEND IT 
	IM	FBAX	INCREMENT INDEX
	XIF
TRT116	EQU	*
	IFT	TPMODE=1 
	LDK	A2,DLE 
	CF	A5,WRIDLE	SEND AN EXTRA DLE 
	XIF
	LDK	A2,ETB	LOAD ETB
TRT120	EQU	*
	IFT	TPMODE=1 
	CM	TPM 
	XIF
	CF	A5,WRITEP	SEND IT 
	IFF	CODE=1 
	LDR	A2,A7	GET LRC
	CF	A5,WRITEP	SEND LRC
	XIF
	IFT	CODE=1 
	LDR	A8,A7	SAVE CURRENT CRC 
	LDR	A2,A7
	ANK	A2,/FF 
	CF	A5,WRIT05	SEND CRC BYTE 1 
	ECR	A2,A8
	ANK	A2,/FF 
	CF	A5,WRIT05	SEND CRC BYTE 2 
	XIF
	ABL	TRRE10	HALT OUTPUT 
TRT130	EQU	*
	IM	XETX	INDICATE 'ETX SENT'
TRT140	EQU	*
	IFT	TPMODE=1 
	LDK	A2,DLE 
	CF	A5,WRIDLE	SEND AN EXTRA DLE 
	XIF
	LDK	A2,ETX	LOAD ETX
	RB	TRT120	SEND ETX AND LRC 
	EJECT
* 
* 
*	TRANSMIT STATUS MESSAGE 
* 
* 
	IFF	STAT=0 
TRSTA	EQU	* 
	IM	XSTA	INDICATE 'STATUS SENT' 
	ST	A6,FDWTUT	SAVE A6 
	CF	A5,TRSYNC	START OUTPUT
	LDK	A2,SOH 
	CF	A5,WRITE	SEND SOH 
	LDK	A7,0	REST LRC
	LDK	A2,'%' 
	CF	A5,WRITEP	SEND '%'
	LDK	A2,'R' 
	CF	A5,WRITEP	SEND 'R'
	LDK	A2,STX 
	CF	A5,WRITE	SEND STX 
	LC	A2,DW1500+1 
	CF	A5,WRITEP	SEND TCA
	LDR*	A2,A6 
	CF	A5,WRITEP	SEND STA
	LD	A1,DWTST,A6	GET STATUS
	ANK	A1,/06	MASK FOR S/S 0
	SRL	A1,1 
	LC	A2,SSTAB,A1	GET STATUS BYTE 
	CF	A5,WRITEP	SEND S/S 0
	LDK	A2,NOIR	PRELOAD S/S 1
	LD	A1,DWTST,A6	GET STATUS
	ANK	A1,5 
	RF(Z)	TRST10	NOT 'IR'
	ANK	A1,4 
	RF(NZ)	TRST10	NO IR IF DE
	LDK	A2,IR
TRST10	EQU	*
	CF	A5,WRITEP	SEND S/S 1
	RB	TRT130	SEND ETX AND LRC 
	XIF
	EJECT
* 
* 
*		TRSYNC : TRANSMIT SYNC SEQUENCE
* 
TRSYNC	EQU	*
	CF	A5,CHALTI	HALT INPUT IF NOT DONE
	CF	A5,CSYNCO	START OUTPUT WITH SYNC DEF
	CF	A5,READ	WAIT FOR OUTPUT INTERRUPT 
* 
* 
*		SEND 4 SYN-CHARACTERS
* 
	LDK	A3,4 
TRS100	EQU	*
	LDK	A2,SYN 
	CF	A5,WRITE	SEND CHARACTER 
	SUK	A3,1 
	RB(NZ)	TRS100
	RTN	A5	RETURN TO CALLER
	EJECT
* 
* 
*		CSYNCI :SEND SYNC-PATTERN FOR INPUT DATA 
* 
CSYNCI	EQU	*
	LD	A2,PFPOST 
	RF(NZ)	CSYN:I	WAIT FOR POWER UP
	CF	A5,CHALTI	STOP INPUT
	ST	A5,DCLCI	SET INPUT ACTIVE FLAG
	IFT	P6805=1
	LDK	A2,PARITY	CHAR PARITY FUNCTION FOR LC
	CIO	A2,1,LCUIN	START I/O 
	LDK	A2,SYNC	SYNC PATTERN 
	OTR	A2,1,LCUIN	SEND INPUT SYNC-PATTERN TO LC 
	XIF
	IFT	P6805=0
	LDKL	A2,CBCARR+SYNC	DEF SYNC-PATTERN 
	CIO	A2,1,LCUIN	SEND INPUT SYNC-PATTERN TO LC 
	XIF
CSYN:I	EQU	*
	RTN	A5	RETURN TO CALLER
	EJECT
* 
* 
*		CHALTI : HALT INPUT CHANNEL
* 
CHALTI	EQU	*
	IFT	P6805=1
	LDK	A2,CBSTOP	STOP FUNCTION BIT
	XIF
	CIO	A2,0,LCUIN	HALT INPUT
	CM	DCLCI	CLEAR INPUT ACTIVE FLAG 
	SST	A2,LCUIN	READ STATUS 
	IFF	LOGG=0 
	CF	A5,LOGSST	LOGG INPUT STATUS 
	XIF
	RTN	A5	RETURN TO CALLER
	EJECT
* 
* 
*		CSYNCO : START TRANSMITTER WITH SYNC DEF 
* 
CSYNCO	EQU	*
	LD	A2,PFPOST 
	RF(NZ)	CSYN:O	WAIT FOR POWER UP
	IFT	P6805=1
	LDK	A2,PARITY	CHAR PARITY CHECK BY CU
	CIO	A2,1,LCUUT	CIO START 
	RF(A)	CSYNC1	ACCEPTED
	SST	A2,LCUUT	TRY TO READ STATUS
	ABL	BRM	NOT ACCEPTED TIMEOUT REQUEST 
CSYNC1	EQU	*
	LDK	A2,SYNC	DEF SYNC PATTERN 
	OTR	A2,1,LCUUT	SEND SYNC PATTERN 
	XIF
	IFT	P6805=0
	CIO	A2,1,LCUUT	START TRANSMITTER 
	XIF
CSYN:O	EQU	*
	RTN	A5	RETURN TO CALLER
	EJECT
* 
* 
*		CHALTO : HALT OUTPUT CHANNEL 
* 
CHALTO	EQU	*
	IFT	P6805=1
	LDK	A2,CBSTOP	STOP FUNCTION
	XIF
	CIO	A2,0,LCUUT	HALT OUTPUT 
	IFT	P6805=1
	CF	A5,READ	WAIT FOR INTERRUPT
	XIF
	SST	A2,LCUUT	GET STATUS
	RTN	A5	RETURN TO CALLER
	EJECT
* 
* 
*   RECEIVER INTERRUPT
* 
* 
IH1501	EQU	*
	ST	P,INTSAV
	IFT	CPU852=1 
	CF	A15,SAVE8	SAVE A1-A8
	XIF

	IFF	CPU852=1 
	MSR	8,A15	SAVE A1-A8	=1
	XIF
	CF	A15,LDREG	RESTORE DC REGS A3 - A8 
	INR	A2,0,LCUIN	READ CHAR 
	RF(NA)	IHIN20	NOT ACCEPTED,CHECK STATUS
	IFF	LOGG=0 
	CF	A5,LOGIN	LOG RECEIVED CHARACTER 
	XIF
	C2	TPM 
	RF(NZ)	IHLC10	DO NOT SKIP SYNC IN TRANSPARENT TEXT 
	C2	SYNSW 
	RF(NZ)	IHLC05	DO NOT SKIP SYNS IN BCC FRAME
	CWK	A2,SYNC
	RF(E)	READ 
IHLC05	EQU	*
	IFT	CODE=0 
	XRR	A7,A2	CALCULATE LRC
	XIF
	IFT	CODE=1 
	CF	A5,CRCCAL	CALCULATE CRC 
	LC	A2,TASCII,A2	TRANSLATE TO ASCII 
	XIF
IHLC10	EQU	*
	LDR	A1,A2
	ORKL	A1,/FF00	SET FLAG FOR CARRIER ON
	ST	A1,DCLCI	SET INPUT ACTIV FLAG 
	CM	DCSTCU	CLEAR SST SAVE 
IHIN10	EQU	*
	RTN	A5	RETURN TO CALLER
IHIN20	EQU	*
	CF	A5,SST	PERFORM SST
	ABL	BRM
	EJECT
* 
* 
*   TRANSMITTER INTERRUPT 
* 
* 
IH1502	EQU	*
	ST	P,INTSAV
	IFT	CPU852=1 
	CF	A15,SAVE8	SAVE A1 - A8
	XIF

	IFF	CPU852=1 
	MSR	8,A15	SAVE A1-A8	=1
	XIF
	CF	A15,LDREG	RESTORE DC REGS A3 - A8 
	RB	IHIN10
	EJECT
* 
* 
*	SST INSTRUCTION AND STATUS CHECK
* 
*   LCU STATUS : BIT 10=CARRIER OFF 
*		BIT 13=PARITY ERROR (6805 ONLY)	SALCUZ 
*                BIT 14=THROUGHPUT ERROR
*                BIT 15=MODEM NOT READY 
* 
SST	EQU	* 
	SST	A2,LCUIN	GET STATUS
	LDR	A1,A2
	IFT	LOGG=1 
	CF	A5,LOGSST	LOGG SST INFORMATION
	XIF
	ANK	A2,SBERR	ERROR BIT SET 
	RF(NZ)	SST050	YES
	IFT	P6805=0
	LD	A2,DCLCI	INPUT STATUS 
	RF(Z)	SST125	INPUT NOT ACTIVE  IGNORE
	RF(N)	SST100	INPUT ACTIVE WITH DATA
	LDKL	A2,CBCARR+SYNC	DEF SYNC PATTERN 
	CIO	A2,1,LCUIN	START INPUT AGAIN 
	RF	SST125	RETURN TO DISPATCHER 
	XIF
	IFT	P6805=1
	RF	SST100
	XIF
SST050	EQU	*
	ANK	A2,SBCARR	CARRIR OFF 
	RF(Z)	SST075	NO
	LD	A2,DCLCI	INPUT STATUS 
	RF(Z)	SST125	NOT ACTIVE IGNORE CARRIER OFF 
	RF	SST100	ACTIVE 
SST075	EQU	*
	LDR	A2,A1
	ANK	A2,SBTHRU	THROUGHPUT ERROR 
	ABL(NZ)	BRM140	YES 
* 
SST100	EQU	*
	LDR	A2,A1
	ANK	A2,SBNOOP	NOT OPRABLE
	RF(Z)	SST200 
	CF	A15,STREG	SAVE REGISTERS
	CF	A15,SETIME	DELAY 1 SEC
	DATA	SST150,10 
SST125	EQU	*
	ABL	TDISP	RETURN TO DISPATCHER 
* 
SST150	EQU	*
	CF	A15,LDREG	LOAD REGISTERS
SST200	EQU	*
	LDR	A2,A1
	ANK	A2,SBCARR	CHECK STATUS IF CARRIER OFF
	RF(Z)	SST225	NO
	XRK	A1,SBCARR	CHECK STATUS IF ONLY CARRIER OFF 
	RF(Z)	SST250	YES 
SST225	EQU	*
	ST	A1,DCSTCU	STORE STATUS AS CURRENT STATUS
	CF	A15,CKMESS	CHECK IF STATUS CHANGE 
SST250	EQU	*
	RTN	A5	RETURN TO CALLER
	EJECT
* 
* 
*	WRITE FROM OR READ ONE CHARACTER TO A2
* 
* 
WRITE	EQU	* 
	IFT	CODE=1 
	C2	TPM 
	RF(Z)	WRIT02	NOT TRANSPARENT MODE
	CWK	A2,DLE	CHECK IF DLE
	RF(NZ)	WRIT05	NO 
	CF	A5,WRIDLE	SEND EXTRA DLE
	LDK	A2,DLE 
	RF	WRIT05
WRIT02	EQU	*
	ANK	A2,/FF 
	CWK	A2,/FF 
	RF(E)	WRIT05	NO TRANSLATION OF TRAILING PAD
	LC	A2,TEBCDIC,A2	TRANSLATE TO EBCDIC 
	XIF
WRIT05	EQU	*
	OTR	A2,0,LCUUT	SEND CHARACTER
	RF(A)	WRIT10 
	RF	READ	THROUGHPUT ERROR 
	IFF	CODE=1 
WRIT10	XRR	A7,A2	ACCUMULATE BCC 
	XIF
	IFT	CODE=1 
WRIT10	CF	A5,CRCCAL	CALCULATE CRC 
	XIF
WRIT15	EQU	*
	IFF	LOGG=0 
	CF	A5,LOGOUT	LOG OUTPUT CHARACTER
	XIF
* 
READ	CF	A15,STREG 
	ABL	TDISP
	IFT	CODE=1 
WRIDLE	EQU	*
	OTR	A2,0,LCUUT 
	RB(NA)	READ	THROUGHPUT ERROR 
	RB	WRIT15
	XIF
	EJECT
* 
* 
***	WRITEP
* 
*   WRITE A2 WITH PARITY
* 
* 
	IFT	CODE+P6805=0		SALCUZ 
WRITEP	ANK	A2,/FF 
	ECR	A1,A2
	ORK	A2,/80 
WRI100	SLL	A1,1 
	RB(P)	WRI100 
	RB(Z)	WRITE	WRITE
	XRK	A2,/80 
	RB	WRI100
	XIF
	IFF	CODE+P6805=0		SALCUZ 
WRITEP	RB	WRITE 
	XIF
* 
* 
* 
***	READP 
* 
*   READ CHARACTER TO A2 AND CHECK PARITY 
* 
* 
READP	CF	A5,READ
	IFT	CODE+P6805=0		SALCUZ 
	ECR	A1,A2
RE100	SLL	A1,1
	RF(Z)	RE110
	RB(NN)	RE100 
	XRK	A2,/80 
	RB	RE100 
RE110	LDR	A1,A2 
	ANK	A2,/7F 
	XIF
	IFF	CODE+P6805=0		SALCUZ 
	LDK	A1,/80 
	XIF
	ADK	A5,4 
	ANK	A1,/80 
	XRK	A1,/80 
	ABR*	A5
* 
* 
	EJECT
* 
*	FIND DWT CONTAINING SUBTERMINAL ADDRESS AS GIVEN IN A2
* 
*	CALLING SEQUENCE: CF A5,FINTER
*	A2=SUBTERMINAL ADDRESS
*	A4 DESTROYED
*	A3#0: DWT TO FOUND TERMINAL 
* 
* NOTE:	FOR SIEMENS MSV1 - SEPARATE SELECT AND POLL ADDRESSES 
*	ENTRY:	FINTER - CHECK SELECT ADDRESS
*		FINTEP - CHECK SPECIFIC POLL ADDRESS 
* 
RBYTE	DATA	0	IF 1 COMPARE WITH RIGTH BYTE 
* 
* 
FINTEP	EQU	*
	IFT	MSV1=0 
FINTER	EQU	*
	XIF
	IM	RBYTE 
	IFT	MSV1=1 
FINTER	EQU	*
	XIF
	LD	A4,DCTAB	GET ADDRESS TO DC:TAB
	AD*	A4,DCTAB	ADDRESS TO END OF DC:TAB
FINT10	SUK	A4,2 
	LDK	A3,0	DEFAULT VALUE 
	CW	A4,DCTAB	END OF TABLE 
	RF(E)	FINT20	SUBTERMINAL NOT FOUND 
	LDR*	A3,A4	LOAD DWT ADDRESS
	IFT	MSV1=1 
	AD	A3,RBYTE	CHOOSE ADDRESS TYPE
	CCR	A2,A3	COMPARE SUBTERMINAL ADDRESS
	XIF
	IFT	MSV1=0 
	CC	A2,1,A3	COMPARE TO SUBTERMINAL ADDRESS
	XIF
	RB(NE)	FINT10	TAKE NEXT TERMINAL 
FINT20	CM	RBYTE 
	ANKL	A3,/FFFE
	RTN	A5 
	EJECT
* 
* 
*	POWER ON FUNCTIONS
* 
* 
DC15ON	EQU	*
	IFT	CPU852=1 
	CF	A15,SAVE8	SAVE A1-A8
	XIF

	IFF	CPU852=1 
	MSR	8,A15	SAVE A1-A8	=1
	XIF
	IFT	STAT=1 
	LDK	A5,4	SET DEVICE END
	LD	A1,DCTAB
	AD*	A1,DCTAB	GET ADDRESS TO END OF TABLE 
DRDC05	SUK	A1,2 
	CW	A1,DCTAB
	RF(E)	DRDC06	END OF TABLE
	LDR*	A6,A1	GET DWT ADDRESS 
	ORS	A5,DWTST,A6	STORE DEVICE END FOR DEVICE
	CF	A15,INSSQ	INSERT IN STATUS QUEUE
	RB	DRDC05
DRDC06	EQU	*
	XIF
	CM	DCLCI	INIT LINE CONTROL UNIT INFO 
	LDK	A2,/40 
	ORS	A2,DCONOF
	CF	A15,CKMESS
	LD	A2,DCTPGP	GET POLL TIMER POINTER
	RF(NZ)	DRDC20	ALREADY STARTED
DRDC10	CF	A15,SPOTIM	START POLL TIMER 
DRDC20	ABL	BRM
	EJECT
* 
*	POLL TIME OUT 
* 
PTOUT	LDKL	A5,STB	LOAD A5 STACK BASE
	LDK	A2,/40 
	ST	A2,DCONOF	INDICATE POLL TIME OUT
	CF	A15,CKMESS	CHECK IF STATUS CHANGE 
	CF	A15,SPOTIM	START POLL TIMER 
	ABL	TDISP
* 
*	RESTART POLL TIMER WHEN POLL HAS BEEN RECEIVED
* 
CPTIM	EQU	* 
	LD	A1,DCONOF	CHECK THE ON-/OFF LINESWITCH
	ANK	A1,/40	IF IT IS POLL TIME OUT
	RF(Z)	CPTIM1	NO
	AN	A1,DCSTOL	IS OLD STATUS POLL TIME OUT 
	RF(Z)	CPTIM2	NO
CPTIM1	EQU	*
	CM	DCONOF	INDICATE POLLING 
CPTIM2	EQU	*
	LDKL	A2,-TIMPOL
	ST*	A2,DCTPGP	RESTART TIMER
	CF	A15,CKMESS	CHECK IF STATUS CHANGE 
	RTN	A5 
* 
*	START POLL TIMER
* 
SPOTIM	CF	A15,SETIME	START TIMER
	DATA	PTOUT,TIMPOL
	ST	A4,DCTPGP	STORE TIMER POINTER 
	ADKL	A15,4 
	ABR*	A15 
	EJECT
* 
*	START PROCEDURE TIMER 
* 
SPTIM	EQU	* 
	LDR	A1,A6	LOAD DWT AS PARAMETER
	CF	A15,SETIME
	DATA	PRTOUT,TIMPRO 
	ST	A4,DCTPP	SAVE TIMER POINTER 
	RTN	A5 
* 
*	PROCEDURE TIMEOUT 
* 
PRTOUT	CM	DCTPP 
	LDR	A6,A1	RELOAD A6
	LDKL	A5,STB	LOAD STACK BASE
	CF	A5,CHALTI	HALT INPUT IF OPEN	SALCUZ 
	LD	A1,XACK 
	RF(Z)	PRT10	ACK NOT EXPECTED 
	CF	A5,TRENQ	SEND ENQ 
	CF	A5,SPTIM	START PROCEDURE TIMER
PRT10	ABL	BRM 
	EJECT
* 
*	STOP PROCEDURE TIMER
* 
HPTIM	LD	A1,DCTPP	GET TIMER POINTER 
	RF(Z)	HPT10	NOT RUNNING
	CM*	DCTPP	STOP TIMER 
	CM	DCTPP 
HPT10	RTN	A5
	EJECT
	IFT	CODE=1 
* 
* 
*	CALCULATION OF CRC
* 
*	A2 = CHARACTER
*	A7 = ACCUMULATED CRC
* 
* 
CRCCAL	EQU	*
	ST	A1,CRCSAV 
	ST	A2,CRCSAV+2 
	ST	A3,CRCSAV+4 
	LDK	A1,8 
CRC100	LDR	A3,A7
	SRL	A7,1 
	XRR	A3,A2
	SRL	A2,1 
	ANK	A3,1 
	RF(Z)	CRC110 
	XRKL	A7,/A001
CRC110	SUK	A1,1 
	RB(NZ)	CRC100
	LD	A1,CRCSAV 
	LD	A2,CRCSAV+2 
	LD	A3,CRCSAV+4 
	RTN	A5 
CRCSAV	RES	3
	EJECT
* 
* 
*	READ CRC CHARACTERS AND CHECK THEM
*	CR = (E) IF CRC WAS OK
* 
* 
RDCRC	LDR	A6,A7	SAVE CURRENT CRC
	IM	SYNSW	DO NOT SKIP SYNCS NOW 
	CF	A5,READ	READ BYTE 1 
	LD	A8,CRCSAV+2	SAVE IT 
	CF	A5,READ	READ BYTE 2 
	CM	SYNSW	SYNCS CAN BE SKIPPED AGAIN
	LD	A2,CRCSAV+2	SAVE IT 
	SLL	A2,8 
	XRR	A2,A8
	ADK	A5,4 
	CWR	A2,A6	COMPARE RECEIVED WITH COMPUTED 
	ABR*	A5
	XIF
	IFT	CODE=0 
* 
*   RDLRC      READ LRC CHARACTER 
*              CR=0 IF LRC OK 
* 
RDLRC	IM	SYNSW
	CF	A5,READP
	ADK	A5,4 
	LDR	A1,A1
	RF(NZ)	LRCEND
	ANK	A7,/7F 
LRCEND	EQU	*
	CM	SYNSW 
	ABR*	A5

	XIF
	EJECT
* 
* 
*	DEVICE WORK TABLE FOR DCTASK
* 
* 
DW1500	EQU	*	TABLE ENTRY
	DATA	0	CU LINE ADDRESS 
	DATA	/8000	STATUS
	DATA	0	ECB ADDRESS 
	DATA	0	ORDER 
	DATA	DC15DC	POINTER TO ADDRESS BLOCK 
	DATA	0	TTAB ADDRESS
	DATA	0	WAIT/ACTIVATE INDICATOR 
	DATA	0	TASK QUEUE
* 
	IFT	MMUPAG=1 
	DATA	0	USER ECB ADDRESS
	DATA	DC:ECB	MMU ECB ADDRESS
	XIF
* 
	DATA	0	TIMER POINTER 
	DATA	0	WRITE QUEUE OR BUFFER QUEUE 
	DATA	0	STATUS QUEUE (NOT USED BY DC-TASK)
	DATA	0	RECEIVE MESSAGE QUEUE 
	DATA	0	SIMULATED DEVICE BUFFER ADDRESS 
	DATA	0	CURSOR ADDRESS
	DATA	0	REQUEST TIMEOUT VALUE 
* 
	IFT	MMUPAG=1 
DC:ECB	EQU	*	MMU ECB
	DATA	0,0,0,0,0,0 
	XIF
* 
	EJECT
* 
* 
*	DC RECEIVE BUFFER POOL
* 
RLINK	EQU	RBUFL+RBUFL+8 
* 
DCRBUF	EQU	*
	DATA	*+2	FREE BUFFER ANCHOR
	IFF	RBUFNR=2 
	DATA	*+RLINK 
	RES	RBUFL+3
	IFF	RBUFNR=3 
	DATA	*+RLINK 
	RES	RBUFL+3
	IFF	RBUFNR=4 
	DATA	*+RLINK 
	RES	RBUFL+3
	XIF
	DATA	*+RLINK 
	RES	RBUFL+3
	DATA	0	END OF CHAIN
	RES	RBUFL+3

	IFF	MMUPAG=0 
MMUBUF	RES	TBUFL+1	MMU WORK BUFFER
	XIF
	EJECT
* 
* 
*	INTERRUPT LOGGING ROUTINE 
* 
* 
	IFF	LOGG=0 
LOGSST	ST	A2,SAVE2
	ORKL	A2,/F000
	RF	LOG10 
LOGOUT	ST	A2,SAVE2
	ORKL	A2,/0F00
	RF	LOG10 
LOGIN	CWK	A2,/FF
	RF(E)	LOGE10 
	ST	A2,SAVE2
LOG10	ST	A3,SAVE3 
	LD	A3,LOGPNT 
	STR	A2,A3
	ADK	A3,2 
	CWK	A3,LOGEND
	RF(L)	LOGEXI 
	LDKL	A3,LOGSTA 
LOGEXI	ST	A3,LOGPNT 
	LD	A2,SAVE2
	LD	A3,SAVE3
LOGE10	RTN	A5 
	EJECT
* 
* 
LOGPNT	DATA	LOGSTA
LOGSTA	EQU	*
	RES	300
LOGEND	EQU	*-4
SAVE2	DATA	0
SAVE3	DATA	0
	XIF
* 
* 
* 
	IFT	RCOM=1 
	EJECT
******************************************************* 
* 
*     L I N C O L 
* 
*     CONVERT CURSOR ADDRESS TO LINE AND COLUMN NUMBER
* 
**********************************************************

LINCOL	EQU	*
	LDR	A2,A3	COPY CURSOR ADDRESS
	SRL	A2,6 
	ANK	A2,X'3F'	
	LC	A2,LICO:T,A2	ASCII LINE NUMBER
	CF	A5,WRITEP	SEND LINE NUMBER

	LDR	A2,A3
	ANK	A2,X'3F' 
	LC	A2,LICO:T,A2	ASCII COLUMN NUMBER
	CF	A5,WRITEP	SEND COLUMN NUMBER
	RTN	A5	RETURN
* 
* 
* 
	EJECT


LICO:T	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
	XIF
	EJECT

DC:IN	DATA	DC:TAB+2 
DCTAB	DATA	DC:TAB 
DC:TAB	DATA	2	LENGTH OF DC:TAB
	DATA	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 
	DATA	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 
DC:END	EQU	*
* 
* 
	END

Full view