DataMuseum.dk

top - metrics - download

    Length: 55882 (0xda4a)
    Notes: pts_type(SC)
    Names: »DRDC.SC«

└─⟦18bf30ff4⟧ Bits:30009692 Philips computer tape "600409"
    └─⟦this⟧ »BDKMON/DRDC.SC« 
└─⟦71472ef1e⟧ Bits:30009661 Philips computer tape "600103"
    └─⟦this⟧ »BDKMON/DRDC.SC« 

PTS(SC)

	IDENT DRDC19	BORN 77-12-27 

* 
********************************************* 
* 
*   PHILIPS TERMINAL SYSTEM PTS 
* 
*   DRDC19: DRIVER DATA COMMUNICATION 
*           BSC MULTIPOINT PRICEDURE
*           ON I/O-PROCESSOR
* 
* 
* 
********************************************
* 
*   NOTE !
*   INTERRUPT VECTOR IHSLCU ON LEVEL 46 
* 
	EJECT

* 
*	STATUS CODES
* 
*	BIT 
*	0-7: 0
*	8:   HARDWARE ERROR 
*	9:   RING INDICATOR 
*	10:  END OF CARRIER 
*	11:  0
*	12:  0
*	13:  PARITY ERROR 
*	14:  THROUGHPUT ERROR 
*	15:  NOT OPERABLE 
* 
	EJECT
* 
* 
*	ENTRY POINTS
* 
* 
	ENTRY	DCADDC	ADDRESS BLOCK DC TASK REQUESTS
	ENTRY	DCAD	ADDRESS BLOCK TERMINAL REQUESTS 
	ENTRY	IHSLCU	INPUT INTERRUPT 
	ENTRY	DRDCON	POWER ON ROUTINE
	ENTRY	DCFC	FILE CODE FOR DCTASK
	ENTRY	DWDC00	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	DCTAB	DC CONFIGURATION TABLE 
	EXTRN	SETIME	SET TIMER 
	EXTRN	DWTST	DWT STATUS 
	EXTRN	DWTOR	DWT ORDER
	EXTRN	DWTECB	DWT ECB 
	EXTRN	INTSAV	SAVE AREA LAST INTERRUPT
	EJECT
