h28143
s 00002/00002/00129
d D 1.2 83/03/17 19:04:54 bog 2 1
c Make room in stack for gsxcomm.
e
s 00131/00000/00000
d D 1.1 83/03/17 17:46:41 bog 1 0
c date and time created 83/03/17 17:46:41 by bog
e
u
4
U
t
T
I 1
Gdos_Int	Equ	224
Gdos_Funct	Equ	115

CPMIO_Code	CSeg

; CP/M-86 I/O Routines

; Fortran callable

Param	Equ	Ss:(DWord Ptr .6)[Bp]	; Parameter address in stack
;	Sp+8		Segment Param
;	  +6		Offset Param
;	  +4		Segment Retaddr
;	  +2		Offset Retaddr
; [Bp]:	Sp		OldBp


	Public	TtyIn
TtyIn:	Mov	Bx,00203h		; Channel 3 Get char, wait


All_In:	Callf	Char_IO			; Call Bdos via Gdos via first-time sw

Valid_Char:
	And	Dl,07fh			; Mask off high order bit

Stuff_Char:
	Push	Bp			; Save caller's stack frame
	Mov	Bp,Sp			; Make my own frame

	Mov	Al,Dl			; Into Stosb register
	Les	Di,Param		; Get pointer to parameter
	Stosb				; Stuff character

	Pop	Bp			;  & Bp
	Retf	4			; Return, trashing parameter pointer


	Public	TtyINW
TtyINW:	Mov	Bx,00303h		; Channel 3, Get char, no wait

	Callf	Char_IO			; Call Bdos via Gdos via first-time sw

	Js	Valid_Char		; Jump if valid char in Dl

	Mov	Dl,-1			; Return -1 if not ready
	Jmps	Stuff_Char		; Go to common stuffer


	Public	RdrIn
RdrIn:	Mov	Bx,00204h		; Channel 4 Get char, wait
	Jmps	All_In			; Go to common get & stuff

	Eject

	Public	TtyOut
TtyOut:	Mov	Bx,00603h		; Channel 3, wait, output


AllOut:	Push	Bp			; Save caller's Bp
	Mov	Bp,Sp			; Point into stack

	Les	Si,Param		; Get pointer to character to show
	Mov	Dl,Es:(Byte Ptr .0)[Si]	; Get the character to show
	Mov	Dh,0			; High order zero

	Callf	Char_IO			; Call Bdos via Gdos via first-time sw

	Pop	Bp			;  & Bp
	Retf	4			; Return, trashing parameter pointer


	Public	PchOut
PchOut:	Mov	Bx,00604h		; Channel 4, wait, output
	Jmps	AllOut			; Go do common Int


	Public	LptOut
LptOut:	Mov	Bx,00605h		; Channel 5, wait, output
	Jmps	AllOut			; Go do common Int


	Public	TtyInE
TtyInE:	Push	Bp			; Save caller's Bp
	Mov	Bp,Sp			; Point into stack
	Push	Ds			; Save caller's Ds

	Lds	Dx,Param		; Point Ds:Dx to buffer
	Mov	Bx,00803h		; Read Console Buffer opcode

	Callf	Char_IO			; Call Bdos via Gdos via first-time sw

	Pop	Ds			; Restore caller's Ds
	Pop	Bp			;  & Bp
	Retf	4			; Return, trashing parameter pointer

	Eject

Char_IO:
	Test	CIO_Segment,0ffffh	; Already found where it is?
	Jz	Find_It			; Jump if need to find layer 1

Char_Jmpf:
;		Jmpf	Far Ptr 0:0	; Hard jump becomes Jmpf Layer1
		Db	0eah		; Jmpf
CIO_Offset	Dw	0		;  Offset
CIO_Segment	Dw	0		;  & Seg

Find_It:
	Push	Ax			; Save registers
	Push	Bx
	Push	Cx
	Push	Es

	Mov	Cx,01600h+Gdos_Funct	; Gdos "Return Layer Pointer" function
	Int	Gdos_Int		; Get ptr to layer 1 table entry

	Les	Bx,Es:(DWord Ptr 1)[Bx]	; Es:Bx <- Ptr to Layer 1
	Mov	CIO_Offset,Bx		; Fix up jump
	Mov	CIO_Segment,Es

	Pop	Es			; Restore registers
	Pop	Cx
	Pop	Bx
	Pop	Ax
	Jmps	Char_Jmpf		;  & call Char I/O layer 1

D 2
Stack	SSeg
	Rs	8			; Space for Bp, Ds, Callf
E 2
I 2
Stack	SSeg	Word
	Rw	32			; Space for Bp, Ds, Callf, Cio
E 2

	End
E 1
