;	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	080h		; 8 level code mask
MASKD	equ	MASK8		; Default
NO	equ	0		; C logical false
YES	equ	not NO
cbase	equ	01A5h		; Communications area base

;;	Device Definitions.

;	This is a special version defined for the 2651 devices.


devbas	equ	0C8h		; Device base
dro	equ	0		; Read offset
dwo	equ	4		; Write offset
rdat	equ	devbas+dro+00	; Read data
rsts	equ	devbas+dro+01	; Read status
rmde	equ	devbas+dro+02	; Read mode registers 1 and 2
rcmd	equ	devbas+dro+03	; Read command
wdat	equ	devbas+dwo+00	; Write data
wmde	equ	devbas+dwo+02	; Write mode registers 1 and 2
wcmd	equ	devbas+dwo+03	; Write command


SRXRDY	equ	001h		; Transmitter Ready
SRRRDY	equ	002h		; Receiver Ready
SRXEMP	equ	004h		; Transmitter empty or Data set change
SRPE	equ	008h		; Parity Error
SROE	equ	010h		; Overrun Error
SRFE	equ	020h		; Frame Error
SRDCD	equ	040h		; Data carrier detect
SRDSR	equ	080h		; Data Set Ready (CC)

SRERR	equ	SRPE or SROE or SRFE ; Any error

CRTXEN	equ	001h		; Transmitter interrupt enable
CRDTR	equ	002h		; Data Terminal Ready (CD)
CRRXEN	equ	004h		; Receiver enable
CRSBRK	equ	008h		; Send break
CRERST	equ	010h		; Error Reset
CRRTS	equ	020h		; Request to Send (CA)

STSDLY	equ	10		; Device not ready delay count

MR1	equ	04Eh		; Mode reg 1, 1 stop, no parity, 8 data, 16x
MR2	equ	030h		; Mode reg 2, select internal rates

;;;;

;	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	YES		; 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
	jz	cin10		; If no speed desired

;	Initialize the 2651.

	mvi	a,CRDTR or CRERST ; Disable transmitter and receiver
	out	wcmd
	in	rcmd		; Reset internal sequencer to mode register 1
	mvi	a,mr1		; Mode register 1
	out	wmde
	mov	a,c
	call	setspd		; If not current default
cin10:	mvi	a,CRRTS or CRDTR or CRRXEN or CRTXEN or CRERST
	out	wcmd

;	Check for 7 or 8 level transfers.

	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	ichrb
	sta	ochra
	sta	ochrb

	lxi	b,0		; Indicate success
	pchl			; Return




;;;	CEND - Terminate communications.

cend:	in	rsts		; Read the status
	ani	SRXEMP		; All sent?
	jz	cend		; If not
	mvi	a,CRDTR
	out	wcmd
	ret			; Exit




;;;	ISTS - Return communications input status.

ists:	in	rsts		; Read status
	ani	SRRRDY		; Mask bit
	mov	c,a		; Return
	mvi	b,0		;  it to caller
	rnz

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




;;;	ICHR - Return communications input.

ichr:	in	rdat		; Get data
	ani	MASKD
ichra	equ	$-1		; 
	mov	c,a		; Return character
	mvi	b,0		;  to caller
	ret			; Exit




;;;	IFSH - Flush any pending input.

ifsh:	in	rsts		; Read status
	ani	SRRRDY
	rz
	in	rdat
	jp	ifsh




;;;	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:	in	rsts		; Read status
	ani	SRRRDY		; Mask bit
	jz	ibf15		; If not ready

	in	rdat		; Read data
	ani	MASKD
ichrb	equ	$-1
	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



;;	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-1
	dad	b		; Index into table
	mov	a,m		; Get control
	out	wmde		; Write mode reqister 2
	ret


spdtbl:	db	mr2+00h		; 50
	db	mr2+01h		; 75
	db	mr2+02h		; 110
	db	mr2+03h		; 134.5
	db	mr2+04h		; 150
	db	mr2+05h		; 300
	db	mr2+06h		; 600
	db	mr2+07h		; 1200
	db	mr2+08h		; 1800
	db	mr2+09h		; 2000
	db	mr2+0Ah		; 2400
	db	mr2+0Bh		; 3600
	db	mr2+0Ch		; 4800
	db	mr2+0Dh		; 7200
	db	mr2+0Eh		; 9600
	db	mr2+0Fh		; 19200
	db	00		; EXTERNAL

;;	Local Data.

;	dseg

cnt:	dw	2		; Byte counter
hlsav:	dw	2		; Save area
initfg:	db	0		; Initialized

        end