* 
* 
* 
* 
*   STANDARD INTERFACE PART FOR DATA COMMUNICATION
* 
* 
* 
* 
*	DWT CONTENTS
* 
*	DWTCHP	TERMINAL ADDRESS AS GIVEN AT PARAMETER TRANSFER (BIT #08-#15)
*	DWTST	BIT #00:     NO REQUEST 
*	DWTTP	TIMERPOINTER, ORDER PROCESS 
*	DWTWQ	WRITE/GET BUFFER QUEUE
* 
* 
*	ECB PARAMETERS
* 
* 
ECBBA	EQU	2	BUFFER ADDRESS
ECBRL	EQU	4	REQUESTED LENGTH
ECBEL	EQU	6	EFFECTIVE LENGTH
ECBRC	EQU	8	RETURN CODE 
ECBCW	EQU	10	CONTROL WORD 
	EJECT
* 
*	DWT DISPLACEMENTS 
* 
DWTTP	EQU	/10	TIMER POINTER ORDER PROCESS 
DWTWQ	EQU	/12	WRITE/GET BUFFER QUEUE
* 
* 
*	PARAMETERS FOR CONDITIONAL ASSEMBLY 
* 
* 
X:A	EQU	175 
RBUFL	EQU	X:A 
X:B	EQU	0	TRANSMIT BUFFER LENGTH
TBUFL	EQU	X:B 
X:C	EQU	/60	DCTASK FILE CODE
DCFC	EQU	X:C
X:E	EQU	20	POLL TIMEOUT VALUE 
TIMPOL	EQU	X:E
X:H	EQU	350	TRANSMIT BLOCK LENGTH 
TBLEN	EQU	X:H 

* 
*	OPTIONS NOT AVAILABLE 
* 
LOGG	EQU	0
STAT	EQU	0
RCOM	EQU	0
CODE	EQU	0
BDKSP	EQU	1	SPECIAL BSC FOR BANKDATA
	EJECT
* 
* 
*	REQUEST HANDLING
* 
* 
* 
*	PARAMETERS
* 
*	A7=ORDER
* 
*	/02: READ 
*	/06: WRITE
*	/08: EXCHANGE 
*	/22: RELEASE READ BUFFER
*	/31: GET WRITE BUFFER 
*	/37: TRANSFER PARAMETERS
*	/38: SET STATUS 
* 
* 
*	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
	IFF	TBUFL=0
DCGWQ	DATA	0	GET BUFFER REQUEST QUEUE 
	XIF
DCTPGP	DATA	0	TIMER POINTER GENERAL POLL
DCADDC	DATA	DCACTD	ADDRESS BLOCK DC TASK
DCAD	DATA	DCACT	ADDRESS BLOCK 
	RES	15	SUBROUTINE STACK FOR INTERRUPTS 
STB	RES	1 
	EJECT
* 
* 
*	ACTIVATION FROM TERMINAL TASKS
* 
DCACT	EQU	* 
	LDK	A1,0	PRESET RETURN CODE
	SUK	A7,/02 
	RF(Z)	DCRD	READ SPECIFIC 
	SUK	A7,/06-/02 
	RF(Z)	DCWR 
	SUK	A7,/08-/06 
	RF(Z)	DCEX	EXCHANGE
	SUK	A7,/22-/08 
	RF(Z)	DCRR	RELEASE READ BUFFER 
	SUK	A7,/37-/22 
	RF(Z)	DCTP	TRANSFER PARAMETERS 
	SUK	A7,/38-/37 
	IFF	STAT=0 
	RF(Z)	DCSS	SET STATUS
	XIF
	IFF	TBUFL=0
	ADK	A7,/38-/31 
	RF(Z)	DCGW	GET WRITE BUFFER
	XIF
	RF	DCA100
	EJECT
* 
* 
*	ACTIVATION FROM DCTASK
* 
* 
DCACTD	EQU	*
	SUK	A7,/02 
	RF(E)	DCRDDC	READ
	SUK	A7,/22-/02 
	RF(E)	DCRR	RELEASE READ BUFFER 
	SUK	A7,/37-/22 
	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 
	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
ENDIO	EQU	* 
	CF	A15,TENDIO	COMPLETE REQUEST 
	RB	DCRTN 
	EJECT
* 
* 
*	WRITE 
* 
* 
*	COMPLETE WHEN:
*	  SUCCESFUL TRANSMISSION
*	  TIME OUT
* 
* 
DCWR	EQU	*
	CF	A15,TIMEWR	SET TIMER
	CF	A15,INSWQ 	QUEUE REQUEST
	RB	DCRTN 
* 
* 
* 
*	READ
* 
* 
*	COMPLETE WHEN:
*	  MESSAGE RECEIVED
*	  TIME OUT
* 
* 
DCRD	EQU	*
	CF	A15,TIMERE	CHECK/SET TIMER
	RB	DCRTN 
	EJECT
* 
* 
*	GET WRITE BUFFER
* 
* 
	IFF	TBUFL=0
*	COMPLETE WHEN:
*	  BUFFER BEEN ALOCATED
*	  TIME OUT
* 
* 
DCGW	EQU	*
	CF	A15,GTBUF	GET TRANSMIT BUFFER 
	LDR	A4,A4
	RF(Z)	DCGW10	NO FREE BUFFER
	ST	A4,ECBBA,A8 
	LDKL	A1,TBUFL+TBUFL
	ST	A1,ECBEL,A8	STORE BUFFER LENGTH 
	LDK	A1,0 
	RB	ENDIO	COMPLETE REQUEST
DCGW10	EQU	*
	CF	A15,TIMERE	START TIMER
	CF	A15,INSGWQ	QUEUE REQUEST
	RB	DCRTN 
	XIF
	EJECT
* 
* 
*	RELEASE READ BUFFER 
* 
* 
DCRR	LD	A4,ECBBA,A8 
	SUK	A4,6 
	CF	A15,RRBUF 
DCRR10	EQU	*
	LDK	A1,0 
	CF	A15,TENDIO	COMPLETE RRBUF REQUEST 
	RB	DCRTN 
	EJECT
* 
* 
*	EXCHANGE
* 
* 
* 
*	COMPLETE WHEN:
*	  MESSAGE PASSED TO TERMINAL
*	  TIME OUT
* 
DCEX	EQU	*
	RB	DCWR	SAME INITIALIZATION AS WRITE 
* 
* 
*	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	DCRR10	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
* 
* 
* 
*	TIMER HANDLING PART 
* 
* 
* 
*	READ TIMER=TIMERR 
* 
TIMERE	EQU	*
	LDR	A1,A6
	LD	A2,ECBCW,A8	GET 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
	IFF	TBUFL=0
	CF	A15,REMOVG	REMOVE FROM QUEUE
	XIF
TOUTR1	EQU	*
	LDK	A1,/40	INDICATE TIME OUT 
	LD	A2,DWTOR,A6	CHECK IF EXCHANGE ORDER 
	SUK	A2,8 
	RF(NZ)	TOUTR2	NOT EXCHANGE 
	ORK	A1,2	RETURN CODE /42 AT EXCHANGE TIME OUT
TOUTR2	RB	ENDIO	COMPLETE REQUEST
* 
*	WRITE TIMER=TIMWR 
* 
TIMEWR	LDR	A1,A6
	LD	A2,ECBCW,A8	GET 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
	LD	A1,DWTOR,A6	GET ORDER 
	SUK	A1,6 
	RF(Z)	TOUT10	WRITE 
	SUK	A1,2 
	RB(NZ)	TOUTR1	ORDER IS NOT EXCHANGE
TOUT10	LD	A2,DWTECB,A6
	LD	A4,ECBBA,A2	FETCH BUFFER
	IFF	TBUFL=0
	CF	A15,RTBUF	RELEASE TRANSMITBUFFER
	CF	A15,CKGBQ	CHECK GET BUFFER QUEUE
	XIF
	CF	A15,REMOVW	REMOVE FROM WRITE QUEUE
* 
*	THIS INSTRUCTION DOES NOT BELONG
*	TO THE STANDARD INTERFACE 
* 
	CM	XACK	INDICATE 'ACK NOT EXPECTED'
	LD	A2,FDWTUT 
	CWR	A2,A6
	RB(NE)	TOUTR1	THIS DWT NOT WRITING 
	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
* 
* 
*	GET TRANSMIT BUFFER 
* 
	IFF	TBUFL=0
*	CALLING SEQUENCE: CF A15,GTBUF
*	A4=0 IF NO BUFFER IS FREE 
*	ELSE A4 CONTAINS BUFFER ADDRESS 
*	A2 AND A3 ARE DESTROYED 
* 
* 
GTBUF	LDKL	A2,DCTBUF	TRANSMIT BUFFERS 
	RB	GBUF
	EJECT
* 
* 
*	CHECK GET BUFFER QUEUE
* 
* 
CKGBQ	EQU	* 
	LDR	A7,A6	SAVE A6
	LD	A6,DCGWQ	GET QUEUE ANCHOR 
	RF(Z)	CKG110	NO ONE ON QUEUE 
	SUK	A6,DWTWQ 
	LD	A2,DWTST,A6 
	RF(N)	CKG100	NO REQUEST
	LD	A2,DWTOR,A6 
	SUK	A2,/31 
	RF(NZ)	CKG100	NO GET BUFFER REQUEST
	CF	A15,GTBUF	GET TRANSMIT BUFFER 
	LDR	A4,A4
	RF(Z)	CKG110	NO BUFFER FREE
	LD	A3,DWTECB,A6
	ST	A4,ECBBA,A3	STORE BUFFER ADDRESS
	LDKL	A1,TBUFL+TBUFL
	ST	A1,ECBEL,A3	STORE BUFFER LENGTH 
	CF	A15,CTIME	STOP REQUEST TIMING 
	ST	A2,ECBCW,A3	STORE REMAINING TIME
	LDK	A1,0 
	CF	A15,TENDIO	COMPLETE REQUEST 
CKG100	EQU	*
	CF	A15,REMOVG	REMOVE FROM QUEUE
CKG110	LDR	A6,A7	RESTORE A6 
	RB	GBUF10	RETURN 
	XIF
	EJECT
* 
* 
*	RELEASE RECEIVE BUFFER
* 
*	A4 CONTAINS BUFFER ADDRESS
*	CALLING SEQUENCE: CF A15,RRBUF
*	A2 AND A3 ARE DESTROYED 
* 
* 
RRBUF	LDKL	A2,DCRBUF	RECEIVE BUFFERS
RBUF	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 
* 
* 
*	RELEASE TRANSMIT BUFFER 
* 
	IFF	TBUFL=0
*	A4 CONTAINS BUFFER ADDRESS
*	CALLING SEQUENCE: CF A15,RTBUF
*	A2 AND A3 ARE DESTROYED 
* 
* 
RTBUF	LDKL	A2,DCTBUF	TRANSMIT BUFFERS 
	RB	RBUF
	XIF
	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 GET WRITE BUFFER QUEUE
* 
	IFF	TBUFL=0
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
INSGWQ	LDKL	A2,DCGWQ	GET QUEUE ANCHOR 
	RB	INSWQ1
* 
* 
*	REMOVE DWT FROM GET WRITE BUFFER QUEUE
* 
*	A2,A3,A4 DESTROYED
*	A6=DWT
* 
REMOVG	LDKL	A2,DCGWQ	GET QUEUE ANCHOR 
	RB	REM05 
	XIF
	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	* 
	LDKL	A2,DWDC00+DWTWQ	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,DWDC00 
	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,DWTWQ,A6	A3=ADDR TO READ QUEUE 
	RF(Z)	CKM200	NO READ IN QUEUE
	LDR*	A2,A3	A2=ADDR TO NEXT READ BUFFER 
	ST	A2,DWTWQ,A6	STORE THIS ADDR INTO QUEUE
	ADK	A3,6	MOVE POINTER TO TEXT
	ST	A3,ECBBA,A8	SAVE THIS ADDR IN ECB 
	LD	A4,-4,A3
	ST	A4,ECBEL,A8	STORE NUMBERS OF CHARACTERS 
	LC	A4,-2,A3
	ANK	A4,/FF 
	ST	A4,ECBCW,A8	STORE LINE DEVICE ADDRESS 
	LDK	A1,0	PARAMETER=OK
CKM100	CF	A15,TENDIO	COMPLETE READ GENERAL REQUEST
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 
	RB	CKM100
	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
* 
* 
* 	CHANNEL UNIT PARAMETERS
* 
* 
SLCU	EQU	/0A
* 
* 
*	TIMER VALUES
* 
* 
TIMPRO	EQU	2	PROCEDURE TIMER 200 MS 
	EJECT
* 
* 
*	CHARACTER EQUATES 
* 
* 
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 
WACK	EQU	/3B
RVI	EQU	/3C 
ACK0	EQU	/30
ACK1	EQU	/31
	XIF
	IFT	CODE=1 
PAR	EQU	/00 
WACK	EQU	/2C
RVI	EQU	/40 
ACK0	EQU	/18
ACK1	EQU	/2F
SYNEBC	EQU	/32
	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
XENB	DATA	0	DRIVER IN ENABLE MODE 
XPWF	DATA	0	POWER FAIL OCCURED
CACK	DATA	0	ACK COUNTER 
	IFT	BDKSP=1		**********
LSEL	DATA	0	LAST COR.REC.MESS.
	XIF			******** 
* 
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	/1616,/1616,0,/FFFF	CONTROL SEQUENCE SAVE AREA
DWTSQ	EQU	/14	DWT STATUS QUEUE
DWTBA	EQU	/16 
DWTRL	EQU	/18 
* 
* 
*	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
* 
* 
*	BASIC RECEIVE MODE
* 
*	ENTERED EVERY TIME A MESSAGE
*	IS EXPECTED FROM THE MASTER SIDE
* 
* 
BRM	EQU	* 
	LDKL	A5,STB	LOAD STACKBASE 
	CM	RBCNT	CLEAR BUFFER

BRM100	EQU	*
	LD	A1,XSEL 
	RF(NZ)	BRM300	SELECTED 

	CF	A5,READP	READ ONE CHARACTER 
	RB(NZ)	BRM	PARITY ERROR

BRM101	LDR	A1,A2
	SUK	A1,STX 
	RF(Z)	BRM315	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 
	LD	A1,XSEL 
	RF(NZ)	BRM300	SELECTED 
	LDR	A8,A2
	CF	A5,READP	READ ONE CHARACTER 
	RB(NZ)	BRM	PARITY ERROR
	CWR	A2,A8
	RB(NE)	BRM	INVALID ADDRESSING
	LDK	A3,0 
	CC	A2,DWDC00+1 
	RF(E)	BRM110	POLLING 
	LDK	A3,2 
	CC	A2,DWDC00 
	RB(NE)	BRM	NOT THIS TCU
BRM110	EQU	*
	CF	A5,READP	READ 1:ST STA
	RB(NZ)	BRM	PARITY ERROR
	LDR	A8,A2
	CF	A5,READP	READ 2:ND STA
	RB(NZ)	BRM	PARITY ERROR
	CWR	A2,A8
	RB(NE)	BRM	INVALID ADDRESS SEQUENCE
	CF	A5,READ	READ ONE CHARACTER
	SUK	A2,ENQ+PAR 
	RB(NZ)	BRM	NOT ENQ 
	LDK	A1,1 
	ST	A1,CACK	LOAD ACK COUNTER
	LDR	A2,A8
	SUK	A3,2 
	RF(Z)	BRM120	SELECTING 
	CWK	A8,GP
	ABL(E)	GPOLL	GENERAL POLL
	CF	A5,FINTER	CHECK IF STA PRESENT
	LDR	A6,A3	LOAD DWT TO A6 
	ABL(NZ)	SPOLL	SPECIFIC POLL
	RB	BRM	INVALID POLL
BRM120	EQU	*
	CF	A5,FINTER	CHECK IF STA PRESENT
	LDR	A6,A3	LOAD DWT TO A6 
	RF(NZ)	BRM130	STA FOUND
	LDKL	A6,DWDC00	SELECT TO DCTASK
BRM130	EQU	*
	ABL	SELECT 
	EJECT
* 
* 
*	EOT HAS BEEN RECEIVED 
* 
* 
BRM200	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	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
* 
* 
*	TEXT IS EXPECTED
* 
* 
BRM300	EQU	*
	CF	A5,HPTIM
	IFT	BDKSP=1		**********
	LD	A1,DCRBUF	ANY BUFFER FREE ? 
	RF(NZ)	BRM305	BUFFER AVAILABLE 
	CF	A5,DUMRD	DUMMY READ 
	ABL	BRM
BRM305	EQU	*
	XIF			********** 
	CF	A5,RDMESS	READ MESSAGE
	SUK	A7,1 
	RF(NZ)	BRM320	MESSAGE OK 
	LD	A2,INITCH	CHECK INIT CHARACTER
	CWK	A2,STX 
	RF(E)	BRM310	STX OK

	LD	A2,TERMCH	NOT STX, GET TERM CHAR
	RB	BRM101

BRM310	EQU	*
	CM	XSTA	INDICATE 'INVALID MESSAGE' 
BRM312	EQU	*
	CF	A5,TRNAK	SEND NAK 
	IFT	BDKSP=1		**********
	CM	LSEL	IND.MESS NOT OK
	XIF			********** 
	RB	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 
	LDR*	A2,A6	GET STA 
	CF	A5,PRREC	PREPARE FOR TEXT RECEPTION 
	LDK	A1,0	SET RC=0
	CF	A5,CWRITE	COMPLETE WRITE REQUEST
	LDK	A1,1 
	XRS	A1,CACK	INCREASE ACK COUNTER 
	RB	BRM305	READ THE MESSAGE 
	XIF
BRM316	CF	A5,READ	READ ONE CHARACTER
	SUK	A2,ENQ+PAR 
	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)	BRM350	READ MODIFIED RECEIVED
	SUK	A1,RDMCOM-RDBCOM 
	RF(Z)	BRM350	READ BUFFER RECEIVED
	XIF
