⟦b20cf9258⟧

PTS(SC)

	IDENT	DRDC15	REL 11.0 DK 82-07-08 870105041100 

			=17, RETURN CODE AT CONNECT
			=16, DLOBUF DESTROYED AT CONNECT 
			=15, NO NEED TO RES 1 WORD BEFORE DATA 
			=14, LOSS OF DRIVER RECEIVE BUFFER 
			REL 11.0 81-05-21
			=13, ERRONEOUS DISCARD DWT HANDLING
			=12, SUB-ADDR IN CW2 AT RECEIVE REQ COMPL
			REL 11.0 81-05-12
			=11, PROCEDURE TIMER PROBLEM 
			=10, EOT ON SPECIFIC POLL
			=9, REMAINING TIME IN ECBCW1 
			REL 11.0 81-04-12
			=8, ODD USER BUFFER ADDRESS
			=7, BINARY STORE PROBLEM 
			REL 11.0 81-04-07
			=6, ERROR IN POLL TIMER HANDLING 
			=5, WRONG STATISTIC HANDLING 
			REL 11.0 81-03-27
			=4, ERROR IN POWER UP
			=3, DELETE INSTRUCTIONS NOT USED 
			=2, CHANGES IN STATUS HANLING
			=1, ERROR IN OPEN/CLOSE REQUESTS 
			REL 11.0 81-01-26
* 
* 
********************************************* 
* 
*   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	DUMMY DWT 
* 
	EJECT
* 
* 
*	EXTERNAL REFERENCES 
* 
	EXTRN	TDISP	DISPATCHER ENTRY 
	EXTRN	SAVE8	SAVE A1-A8 ON A15 STACK
	EXTRN	TENDIO	COMPLETE I/O EVENT
	EXTRN	SETIME	SET TIMER 
	EXTRN	DWTCHP	DWT ADDRESS 
	EXTRN	DWTST	DWT STATUS 
	EXTRN	DWTOR	DWT ORDER
	EXTRN	DWTECB	DWT ECB 
	EXTRN	DWTOPT	OPTION CODE 
	EXTRN	DWTUEC	USER ECB IF MMU 
	EXTRN	DWTMEC	MMU ECB 
	EXTRN	ECBFC	FILE CODE
	EXTRN	ECBBA	BUFFER ADDRESS 
	EXTRN	ECBRL	REQUESTED LENGTH 
	EXTRN	ECBEL	EFFECTIVE LENGTH 
	EXTRN	ECBCW1	CONTROL WORD 1
	EXTRN	ECBCW2	CONTROL WORD 2
	EXTRN	GETSSA 
	EXTRN	INTSAV	SAVE AREA LAST INTERRUPT
	EXTRN	TEBCDIC	ASCII TO EBCDIC TABLE
	EXTRN	TASCII	EBCDIC TO ASCII TABLE 
	EXTRN	DCSRED	READ STATISTICS ENTRY POINT 
	EXTRN	DCSRLL	RESET ALL STATISTICS BUFFERS ENTRY POINT
	EXTRN	DCSUPS	UPDATE STATISTICS ENTRY POINT IN DCSTAT 
	EXTRN	GETDNA	VALIDATE AND CONVERT SYMBOLIC DTE ADDR
	EXTRN	GETSNA	VALIDATE AND CONVERT SYMBOLIC SUB ADDR
	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		
**********************************************************************
* 
*	REGISTER USAGE:	
* 
*	A1	WORK (RETURN CODE) 
*	A2	WORK 
*	A3	WORK (BUFFER LENGTH) 
*	A4	WORK (BUFFER POINTER)
*	A5	DRIVER STACK POINTER 
*	A6	DWT ADDRESS
*	A7	ORDER CODE, DTETAB ADDRESS 
*	A8	ECB ADDRESS
* 
************************************************************************
	EJECT
******************************************************* 
* 
*	PARAMETERS FOR CONDITIONAL ASSEMBLY 
* 
* 
X:A	EQU	1000	RECEIVE BUFFER LENGTH
RBUFL	EQU	1150
X:B	EQU	0	IF 1 INTERRUPT LOGGING
LOGG	EQU	X:B
X:C	EQU	600	POLL TIMEOUT VALUE
TIMPOL	EQU	X:C
X:D	EQU	0	STATUS AND RVI HANDLING IF=1
STARVI	EQU	1
X:E	EQU	0	READ COMMAND HANDLING IF =1 
RCOM	EQU	1	 
X:F	EQU	252	TRANSMIT BLOCK LENGTH 
TBLEN	EQU	X:F 
X:G	EQU	0	CODE , 0=ASCII , 1=EBCDIC 
CODE	EQU	1
X:H	EQU	0	IF 1 SPECIFIC POLL HANDLING 
SPECP	EQU	X:H 
X:I	EQU	0	IF = 1 LINE SPEED SET TO HIGH 
			IF = 0  LINE SPEED IS SET TO LOW 
SPEED	EQU	1 
X:J	EQU	0	IF 1 SIEMENS MSV1 PROCEDURE 
MSV1	EQU	X:J
X:K	EQU	2	NUMBER OF RECEIVE BUFFERS (2-5) 
RBUFNR	EQU	2
X:L	EQU	0	IF = 1  PTS 6805 ADAPTION	SALCUZ
P6805	EQU	X:L 
X:M	EQU	/02 
	IFT	P6805=0
LCUIN	EQU	X:M	DEVICE ADDRESS OF RECEIVER
	XIF
	IFT	P6805=1
LCUIN	EQU	/0A	DEVICE ADDRESS OF RECEIVER
	XIF
	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 
X:N	EQU	0 
IBMCHR	EQU	X:N	IF 1 IBM CHARACTER HANDLING
X:O	EQU	0	IF 1 MESSAGE PASSING TO DC TASK 
MESPAS	EQU	X:O
X:P	EQU	0	IBM-3270 EMULATION PACKAGE, IF NOT = 0
EM3270	EQU	1
X:Q	EQU	0 
TPMODE	EQU	X:Q	IF = 1 TRANSPARANT MODE
X:R	EQU	0 
STTSTS	EQU	X:R	IF = 1 STATISTICS INCLUDED 
X:S	EQU	500 
TBUFL	EQU	1150	MMU BUFFER LENGTH
BINTRM	EQU	0	IF 1 BINARY TRANSMISSION 
DMRK	EQU	1	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". 
				=2

REMTIM	EQU	0		=9
			IF = 1 THE REMAINING TIME UNTIL TIMEOUT	=9 
			IS DELIVERED IN ECBCW1 AT COMPLETION 	=9 
			OF SEND AND RECEIVE REQUESTS	=9
* 
	IFT	SPEED=1
LSPEED	EQU	/0200
	XIF
	IFT	SPEED=0
LSPEED	EQU	0
	XIF
	EJECT
* 
* 
***************************************** 
* 
*	CONDITIONAL ASSEMBLY
* 
***************************************** 
* 
*	A PROGRAM VERSION USING TOSS MMU PAGING 
*	IS OBTAINED BY SETTING MMUPAG EQU 1.
* 
MMUPAG	EQU	1
* 
* 
*	A PROGRAM VERSION USING THE EXTENDED INSTRUCTION
*	SET IS OBTAINED BY SETTING CPU852 EQU 0.
* 
CPU852	EQU	0
* 
DEVIND	EQU	0	DEVICE INDEX DATA COMMUNICATION
BUFLEN	EQU	TBUFL+TBUFL	MMU BUFFER SIZE
* 
	EJECT
* 
**************************************
* 
*	DCDEFS  COMMON DEFS FOR DC DRIVERS/PACKAGES 
*	
**************************************
	 
*************************************** 
* 
*	TABLE AND PACKET LAYOUTS
* 
*************************************** 
	 
	 
	EJECT
**********************************************************************
* 
*	DWT, DEVICE WORK TABLE
* 
************************************************************************
* 
*	    ................... 
*	  0 .  DWTCHP         . 
*	    ................... 
*	  2 .  DWTST          . 
*	    ................... 
*	  4 .  DWTECB         . 
*	    ................... 
*	  6 . DWTOPT . DWTOR  . 
*	    ................... 
*	  8 .  DWTADR         . 
*	    ................... 
*	 10 .  DWTTAB         . 
*	    ................... 
*	 12 .  DWTWAT         . 
*	    ................... 
*	 14 .  DWTTQ          . 
*	    ................... 
*	(16).  DWTUEC         .   IF   MMUPAG 
*	    ................... 
*	(18).  DWTMEC         .   IF   MMUPAG 
*	    ................... 
* DWTDRD	 +2 .  DWTSTB         .
*            ...................
*	 +4 .  DWTCHD         . 
*	    ................... 
*	 +6 .  DWTCHN         . 
*	    ................... 
*	 +8 .  DWTLAD         . 
*	    ................... 
*	+10 .  DWTRAD         . 
*	    ................... 
*	+12 .  DWTDR1/SUB     . 
*	    ................... 
*	+14 .  DWTRCL         . 
*	    ................... 
*	+16 .  DWTRTV         . 
*	    ................... 
*	+18 .  DWTRTP         . 
*	    ................... 
*	+20 .  DWTOPE         . 
*	    ................... 
*	+22 .  DWTOPN         . 
*	    ................... 
*	+24 .  DWTIPC         . 
*	    ................... 
*	+26 .  DWTIPT         . 
*	    ................... 
*	+28 .                 . 
*	    /  DRIVER DEPEND  / 
*	    /                 / 
*	    /                 / 
*	    ................... 
*	    .  STATISTIC      .   IF STAT   AND DWTSTB /=0
*	    /  BUFFER         / 
*	    ................... 
* 
	EJECT
* 
********************************************************* 
* 
*	D W T  D I S P L A C E M E N T S
* 
********************************************************* 
* 
DWTTQ	EQU	/0E	TERMINAL QUEUE
	IFT	MMUPAG=0 
DWTDRD	EQU	DWTTQ+2	START OF DRIVER DEPENDENT AREA 
	XIF
	IFT	MMUPAG=1 
DWTDRD	EQU	DWTTQ+6	START OF DRIVER DEPENDENT AREA 
	XIF
DWTSTB	EQU	DWTDRD	OFFSET REL START DWT TO STATISTIC BUFF IF ANY 
DWTCHD	EQU	DWTDRD+2	CONFIG CHAIN LINK HEAD DWT
DWTCHN	EQU	DWTDRD+4	CONFIG CHAIN LINK NEXT DWT
DWTLAD	EQU	DWTDRD+6	LOCAL SYMBOLIC DTE ADDRESS
DWTRAD	EQU	DWTDRD+8	REMOTE SYMBOLIC DTE ADDRESS 
DWTDR1	EQU	DWTDRD+10	DRIVER DEP WORD 1
DWTSUB	EQU	DWTDR1	SYMBOLIC SUBADDRESS 
DWTRCL	EQU	DWTDRD+12	REQUEST CONTROL WORD 
DWTRTV	EQU	DWTDRD+14	REQUEST TIMER VALUE
DWTRTP	EQU	DWTDRD+16	REQUEST TIMER POINTER
DWTOPE	EQU	DWTDRD+18	O/P DATA Q EXPEDITED/STATUS LINK NXT DWT 
DWTOPN	EQU	DWTDRD+20	O/P DATA Q NORMAL LINK NXT DWT 
DWTIPC	EQU	DWTDRD+22	I/P DATA Q LINK TO BUFFER
DWTIPT	EQU	DWTDRD+24	I/P DATA TIMER POINTER 
DWTCUR	EQU	DWTDRD+26	CURSOR ADDRESS 
DWTBUF	EQU	DWTDRD+28	DEVICE BUFFER ADDRESS
DWTSTA	EQU	DWTDRD+30	DWT STATUS 
	EJECT
**********************************************************************
* 
*	DTE, DTE CONTROL TABLE
* 
************************************************************************
* 
*	    ................... 
*	  0 .  DTECHP         . 
*	    ................... 
*	  2 .  DTEST          . 
*	    ................... 
*	  4 .  DTEECB         . 
*	    ................... 
*	  6 . DTEOPT . DTEOR  . 
*	    ................... 
*	  8 .  DTEADR         . 
*	    ................... 
*	 10 .  DTETAB         . 
*	    ................... 
*	 12 .  DTEWAT         . 
*	    ................... 
*	 14 .  DTETQ          . 
*	    ................... 
*	(16).  DTEUEC         .   IF   MMUPAG 
*	    ................... 
*	(18).  DTEMEC         .   IF   MMUPAG 
*	    ................... 
* DTEDRD	 +2 .  DTESTB         .
*            ...................
*	 +4 .  DTECHD         . 
*	    ................... 
*	 +6 .  DTECHN         . 
*	    ................... 
*	 +8 .  DTELAD         . 
*	    ................... 
*	+10 .                 . 
*	    /  DRIVER DEPEND  / 
*	    /                 / 
*	    /                 / 
*	    ................... 
*	    .  STATISTIC      .   IF STAT   AND DTESTB /=0
*	    /  BUFFER         / 
*	    ................... 
* 
DTETQ	EQU	14
DTEUEC	EQU	DTETQ+2
DTEMEC	EQU	DTEUEC+2 

	IFT	MMUPAG=0 
