h08489
s 00001/00001/00288
d D 1.2 83/03/17 19:14:01 bog 2 1
c Word align SSeg.
e
s 00289/00000/00000
d D 1.1 83/03/17 17:46:25 bog 1 0
c date and time created 83/03/17 17:46:25 by bog
e
u
4
U
t
T
I 1
	Title	'CpmBdos  GSS-GRAPH Interface to CP/M-86'

;	Integer*2 Function Cpm(Funct,Arg)	{Far Fortran invocation}

;		Input	Funct	Integer*2 Bdos function code
;			Arg	untyped Bdos argument

;		Result	Cpm	Integer*2 Ax from Bdos

OldBp		Equ	Word Ptr 0[Bp]
OldDs		Equ	Word Ptr OldBp+2[Bp]
Ret_Addr	Equ	DWord Ptr OldDs+2[Bp]
Argument_Ptr	Equ	DWord Ptr Ret_Addr+4[Bp]
Function_Ptr	Equ	DWord Ptr Argument_Ptr+4[Bp]

Bdos		Equ	224

CpmBdos_Code	CSeg
		Public	Cpm

Cpm:	Push	Ds		; Save caller's Ds
	Push	Bp		;  & frame
	Mov	Bp,Sp		; Make local frame

	Lds	Bx,Function_Ptr	; Point to function code
	Mov	Cx,Ds:(Word Ptr 0)[Bx]	; Get function code
	Lds	Dx,Argument_Ptr	; Get pointer to Bdos argument

	Int	Bdos		; Invoke Bdos function -- Ax <- Bdos result

	Pop	Bp		; Restore caller's frame
	Pop	Ds		;  & Ds
	Retf	8		;  & return

;	Call SetDMA(Buff)		{Far Fortran invocation}

;		Input	Buff	untyped buffer pointer

Buff_Ptr	Equ	DWord Ptr Ret_Addr+4[Bp]

SetDMA_Seg	Equ	51
SetDMA_Offset	Equ	26

	Public	SetDMA

SetDMA:	Push	Ds		; Save caller's Ds
	Push	Bp		;  & frame
	Mov	Bp,Sp		; Make local frame

	Mov	Dx,Word Ptr Buff_Ptr+2	; Get DMA seg base

	Mov	Cl,SetDMA_Seg		; Bdos "Set DMA Seg Base" function
	Int	Bdos

	Mov	Dx,Word Ptr Buff_Ptr	; Get DMA offset

	Mov	Cl,SetDMA_Offset	; Bdos "Set DMA Offset" function
	Int	Bdos

	Pop	Bp		; Restore caller's frame
	Pop	Ds		;  & Ds
	Retf	4		;  & return

	Eject

; FParse        Parse a CP/M-86 filespec -- d:filename.ext
;               Return the first 12 bytes of an Fcb

;	Integer*2 Function FParse(StrPtr,NewFcbPtr) {Far Fortran invocation}

;	Dword Ptr StrPtr is input filename.
;	Dword Ptr NewFcbPtr is the pointer to the Fcb being built.

;	Result FParse is -1 if no filename was found, else 0.


; The first 12 bytes of the Fcb at NewFcbPtr are filled with the appropriate
; stuff from the filespec.  A legal or blank default filespec must be given
; at NewFcbPtr+9.  The drive used if none is specified in the string must be
; given at NewFcbPtr+0.

; Wildcards are not accepted.

; BNF for filespec parse
;  1    <filespec>      ::= <drive>        '.'         {blank name & extension}
;  2                      | <drive>        '.' <name>  {blank name}
;  3                      | <drive> <name>             {default extension}
;  4                      | <drive> <name> '.'         {blank extension}
;  5                      | <drive> <name> '.' <name>  {full name & extension}

;  7    <drive>         ::=                            {default drive}
;  8                      | <drivechar> ':'            {drive specified}

;  9    <drivechar>     ::= '@'..'P' | 'a'..'p'        {lower => upper case}
;						       {'@' is current logged}

; 41    <name>          ::= <name> <namechar>          {arbitrary length}

; 42    <namechar>      ::= '!'..')' | '+' | '-'
; 53                      | '/' | '0'..'9' | '@'
; 65                      | 'A'..'Z' | '\' | '^'
; 93                      | '_' | '`' | 'a'..'z'       {lower => upper case}
; 121                     | '{' | '|' | '}' | '~'

	Eject

	Public	FParse

Work_Ptr	Equ	DWord Ptr (-4)[Bp]
ReturnAddress	Equ	DWord Ptr (OldDs+2)[Bp]
NewFcbPtr	Equ	DWord Ptr (ReturnAddress+4)[Bp]
StrPtr		Equ	DWord Ptr (NewFcbPtr+4)[Bp]

FParse:	Push	Ds			; Save caller's registers
	Push	Bp			;  & stack frame
	Mov	Bp,Sp			; Make local stack frame
	Push	Ax			; Room for Work_Ptr
	Push	Ax

	Les	Di,NewFcbPtr		; Point to new Fcb

	Lds	Si,StrPtr		; Point to filename string
	Mov	Word Ptr Work_Ptr+2,Ds	; Save segbase
	Mov	Word Ptr Work_Ptr,Si	;  & offset