BRM325	EQU	*
	SUK	A7,1 
	RF(Z)	BRM340	MESSAGE ENDED BY ETB
	CM	XSEL
	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,DWDC00
	RF(E)	BRM330	MESSAGE IS MENT FOR DCTASK
	LD	A2,DWTST,A6	GET STATUS
	RF(N)	BRM329	NO REQUEST
	LDK	A2,2 
	CW	A2,DWTOR,A6 
	RF(NE)	BRM329	NO READ REQUEST
BRM327	EQU	*
	LDK	A1,0	SET RC=0
	LD	A8,DWTECB,A6	GET ECB ADDRESS
	ST	A4,ECBBA,A8	STORE BUFFER 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
	CF	A15,TENDIO	COMPLETE REQUEST 
	RF	BRM345
BRM329	EQU	*
	LDR*	A2,A6	GET CURRENT STA 
	LDR	A7,A4	SAVE A4
	CF	A5,FINTER	SEARCH IF ANY OTHER TASK ON READ
	LDR	A4,A7	RESTORE A4 
	LDR	A6,A3	GET DWT
	RF(Z)	BRM330	NOT FOUND 
	LD	A2,DWTST,A6 
	RF(N)	BRM330	NO REQUEST
	LDK	A2,2 
	CW	A2,DWTOR,A6 
	RB(E)	BRM327	ANOTHER READ TASK FOUND 
	EJECT