DTEDRD	EQU	DTETQ+2	START OF DC DEPENDENT AREA 
	XIF
	IFT	MMUPAG=1 
DTEDRD	EQU	DTEMEC+2	START OF DC DEPENDENT AREA
	XIF
DTESTB	EQU	DTEDRD	OFFSET REL START DTE TO STATISTIC BUFF IF ANY 
DTECHD	EQU	DTEDRD+2	CONFIG CHAIN LINK HEAD DTE
DTECHN	EQU	DTEDRD+4	CONFIG CHAIN LINK NEXT DTE
DTELAD	EQU	DTEDRD+6	LOCAL SYMBOLIC DTE ADDRESS
*	DRIVER DEPENDENT
DTEPLS	EQU	DTEDRD+8	PHYSICAL LINK STATUS
DTEDLS	EQU	DTEDRD+10	DATA LINK STATUS 
DTESTA	EQU	DTEDRD+12	DTE STATUS 
DTEDWT	EQU	DTEDRD+14	CHAIN LINK  DWT
DTEDDT	EQU	DTEDRD+16	CHAIN LINK  DISCARD DWT
*	STATITICS BUFFER
STWSID	EQU	DTEDRD+18	RESERVED FOR SYMBOLIC ID 
STWCST	EQU	DTEDRD+20	COUNTER STATUS INDEX 
STWMIX	EQU	DTEDRD+22	MAX COUNTER INDEX
STWCTA	EQU	DTEDRD+24	COUNTERS 
	EJECT
**********************************************************************
* 
*	COUNTER INDECES - PARAMETER-1 EQUATES 
* 
*	REQUEST LEVEL COUNTERS: 
* 
*************************************************************** 
* 
CSRCON	EQU	/01	CONNECTIONS ESTABLISHED
CSRCBY	EQU	/02	CONNECTION NOT ESTABLISHED - BUSY
CSRMSR	EQU	/03	MESSAGES RECEIVED
CSRCHR	EQU	/C5	CHARACTERS RECEIVED
CSRMST	EQU	/06	MESSAGES TRANSMITTED 
CSRCHT	EQU	/C8	CHARACTERS TRANSMITTED 
CSRTOP	EQU	/09	TIMEOUT
CSRABT	EQU	/0A	ABORTED
CSRERR	EQU	/0B	ERROR
CSRTRE	EQU	/0C	TRANSMISSION ERROR 
CSRXC1	EQU	/0D	PROTOCOL DEPENDENT 
* 
*	LINK LEVEL COUNTERS 
	 
CSSRBL	EQU	/10	SYNCH DATA BLOCKS RECEIVED 
CSSRBY	EQU	/11	  "   DATA BLOCKS REJECTED BUFFER BUSY 
CSSRBO	EQU	/12	  "   DATA BLOCKS REJECTED BUFFER OVERFLOW 
CSSRAB	EQU	/13	  "   DATA BLOCKS REJECTED ABORTED 
CSSRPE	EQU	/14	  "   DATA BLOCKS REJECTED PARITY ERROR
CSSTBL	EQU	/15	  "   DATA BLOCKS TRANSMITTED
CSSTRT	EQU	/16	  "   DATA BLOCKS RETRANSMITTED
CSSTAB	EQU	/17	  "   DATA BLOCKS ABORTED
CSSXC1	EQU	/18	NBR OF REPLY REQUESTS TRANSMITTED
CSSXC2	EQU	/19	PROCEDURE TIME OUTS
CSSXC3	EQU	/1A	NBR OF TIMES POLL TIMEOUT HAS OCCURED
	 
	 
	EJECT
*	DTE/DCE LEVEL COUNTERS
	 
CSCDTE	EQU	/28	DTE NOT OPERABLE 
CSCDIT	EQU	/29	I/P THROUGHPUT ERROR 
CSCDOT	EQU	/2A	O/P THROUGHPUT ERROR 
CSCDCE	EQU	/2B	DCE NOT OPERABLE 
CSCXC1	EQU	/2C	CONTROL UNIT DEPENDENT 
CSCXC2	EQU	/2D	    "
CSCXC3	EQU	/2E	    "
	EJECT
* 
* 
*	REQUEST HANDLING
* 
* 
*	ORDER CODE (A7) 
* 
OPEN	EQU	/21	OPEN 
CLOSE	EQU	/22	CLOSE 
CONPAS	EQU	/27	CONNECT PASSIVE
DISCO	EQU	/2F	DISCONNECT
RECEIVE	EQU	/02	RECEIVE 
SEND	EQU	/06	SEND 
RSTAT	EQU	/00	READ STATUS 
SSTAT	EQU	/38	SET STATUS
STATIS	EQU	/2D	READ/RESET STATISTICS
STIMOT	EQU	/39	SET TIMEOUT VALUE
* 
*	OPTIONS:
* 
TYPRR	EQU	/4343	RESET STATISTICS AFTER READ	=5
	EJECT
* 
**********************************************************
* 
*	S O F T W A R E  R E T U R N  C O D E S 
* 
**********************************************************
* 
*---------------------------------------------------------------------- 
R:REQ	EQU	/8000	REQUEST ERROR 
R:ABRT	EQU	/4000	REQUEST ABORTED
R:2	EQU	/2000 
R:3	EQU	/1000 
*---------------------------------------------------------------------
R:4	EQU	/0800 
R:5	EQU	/0400 
R:6	EQU	/0200 
R:DATA	EQU	/0100	DATA AVAILABLE (QUEUED)
*---------------------------------------------------------------------
R:8	EQU	/0080 
R:TIME	EQU	/0040	TIME OUT 
R:10	EQU	/0020
R:SEQ	EQU	/0010	SEQUENCE ERROR
*---------------------------------------------------------------------
R:LGTH	EQU	/0008	ILLEGAL LENGTH 
R:13	EQU	/0004
R:LOGC	EQU	/0002	LOGICAL CONNECTION ERROR 
R:PHYC	EQU	/0001	PHYSICAL CONNECTION ERROR
*---------------------------------------------------------------------- 
* 
	EJECT
* 
********************************************************
* 
*	H A R D W A R E  R E T U R N  C O D E S 
* 
*********************************************************=
* 
*---------------------------------------------------------------------- 
H:0	EQU	/8000 
H:1	EQU	/4000 
H:2	EQU	/2000 
H:3	EQU	/1000 
*---------------------------------------------------------------------- 
H:4	EQU	/0800 
H:5	EQU	/0400 
H:6	EQU	/0200 
H:7	EQU	/0100 
*---------------------------------------------------------------------- 
H:8	EQU	/0080 
H:9	EQU	/0040 
H:CARR	EQU	/0020	CARRIER OFF
H:11	EQU	/0010
*-------------------------------------------------------------------- 
H:12	EQU	/0008
H:PARI	EQU	/0004	PARITY ERROR 
H:THRU	EQU	/0002	THROUGHPUT ERROR 
H:NOOP	EQU	/0001	NOT OPERABLE 
*---------------------------------------------------------------------- 
	EJECT			 
**********************************************************
* 
*	LINE CONTROL CHAR EQU:S		 
*				 
**********************************************************
* 
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
	EJECT
	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
PAD	EQU	/FF	DK1 
	XIF
	IFT	P6805=0
ENQPAR	EQU	ENQ+PAR
RVIPAR	EQU	RVI+PAR
ACKPAR	EQU	ACK0+PAR 
	XIF
	IFT	P6805=1
ENQPAR	EQU	ENQ
RVIPAR	EQU	RVI
ACKPAR	EQU	ACK0 
	XIF
	EJECT
* 
* 
*	3270 SENSE/STATUS INFORMATION 
* 
* 
	IFF	STARVI=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
* 
* 
*	TIMER VALUES
* 
* 
TIMPRO	EQU	30	PROCEDURE TIMER 3 SEC 
* 
* 
	EJECT
************************************************************* 
* 
*	LINE CONTROL UNIT FUNCTION CONTROL EQU:S
* 
************************************************************* 
* 
	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 
* 
*************************************************** 
* 
	IFT	P6805=0
H:ERR	EQU	/23	H:NOOP+H:THRU+H:CARR
	XIF
	IFT	P6805=1
H:ERR	EQU	/27	H:NOOP+H:THRU+H:CARR+H:PARI 
	XIF
	EJECT			 
****************************************************************
* 
*	DRIVER ADDRESS BLOCK
* 
*************************************************************** 
* 
	DATA	BUFLEN	MMU BUFFER SIZE
	DATA	DEVIND	DEVICE INDEX 
DC15AD	DATA	DCACT	ACTIVATION ADDRESS
	DATA	ABORT	ABORT ROUTINE 
	DATA	DCRBUF	REC. BUFFER ANCHOR 
	DATA	6	HEADER LENGTH 
* 
	RES	15	SUBROUTINE STACK FOR INTERRUPTS 
STB	RES	1 
	EJECT

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

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

AB:10	LD	A2,DWTOR,A6	ORDER CODE 
	ANK	A2,/7F 
	SUK	A2,6 
	RF(NE)	AB:RTN
	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	FDWTUT	REST SENDING DWT 
	CM	XACK	RESET ACK EXPECTED 

AB:RTN	EQU	*
	ABL	RTABRT 
	EJECT
**********************************************************************
**********************************************************************
* 
* 
*	REQUEST HANDLER/APPLICATION INTERFACE 
* 
* 
**********************************************************************
**********************************************************************
* 
*	ACTIVATION FROM TERMINAL TASKS
* 
DCACT	EQU	* 
	LDK	A1,0	PRESET RETURN CODE
	LDR	A2,A7	ORDER CODE AS PARAMETER
	LDKL	A7,DTETAB	DTE TAB ADDR
	ANK	A2,/FF	STRIP OFF OPTION BITS 
	CF	A15,LOOKUP	BRANCH ON CODES, TABLE ADDRESS TO STACK
	DATA	TREQX,RTREQ	LAST ENTRY; ERROR ADDRESS 
	DATA	RECEIVE,RQRECE	RECEIVE REQUEST
	DATA	SEND,RQSEND	SEND REQUEST
	DATA	OPEN,RQOPEN	OPEN REQUEST
	DATA	CLOSE,RQCLOS	CLOSE REQUEST
	DATA	CONPAS,RQCON	CONNECT PASSIVE REQUEST
	DATA	DISCO,RQDIS	DISCONNECT REQUEST
	DATA	RSTAT,RQRSTS	READ STATUS REQUEST
	DATA	SSTAT,RQSST	SET STATUS REQUEST
	DATA	STIMOT,RQTIME	SET REQUEST TIMEOUT 
TREQX	DATA	STATIS,RQSTAT	READ/RESET STATISTICS REQUEST
	EJECT
* 
* 
*	OPEN REQUEST
* 
*	ACTIVATION PARAMETERS:
*		SYMBOLIC DTE-ADDRESS (ECBCW2)
* 
*	FUNCTIONS:
*		1. CHECK IF ALREADY OPEN & IF SO SAME DTE-ADDRESS
*		2. CONVERT & VERIFY DTE ADDRESS
* 
RQOPEN	EQU	*
	LD	A1,ECBCW2,A8	GET SYMBOLIC DTE-ADDRESS 
	LD	A2,DTESTA,A7	GET DTE STATUS 
	ADR	A2,A2	WORD ALIGNED INDEX VALUE 
	ABI	RQOPTB,A2	BRANCH ON INDEX IN TABLE 
RQOPTB	DATA	RQOP20	CLOSED/INACTIVE
	DATA	RQOP15	OPEN IN PROGRESS 
	DATA	RQOP10	OPEN 
	DATA	RQOP15	CLOSE IN PROGRESS
RQOP10	EQU	*
	CW	A1,DTELAD,A7	SAME AS THE ONE WHO OPENED ? 
	RF(E)	RQOP90	YES - OK
RQOP15	EQU	*
	ABL	RTSEQ	RETURN: SEQUENCE ERROR 