SkipBl:	Call	FGetCh			; Get the first character
	Cmp	Al,' '			; Whitespace?
	Je	SkipBl			; Loop if so
	Cmp	Al,8			; Tab?
	Je	SkipBl			; Skip if so

	Call	FUpCase			; Upcase past whitespace

	Cmp	Al,64			; Potential <drivechar>?  @ is logged
	Jb	FTryFN			; No; try for filename

	Cmp	Al,'P'			; Maybe still potential filename?
	Ja	FTryFN			; Jump if not in range '@'..'P'

	Push	Ax			; Save possible <drivechar>

	Call	FPeekCh			; Look at but don't GetCh next char

	Cmp	Al,':'			; Drive specified?
	Jne	FNDriv			; Jump if drive not specified

	Pop	Ax			; Get <drivechar> back

	Sub	Al,'@'			; 'A' => 1 .. 'P' => 16 drive code
	Mov	Es:[Di],Al		; Stuff drive code

	Call	FGetCh			; Real GetCh of ':'

	Call	FGetCh			; GetCh first filename char
	Call	FUpCase			;  & upcase it

	Push	Ax			; Compensate for following pop

FNDriv:	Pop	Ax			; Restore first filename char

FTryFN:	Inc	Di			; Point to first filename char in Fcb
	Mov	Cx,8			; Name is 8 characters long

	Call	FPName			; Parse and fetch name, if present

	Cmp	Al,'.'			; Extension follows?
	Jne	FAftExt			; Jump if no extension

	Call	FGetCh			; Skip the '.'
	Call	FUpCase			;  & upcase next character

	Mov	Cl,3			; Extension is 3 chars long
	Call	FPName			; Parse and fetch extension

; If the first FPName found no filename, Cx would still be 8.  If a '.'
; were found and an extension parsed, Cx would be 3 or less.  Thus, if Cx
; is 8, no filename or '.' or extension was found, and the filename is at
; best only d:, which is illegal.  If this is the case, set carry and return.
FAftExt:
	Cmp	Cl,8			; Set carry if Cx less than 8
	Cmc				; Reset carry if Cx less than 8
	Sbb	Ax,Ax			; Ax <- Carry

	Mov	Sp,Bp			; Trash local frame
	Pop	Bp			; Restore caller's registers
	Pop	Ds

	Retf	8			;  & return
	Eject
; Al contains possible first name character
; Cx contains count of characters in field
; Es:Di points to first byte of field
; Clear field to spaces and parse name into field
; Direction flag preserved
FPName:	Pushf				; Preserve direction flag
	Cld				; Work up in address

FPNameS:
	Call	FNameCh			; See if this char is valid name char
	Jc	FPNameQ			; Quit if not valid name char
	Jcxz	FPNameN			; Bypass store if field full
	Stos	Es:Byte Ptr[Di]		; Stuff & increment field ptr
	Dec	Cx			; Decrement char count

FPNameN:
	Call	FGetCh			; Get next char
	Call	FUpCase			;  & upcase it
	Jmps	FPNameS			; Loop until name exhausted

FPNameQ:
	Push	Cx			; Save indicator of num chars found
	Push	Ax			; Save next character
	Mov	Al,' '			; Clear the rest of the field
    Rep	Stos	Es:Byte Ptr[Di]		;  to spaces; note Rep is a While
	Pop	Ax			; Restore next character
	Pop	Cx			; Restore num chars found indicator
	Popf				; Restore direction flag
	Ret				;  & return
	Eject
; Return carry reset if valid name character in Al
FNameCh:
	Push	Di			; Save caller's Di
	Push	Es			;  & Es
	Push	Cs			; Point Es to Cs
	Pop	Es

	Cmp	Al,080h			; If char >= 080h then carry is clear,
	Jnb	FNamChC			;  so return invalid character
	Mov	Di,Offset FNamChs	; Point to valid character table

FNamChL:
	Scas	Es:(Byte Ptr 0)[Di]	; Compare with bottom of range, bump Di
	Jb	FNamChQ			; Quit if below; not valid
	Scas	Es:(Byte Ptr 0)[Di]	; Compare with top+1 of range, bump Di
	Jnb	FNamChL			; Loop if not in range
					;  else carry is set & char is in range

FNamChC:
	Cmc				; Complement carry

FNamChQ:
	Pop	Es			; Restore caller's Es
	Pop	Di			; Restore caller's Di
	Ret				;  & return

FNamChs Db	'!',')'+1		; Ranges of valid name characters
	Db	'+','+'+1		; <firstvalid>,<lastvalid>+1
	Db	'-','-'+1
	Db	'/','9'+1
	Db	'@','Z'+1
	Db	'\','\'+1
	Db	'^','~'+1
	Db	0ffh			; Stopper

	Eject

; Subroutines for FParse

FPeekCh:
	Push	Ds		; Save caller's Ds & Si
	Push	Si

	Lds	Si,Work_Ptr	; Point to next char in string
	Lods	Ds:(Byte Ptr 0)[Si]	; Get it

	Pop	Si		; Restore caller's Ds & Si
	Pop	Ds
	Ret

FGetCh:	Call	FPeekCh		; Get next byte
	Inc	Word Ptr Work_Ptr	;  & point to it
	Ret

FUpCase:
	Pushf			; Save caller's flags
	Cmp	Al,'a'		; Lowercase char?
	Jb	UpCaseQ		; Jump if nope
	Cmp	Al,'z'		; Lowercase range?
	Ja	UpCaseQ		; Jump if nope

	Sub	Al,'a'-'A'	; Upcase the char

UpCaseQ:
	Popf			; Restore flags
	Ret			;  & return

D 2
Stack	SSeg
E 2
I 2
Stack	SSeg	Word
E 2
	Rs	20		; Deepest in FParse
	End
E 1