BRM330	EQU	*
	IFT	BDKSP=1		*********** 
	ST	A6,LSEL	IND.LAST DEV.REC.CORRECT MESS.; 
	XIF			+**********
	SUK	A4,6	GET BUFFER BASE 
	CF	A5,QRBUF	QUEUE BUFFER FOR DCTASK
	CF	A15,CKMESS	COMPLETE DCTASK READ IF ANY
BRM340	EQU	*
* 
*	DELAY ACK FOR 3270 INTERNAL PROCESSING
* 
	IFT	STAT=1 
	CF	A15,SETIME
	DATA	BRM341,2
	ABL	TDISP
BRM341	EQU	*
	LDKL	A5,STB
	XIF
	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
	IFT	BDKSP=1		**********
	EJECT
*	
*	
*	DUMMY READ NO REC.BUF AT TIME SELECTION 
*	OR MESSAGE ALREADY RECIEVED 
* 
DUMRD	EQU	* 
	CF	A5,READ 
	RTN	A5 
	XIF			********** 
	EJECT
* 
* 
*	READ MODIFIED OR READ BUFFER RECEIVED 
* 
* 
	IFF	RCOM=0 
BRM350	EQU	*
	CM	XSEL	RESET 'SELECTED' 
	LD	A6,FDWTIN	GET DWT FOR ADDRESSED TERMINAL
	LD	A4,DWTBA,A6	GET LAST WRITE BUFFER ADDRESS 
	LD	A3,DWTRL,A6	GET LAST REQUESTED LENGTH 
	CM	FDWTUT
	LDK	A1,1 
	XRS	A1,CACK	INCREMENT ACK COUNTER
	ABL	POL127 
	XIF
