;	name	('CLCPM')
;	title	CLCPM - CP/M Dependent Communications I/O for Local

;;;	polygon associates, inc.
;
;	B. W. Baebler	82/03/31  v3.1

;;;	Copyright (c) 1981, 1982, Polygon Associates, Incorporated.
;
;	Reproduction or publication in any form or format prohibited.
;	This unpublished program is the property of Polygon Associates,
;	Inc.
;
;	Current licensees of Polygon Associates, Inc. software which
;	requires customization are hereby granted permission to modify
;	the source code supplied with the software, and merge it into
;	the binary code provided by Polygon, for the purpose of enabling
;	Polygon software to execute on the Licensee's computer or CPU
;	registered with Polygon Associates, Inc.  Any other use is
;	prohibited.


;	poly-, and poly-XFR are trademarks of Polygon Associates, Inc.
;	CP/M is a registered trademark of Digital Research.



;;;	CLCPM - CP/M Dependent Communications I/O for XFRLOC.
;
;	This module defines the following C Callable functions:
;
;
;	TEXT   *comini(spd, siz)	Initialize Communications
;	VOID	comend()		End communications
;	BOOL	inpsts()		Get input status
;	TEXT	inpchr()		Get input data
;	VOID	inflsh()		Flush any input
;	BOOL	outsts()		Get output status
;	VOID	outchr(chr)		Send character
;	COUNT	bufin(ptxt,ltxt)	Get input buffer
;	VOID	bufout(ptxt,ltxt)	Send character buffer
;	COUNT	boutin(otxt,olen,itxt,ilen) Send/rcv buffer
;
;	where:
;	typedef unsigned char TEXT;
;	typedef int BOOL, VOID;
;	typedef short COUNT;


;;;;	External Entry Points.

;	public	comini,comend
;	public	inpsts,inpchr,inflsh
;	public	outsts,outchr
;	public	bufin$,bufout,boutin

;	External Symbols.

;	public	loops$,parm1$,parm2$

;;;;


;;;;	Symbol Definitions.

MASK7	equ	07Fh		; 7 level code mask
MASK8	equ	0FFh		; 8 level code mask
MASKD	equ	MASK8		; Default level

cbase	equ	01A5H		; Communications base
intset	equ	0F236H		; Interrupt vector set

;;	Device Definitions.

;	This is a special version defined for Florida Computer Graphics.

baudt	equ	052h		; Baud rate control - CTC
baudr	equ	060h		;

rdat	equ	021h		; SIO base
rsts	equ	023h

wdat	equ	021h
wcmd	equ	023h


SRXRDY	equ	004h		; Transmitter Ready
SRRRDY	equ	001h		; Receiver Ready
;	equ	004h		; unused
SRPE	equ	008h		; Parity Error
SROE	equ	010h		; Overrun Error
SRFE	equ	020h		; Frame Error
SRDSR	equ	040h		; Data Set Ready (CC)
SRCTS	equ	080h		; Clear to send (CB)

SRERR	equ	SRPE or SROE or SRFE ; Any error

CRRIE	equ	001h		; Receiver interrupt enable
CRXIE	equ	002h		; Transmitter interrupt enable
CRDTR	equ	004h		; Data Terminal Ready (CD)
CRRTS	equ	008h		; Request to Send (CA)

STSDLY	equ	10		; Device not ready delay count

;;;;

;	cseg
	org	cbase

;;	Dispatch Vectors.

comini:	jmp	cini		; Initialize
comend:	jmp	cend		; Terminate
inpsts:	jmp	ists		; Input status
inpchr:	jmp	ichr		; Input data
inflsh:	jmp	ifsh		; Flush input
outsts:	jmp	osts		; Output status
outchr:	jmp	ochr		; Output character
bufin$:	jmp	ibuf		; Input buffer
bufout:	jmp	obuf		; Output buffer
boutin:	jmp	oibf		; Output/Input buffer

;	Global constants.

loops$:	dw	65000		; Timeout loop counter
parm1$:	dw	0FFh		; Binary transfers
parm2$:	dw	15		; Maximum buffer size (128)