* 
RQOP20	EQU	*
	IM	DTESTA,A7	SET OPEN IN PROGRESS
	ST	A1,DTELAD,A7	SAVE SYMBOLIC DTE ADDRESS
	LDR	A2,A7	ADDR TO SELECT AND POLL IN DTE TAB 
	CF	A15,GETDNA	CONVERT AND VALIDATE DTE ADDR
	LDR	A1,A1
	RF(NN)	RQOP80	OK 
	CM	DTELAD,A7	CLEAR DTE ADDR
	CM	DTESTA,A7	CLEAR DTE STATUS
	ABL	RTREQ	RETURN: REQUEST ERROR
* 
RQOP80	EQU	*
	IFT	CODE=1 
	LDR*	A2,A7	DTE ADDRESS IN EBCDIC 
	LDR	A1,A2
	ANK	A2,/FF 
	RF(Z)	RQOP30	ONLY ONE BYTE 
	LC	A2,TASCII,A2	CONVERT INTO ASCII 
	SLL	A2,8 
RQOP30	EQU	*
	ECR	A1,A1
	ANK	A1,/FF 
	LC	A2,TASCII,A1
	STR	A2,A7	SAVE ASCII VALUE IN DTETAB 
	XIF
				=1
	ABL	DTE:ON	CONNECT MODEM 
RQOP90	EQU	*
	LD	A2,DTEPLS,A7	PHYSICAL CONNECTION ?
	ABL(NZ)	RTOK	YES RETURN OK 
	ABL	RTPHYC	RETURN PHYSICAL CONNECTION
	EJECT
* 
*	CLOSE REQUEST 
* 
*	ACTIVATION PARAMETERS:
*		OPTION	/00 = UNCONDITIONAL 
*			/80 = CONDITIONAL 
*	FUNCTIONS:
*		1. IF CONDITIONAL, CHECK IF ANY LOGICAL CONNECTIONS (DWTS) ARE ACTIVE
*		   ACTIVE. 
*		2. IF UNCONDITIONAL, DISCONNECT ALL DWT:S
* 
RQCLOS	EQU	*
	LD	A5,DWTOR,A6	GET OPTION AND ORDER
	LD	A2,ECBCW2,A8	GET SYMBOLIC DTE - ADDR
	RF(Z)	RQCL20 
	CW	A2,DTELAD,A7	CORRECT DTE ?
	ABL(NE)	RTREQ	RETURN: REQUEST ERROR
RQCL20	EQU	*
	LD	A2,DTESTA,A7	GET DTE STATUS 
	ABL(Z)	RTOK	RETURN : OK
	SUK	A2,2	DTE OPENED ?
	ABL(NZ)	RTSEQ	RETURN: SEQUENCE ERROR 
	IM	DTESTA,A7	CLOSE IN PROGRESS 
	LDR	A8,A6	SAVE REQUESTING DWT-ADDR 
* 
RQCL40	EQU	*
	IFT	MESPAS=1 
	LD	A6,DTEDDT,A7	GET DISCARD DWT ADDR 
	RF(Z)	RQCL50 
	LDR	A5,A5	CONDITIONAL CLOSE ?
	RF(N)	RQCL95	YES ! 
	LD	A2,DWTCHN,A6	GET POINTER TO NEXT DWT
	ST	A2,DTEDDT,A7	DISCARD DWT ADDR REMOVED 
	RF	RQCL60
RQCL50	EQU	*
	XIF
	LD	A6,DTEDWT,A7	GET DWT ADDR 
	RF(Z)	RQCL90	NO DWT IN QUEUE 
	LDR	A5,A5	CONDITIONAL CLOSE ?
	RF(N)	RQCL95	YES ! 
	LD	A2,DWTCHN,A6	GET POINTER TO NEXT DWT IN CHAIN 
	ST	A2,DTEDWT,A7	DWT FIRST IN QUEUE REMOVED 
	IFT	MESPAS=1 
RQCL60	EQU	*
	XIF
	CF	A15,RELBUF	REMOVE BUFFERS QUEUED ON DWT 
	CM	DWTSTA,A6	CLEAR DWT-STATUS
	LDK	A1,0	PRESET RETURN CODE
	CWR	A8,A6	REQUESTING DWT ? 
	RF(E)	RQCL80	YES-COMPLETE REQUEST
	LD	A2,DWTST,A6	A PENDING REQUEST ? 
	RB(N)	RQCL40	NO TAKE NEXT DWT
	LDK	A1,R:SEQ	COMPLETE REQUEST WITH SEQUENCE ERROR
RQCL80	EQU	*
	CF	A15,TENDIO	COMPLETE THE REQUEST 
	RB	RQCL40	TAKE NEXT ON QUEUE 
RQCL90	EQU	*
				=1
	LDR	A6,A8	GET REQUESTING DWT ADDR
	LD	A8,DWTECB,A6	RESTORE ECB ADDRESS
				=1
	RF(Z)	RQCL92	REQUEST ALREADY COMPLETED	=1
	LDK	A1,0	RC=0	=1 
	CF	A15,TENDIO	COMPLETE CLOSE REQUEST	=1
RQCL92	EQU	*		=1
	IFT	P6805=0		=1
	LDKL	A5,STB		=1
	CF	A5,CHALTI	HALT I/P DEVICE	=1
	CF	A5,CHALTO	HALT O/P DEVICE	=1
	LDK	A2,0		=1 
	CIO	A2,1,LCUIN	DISCONNECT MODEM	=1 
	XIF			=1 
	IFT	P6805=1		=1
	LDK	A2,1	DISCONNECT ORDER	=1 
	CIO	A2,0,LCUIN	DISCONNECT MODEM	=1 
	XIF			=1 
	CMR	A7	REMOVE NETWORK ADDRESS	=1 
	CM	DTESTA,A7	CLEAR STATUS	=1 
	LD	A1,DCTPGP	POLL TIMER RUNNING ?	=6 
	RF(Z)	RQCL94	NO	=6 
	CM*	DCTPGP	KILL TIMER	=6 
	CM	DCTPGP	CLEAR POINTER	=6 
RQCL94	EQU	*		=6
	CM	DTEDLS,A7	INDICATE DATA LINK DOWN	=6
	ABL	TDISP		=1
RQCL95	EQU	*
	LDK	A2,2 
	ST	A2,DTESTA,A7	SET DTE OPEN AGAIN 
	LDR	A6,A8	RESTORE DWT ADDRESS
	ABL	RTSEQ	SEQUENCE ERROR 
	EJECT
* 
*	CONNECT PASSIVE REQUEST 
* 
*	ACTIVATION PARAMETERS:
*		- SYMBOLIC SUBADDRESS (RIGHTMOST BYTE IN ECBBA-BFR)
*		- DEVICE ADDRESSES IN ECBBA-BFR
*		- LENGTH OF BUFFER (ECBRL) 
*		- SYMBOLIC DTE-ADDRESS (ECBCW2)
* 
*	FUNCTIONS:
*		1. VERIFY DTE-ADDRESS AS PER OPEN REQUEST
*		2. VERIFY & CONVERT SUBTERMINAL ADDRESS
*		3. VERIFY AND STORE DEVICE ADDRESSES 
*		4. LINK CALLING DWT TO QUEUE 
* 
RQCON	EQU	* 
	LD	A2,DTELAD,A7	SYMBOLIC DTE-ADDR
	CW	A2,ECBCW2,A8	CORRECT DTE ?
	ABL(NE)	RTREQ	NO, RETURN: REQUEST ERROR
	LD	A2,DTESTA,A7	GET DTE STATUS 
	SUK	A2,2	OPEN ?
	ABL(NZ)	RTSEQ	NO, RETURN: SEQUENCE ERROR 
	LD	A2,DWTSTA,A6	GET DWT STATUS 
	SUK	A2,2	ALREADY CONNECTED ? 
	ABL(Z)	RTOK	ALREADY CONNECTED	=17
	IFT	MESPAS=1		=13
	LDK	A2,/40	OPTION CODE	=13 
	CC	A2,DWTOPT,A6	DISCARD DWT ?	=13
	RF(NE)	RQCN10	NO	=13 
	CM	DWTCHP,A6	INDICATE DISCARD DWT	=13
	LD	A1,DTEDDT,A7	POINTER TO DISCARD DWT	=13 
	RF(NZ)	RQCN50	MORE THAN ONE DISC. DWT ?	=13
	ST	A6,DTEDDT,A7	SAVE POINTER TO TO DISCARD DWT	=13 
	RF	RQCN60		=13 
RQCN10	EQU	*		=13 
	XIF			=13
	IFF	MMUPAG=0 
	LDKL	A4,SUBBUF	MMU BUFFER ADDRESS	=16
	ST	A4,ECBBA,A8	TO ECB
	CF	A15,DC:MOT	MOVE DATA TO MMU BUFFER
	XIF
	LD	A4,ECBBA,A8	GET ECB-BUFFER ADDRESS
	IFT	MSV1=1 
	LDK	A2,0	RESET A2
	LCR	A2,A4	GET SELECT SUB-ADDRESS 
	SC	A2,DWTSUB,A6	SAVE IT IN THE DWT 
	LD	A1,ECBCW2,A8	GET SYMBOLIC DTE-ADDRESS 
	CF	A15,GETSNA	VALIDATE AND TRANSLATE THE SUB-ADDR
	LDR	A1,A1	IS IT OK ? 
	RF(NN)	RQCN20	YES
	CM	DWTSUB,A7	CLEAR SUB-ADDRESS 
	ABL	RTREQ	RETURN REQUEST ERROR 
RQCN20	EQU	*
	IFT	CODE=1 
	LC	A1,TASCII,A1	CONVERT FROM EBCDIC TO ASCII 
	XIF
	IFT	MSV1=1 
	SC	A1,DWTCHP,A6	SAVE NETWORK ADDRESS 
	XIF
	LC	A2,1,A4	GET SYMBOLIC ADDRESS	=8 
	SC	A2,DWTSUB+1,A6	SAVE IT IN THE DWT 
	LD	A1,ECBCW2,A8	GET SYMBOLIC DTE ADDRESS 
	ST	A1,DWTLAD,A6	SAVE IT IN THE DWT 
	CF	A15,GETSNA	VALIDATE AND TRANSLATE THE SUB-ADDRESS 
	LDR	A1,A1	IS IT OK ? 
	RF(NN)	RQCN30	YES
	CM	DWTSUB,A6	CLEAR SUB-ADDRESS 
	CM	DWTLAD,A6	CLEAR DTE ADDRESS 
	ABL	RTREQ	RETURN REQUEST ERROR 
RQCN30	EQU	*
	IFT	CODE=1 
	LC	A1,TASCII,A1	CONVERT FROM EBCDIC TO ASCII 
	XIF
	SC	A1,DWTCHP+1,A6	SAVE NETWORK ADDRESS 
	IFT	EM3270=1 
	ST	A1,ECBCW2,A8
	XIF
* 
* 
*		LINK DWT TO CONFIGURATION CHAIN
* 
				=13 
RQCN40	EQU	*
	LD	A1,DTEDWT,A7	GET POINTER TO DWT QUEUE 
	RF(NZ)	RQCN50	YES
	ST	A6,DTEDWT,A7	SAVE POINTER TO DWT QUEUE
	RF	RQCN60
RQCN50	EQU	*
	LDR	A2,A1	MOV ADDR TO A2 
	LD	A1,DWTCHN,A2	POINTER TO NEXT DWT
	RB(NZ)	RQCN50	KEEP ON UNTIL LAST IN CHAIN
	ST	A6,DWTCHN,A2	ADD NEW DWT TO CHAIN 
RQCN60	EQU	*
	CM	DWTCHN,A6	END OF CHAIN MARKER 
	ST	A7,DWTCHD,A6	BACKWARD LINK TO ANCHOR
	LDK	A2,2	
	ST	A2,DWTSTA,A6	SET STATUS: CONNECTED
	LDKL	A2,/8000
	ST	A2,DWTRTV,A6	STORE NO TIMING
				=13 
	IFT	STARVI=1 
	LD	A1,DWTCHP,A6	DISCARD DWT ?	=13
	RF(Z)	RQCN65	YES, DO NOT SEND DE	=13 
	LDK	A1,4	STORE DEVICE
	ORS	A1,DWTST,A6	END IN THE DWT 
	CF	A15,INSSQ	INSERT DWT IN STATUS QUEUE
RQCN65	EQU	*		=13 
	XIF
* 
*	START POLL TIMER
* 
	LD	A2,DCTPGP	POLL TIMER POINTER
	RF(NZ)	RQCN70	TIMER ALREADY STARTED	=6 
	CF	A15,SPOTIM