* 
* 
*	ENQ HAS BEEN RECEIVED 
* 
* 
BRM400	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	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(Z)	BRM636	ACK NOT EXPECTED
	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 
* 
* 
*	DLE HAS BEEN RECEIVED 
* 
* 
BRM600	EQU	*
	CF	A5,HPTIM	STOP PROCEDURE TIMER 
	LD	A1,XACK 
	RB(Z)	BRM410	ACK NOT EXPECTED
	CF	A5,READ	READ SECOND CHARACTER 
	CWK	A2,ACK0+PAR
	RF(NE)	BRM620
* 
*	ACK , 0 RECEIVED
* 
	LD	A1,CACK	GET ACKCOUNTER
	RF(Z)	BRM630	ACK,0 EXPECTED
BRM610	EQU	*
	IFF	BDKSP=1		********* 
	CF	A5,TRENQ	SEND ENQ 
	XIF			******** 
	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	*
	IFF	BDKSP=1		*********** 
	CF	A5,TREOT	SEND EOT 
	XIF			********** 
	RB	BRM410
BRM640	EQU	*
	LDK	A1,1 
	XRS	A1,CACK	INCREMENT ACK COUNTER
	ABL	POL130 
BRM650	EQU	*
	CWK	A2,RVI+PAR 
	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	*
	IFT	BDKSP=1		*********** 
	CW	A6,LSEL	MESS.REC.EARLIER ?
	RF(NE)	SEL110	NO 
	CF	A5,DUMRD
	CF	A5,TRACK
	RF	SEL100
	XIF			*********
	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	*
	IFF	STAT=0 
	ANK	A3,8 
	RF(NZ)	SEL115	BUSY 
	XIF
	LD	A1,DCRBUF 
	RF(NZ)	SEL120	BUFFER AVAILABLE 
SEL115	EQU	*
	IFF	BDKSP=1		**********
	CF	A5,TRWACK	SEND WACK 
	XIF			********** 
	RB	SEL100
SEL120	EQU	*
	CF	A5,PRREC	PREPARE FOR TEXT RECEPTION 
	IFF	BDKSP=1		**********
	CF	A5,TRACK	SEND ACK,0 
	XIF			********** 
	IFT	BDKSP=1		*********** 
	LDK	A2,1 
	XRS	A2,CACK
	XIF			********** 
	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
	SC	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	* 
	CF	A5,CPTIM	CHECK POLL TIMER 
	IFT	BDKSP=1		**********
	CM	LSEL	IND.DEV.FREE FOR NEW SEL.
	XIF			*********
	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 
	LD	A4,ECBBA,A8	GET BUFFER ADDRESS
	LD	A3,ECBRL,A8	GET LENGTH
	IFT	RCOM=1 
	ST	A4,DWTBA,A6	REMEMBER BUFFER ADDRESS 
	ST	A3,DWTRL,A6	REMEMBER LENGTH 
	XIF
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=0 
	LDR	A7,A6	SAVE A6
	CF	A5,CPTIM	CHECK POLLTIMER
	LDR	A6,A7	RESTORE A6 
	LD	A1,DWTST,A6	GET STATUS
	ANK	A1,7 
	RB(NZ)	POL050	PENDING STATUS 
	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
	RB	POL115
	XIF
	IFF	STAT=1 
	RB	POL115
	XIF
	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	*
	IFF	TBUFL=0
	LD	A4,FECBBA	GET BUFFER ADDRESS
	CF	A15,RTBUF	RELEASE TRANSMIT BUFFER 
	CF	A15,CKGBQ	CHECK GET BUFFER QUEUE
	XIF
CWR900	EQU	*
	CM	XACK	RESET 'ACK EXPECTED' 
	CM	FDWTUT
	RTN	A5 
	EJECT
* 
* 
*	READ ONE TEXT BLOCK 
* 
*	ON EXIT A3 **AND A7** 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,5	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
RDM100	EQU	*
	LDKL	A1,RBUFL+RBUFL
	SU	A1,FBAX	CALC MAX LENGTH 
	CWK	A1,4 
	RF(L)	RDM140	BUFFER OVERFLOW 

	CF	A5,READM	READ MESSAGE 
	LC*	A7,FBLST	GET INIT CHARACTER
	ANK	A7,/7F 
	ST	A7,INITCH	AND STORE 
	LC	A7,-1,A4	GET TERM CHARACTER 
	ANK	A7,/7F 
	ST	A7,TERMCH	AND STORE 

	LDR	A2,A2
	RF(NZ)	RDM140	PARITY ERROR 

	SUK	A1,3	UPDATE INDEX
	ADS	A1,FBAX
	ADK	A1,2 


	LD	A2,LASTCH	RESTORE PREVIOUS LAST CHAR
	SC*	A2,FBLST 

	LC	A2,-3,A4	SAVE LAST CHAR 
	ST	A2,LASTCH 

	LC	A2,-2,A4	GET CHAR BEFORE LRC
	ANK	A2,/7F 

	LDK	A7,STX	CHECK INIT CHAR 
	CW	A7,INITCH 
	RF(NE)	RDM140	NOT STX
	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)	RDM140	ENQ IN TEXT RECEIVED

	RF	RDM140	SOMETHING BAD