;;;	CINI - Initialize Communications Interface.
;


cini:	lda	initfg
	ora	a		; Initialized
	jnz	cin10		; If so
	inr	a
	sta	initfg		; Set initialized

;	Process desired speed if present.

	pop	h		; Return address
	pop	b		; Requested baud rate
	push	b
	push	h
	mov	a,c
	ora	a
	cnz	setspd		; If not current default

;	Initialize the SIO.

	call	iniint		; Initialize the interrupt system
	lxi	h,siotbl	; Point to table
	mvi	b,lsiotb	; Set length
cin5:	mov	a,m		; Pick up byte
	out	wcmd		; Put in device
	inx	h		; Advance pointer
	xthl			; Delay enough for device
	xthl
	dcr	b		; Finished?
	jnz	cin5		; If not
	xra	a		; Set
	out	wcmd		;  device reg address 0

;	Check for 7 or 8 level transfers.

cin10:	pop	h		; Return address
	pop	b		; Requested baud rate
	pop	b
	push	b
	push	b
	mov	a,c
	cpi	8
	mvi	a,MASK8		; Assume 8 level
	jz	cin15
	mvi	a,MASK7
cin15:	sta	ichra
	sta	ochra
	sta	ochrb

	lxi	b,0		; Indicate success
	pchl			; Return


siotbl:	db	  018h		; Reset
	db	4,04Ch		; x16, 2 stop, no parity
	db	3,0C1h		; Rx 8 bits, Rx enable
	db	5,0EAh		; DTR, Tx 8 bits, Tx enable, RTS
	db	1,000h		; no interrupts
lsiotb	equ	$-siotbl




;;;	CEND - Terminate communications.

cend:	mvi	a,1		; Select
	out	wcmd		;  Register 1
	in	rsts		; Read the status
	ani	01h		; All sent?
	jz	cend		; If not

	mvi	a,1		; Disable interrupts
	out	wcmd
	xra	a		;
	out	wcmd		;
	out	wcmd		; and select Register 0
	ret			; Exit




;;;	ISTS - Return communications input status.

ists:	lda	comists		; Input ready status flag
	mov	c,a		; Return
	mvi	b,0		;  it to caller
	ora	a
	rnz

	mvi	a,STSDLY
ists5:	dcr	a
	jnz	ists5
	ret			; Exit




;;;	ICHR - Return communications input.

ichr:	xra	a
	sta	comists		; Set read
	lda	comidat		; Get data value
	mov	c,a		; Return character
	mvi	b,0		;  to caller
	ret			; Exit




;;;	IFSH - Flush any pending input.

ifsh:	xra	a
	sta	comists
	ret




;;;	OSTS - Return status of communications output.

osts:	in	rsts		; Read status
	ani	SRXRDY		; Mask bit
	mov	c,a		; Return
	mvi	b,0		;  it to caller
	ret			; Exit




;;;	OCHR - Send communications output.

ochr:	pop	h		; Pick up return address
	pop	b		; Pick up data
	push	b		; Maintain sp
	mov	a,c		; Set data
	ani	MASKD
ochra	equ	$-1
	out	wdat		; Send

	pchl			; Exit




;;;	IBUF - Get input buffer.

ibuf:	lxi	h,0		; Initialize
	shld	cnt		;  number read

	pop	h		; get return pc
	pop	b		; get buffer pointer
	xthl			; save return pc, get length

ibf5:	mov	a,h		; End
	ora	l		;  of buffer?
	jz	ibf20		; If yes
	dcx	h		; Count down remaining
	push	h		; Save remaining length

	lhld	loops$		; Get loop counter
ibf10:	lda	comists		; Read status
	ora	a		; Mask bit
	jz	ibf15		; If not ready

	xra	a
	sta	comists		; Set read
	lda	comidat		; Read data
	stax	b		; Store
	inx	b		; Advance pointer
	lhld	cnt		; Count
	inx	h		;  the input
	shld	cnt		;  byte
	pop	h		; Get remaining length
	jmp	ibf5		; Continue