RQCN70	EQU	*
	ABL	RQOP90 
	EJECT
* 
*	DISCONNECT REQUEST
* 
*	ACTIVATION PARAMETERS:
*		DWT-ADDRESS (A6) 
* 
*	FUNCTIONS:
*		1. CHECK IF IN CONNECTED STATE 
*		2. REMOVE DWT-ADDRESS FROM CONFIGURATION CHAIN 
*		3. SET DWT STATUS DISCONNECTED 
* 
*	COMPLETION PARAMETERS:
*		RETURN CODE (A1) 
* 
RQDIS	EQU	* 
	LD	A2,DWTSTA,A6	DWT STATUS = DISCONNECTED ?
	ABL(Z)	RTOK	YES, RETURN: OK
	LD	A3,DTEDWT,A7	FIRST DWT ADDR TO A3 
	RF(Z)	RQDI20	END OF CHAIN
	CWR	A3,A6	OUR DWT ?
	RF(NE)	RQDI10	NO 
	CF	A15,RELBUF	RELEASE QUEUED BUFFERS 
	LD	A3,DWTCHN,A6	YES-TAKE POINTER TO NEXT DWT 
	CM	DWTSTA,A6	SET DWT FREE
	ST	A3,DTEDWT,A7	STORE DWT-ADDR IN DTETAB 
	RB	RQCN70
RQDI10	EQU	*
	LDR	A5,A3	A5 CONTAINES PREVIOUS DWT-ADDR 
	LD	A3,DWTCHN,A5	A3 CONTAINES ADDR TO NEXT DWT ON CHAIN 
	RF(Z)	RQDI20	END OF CHAIN
	CWR	A3,A6	OUR DWT ?
	RB(NE)	RQDI10	NO TAKE NEXT IN CHAIN
	CF	A15,RELBUF	RELEASE QUEUED BUFFERS 
	LD	A3,DWTCHN,A6	YES-TAKE POINTER TO NEXT DWT 
	ST	A3,DWTCHN,A5	AND STORE IT IN PREVIOUS DWT 
	CM	DWTSTA,A6	SET DWT FREE
	RB	RQCN70
RQDI20	EQU	*
	IFT	MESPAS=1 
	LD	A3,DTEDDT,A7	TAKE THE DISCARD DWT ADDR
	CWR	A3,A6	OUR DWT ?
	RF(NE)	RQDI30	SEQUENCE ERROR 
	CF	A15,RELBUF	RELEASE BUFFERS QUEUED 
	CM	DTEDDT,A7 
	CM	DWTSTA,A6	SET DWT FREE
	RB	RQCN70
RQDI30	EQU	*
	XIF
	ABL	RTSEQ	SEQUENCE ERROR 
	EJECT
* 
* 
*	READ STATUS REQUEST 
* 
*	ACTIVATION PARAMETERS:
*		DWT - ADDRESS (A6) 
* 
*	FUNCTIONS:
*		1. TRANSFER LOGICAL CONNECTION STATUS TO APPLICATION 
* 
*	COMPLETION PARAMETERS:
*		LOGICAL CONNECTION STATUS (ECBCW1) 
* 
*	0       3 4       7 8      11 12      15
*	........................................
*	.  DWT   .  DTE    .  DATA   .  PHYS   .
*	.  STATE .  STATE  .  LINK   .  LINK   .
*	.        .         .  STATUS .  STATUS .
*	........................................
* 
RQRSTS	EQU	*
	IFT	EM3270=1 
	LD	A2,ECBCW1,A8	GET OPTION CODE
	RF(NZ)	RQRS10	TEST IF ANY MESSAGE
	XIF
	LD	A2,DWTSTA,A6	DWT STATUS 
	SLL	A2,4	BITS 0-3
	AD	A2,DTESTA,A7	DTE STATUS 
	SLL	A2,4	BITS 4-7
	AD	A2,DTEDLS,A7	DATA LINK STATUS 
	SLL	A2,4	BITS 8-11 
	AD	A2,DTEPLS,A7	PHYSICAL LINK STATUS (BITS 12 - 15)
	ST	A2,ECBCW1,A8	STATUS TO ECB CONTROL WORD 1 
	ABL	RTOK	RETURN: OK
	IFT	EM3270=1 
* 
* 
*		ANY MESSAGE ORDER (ONLY IF EM3270 = 1) 
* 
RQRS10	EQU	*
	LD	A2,DTESTA,A7	GET DTE STATUS 
	SUK	A2,2	OPEN ?
	ABL(NZ)	RTSEQ	NO,SEQUENCE ERROR
	LD	A2,DWTSTA,A6	GET DWT STATUS 
	SUK	A2,2	CONNECTED ? 
	ABL(NZ)	RTSEQ	NO,SEQUENCE ERROR
	LD	A4,DWTIPC,A6	ANY QUEUED MESSAGE ON THIS DWT ? 
	ABL(NZ)	RTOK	YES COMPLETE THE REQUEST
	ABL TDISP	TO DISPATCHER
	XIF
	EJECT