* 
*	ETX RECEIVED
* 
RDM130	EQU	*
	LD	A7,DCRBUF	GET BUFFER ADDRESS
	LD	A2,FBAX	GET BUFFER INDEX
	ST	A2,+2,A7	STORE EFFECTIVE LENGTH IN HEADER 

	CF	A5,CKLRC	CHECK LRC
	RF(Z)	RDM150	LRC WAS OK

RDM140	EQU	*
	LDK	A3,1	INDICATE INVALID MESSAGE
RDM150	EQU	*
	LDR	A7,A3	SAVE RESULT REGISTER 
	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	*

	CF	A5,CKLRC	CHECK LRC
	RB(Z)	RDM100	LRC WAS OK
	LDK	A3,1 
	RB	RDM100
	EJECT

* 
*	CHECK LRC 
* 

CKLRC	LD	A2,FBLST 
	ADK	A2,1 
	LDK	A7,0 
	LDK	A4,0 
	ADK	A5,4 
	IM	XENB
	ENB
CKLRC1	LCR	A4,A2
	XRR	A7,A4
	ADK	A2,1 
	SUK	A1,1 
	RB(NZ)	CKLRC1
	ANK	A7,/7F 
	INH
	CM	XENB
	LD	A1,XPWF	CHECK IF POWER FAIL OCCURED 
	RF(NZ)	CKLRC2
	LDR	A7,A7
	ABR*	A5
CKLRC2	EQU	*

	CM	XPWF	POWER FAIL IN ENABLE 
	CM	XSEL
	CM	XSTA
	ABL	BRM
	EJECT


* 
*	SOME INTERESTING CHARACTERS 
* 

INITCH	DATA	0	INITIATING CHAR 
LASTCH	DATA	0	LAST TEXT CHAR
TERMCH	DATA	0	TERMINATING CHAR (NORM LRC) 
	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+4	PUT INSAVE AREA 
	SC	A3,RESEND+5	
	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+4	PUT IN SAVE AREA
	LDK	A2,/FF 
	SC	A2,RESEND+5 

TRREP	LDK	A1,8
	LDKL	A4,RESEND 
	CF	A5,WRITEM 
	RTN	A5 
	EJECT
* 
* 
*	TRANSMIT ONE TEXT BLOCK 
* 
* 
TRTEXT	EQU	*

	LDK	A2,0 
	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,DWDC00+1	GET TCA 
	SC	A2,XMTBUF+5 
	XRR	A7,A2
	LDR*	A2,A6	GET STA 
	SC	A2,XMTBUF+6 
	XRR	A7,A2
	LDK	A3,2 

TRT100	LD	A1,FECBRL	CHECK LENGTH
	SU	A1,FBAX 
	ADR	A1,A3
	CWK	A1,TBLEN 
	RF(NG)	TRT110	SMALL ENOUGH 

	LDKL	A1,TBLEN	MUST BE BLOCKED
	RF	TRT120

TRT110	IM	XETX	INDICATE ETX SENT

TRT120	ST	A1,XMTLEN 
	SUR	A1,A3
	ADS	A1,FBAX
	ADKL	A3,XMTBUF+5 

TRT130	IM	XENB
	ENB
	LCR	A2,A4	MOVE MESSAGE BLOCK 
	XRR	A7,A2
	SCR	A2,A3
	ADK	A3,1 
	ADK	A4,1 
	SUK	A1,1 
	RB(NZ)	TRT130
	INH
	CM	XENB
	LD	A1,XPWF	CHECK IF POWER FAIL OCCURED 
	RF(Z)	TRT135	NO

	CM	XPWF	POWER FAIL IN ENABLE 
	ABL	BRM

TRT135	LDK	A2,ETX 
	LD	A1,XETX 
	RF(NZ)	TRT140	ETX BLOCK
	LDK	A2,ETB	ETB BLOCK 

TRT140	XRR	A7,A2
	SCR	A2,A3	STORE ETB/ETX
	SC	A7,1,A3	AND LRC 
	LDK	A2,/FF 
	SC	A2,2,A3	AND PAD 
	SC	A2,3,A3 

	LD	A1,XMTLEN 
	ADK	A1,9 

	LDKL	A4,XMTBUF 

	CF	A5,WRITEM	WRITE MESSAGE 
	RTN	A5 


XMTLEN	DATA	0 
XMTBUF	DATA	/1616,/1616,/0200 
	RES	TBLEN	TOO MANY BYTES 
	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,DWDC00+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

* 
*	READP   READ CHARACTER AND CHECK PARITY 
* 
*	EXIT
*	A1:  DESTR
*	A2:  CHARACTER
*	CR:  Z=OK, NZ= PARITY ERR 
* 

READP	CF	A5,READ
READP1	ANK	A2,/7F 
	ADKL	A5,4
	LD	A1,SLCUST 
	ABR*	A5
	EJECT

* 
*	READ  READ CHARACTER
* 
*	EXIT
*	A1:  DESTR
*	A2:  CHARACTER
* 

READ	LD	A1,RBCNT
	RF(Z)	READ10 

	LC*	A2,RBPNT 
	ANK	A2,/FF 
	IM	RBPNT 
	SUK	A1,1 
	ST	A1,RBCNT
	RTN	A5 

READ10	LDK	A1,100 
	ST	A4,A4SAV+2
	LDKL	A4,RECBUF 
	ST	A4,RBPNT
	CF	A5,READM
	CWK	A1,100 
	RB(E)	READ10 
	ST	A1,RBCNT