ibf15:	dcx	h		; Count down
	mov	a,h		; Timed
	ora	l		;  out?
	jnz	ibf10		; If not
	pop	h		; Clean stack

ibf20:	lhld	cnt		; Get count
	mov	b,h		; Put in
	mov	c,l		;  return register
	xthl			; Get return pc
	push	b		; Restore stack
	pchl			; Exit



;;;	OBUF - Send character buffer.

obuf:	pop	h		; get return pc
	pop	b		; get buffer pointer
	xthl			; save return pc, get length

obf5:	mov	a,h		; End
	ora	l		;  of buffer?
	jz	obf15		; If yes

obf10:	in	rsts		; Read status
	ani	SRXRDY		; Mask bit
	jz	obf10		; If not ready

	ldax	b		; Get input
	inx	b		; Advance pointer
	ani	MASKD
ochrb	equ	$-1
	out	wdat		; Write data
	dcx	h		; Count down remaining
	jmp	obf5		; Continue

obf15:	xthl			; Get return pc
	push	b		; Restore stack
	pchl			; Exit




;;;	OIBF - Output/Input buffer.

oibf:	pop	h		; Save caller's
	shld	hlsav		;  return pc

	call	obuf		; Send output buffer

	pop	psw		; Remove output buffer pointer
	pop	psw		; Remove output buffer length
	call	ibuf		; Get input buffer
	push	psw		; Restore
	push	psw		;  stack

	lhld	hlsav		; Return
	pchl			;  to caller


;;;	Interrupt Routines.

;;	Receiver interrupt.

i$rca:	in	rdat		; Get data
	ani	MASKD
ichra	equ	$-1		; 
	sta	comidat
	mvi	a,1
	sta	comists		; Set ready
	ret			; Exit


;;	Special Receiver Conditions.

i$src:	in	rdat

;;	External status change.
;;	Transmitter empty.

i$esc:
i$txe:
	ret


;;	iniint - initialize the interrupt system.
;
;	Tie into the system interrupt vectors.
;
;	Entry:	None.
;	Exit:	Interrupts set.
;	Uses:	a, de, 2sp.
;	Calls:	None.


iniint:	push	d		; Save C frame pointer

	mvi	a,0		; Set Transmitter empty vector
	lxi	d,i$txe
	call	intset

	mvi	a,1		; Set External status change
	lxi	d,i$esc
	call	intset

	mvi	a,2		; Set Receiver character available
	lxi	d,i$rca
	call	intset

	mvi	a,3		; Special receive characteristics
	lxi	d,i$src
	call	intset
	pop	d
	ret


;;	setspd - Set device baud rate.
;
;
;	Entry:	c = Requested speed ordinal.
;	Exit:	speed set.
;	Uses:	b, c, h, l.
;	Calls:	None.


setspd:	mov	b,0
	lxi	h,spdtbl-2
	dad	b
	dad	b		; Index into table
	mov	b,m		; Get control
	inx	h
	mov	c,m		; and time constant
	mov	a,b
	out	baudt		; Send CTC device control
	mov	a,c
	out	baudt
	mov	a,b
	out	baudr		; For both channels
	mov	a,c
	out	baudr
	ret


spdtbl:	db	035h,20		; 50		(/256 internal 4MHz clock)
	db	015h,208	; 75		(/16 )
	db	015h,142	; 110
	db	015h,116	; 134.5
	db	015h,104	; 150
	db	015h,52		; 300
	db	055h,128	; 600		(external 1.228MHz clock)
	db	055h,64		; 1200
	db	055h,43		; 1800
	db	055h,38		; 2000
	db	055h,32		; 2400
	db	055h,21		; 3600
	db	055h,16		; 4800
	db	055h,11		; 7200
	db	055h,8		; 9600
	db	055h,4		; 19200
	db	055h,2		; 38400

;;	Local Data.

;	dseg

cnt:	dw	2		; Byte counter
hlsav:	dw	2		; Save area
initfg:	db	0		; Initialized
comists:db	0		; Input data available
comidat:db	0		; Input data
comosts:db	0		; Output ready status
comodat:db	0		; Output data

        end