* 
*	SET STATUS REQUEST
* 
* 
*	ACTIVATION PARAMETERS 
*		DWT ADDRESS (A6) 
* 
*	FUNCTIONS:
*		SET DEVICE STATUS (ONLY IF STARVI = 1) 
* 
*		DE DEVICE END : X`'00' 
* 
*		IR INTERVENTION REQUIRED : X'01' 
* 
*		DB DEVICE BUSY :X'10'
* 
*	COMPLETION PARAMETERS:
*		RETURN CODE (A1) 
* 
RQSST	EQU	* 
	IFT	STARVI=0 
	ABL	RTREQ	SET STATUS NOT INCLUDED
	XIF
	IFT	STARVI=1 
	LD	A1,ECBCW1,A8	GET DEVICE STATUS
	ANK	A1,3	MASK DB,IR
	RF(NZ)	RQST90	NOT DE 
	LD	A1,DWTST,A6	GET DEVICE STATUS 
	ANK	A1,/B	WACK SENT, DB OR IR ?	=2 
	RF(Z)	RQST90	NO	=2 
	CF	A15,INSSQ	INSERT DWT IN STATUS QUEUE
	LDK	A1,4	SET DE
RQST90	EQU	*
	ST	A1,DWTST,A6	SAVE STATUS 
	ABL	RTOK	RETYURN : OK
	XIF
	EJECT
* 
*	READ/RESET STATISTICS REQUEST 
* 
*	ACTIVATION PARAMETERS:
*		TYPE = BITS 0-7 OF ECBCW1
*		ECB-ADDRESS (A8) 
*		DWT-ADDRESS OF LOW-LEVEL DWT (A6)
* 
*	FUNCTIONS:
*		1. READ STATISTICS TO USER AREA
*		2. RESET ALL STATISTICS BUFFERS
* 
*	COMPLETION PARAMETERS:
*		NUMBER OF BYTES TRANSFERRED (ECBEL)
*		RETURN CODE (A1) 
* 
RQSTAT	EQU	*
	IFT	STTSTS=0 
	ABL	RTREQ	RC : REQUEST ERROR NO STATISTICS INCLUDED
	XIF
	IFF	STTSTS=0 
	CF	A15,DCSRED	READ STATISTICS
	LDR	A1,A1	OK?
	ABL(NZ)	RTREQ	NO, RETURN: REQUEST ERROR
	LD	A1,ECBCW1,A8	GET TYPE 
	SRL	A1,8	TYPE FIELD TO LEFT BYTE 
	CCK	A1,TYPRR	CORRECT TYPE? 
	RF(NE)	RQST40
	CF	A15,DCSRLL	RESET ALL STATISTICS BUFFERS 
	LDR	A1,A1	LUCKY AGAIN? 
	ABL(NZ)	RTREQ	NO, RETURN: REQUEST ERROR
RQST40	EQU	*
	ABL	RTOK	RETURN: OK
	XIF
	EJECT
* 
*	SET TIMEOUT VALUE 
* 
*	ACTIVATION PARAMETERS:
*		ECBCW1 >= 0 : ACTIVATE TIMING CONTROL
*		              TIMEOUT VALUE IN MULTIPLES OF 100 MS;
*		              0 = IMMEDIATE TIMEOUT. 
*		       < 0:   DE-ACTIVATE TIMING CONTROL 
* 
*	FUNCTIONS:
*		STORE VALUE DIRECTLY IN CALLER'S DWT 
* 
*	COMPLETION PARAMETERS:
*		DWTRTV = TIMEOUT VALUE = ECBCW1
* 
RQTIME	EQU	*
	LD	A2,ECBCW1,A8	GET TIMEOUT VALUE FROM ECB 
	ST	A2,DWTRTV,A6	STORE IN DWT 
	ABL	RTOK	RETURN: OK
	EJECT
* 
*	SEND REQUEST
* 
*	ACTIVATION PARAMETERS:
*		BUFFER ADDRESS (ECBBA) 
*		BUFFER LENGTH (ECBRL)
*		SUBTERMINAL ADDRESS (DWT)
*		ECB CONTROL WORD 1 
*	
*	FUNCTIONS:
*		1. VERIFY THAT LOGICAL & PHYSICAL CONNECTIONS EXIST. 
*		2. VERIFY BUFFER SIZE IF MMU 
*		3. QUEUE REQUESTING DWT
*		4. COMPLETE WHEN ACK'D OR TIMEOUT. 
* 
RQSEND	EQU	*
	LD	A2,DWTSTA,A6	GET DWT STATUS 
	SUK	A2,2	CONNECTED ? 
	ABL(NZ)	RTSEQ	NO, RETURN: SEQUENCE ERROR 
	LD	A2,DTEPLS,A7	PHYSICAL CONNECTION ACTICE ? 
	ABL(Z)	RTPHYC	NO, RETURN: PHYSICAL CONNECTION ERROR
	LD	A2,DTEDLS,A7	LOGICAL CONNECTION ACTIVE ?
	ABL(Z)	RTLOGC	NO, RETURN: LOGICAL CONNECTION ERROR 
	LC	A2,DWTOPT,A6	GET OPTION 
	ANK	A2,/FF 
	RF(Z)	RQSE10	THERE IS NO OPTION
	SUK	A2,/20	WHICH OPTION ?
	ABL(NZ)	RTREQ	WRONG OPTION :REQUEST ERROR
	CF	A15,RELBUF	RELEASE BUFFERS QUEUED 
RQSE10	EQU	*
	IFT	MMUPAG=1 
	LD	A2,ECBRL,A8	REQUESTED LENGTH
	CWK	A2,BUFLEN	ILLEGAL LENGTH ? 
	ABL(G)	RTLGTH	YES, RETURN: ILLEGAL BUFFER LENGTH 
	XIF
	CF	A15,TIMEWR	START TIMER
	CF	A15,INSWQ	QUEUE SEND REQUEST
	ABL	TDISP
* 
	EJECT
* 
*	RECEIVE REQUEST 
* 
*	ACTIVATION PARAMETERS:
*		BUFFER ADDRESS (ECBBA) 
*		REQUESTED BUFFER LENGTH IN CHARS. (ECBRL)
*		SUBTERMINAL ADDRESS (DWT)
* 
*	FUNCTIONS:
*		1. VERIFY THAT LOGICAL & PHYSICAL CONNECTIONS EXIST. 
*		2. TRANSFER TO THE APPLICATION ANY MESSAGE QUEUED FOR THE DWT, 
*		3. COMPLETE WHEN MESSAGE RECEIVED OR NO MESSAGE RECEIVED 
*		   WITHIN TIMEOUT PERIOD.
* 
*	COMPLETION PARAMETERS:
*		ACTUAL LENGTH OF RECEIVED MESSAGE (ECBEL)
*		RETURN CODE (A1) 
* 
RQRECE	EQU	*
	LD	A2,DWTSTA,A6	GET DWT STATUS 
	SUK	A2,2	CONNECTED ? 
	ABL(NZ)	RTSEQ	NO, RETURN: SEQUENCE ERROR 
	LD	A2,DTEPLS,A7	PHYSICAL CONNECTION ACTIVE ? 
	ABL(Z)	RTPHYC	NO, RETURN: PHYSICAL CONNECTION ERROR
	LD	A4,DWTIPC,A6	ANY BUFFER ON QUEUE ?
	RF(NZ)	RQRE10	YES
	LD	A2,DTEDLS,A7	LOGICAL CONNECTION ACTIVE ?
	ABL(Z)	RTLOGC	NO, RETURN: LOGICAL CONNECTION ERROR 
	CF	A15,TIMERE	START TIMER
	RF	RQRE40	GO TO DISPATCHER 
RQRE10	EQU	*
	LD	A3,2,A4	EFFECTIVE LENGTH
	ST	A3,ECBEL,A8 
	LD	A1,DWTLAD,A6	SYMBOLIC DTE-ADDRESS 
	LD	A2,4,A4	NETWORK SUB-ADDRESS 
	CF	A15,GETSSA	GET SYMBOLIC SUB-ADDRESS 
	ST	A1,ECBCW2,A8	AND SAVE IT IN ECB 
	IFT	REMTIM=1		=9 
	LD	A1,DWTRTV,A6	GET REQUESTED TIMEOUT VALUE	=9 
	ST	A1,ECBCW1,A8	STORE IN CONTROL WORD 1	=9 
	XIF			=9 
	LDK	A1,0	RC : ACCEPTED AND COMPLETED 
	LDR*	A2,A4	GET NEXT BUFFER IN QUEUE
	RF(Z)	RQRE20	NO MORE BUFFERS IN QUEUE
	ORKL	A1,R:DATA	RC: AND MORE DATA AVAILABLE 
RQRE20	EQU	*
	ST	A2,DWTIPC,A6 	STORE AS FIRST IN QUEUE 
	ADK	A4,6 
	CF	A15,DC:MIN	MOVE DATA TO USER BUFFER 
RQRE40	EQU	*
	ABL	TDISP	GO TO DISPATCHER 
	EJECT
* 
* 
*		COMPLETE APPLICATION REQUEST 
* 
RTREQ	EQU	* 
	LDKL	A1,R:REQ	RC = REQUEST ERROR 
	RF	RQRTN 
RTABRT	EQU	*
	LDKL	A1,R:ABRT	RC = ABORTED
	RF	RQRTN 
RTTIME	EQU	*
	LDK	A1,R:TIME	RC = TIME OUT
	RF	RQRTN 
RTSEQ	EQU	* 
	LDK	A1,R:SEQ	RC = SEQUENCE ERROR 
	RF	RQRTN 
RTLGTH	EQU	*
	LDK	A1,R:LGTH	RC = ILLEGAL LENGTH
	RF	RQRTN 
RTLOGC	EQU	*
	LDK	A1,R:LOGC	RC = LOGICAL CONNECTION ERROR
	RF	RQRTN 
RTPHYC	EQU	*
	LDK	A1,R:PHYC	RC = PHYSICAL CONNECTION ERROR 
	RF	RQRTN 
RTOK	EQU	*
	LDK	A1,0	RC = OK 
RQRTN	EQU	* 
	ABL	DISEND	COMPLETE REQUEST AND GO TO DISPATCHER 
	EJECT
* 
*	LOOKUP - LOOK UP KEY IN TABLE & BRANCH ON ADDRESS 
* 
*	CALL: 
*		CF     A15,LOOKUP          TABLE ADDRESS TO STACK
*		DATA   LAST,ADDRE          LAST ENTRY; ERROR ADDRESS 
*		DATA   KEY1,ADDR1          KEY (A2); ADDRESS FOR BRANCH
*		 "       "    "
*	LAST	DATA   KEYN,ADDRN
* 
*	ENTRY: A2 = KEY VALUE 
*	EXIT: A3 & A4 DESTROYED 
* 
LOOKUP	EQU	*
	LDR*	A3,A15	POINT TO NEXT INSTRUCTION ADDRESS IN STACK 
	LDR*	A3,A15	GET CONTENTS = TABLE ADDRESS 
	LDR*	A4,A3	GET LAST LEGAL ADDRESS
	LD	A1,2,A3	ERROR ADDRESS 
* 
LOOK50	EQU	*	LOOP ENTRY 
	ADK	A3,4	GET NEXT TABLE ENTRY ADDRESS
	CWR	A3,A4	PAST THE END?
	RF(G)	LOOK90	YES = NOT FOUND 
	CWR*	A2,A3	KEY = VALUE IN TABLE? 
	RB(NE)	LOOK50	NO - CHECK NEXT ENTRY
	ABI	2,A3	BRANCH TO TABLE ADDRESS 
*		KEY NOT FOUND
LOOK90	EQU	*
	LDR	P,A1	GO TO ERROR ADDRESS 
	EJECT
* 
* 
* 
*	REQUEST TIMER HANDLING PART 
* 
* 
* 
*	RECEIVE TIMER=TIMERR
* 
TIMERE	EQU	*
	LDR	A1,A6
	LD	A2,DWTRTV,A6	GET TIMEOUT VALUE
	RF(N)	TIMRTN	NO TIMING 
	RF(Z)	ITOUTR	TIMER=0 => IMMEDIATE TIMEOUT
	ST	A2,TIMERR 
	CF	A15,SETIME
	DATA	TOUTRE
TIMERR	DATA	0 
	ST	A4,DWTRTP,A6	STORE TIMER POINTER
TIMRTN	EQU	*
	ABL	RTNA15 
* 
*	TIMEOUT READ TIMER
* 
ITOUTR	EQU	*
	ADKL	A15,4 
	RF	TIMOUT
TOUTRE	EQU	*
	LDR	A6,A1	FETCH DWT
	CM	DWTRTP,A6 
	RF	TIMOUT	COMPLETE REQUEST RC=TIMEOUT
* 
* 
*		 RETURN FROM TIMER HANDLING
* 
	EJECT
* 
*	SEND TIMER=TIMWR
* 
TIMEWR	LDR	A1,A6
	LD	A2,DWTRTV,A6	GET TIMEOUT VALUE
	RB(N)	TIMRTN	NO TIMING 
	RB(Z)	ITOUTR	TIMER=0 => IMMEDIATE TIMEOUT
	ST	A2,TIMWR
	CF	A15,SETIME
	DATA	TOUTWR
TIMWR	DATA	0
	ST	A4,DWTRTP,A6
	RB	TIMRTN
* 
*	TIMEOUT WRITE TIMER 
* 
TOUTWR	EQU	*
	LDR	A6,A1	FETCH DWT
	CM	DWTRTP,A6 
	CF	A15,REMOVW	REMOVE FROM WRITE QUEUE
* 
* 
*	THIS INSTRUCTION DOES NOT BELONG
*	TO THE STANDARD INTERFACE 
	LD	A2,FDWTUT 
	CWR	A2,A6
	RF(NE)	TIMOUT	THIS DWT IS NOT WRITING
	CM	XACK	INDICATE 'ACK NOT EXPECTED'
	CM	FDWTUT
TIMOUT	EQU	*
	ABL	RTTIME	COMPLETE REQUEST RC=TIMEOUT 
	EJECT
* 
* 
*	STOP REQUEST TIMING 
* 
*	REMAINING TIME IS RETURNED IN A2
* 
* 
CTIME	EQU	* 
	LD	A2,DWTRTP,A6	GET TIMER POINTER
	RF(Z)	CTIM10	NOT RUNNING 
	IFT	REMTIM=1		=9 
	LDR*	A2,A2		=9 
	NGR	A2,A2	GET REMAINING TIME	=9
	XIF			=9 
	CM*	DWTRTP,A6	KILL TIMER	=9
	CM	DWTRTP,A6 
				=3
CTIM10	EQU	*
	ABL	RTNA15 
	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
	INH
	LDR*	A4,A2 
	RF(Z)	GBUF10	NO BUFFER FREE
	LDR*	A3,A4	REMOVE BUFFER FROM FREE CHAIN 
	STR	A3,A2
GBUF10	EQU	*
	ABL	RTNA15 
	EJECT
* 
* 
*	RELEASE RECEIVE BUFFER
* 
*	A4 CONTAINS BUFFER ADDRESS
*	CALLING SEQUENCE: CF A15,RRBUF
*	A2 AND A3 ARE DESTROYED 
* 
* 
RRBUF	LDKL	A2,DCRBUF	RECEIVE BUFFERS
	INH
RBUF10	EQU	*
	LDR*	A3,A2 
	RF(Z)	RBUF20 
	LDR	A2,A3
	RB	RBUF10
RBUF20	EQU	*
	STR	A4,A2
	CMR	A4 
	RB	GBUF10	RETURN TO CALLER 
	EJECT
* 
*	RELEASE ALL RECEIVE BUFFERS QUEUED ON A DWT 
* 
*	A6 - DWT ADDR 
*	A1 AND A4 ARE DESTROYED 
*	CALLING SEQUENCE: CF    A15,RELBUF
* 
* 
RELBUF	EQU	*
	LDK	A1,DWTIPC	SET BUFFER QUEUE DISP. 
	ADR	A1,A6
RLBU10	EQU	*
	LDR*	A4,A1	NEXT IN BUFFER QUEUE
	RB(Z)	GBUF10 
	LDR*	A2,A4	REMOVE FROM QUEUE 
	STR	A2,A1	.
	CF	A15,RRBUF	RELEASE BUFFER
	RB	RLBU10
	EJECT
* 
* 
*	INSERT DWT IN SEND REQUEST QUEUE
* 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
INSWQ	LDKL	A2,DCWRQ	GET QUEUE ANCHOR
	LDK	A4,DWTOPN
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 
	EJECT
* 
* 
*	REMOVE DWT FROM SEND REQUEST QUEUE
* 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
REMOVW	LDKL	A2,DCWRQ	GET QUEUE ANCHOR 
	LDK	A4,DWTOPN	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	STARVI=0 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
INSSQ	LDKL	A2,DCSTQ	GET QUEUE ANCHOR
	LDK	A4,DWTOPE
	RB	INSWQ2
* 
* 
*	REMOVE DWT FROM STATUS QUEUE
* 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
REMOVS	LDKL	A2,DCSTQ	GET QUEUE ANCHOR 
	LDK	A4,DWTOPE
	RB	REM06 
	XIF
	EJECT
* 
* 
*	QUEUE ALLOCATED RECEIVE BUFFER
* 
*	A4=BUFFER ADDR
*	A2,A3 DESTROYED 
* 
QRBUF	EQU	* 
	SUK	A4,6 
	LDK	A2,DWTIPC	SET BUFFER QUEUE DISP. 
	ADR	A2,A6
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
* 
* 
*	STORE REGISTER A3-A8
*	CALLING SEQUENSE: CF A15,STREG
* 
STREG	ST	A3,LCA3
	ST	A4,LCA4 
	ST	A5,LCA5 
	ST	A6,LCA6 
	ST	A7,LCA7 
	ST	A8,LCA8 
	RF	RTNA15	RETURN 
* 
* 
*	RESTORE 
*	CALLING SEQUENCE: CF A15,LDREG
* 
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
* 
* 
*		RETURN VIA REGISTER 15 
* 
RTNA15	EQU	*
	ADKL	A15,4 
	ABR*	A15 
	EJECT
* 
*	POLL TIME OUT 
* 
PTOUT	LDKL	A5,STB	LOAD A5 STACK BASE
	LDR	A6,A1	RELOAD DWT ADDRESS 
	LDKL	A7,DTETAB 
	CM	DTEDLS,A7 
	IFT	STTSTS=1 
* 
* 
*		COUNT POLL TIME OUT
* 
	LDK	A1,CSSXC3
	CF	A15,DCSUPS
	XIF
	CF	A15,SPOTIM	START POLL TIMER 
	ABL	TDISP
* 
*	RESTART POLL TIMER WHEN POLL HAS BEEN RECEIVED
* 
CPTIM	EQU	* 
	LDK	A2,1	INDICATE
	ST	A2,DTEDLS,A7	DATA LINK UP 
	LDKL	A2,-TIMPOL
	ST*	A2,DCTPGP	RESTART TIMER
	RTN	A5 
* 
*	START POLL TIMER
* 
SPOTIM	EQU	*
	LDR	A1,A6	LOAD DWT ADDRESS AS PARAMETER
	CF	A15,SETIME	START TIMER
	DATA	PTOUT,TIMPOL
	ST	A4,DCTPGP	STORE TIMER POINTER 
	RB	RTNA15	RETURN 
	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
	LDKL	A7,DTETAB 
	IFT	STTSTS=1 
* 
* 
*		COUNT PROCEDURE TIME OUT 
* 
	LDK	A1,CSSXC2
	CF	A15,DCSUPS
	XIF
	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
	CMR	A1	STOP TIMER
	CM	DCTPP 
HPT10	RTN	A5

* 
* 
*   WAIT 1 SEC. FOR MODEM CONNECTION
* 

DTE:ON	LDR	A1,A6	DWT ADDRESS
	CF	A15,SETIME	WAIT 1 SEC.
	DATA	DTE:10,10 
				=1
	LDKL	A5,STB		=1
	CF	A5,CSYNCI	CONNECT MODEM	=1
	CF	A5,CHALTI	NO INTERRUPTS ALLOWED	=1
	ABL	TDISP	=1 


* 
* 
*   MODEM-CONNECT TIMEOUT 
* 

DTE:10	LDR	A6,A1	DWT ADDRESS
	LDKL	A7,DTETAB 
	IM	DTESTA,A7	SET OPEN STATUS	=1
	LDKL	A5,STB		=1
	CF	A5,CSYNCI	PUT CU IN ACTIVE MODE	=1
	CF	A5,CHALTI	HALT I/P DEVICE TO GET MODEM STATUS	=1
	IM	DTEPLS,A7	PRESET PHYSICAL STATUS = OK	=1
	ANK	A2,1	MODEM OK ?	=1 
	RF(Z)	DTE:20	YES	=1
	CM	DTEPLS,A7	INDICATE PHYSICAL ERROR	=1
DTE:20	EQU	*		=1
	LDR	A1,A2	SET RETURN CODE	=1 
	CF	A15,TENDIO	COMPLETE THE REQUEST	=1
	CF	A15,SPOTIM	START POLL TIMER	=6
	ABL	BRM	START I/P	=1 
	EJECT
	IFT	MESPAS=1 
* 
* 
*		GET DWT ADDRESS
* 
MESDWT	EQU	*
	CWR	A6,A7	IS IT DTETAB-ADDRESS ? 
	RF(E)	MES200	YES 
	LD	A2,DTEDDT,A7	GET ADDR TO DDT
	CWR	A6,A2	IS IT DDT-ADDR 
	RF(E)	MES200	YES 
	LD	A2,DWTST,A6	ANY REQUEST ? 
	RF(N)	MESD50	NO
	LD	A2,DWTOR,A6	ANY MESSAGE ORDER ? 
	ANK	A2,/FF 
	RF(Z)	MES200	YES 
	SUK	A2,RECEIVE	A RECEIVE ORDER ? 
	RF(Z)	MES200	YES 
MESD50	EQU	*
	LD	A2,DTEDDT,A7	IS THERE A DDT CONNECTED ? 
	RF(Z)	MES100	NO
	LDR	A6,A2	GET DDT-ADDR 
	RF	MES200
MES100	EQU	*
	LDR	A6,A7	GET DTETAB-ADDR
MES200	EQU	*
	ABL	RTNA15	RETURN VIA A15
	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)	BRM120	PARITY ERROR 
* 
* 
*		CHECK IF IT IS A CONTROL CHARACTER 
* 
	LDR	A1,A2
	CF	A15,LOOKUP	BRANCH ON CODES, TABLE ADDRESS TO STACK
	DATA	BRM100,BRM200	LAST ENTRY,POLL OR SELECT SEQUENCE
	DATA	PAD,BRM130	PAD RECEIVED	DK1 
	DATA	STX,STX100	STX RECEIVED 
	DATA	EOT,EOT100	EOT RECEIVED 
	DATA	ENQ,ENQ100	ENQ RECEIVED 
	DATA	DLE,DLE100	DLE RECEIVED 
BRM100	DATA	NAK,NAK100	NAK RECEIVED 
	EJECT
* 
* 
*		THROUGHPUT ERROR 
* 
BRM110	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.
* 
BRM120	EQU	*
	CF	A5,READ	READ CHARACTER
	LD	A1,DCSTCU	ANY STATUS FROM CONTROL UNIT ?
	RF(NZ)	BRM130	YES
BRM125	EQU	*		DK1 
	ANK	A2,/7F 
	SUK	A2,/7F 
	RB(NZ)	BRM120	NO 
BRM130	EQU	*
	CF	A5,CHALTI	HALT INPUT
	RB	BRM 
	EJECT
* 
* 
*		CHECK IF IT IS A POLL OR A SELECT SEQUENCE 
* 
BRM200	EQU	*
	IFT	MSV1=0 
	LDR	A4,A2
	CF	A5,READP	READ CHARACTER 
	CWR	A2,A4
	RB(NE)	BRM125	INVALID SEQUENCE	DK1 
	XIF
	LDK	A3,0 
	CC	A2,1,A7	IS IT A POLL ?
	RF(E)	BRM210	POLLING 
	LDK	A3,2 
	CCR	A2,A7	IS IT A SELECT ? 
	RB(NE)	BRM125	INVALID SEQUENCE	DK1 
BRM210	EQU	*
	CF	A5,READP	READ 1:ST STA
	RB(NZ)	BRM	PARITY ERROR
	LDR	A4,A2
	IFT	MSV1=0 
	CF	A5,READP	READ 2:ND STA
	CWR	A2,A4
	RB(NE)	BRM120	INVALID SEQUENCE 
	XIF
	CF	A5,READP	READ ENQ 
	SUK	A2,ENQ 
	RB(NE)	BRM120	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,A4
	SUK	A3,2 
	RF(Z)	SELECT	SELECTING 
* 
* 
*		POLLING
* 
	CWK	A4,GP
	RF(E)	GPOLL	GENERAL POLL 
	CF	A5,FINTEP	CHECK IF STA PRESENT (POLL ADDRESS) 
				=10 
* 
	EJECT
* 
* 
*	SPECIFIC POLL HAS BEEN RECEIVED 
* 
* 
	IFF	STARVI+SPECP=0 
	LD	A1,XACK	
	RF(NZ)	POL100	ACK EXPECTED 
	LDR	A6,A3	LOAD DWT ADDRESS IN A6	=10 
	RF(Z)	POL150	REQ. DEV. NOT CONNECTED, SEND EOT	=10 
	CF	A5,CPTIM	CHECK POLLTIMER
	IFT	STARVI=1 
	LD	A1,DWTST,A6	GET STATUS
	ANK	A1,7 
	RF(NZ)	POL120	PENDING STATUS 
	XIF
	IFF	STARVI+SPECP=0 
	LD	A1,DWTST,A6 
	RF(N)	POL150	NO REQUEST
	LD	A1,DWTOR,A6	GET ORDER 
	ANK	A1,/FF	MASK AWAY OPTION PART 
	SUK	A1,6 
	RF(Z)	POL170	WRITE REQUEST 
	XIF
	RF	POL150	SEND EOT 
	EJECT
* 
* 
*	GENERAL POLL HAS BEEN RECEIVED
* 
* 
GPOLL	EQU	* 
	LD	A1,XACK	
	RF(Z)	POL110	ACK NOT EXPECTED
				=11 
POL100	EQU	*
	CF	A5,HPTIM	KILL PROCEDURE TIMER	=11 
	CF	A5,TRENQ	SEND ENQ 
	CF	A5,SPTIM	START PROCEDURE TIMER
	ABL	BRM	WAIT FOR RESPONSE
POL110	EQU	*	 
	CF	A5,CPTIM	CHECK POLL TIMER 
	IFF	STARVI=0 
	LD	A6,DCSTQ	 
	RF(Z)	POL140	NO STATUS TO BE SENT
	SUK	A6,DWTOPE	GET DWT ADDRESS
POL120	EQU	*
	CF	A5,TRSTA	SEND STATUS
	CF	A5,SPTIM	START PROCEDURE TIMER
	IM	XACK	SET 'ACK EXPECTED' 
	XIF
	IFF	STARVI=1 
	RF	POL140
	XIF
POL130	EQU	*
	ABL	BRM
POL140	EQU	*
	LD	A6,DCWRQ
	RF(NZ)	POL160	WRITE ON QUEUE 
POL150	EQU	*
	CF	A5,TREOT	SEND EOT 
	RB	POL130
POL160	EQU	*
	SUK	A6,DWTOPN	GET DWT ADDRESS
POL170	EQU	*
	LD	A8,DWTECB,A6	GET ECB ADDRESS
	RF(NZ)	POL180
	CF	A15,REMOVW
	RB	POL150
POL180	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
POL190	EQU	*
	ST	A4,FECBBA	SAVE BUFFER ADDRESS 
			.	=15
	ST	A3,FECBRL	SAVE LENGTH 
	CM	FBAX	RESET BUFFER INDEX 
POL200	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	POL130
	EJECT
* 
* 
*		SELECT HAS BEEN RECEIVED 
* 
SELECT	EQU	*
	CF	A5,FINTES 
	LDR	A6,A3	GET DWT-ADDR 
	RF(NZ)	SEL100
	IFT	MESPAS=1 
	LD	A6,DTEDDT,A7	GET DDT-ADDR 
	RF(NZ)	SEL100
	XIF
	LDKL	A6,DTETAB	DTETAB ADRR 
SEL100	EQU	*
	LD	A1,XACK	
	RB(NZ)	POL100	ERROR. ACK EXPECTED
	IFF	STARVI=0 
	LD	A1,DWTST,A6	GET STATUS
	LDR	A3,A1
	ANK	A1,1 
	RF(Z)	SEL120	NO PENDING STATUS 
	CF	A5,TRRVI	SEND RVI 
	XIF
	IFF	STARVI=1 
	RF	SEL120
	XIF
SEL110	EQU	*
	ABL	BRM
SEL120	EQU	*
				=2
	IFT	STARVI=1		=2 
	ANK	A3,/A	WACK SENT OR DB ?	=2 
	RF(NZ)	SEL140	YES	=2 
	XIF
				=2
	LD	A1,DCRBUF 
	RF(NZ)	SEL150	BUFFER AVAILABLE 
	IFT	STTSTS=1 
	LDK	A1,CSSRBY	BUFFER NOT AVAILABLE 
	CF	A15,DCSUPS	INCREMENT COUNTER
	XIF
SEL140	EQU	*
				=2
	IFF	NOWACK=1		=2 
	CF	A5,TRWACK	SEND WACK 
	XIF
	RB	SEL110
SEL150	EQU	*
	CF	A5,PRREC	PREPARE FOR TEXT RECEPTION 
	ADK	A1,6 
	ST	A1,FBLST
	CF	A5,TRACK	SEND ACK,0 
	RB	SEL110
	EJECT
* 
* 
*	EOT HAS BEEN RECEIVED 
* 
* 
EOT100	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	IFT	RCOM=1 
	CM	XRB	RESET READ BUFFER 
	XIF
	LD	A1,XACK 
	RF(Z)	EOT120	ACK IS NOT EXPECTED 
	LD	A6,FDWTUT	GET WRITING DWT 
	RF(Z)	EOT110	NO ONE WRITING
	LDK	A1,2	SET RC=2
	CF	A5,CWRITE	COMPLETE WRITE REQUEST
EOT110	EQU	*
	CM	XACK	RESET 'ACK EXPECTED' 
EOT120	EQU	*
	CM	XSEL	RESET 'SELECTED' 
	ABL	BRM
	EJECT
* 
* 
*	STX HAS BEEN RECEIVED 
* 
* 
STX100	EQU	*
	CF	A5,HPTIM
	IFT	TPMODE=1 
	ABL	BRM120	INVALID SEQENCE 
STX110	EQU	*
	XIF
	LD	A1,XSEL 
	RF(Z)	STX150	NOT SELECTED
	LD	A1,DCRBUF 
	IFF	STTSTS=1 
	ABL(Z)	BRM120	NO BUFFER AVAILABLE
	XIF
	IFT	STTSTS=1 
	RF(NZ)	STX120
* 
*	NO BUFFER AVAILABLE 
* 
	LDK	A1,CSSRBY
	CF	A15,DCSUPS	INCREMENT COUNTER
	ABL	BRM120 
	XIF
STX120	EQU	*
	CF	A5,RDMESS	READ MESSAGE
	IFT	STTSTS=1 
* 
* 
*		COUNT MESSAGES RECEIVED
* 
	LDK	A1,CSSRBL
	CF	A15,DCSUPS
	XIF
	SUK	A3,1 
	RF(NZ)	STX170	MESSAGE OK 
STX130	EQU	*
	CM	XSTA	INDICATE 'INVALID MESSAGE' 
STX140	EQU	*
	CF	A5,TRNAK	SEND NAK 
	ABL	BRM
STX150	EQU	*
	IFT	RCOM=1 
	LD	A1,XACK 
	RF(Z)	STX160	ACK IS NOT EXPECTED 
	LD	A1,DCRBUF 
	RF(Z)	STX160	NO BUFFER AVAILABLE 
	LD	A6,FDWTUT	GET WRITING DWT 
	ABL(Z)	BRM120	NO ONE WRITING. RESYNCHRONIZE
	LDR*	A2,A6	GET STA 
	CF	A5,PRREC	PREPARE FOR TEXT RECEPTION 
	LDK	A1,0	SET RC=0
	CF	A5,CWRITE	COMPLETE WRITE REQUEST
	CM	CACK	PRESET ACK-1 
	RB	STX120	READ THE MESSAGE 
	XIF
STX160	CF	A5,READ	READ ONE CHARACTER
	CWK	A2,ENQPAR	IS IT ENQ ?
	RB(Z)	STX140	FORWARD ABORT SEQUENCE
	RB	EOT120
STX170	EQU	*
	IM	XSTA	INDICATE MESSAGE OK
	LD	A4,DCRBUF	GET BUFFER ADDRESS
	ADK	A4,6 
	CW	A4,FBLST
	RF(NE)	STX180	NOT FIRST BLOCK
	IFF	RCOM=0 
	LDK	A1,ESC 
	CCR	A1,A4
	RB(NE)	STX130	ESC NOT FOUND
	LC	A1,1,A4	GET COMMAND CODE
	SUK	A1,RDBCOM
	RF(Z)	RDBUF	READ MODIFIED RECEIVED 
	SUK	A1,RDMCOM-RDBCOM 
	RF(Z)	RDMOD	READ BUFFER RECEIVED 
	XIF
STX180	EQU	*
	SUK	A3,1 
	RF(Z)	STX280	SEND ACK
	LD	A6,FDWTIN	GET INPUT DWT 
	IFT	MESPAS=1 
	CF	A15,MESDWT
	XIF
	CWR	A7,A6	IS IT DTETAB ? 
	RF(E)	STX280	SEND ACK
	LD	A2,DWTSTA,A6	.	=14
	RF(Z)	STX280	TERMINAL DISCONNECTED	=14 
	CM	FBAX
	CF	A15,GRBUF	ALLOCATE RECEIVE BUFFER 
	ADK	A4,6 
	IFT	RCOM=1 
	LDR*	A2,A6	GET ADDRESS 
	LC	A2,TEBCDIC,A2	TRANSLATE IT TO EBCDIC
	LD	A1,DCRBUF	IS THERE A BUFFER 
	RF(Z)	STX200	NO
	ST	A2,+4,A1	STORE THE ADDR 
STX200	EQU	*
	XIF
	LD	A2,DWTST,A6	ANY REQUEST ? 
	RF(N)	STX220	NO
	LD	A2,DWTOR,A6	GET ORDER 
	IFT	EM3270=1 
	RF(Z)	STX210	ANY MESSAGE ORDER ? 
	XIF
	CWK	A2,RECEIVE	A RECEIVE ? 
	RF(NE)	STX220	NO 
STX210	EQU	*
				=12 
	LD	A8,DWTECB,A6	GET ECB ADDRESS
	LD	A3,-4,A4	GET LENGTH 
	ST	A3,ECBEL,A8	STORE EFFECTIVE LENGTH
	LD	A1,DWTLAD,A6	SYMBOLIC DTE ADDRESS	=12 
	LD	A2,-2,A4	NETWORK SUB-ADDRESS	=12
	CF	A15,GETSSA	GET SYMBOLIC SUB ADDRESS	=12 
	ST	A1,ECBCW2,A8	AND SAVE IT IN ECB	=12 
	LDK	A1,0	RESET RETURN CODE	=12 
	CF	A15,CTIME	STOP REQUEST TIMING 
	IFT	REMTIM=1		=9 
	ST	A2,ECBCW1,A8	STORE REMAINING TIME 
	XIF			=9 
STX220	EQU	*
	IFT	STARVI=1 
	LC	A2,+2,A4	GET WCC/CCC
	ANK	A2,/FF 
	LC	A2,TEBCDIC,A2 
	ANK	A2,8 
	RF(Z)	STX230 
	LD	A2,DWTST,A6 
	ORK	A2,/A
	ST	A2,DWTST,A6 
STX230	EQU	*
	XIF
	LD	A2,DWTST,A6	ANY REQUEST ? 
	RF(NN)	STX240	YES
	CF	A5,QRBUF	QUEUE BUFFER 
	RF	STX270
STX240	EQU	*
	LD	A2,DWTOR,A6	GET ORDER 
	CWK	A2,RECEIVE	RECEIVE ORDER ? 
	RF(NE)	STX260	NO 
				=12 
	LDK	A1,0	RESET RETURN CODE 
	LD	A2,DWTIPC,A6	ANY QUEUED MESSAGES ?
	RF(Z)	STX250	NO
	ORKL	A1,R:DATA	YES 
STX250	EQU	*
	CF	A15,DC:MIN	MOVE TO USER BUFFER
	RF	STX270
STX260	EQU	*
	CF	A5,QRBUF	QUEUE BUFFER 
	IFT	EM3270=1 
	LD	A2,DWTOR,A6	GET ORDER 
	RF(NZ)	STX270	NOT ANY MESSAGE ORDER
	CF	A15,TENDIO	COMPLETE REQUEST 
	XIF
STX270	EQU	*
	IFT	STARVI=1 
	LD	A1,DWTST,A6	GET STATUS
	ANK	A1,8	MASK A1 
	RF(Z)	STX280 
	CF	A5,TRWACK	SEN WACK
	RF	STX290
	XIF
STX280	EQU	*
	CF	A5,TRACK	SEND ACK 
STX290	EQU	*
	ABL	BRM
	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	POL190 
	XIF
	EJECT
* 
* 
*	ENQ HAS BEEN RECEIVED 
* 
* 
ENQ100	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	LD	A1,XACK 
	RF(NZ)	NAK110	RETRANSMISSION OF MESSAGE
	OR	A1,XSEL 
	RF(Z)	ENQ110	IN CONTROL STATE
	CF	A5,TRREP	REPEAT LAST CONTROL SEQUENCE 
ENQ110	EQU	*
	ABL	BRM
	EJECT
* 
* 
*	NAK HAS BEEN RECEIVED 
* 
* 
NAK100	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	LD	A1,XACK 
	RF(NZ)	NAK110	ACK EXPECTED 
	OR	A1,XSEL 
	RB(Z)	ENQ110	IN CONTROL STATE
	RF	DLE160
NAK110	EQU	*
	LD	A6,FDWTUT	GET WRITING DWT 
	IFF	STARVI=0 
	LD	A1,XSTA 
	ABL(NZ)	POL120	STATUS HAS BEEN TRANSMITTED 
	XIF
	LD	A1,FBLST	GET START POINT FOR LAST BLOCK 
	SU	A1,FECBBA	COMPUTE BUFFER INDEX
	ST	A1,FBAX 
	IFT	STTSTS=1 
* 
* 
*		COUNT MESSAGES RETRANSMITTED 
* 
	LDK	A1,CSSTRT
	CF	A15,DCSUPS
	XIF
	ABL	POL200 
	EJECT
* 
* 
*	DLE HAS BEEN RECEIVED 
* 
* 
DLE100	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	LD	A1,XACK 
	RF(NZ)	DLE110
	IFT	TPMODE=1 
	CF	A5,READ 
	CWK	A2,STX 
	ABL(Z)	STX110	YES - TRANSPARENT TEXT 
	XIF
	RB	ENQ110
DLE110	EQU	*
	CF	A5,READ	READ SECOND CHARACTER 
	CWK	A2,ACKPAR	IS IT ACK 0 ?
	RF(NE)	DLE130
* 
*	ACK , 0 RECEIVED
* 
	LD	A1,CACK	GET ACKCOUNTER
	RF(Z)	DLE140	ACK,0 EXPECTED
DLE120	EQU	*
	CF	A5,TRENQ	SEND ENQ 
	CF	A5,SPTIM	START PROCEDURE TIMER
	RB	ENQ110
DLE130	EQU	*
	CWK	A2,ACK1
	RF(NE)	DLE180
* 
*	ACK , 1 RECEIVED
* 
	LD	A1,CACK	GET ACK COUNTER 
	RB(Z)	DLE120	ACK,1 NOT EXPECTED
DLE140	EQU	*
	LD	A1,XETX 
	RF(Z)	DLE170	ETX NOT SENT
	EJECT
* 
*	ACK HAS BEEN RECEIVED TO AN ETX BLOCK 
* 
	LDK	A1,0	SET RC=0
DLE150	EQU	*
	IFF	STARVI=0 
	LD	A2,XSTA 
	RF(NZ)	DLE200	STATUS HAS BEEN TRANSMITTED
	XIF
	CF	A5,CWRITE	COMPLETE WRITE REQUEST
DLE160	EQU	*
	CF	A5,TREOT	SEND EOT 
	IFT	RCOM=1 
	CM	XRB	RESET READ BUFFER 
	XIF
	RB	ENQ110
DLE170	EQU	*
	LDK	A1,1 
	XRS	A1,CACK	INCREMENT ACK COUNTER
	ABL	POL200 
DLE180	EQU	*
	CWK	A2,RVIPAR	IS IT RVI ?
	RB(NE)	DLE120	INVALID DLE SEQUENCE 
	CM	XACK	RESET 'EXPECTING ACK'
	LD	A1,XETX 
	RF(NZ)	DLE190	ETX HAS BEEN SENT
	LDK	A1,2	SET RC=2
	RB	DLE150
DLE190	EQU	*
	LDK	A1,0	SET RC=0
	RB	DLE150
	EJECT
	IFF	STARVI=0 
* 
* 
*	STATUS HAS BEEN TRANSMITTED 
* 
* 
DLE200	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)	DLE160	NOT DE
	LDKL	A1,/8000
	ANS	A1,DWTST,A6	CLEAR STATUS 
	RB	DLE160
	XIF
	EJECT
* 
*	FIND DWT CONTAINING SUBTERMINAL ADDRESS AS GIVEN IN A2
* 
*	CALLING SEQUENCE: CF A5,FINTER(S) 
*	A2=SUBTERMINAL ADDRESS
*	A4 DESTROYED
*	A3#0: DWT TO FOUND TERMINAL 
* 
* NOTE:	FOR SIEMENS MSV1 - SEPARATE SELECT AND POLL ADDRESSES 
*	ENTRY:	FINTES - CHECK SELECT ADDRESS
*		FINTEP - CHECK SPECIFIC POLL ADDRESS 
* 
* 
* 
FINTES	EQU	*
	IFT	MSV1=1 
	LDK	A4,0 
	RF	FINT05
	XIF
FINTEP	EQU	*
	LDK	A4,1	RIGTH BYTE
FINT05	EQU	*
	LD	A3,DTEDWT,A7	GET FIRST DWT
FINT10	EQU	*
	RF(Z)	FINT20	END QUEUE 
	ADR	A3,A4
	CCR	A2,A3	THIS SUB-ADDRESS ? 
	RF(E)	FINT20	YES 
	SUR	A3,A4
	LD	A3,DWTCHN,A3	GET NEXT DWT 
	RB	FINT10
FINT20	EQU	*
	ANKL	A3,/FFFE
	RTN	A5 
	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
* 
* 
*	CHECK IF THERE IS A SEND 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 
	ANK	A2,/FF	MASK AWAY OPTION PART 
	SUK	A2,6 
	RF(NZ)	CWR900	NOT SEND REQUEST 
	LD	A2,DWTIPC,A6	ANY RECEIVED BUFFERS ON QUEU ? 
	RF(Z)	CWR110	NO
	ORKL	A1,R:DATA	ACCEPTED AND DATA AVAILABLE 
CWR110	EQU	*
	LD	A8,DWTECB,A6
	CF	A15,CTIME	STOP TIMER
	IFT	REMTIM=1		=9 
	ST	A2,ECBCW1,A8
	XIF			=9 
	CF	A15,TENDIO	COMPLETE REQUEST 
CWR150	EQU	*
	CF	A15,REMOVW	REMOVE FROM WRITE QUEUE
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
	CM	XSTA
	SUR	A8,A8	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)	RDM140	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
	RB(NE)	RDM105	NOT END OF BLOCK 
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 
	SCR	A1,A4		=7
	CF	A5,READP	8-BIT CHAR GET NEXT PART 
	RF(NZ)	RDM120	PARITY ERROR 
	LCR	A1,A4		=7
	SUK	A2,/20	ASSEMBLE TO ONE CHARACTER 
	ORR	A2,A1		=7
	XIF
RDM115	EQU	*
	ADK	A3,0	ERROR DETECTED EARLIER ?
	RB(NZ)	RDM100	YES !!!
	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 
* 
*	BUFFER OVERFLOW 
* 
	LDK	A3,1	INDICATE BUFFER OVERFLOW
	IFT	STTSTS=1 
	LDK	A1,CSSRBO	BUFFER OVERFLOW
	CF	A15,DCSUPS	INCREMENT COUNTER
	XIF
	RB	RDM100
* 
*	PARITY ERROR DETECTED 
* 
RDM120	EQU	*
	IFT	STTSTS=1 
	LDK	A1,CSSRPE
	CF	A15,DCSUPS	INCREMENT COUNTER
	XIF
	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	CODE=1 
	CF	A5,RDCRC	READ CRC AND CHECK IT
	RF(E)	RDM150	CRC WAS OK
	XIF
RDM140	EQU	*
	LDK	A3,1	INDICATE INVALID MESSAGE
RDM150	EQU	*
	CF	A5,CHALTI	HALT INPUT
	IFT	P6805=1
	IFT	CODE=0 
	ANK	A2,H:PARI
	RF(Z)	RDM155 
	LDK	A3,1	PARITY ERROR
RDM155	EQU	*
	XIF
	IFT	TPMODE=1 
	CWK	A3,1	ERROR DETECTED EARLIER ?
	RF(NE)	RDM158	NO 
	CM	TPM	OUT OF TRANSPARENT TEXT 
RDM158	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	STARVI=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=0 
	LDK	A2,DLE 
	CF	A5,WRIDLE	SEND DLE
	XIF
	LDK	A2,STX 
	CF	A5,WRITE	SEND STX 
	SUR	A8,A8	RESET LRC
	LD	A4,FECBBA	GET BUFFER ADDRESS
	AD	A4,FBAX	ADD BUFFER INDEX
	ST	A4,FBLST	REMEMBER START OF BLOCK
			.	=15
	LDK	A3,0	RESET CHARACTER COUNTER 
	LD	A1,FBAX	GET BUFFER INDEX
	RF(NZ)	TRT100	NOT FIRST BLOCK
	LDR*	A2,A7	NETWORK POLL ADDR 
	CF	A5,WRITEP	SEND TCA
	LD	A2,FDWTUT	GET DWT-ADDRESS 
	LDR*	A2,A2	GET NETWORK SUB-ADDRESS 
	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 
	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
	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,A8	GET LRC
	CF	A5,WRITEP	SEND LRC
	XIF
	IFT	CODE=1 
	LDR	A6,A8	GET CRC	DK 
	LDR	A2,A6
	ANK	A2,/FF 
	CF	A5,WRIT05	SEND CRC BYTE 1 
	ECR	A2,A6
	ANK	A2,/FF 
	CF	A5,WRIT05	SEND CRC BYTE 2 
	XIF
	IFT	STTSTS=1 
* 
* 
*		COUNT MESSAGES TRANSMITTED 
* 
	LDK	A1,CSSTBL
	CF	A15,DCSUPS
	XIF
	ABL	TRRE10	HALT OUTPUT 
TRT130	EQU	*
	IM	XETX	INDICATE 'ETX SENT'
	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	STARVI=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 
	SUR	A8,A8	RESET LRC
	LDK	A2,'%' 
	CF	A5,WRITEP	SEND '%'
	LDK	A2,'R' 
	CF	A5,WRITEP	SEND 'R'
	LDK	A2,STX 
	CF	A5,WRITE	SEND STX 
	LDR*	A2,A7 
	CF	A5,WRITEP	SEND TCA
	LD	A4,FDWTUT	GET DWT-ADDRESS 
	LDR*	A2,A4	GET NETWORK SUB-ADDRESS 
	CF	A5,WRITEP	SEND STA
	LD	A1,DWTST,A4	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,A4	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 
				=1
	XIF
CSYN:I	EQU	*
	RTN	A5	RETURN TO CALLER
* 
* 
*		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 
	RF(A)	CHALTR	SST ACCEPTED	=1 
	LDK	A2,1	INSTRUCTION NOT ACCEPTED, SET MODEM ERR.	=1 
CHALTR	EQU	*		=1
	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
* 
* 
*		CHALTO : HALT OUTPUT CHANNEL 
* 
CHALTO	EQU	*
	IFT	P6805=1
	LDK	A2,CBSTOP	STOP FUNCTION
	XIF
	CIO	A2,0,LCUUT	HALT OUTPUT 
	IFT	P6805=1
	LDK	A2,1	PRESET STATUS = MODEM ERROR	=1
	RF(NA)	CHLT00	INSTRUCTION NOT ACCEPTED	=1
	CF	A5,READ	WAIT FOR INTERRUPT
	XIF
	SST	A2,LCUUT	GET STATUS
CHLT00	EQU	*
	IFT	STTSTS=1 
	ANK	A2,H:NOOP+H:THRU 
	RF(Z)	CHLTO2 
	LDK	A1,CSCDCE	DCE NOT OPERABLE 
	ANK	A2,H:NOOP
	RF(NZ)	CHLTO1	YES
	LDK	A1,CSCDOT	OUTPUT THROUGHPUT ERROR
CHLTO1	EQU	*
	CF	A15,DCSUPS	INCREMENT COUNTER
CHLTO2	EQU	*
	XIF
	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 
	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
	IFT	TPMODE=1 
	C2	TPM 
	RF(NZ)	IHLC10	DO NOT SKIP SYNC IN TRANSPARENT TEXT 
	XIF
	C2	SYNSW 
	RF(NZ)	IHLC05	DO NOT SKIP SYNS IN BCC FRAME
	CWK	A2,SYNC
	RF(E)	READ 
IHLC05	EQU	*
	IFT	CODE=0 
	XRR	A8,A2	CALCULATE LRC
	XIF
	IFT	CODE=1 
	LD	A1,XSEL	SEE IF SELECTED	DK1 
	RF(Z)	IHLC07	NO, SKIP IT	DK1 
	CF	A5,CRCCAL	CALCULATE CRC 
IHLC07	EQU	*		DK1 
	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 
	LDK	A1,1 
	ST A1,DTEPLS,A7	CU OPERABLE
	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 
	XIF
	CF	A15,LDREG	RESTORE DC REGS A3 - A8 
	RTN	A5 
	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,H:ERR	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,H:CARR	CARRIR OFF 
	RF(Z)	SST075	NO
	LD	A2,DCLCI	INPUT STATUS 
	RF(Z)	SST125	NOT ACTIVE IGNORE CARRIER OFF 
	RF	SST100	ACTIVE 
SST075	EQU	*
	CM	DTEPLS,A7	CLEAR PHYS. LINK STATUS	DK
	LDR	A2,A1
	ANK	A2,H:THRU	THROUGHPUT ERROR 
	RF(Z)	SST100	NO
	IFT	STTSTS=1 
* 
* 
*		COUNT INPUT THROUGHPUT ERROR 
* 
	LDK	A1,CSCDIT
	CF	A15,DCSUPS
	XIF
	ABL	BRM110 
* 
SST100	EQU	*
	LDR	A2,A1
	ANK	A2,H:NOOP	NOT OPERABLE 
	RF(Z)	SST200 
	IFT	STTSTS=1 
* 
* 
*		COUNT DCE NOT OPERABLE 
* 
	LDK	A1,CSCDCE
	CF	A15,DCSUPS
	XIF
	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,H:CARR	CHECK STATUS IF CARRIER OFF
	RF(Z)	SST225	NO
	XRK	A1,H:CARR	CHECK STATUS IF ONLY CARRIER OFF 
	RF(Z)	SST250	YES 
SST225	EQU	*
	ST	A1,DCSTCU	STORE STATUS AS CURRENT STATUS
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 
	IFF	CODE=1 
WRIT10	XRR	A8,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
* 
* 
*		THESE INSTRUCTIONS ARE ONLY USED TO SEND AN EXTRA DLE
*		WHEN TRANSPARENT MODE IS CONFIGURED
* 
WRIDLE	EQU	*
	OTR	A2,0,LCUUT	SEND CHARACTER
	RB(A)	WRIT15	ACCEPTED
	RB	READ	OUTPUT THROUGHPUT ERROR
	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
* 
* 
*	POWER ON FUNCTIONS
* 
* 
DC15ON	EQU	*
	IFT	CPU852=1 
	CF	A15,SAVE8	SAVE A1-A8
	XIF

	IFF	CPU852=1 
	MSR	8,A15	SAVE A1-A8 
	XIF
	LDKL	A7,DTETAB	DTETAB ADDRESS
	IFT	STARVI=1 
	LDK	A5,4	SET DEVICE END
	LD	A6,DTEDWT,A7	GET FIRST DWT ADDR 
DC1510	EQU	*
	RF(Z)	DC1520	END OF CHAIN
	ORS	A5,DWTST,A6	STORE DEVICE END 
	CF	A15,INSSQ	INSERT DWT IN STAUS QUEUE 
	LD	A6,DWTCHN,A6	GET NEXT DWT IN CHAIN
	RB	DC1510
DC1520	EQU	*
				=4
				=13 
	XIF
	LD	A2,DTESTA,A7	DTE STATUS 
	SUK	A2,2 
	ABL(NZ)	TDISP	OPEN NOT EXECUTED
	CM	DCLCI	INIT LINE CONTROL UNIT INFO 
	LD	A2,DCTPGP	GET POLL TIMER POINTER
	RF(NZ)	DC1540	ALREADY STARTED
	CF	A15,SPOTIM	START POLL TIMER 
DC1540	EQU	*
	ABL	BRM
	EJECT
	IFT	CODE=1 
* 
* 
*	CALCULATION OF CRC
* 
*	A2 = CHARACTER
*	A8 = ACCUMULATED CRC
* 
* 
CRCCAL	EQU	*
	ST	A1,CRCSAV+2 
	ST	A2,CRCSAV+6 
	ST	A3,CRCSAV+10
	ST	A4,CRCSAV+14
	LDK	A1,8 
	LDR	A4,A8	GET OLD CRC
CRC100	LDR	A3,A4
	SRL	A4,1 
	XRR	A3,A2
	SRL	A2,1 
	ANK	A3,1 
	RF(Z)	CRC110 
	XRKL	A4,/A001
CRC110	SUK	A1,1 
	RB(NZ)	CRC100
	LDR	A8,A4	SAVE NEW CRC 
CRCSAV	EQU	*
	LDKL	A1,0
	LDKL	A2,0
	LDKL	A3,0
	LDKL	A4,0
	RTN	A5 
	EJECT
* 
* 
*	READ CRC CHARACTERS AND CHECK THEM
*	CR = (E) IF CRC WAS OK
* 
* 
RDCRC	EQU	* 
	STR	A8,A5	SAVE CURRENT CRC 
	SUK	A5,2	ADJUST STACK POINTER
	IM	SYNSW	DO NOT SKIP SYNCS NOW 
	CF	A5,READ	READ BYTE 1 
	LD	A4,CRCSAV+6	SAVE IT 
	CF	A5,READ	READ BYTE 2 
	CM	SYNSW	SYNCS CAN BE SKIPPED AGAIN
	LD	A2,CRCSAV+6	SAVE IT 
	SLL	A2,8 
	XRR	A2,A4
	ADK	A5,6 
	CW	A2,-4,A5
	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
	ANKL	A8,/007F
LRCEND	EQU	*
	CM	SYNSW 
	ABR*	A5

	XIF
	EJECT
****************************************
* 
*		DRIVER WORK AREAS
* 
****************************************
* 
* 
*	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
SUBBUF	RES	3	MMU BUFFER FOR CONNECT REQUEST	=16 
	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
* 
*	DTETAB
* 
*	FIXED PART
* 
DW1500	EQU	*
DTETAB	DATA	0,0 
	DATA	0,0,0,0,0,0 
	IFT	MMUPAG=1 
	DATA	0,0 
	XIF
*	DRIVER DEPENDENT PART 
	DATA	DTESBU-DTETAB	START OF STATISTIC BUFFER 
	DATA	0,0,0,0,0,0 
	DATA	0,0,0,0,0,0	 *
DTESBU	EQU	*
	DATA	0	SYMBOLIC ID 
	DATA	0	COUNTER STATUS WORD 
	DATA	/20	MAX NUMBER OF COUNTERS
	RES	/20	STATISTIC BUFFER 
	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 
DCWRQ	DATA	0	WRITE REQUEST QUEUE
RESEND	DATA	0	CONTROL SEQUENCE SAVE AREA
* 
	EJECT
* 
* 
*	CONSTANTS AND WORK AREAS
* 
* 
DCSTCU	DATA	0	CURRENT STATUS
DCTPGP	DATA	0	TIMER POINTER GENERAL POLL
DCLCI	DATA	0	DC UNIT INPUT STATUS 
	END
DataMuseum.dk

Philips Data Systems

⟦b20cf9258⟧

Derivation

PTS(SC)

Full view