A4SAV	LDKL	A4,0 
	RB	READ

RBCNT	DATA	0
RBPNT	DATA	0
RECBUF	RES	50 
	EJECT

* 
*	READM   READ MESSAGE
* 
*	ENTRY 
*	A1:  MAX LENGTH 
*	A4:  BUFFER ADDRESS 
* 
*	EXIT
*	A1:  EFFECTIVE LENGTH 
*	A2:  STATUS 
*	A4:  ADDRESS AFTER MESSAGE
*	CR:  Z=OK, NZ= PARITY ERR, BUFF OVFLO 
* 

READM	WER	A1,SLCU+SLCU
	WER	A4,SLCU+SLCU+1 

	LDK	A1,/8D 
	CF	A5,STARTR 

	RER	A2,SLCU+SLCU+1 
	LDR	A1,A2
	SUR	A1,A4
	RF(NZ)	*+4 
	RF	HERROR	BAD HARDWARE 
	LDR	A4,A2
	ADKL	A5,4
	LD	A2,SLCUST 
	ABR*	A5
	EJECT

* 
*	STARTR   START RECIEVER 
* 
*	ENTRY 
*	A1:  START CODE 
* 
*	EXIT
*	A1,A2: DESTR
* 

STARTR	CF	A15,STREG 
	CIO	A1,1,SLCU
	RF(A)	STAR10 
	SST	A2,SLCU
	RF(A)	*+4
	RF	HERROR	BAD HARDWARE 
	CIO	A1,1,SLCU
	RF(A)	*+4
	RF	HERROR	BAD HARDWARE 
STAR10	LDK	A1,SYN 
	OTR	A1,1,SLCU
	RF(A)	*+4
	RF	HERROR	BAD HARDWARE 
	ABL	TDISP
	EJECT

* 
*	WRITEM   WRITE MESSAGE
* 
*	ENTRY 
*	A1:LENGTH 
*	A2:  BUFFER ADDRESS 
* 
*	EXIT
*	A1,A2:  DESTR 
* 

WRITEM	ORKL	A1,/4000
	WER	A1,SLCU+SLCU 
	WER	A4,SLCU+SLCU+1 
	LDK	A1,/0C 
	CF	A15,STREG 
	CIO	A1,1,SLCU
	RF(A)	WRITEX 
	SST	A2,SLCU
	RF(A)	*+4
	RF	HERROR	BAD HARDWARE 
	CIO	A1,1,SLCU
	RF(A)	*+4
	RF	HERROR	BAD HARDWARE 
WRITEX	ABL	TDISP
	EJECT

* 
*	SLCU INTERRUPT HANDLER
* 

IHSLCU	ST	P,INTSAV
	CF	A15,SAVE8 
	CF	A15,LDREG 
	SST	A1,SLCU
	RF(A)	*+4
	RF	HERROR	BAD HARDWARE 
	ST	A1,SLCUST 
	ST	A1,DCSTCU 
	ANK	A1,/FB 
	RF(NZ)	IHERR	SOMETHING BAD 
	RTN	A5 

IHERR	CF	A15,CKMESS	CHECK IF STATUS CHANGE
	ABL	BRM

SLCUST	DATA	0	LAST STATUS 
	EJECT

* 
*	HARDWARE ERROR RETURN CODE = /0081
* 

HERROR	LDK	A1,1	DISCONNECT
	CIO	A1,0,SLCU

	LDK	A1,/81 
	CF	A15,CKMESS	IND HARD ERR, NOT OPERABLE 

	CF	A15,SETIME	WAIT 0,5 SECONDS 
	DATA	HERR10,5
	ABL	TDISP

HERR10	ABL	BRM
	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 
* 
FINTER	EQU	*
	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
	CWR*	A2,A3	COMPARE SUBTERMINAL ADDRESS 
	RB(NE)	FINT10	TAKE NEXT TERMINAL 
FINT20	RTN	A5 
	EJECT
* 
* 
*	POWER ON FUNCTIONS
* 
* 
DRDCON	CF	A15,SAVE8	SAVE A1 - A8
	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
	LD	A2,DCTPGP	GET POLL TIMER POINTER
	RF(NZ)	DRDC20	ALREADY STARTED
DRDC10	CF	A15,SPOTIM	START POLL TIMER 
DRDC20	LD	A1,XENB	WAS DRIVER IN ENABLE MODE 
	ABL(Z)	BRM	NO
	IM	XPWF	YES INDICATE POWER FAIL
	ABL	TDISP
	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	CM	DCONOF	INDICATE POLLING
	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	* 
	IFF	BDKSP=1		*********** 
	LDR	A1,A6	LOAD DWT AS PARAMETER
	CF	A15,SETIME
	DATA	PRTOUT,TIMPRO 
	ST	A4,DCTPP	SAVE TIMER POINTER 
	XIF			***********
	RTN	A5 
* 
*	PROCEDURE TIMEOUT 
* 
PRTOUT	CM	DCTPP 
	LDR	A6,A1	RELOAD A6
	LDKL	A5,STB	LOAD STACK BASE
	LD	A1,XACK 
	RF(Z)	PRT10	ACK NOT EXPECTED 
	LDK	A1,0 
	CIO	A1,0,SLCU
	SST	A1,SLCU
	RF(A)	*+4
	RB	HERROR	BAD HARDWARE 
	IFF	BDKSP=1		*********** 
	CF	A5,TRENQ	SEND ENQ 
	XIF			********** 
	CF	A5,SPTIM	START PROCEDURE TIMER
	ABL	BRM

PRT10	RB	HERROR	BAD HARDWARE
	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
	IFT	CODE=1 
	EJECT
* 
* 
*	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
* 
SYNSW	DATA	0	0= SKIP SYNC CHARACTERS
*			1= DO NOT SKIP SYNC CHARS, BECAUSE IT BELONGS TO BCC
	EJECT
* 
* 
*	TABLE FOR CONVERSION OF EBCDIC CODE TO ASCII
* 
* 
TASCII	EQU	*
	DATA	/7F01,/0203,/0009,/0000	00-07 
	DATA	/0000,/0000,/0C00,/0000	08-0F 
	DATA	/1011,/1213,/000A,/0000	10-17 
	DATA	/0019,/0000,/1C1D,/1E1F	18-1F 
	DATA	/0000,/0000,/0000,/171B	20-27 
	DATA	/0000,/0000,/0005,/0000	28-2F 
	DATA	/0000,/1600,/0000,/0004	30-37 
	DATA	/0000,/0000,/1415,/001A	38-3F 
	DATA	/2041,/4243,/4445,/4647	40-47 
	DATA	/4849,/5B2E,/3C28,/2B21	48-4F 
	DATA	/264A,/4B4C,/4D4E,/4F50	50-57 
	DATA	/5152,/5D24,/2A29,/3B5E	58-5F 
	DATA	/2D2F,/5354,/5556,/5758	60-67 
	DATA	/595A,/7C2C,/255F,/3E3F	68-6F 
	DATA	/1831,/3233,/3435,/3637	70-77 
	DATA	/3839,/3A23,/4027,/3D22	78-7F 
	DATA	/2061,/6263,/6465,/6667	80-87 
	DATA	/6869,/5B2E,/3C28,/2B21	88-8F 
	DATA	/266A,/6B6C,/6D6E,/6F70	90-97 
	DATA	/7172,/5D24,/2A29,/3B5E	98-9F 
	DATA	/2D2F,/7374,/7576,/7778	A0-A7 
	DATA	/797A,/7C2C,/255F,/3E3F	A8-AF 
	DATA	/3031,/3233,/3435,/3637	B0-B7 
	DATA	/3839,/3A23,/4027,/3D22	B8-BF 
	DATA	/2041,/4243,/4445,/4647	C0-C7 
	DATA	/4849,/5B2E,/3C28,/2B21	C8-CF 
	DATA	/264A,/4B4C,/4D4E,/4F50	D0-D7 
	DATA	/5152,/5D24,/2A29,/3B5E	D8-DF 
	DATA	/2D2F,/5354,/5556,/5758	E0-E7 
	DATA	/595A,/7C2C,/255F,/3E3F	E8-EF 
	DATA	/3031,/3233,/3435,/3637	F0-F7 
	DATA	/3839,/3A23,/4027,/3DFF	F8-FF 
	XIF
	EJECT
	IFF	CODE+RCOM=0
* 
* 
*	TABLE FOR CONVERSION OF ASCII CODE TO EBCDIC
* 
* 
TEBCDIC	EQU	* 
	DATA	/0001,/0203,/372D,/0000	00-07 
	DATA	/0005,/1500,/0C00,/0000	08-0F 
	DATA	/1011,/1213,/3C3D,/3226	10-17 
	DATA	/7019,/3F27,/1C1D,/1E1F	18-1F 
	DATA	/404F,/7F7B,/5B6C,/507D	20-27 
	DATA	/4D5D,/5C4E,/6B60,/4B61	28-2F 
	DATA	/F0F1,/F2F3,/F4F5,/F6F7	30-37 
	DATA	/F8F9,/7A5E,/4C7E,/6E6F	38-3F 
	DATA	/7CC1,/C2C3,/C4C5,/C6C7	40-47 
	DATA	/C8C9,/D1D2,/D3D4,/D5D6	48-4F 
	DATA	/D7D8,/D9E2,/E3E4,/E5E6	50-57 
	DATA	/E7E8,/E94A,/005A,/5F6D	58-5F 
	DATA	/0081,/8283,/8485,/8687	60-67 
	DATA	/8889,/9192,/9394,/9596	68-6F 
	DATA	/9798,/99A2,/A3A4,/A5A6	70-77 
	DATA	/A7A8,/A91C,/6A00,/0000	78-7F 
	XIF
	EJECT
* 
* 
*	DEVICE WORK TABLE FOR DCTASK
* 
* 
DWDC00	EQU	*	TABLE ENTRY
	DATA	0	CU LINE ADDRESS 
	DATA	/8000	STATUS
	DATA	0	ECB ADDRESS 
	DATA	0	ORDER 
	DATA	DCADDC	POINTER TO ADDRESS BLOCK 
	DATA	0	TTAB ADDRESS
	DATA	0	WAIT/ACTIVATE INDICATOR 
	DATA	0	TASK QUEUE
	DATA	0	TIMER POINTER 
	DATA	0	WRITE QUEUE OR BUFFER QUEUE 
	EJECT
* 
* 
*	DC RECEIVE BUFFER POOL
* 
* 
DCRBUF	EQU	*
	DATA	BUF1	POINTER TO FIRST FREE BUFFER 
BUF1	DATA	BUF2	POINTER TO NEXT FREE BUFFER
	RES	RBUFL+3	BUFFER AREA 1
BUF2	DATA	0	END OF CHAIN
	RES	RBUFL+3	BUFFER AREA 2
* 
* 
*	DC TRANSMIT BUFFER POOL 
* 
* 
DCTBUF	EQU	*
* 
* 
	IFF	TBUFL=0
	DATA	BUF3	POINTER TO FIRST FREE BUFFER 
BUF3	DATA	BUF4	POINTER TO NEXT FREE BUFFER
	RES	TBUFL	BUFFER AREA 3
BUF4	DATA	0	END OF CHAIN
	RES	TBUFL	BUFFER AREA 4
	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
* 
* 
* 
	END