inpdsk.asm

[随书类]Dos6.0源代码

	TITLE	INPDSK - disk input
	page	,132
;***
; INPDSK - disk input
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
;
;BASIC Syntax mapping to included runtime entry points:
;
;i)	INPUT[;]["prompt";|,]variable[,variable]...
;
;	BASCOM 2.0 generates calls to IN0A, IPUA, and a call to IPUB for
;	each variable.	Now it will generate the following calls :
;
;	1.	void B$INPP (sd *psdPrompt, I2 FAR *pBlock)
;
;			Where pBlock is a far pointer to a block
;			with the following information :
;
;			word 1 .... word count of the length of this block
;			byte 3 .... an encoded flag having information about
;					CRLF and the ?. It is described below.
;			bytes 4 to n+3 .... have the n types.
;
;			the block would look like :
;
;			1  2  3 	  4
;			----------------------------------------------
;			| n+3 | fCRLFqMark|<---------n types-------->|
;			______________________________________________
;			^
;			|
;			|
;			|
;			pBlock
;
;		The CRLFqMark flag can take the following values :
;
;		0 ....	no ';' before prompt and ';' after prompt.
;		1 ....	no ';' before prompt and ',' after prompt.
;		2 ....	   ';' before prompt and ';' after prompt.
;		3 ....	   ';' before prompt and ',' after prompt.
;
;		Note: the above has the same meaning as:
;			bit 0 set if NO question mark will be displayed
;			bit 1 set if NO no carriage return will be forced.
;
;		The types are as follows :
;
;		I2 .... 2H     \
;		I4 .... 14H	\    This is what the runtime is
;		R4 .... 4H	     using.
;		R8 .... 8H	/
;		SD .... 3H     /
;
;		(INPP stands for INPut Preamble)
;
;		The value of b$FInput will be:
;
;		default 0FFH
;		inptty	0H
;		inpdsk	1H
;
;	2. void B$RD<type> (<type> *pDest)
;
;		Where,
;			<type>	=	I2:	Two byte integer
;					I4:	Four byte integer
;					R4:	Single precision real
;					R8:	Double precision real
;					SD:	String descriptor
;
;		This will be called once for each variable.
;
;		The B$RD<type> routines are going to be shared between
;		the READ and INPUT statements and they need to know whether
;		they are called from an INPUT statement or a READ
;		statement. This is done by setting a flag (say b$FInput)
;		in B$DSKI.
;		(The default value of b$FInput would be used for READ)
;
;		(Note:
;		In the case of interpreted code, the B$RD<type>
;		routines will call the interpreter to get a pointer to
;		the next DATA item and return the # of bytes consumed.)
;
;	3. void B$PEOS(void)
;
;		The flag b$FInput gets cleared in B$PEOS.
;
;ii)	INPUT #filenum, variable [,variable]...
;
;	BASCOM 2.0 generates calls to IN0B, IPUA and IPUB. Now it will
;	generate the following calls :
;
;
;	1. void B$DSKI (I2 channel)
;
;	2. void B$RD<type> (<type> *pDest)
;
;		Refer to the description above.
;
;	3. void B$PEOS(void)
;
;		Refer to the description above.
;
;iii)	LINE INPUT [;]["prompt";|,] stringvar
;
;	BASCOM 2.0 generates calls to IN0A and LIPA. Now it will generate
;	a call to B$LNIN. (see routine documentation).
;
;iv)	LINE INPUT #filenum, stringvar
;
;	BASCOM 2.0 generates calls to IN0B and LIPA. Now it will generate
;	calls to B$DSKI followed by B$LNIN.
;
;	Since B$LNIN is shared between LINE INPUT and LINE INPUT #, B$DSKI
;	sets b$FInput telling B$LNIN that this is disk input. b$FInput gets
;	cleared before exiting B$LNIN.
;
;	B$INPP is in inptty.asm
;	B$DSKI is in inpdsk.asm
;	B$LNIN is in lininp.asm
;	B$RD<type> is in read.asm
;
;******************************************************************************

	INCLUDE switch.inc
	INCLUDE rmacros.inc

;Code segment
	useSeg	DK_TEXT
	useSeg	NH_TEXT
	useSeg	ST_TEXT
	useSeg	MT_TEXT
	useSeg	ER_TEXT
;Data segment
	useSeg	_DATA
	useSeg	_BSS

	INCLUDE seg.inc
	INCLUDE baslibma.inc
	INCLUDE devdef.inc
	INCLUDE files.inc
	INCLUDE ascii.inc
	INCLUDE rtps.inc	; constants shared with QBI
	INCLUDE idmac.inc	

	SUBTTL	local constant definitions
	page


	NEWLINE= ASCCR

	InpDefault	EQU	0FFH	;default READ statement
	InpTTY		EQU	0H	;console input
	InpDsk		EQU	1H	;device input

	SUBTTL	data definitions
	page

sBegin	_DATA

	externW B$ENTRY_BUFCNT	;buffer position in fdb before current stmt.
	externB b$FInput	;default InpDefault
	externW b$GetOneVal	;default OFFSET ReadVal
	externW b$SDBuf1	; sd of b$Buf1
	externW B$AC

sEnd	;_DATA

sBegin	_BSS

	externW b$PTRFIL	;defined in GOSTOP.ASM
	externB b$Buf1		; defined in GWINI.ASM
	externB b$VTYP 	;defined in GLOBAL.INC

sEnd	;_BSS

	SUBTTL	code externals
	page


sBegin	NH_TEXT
	externNP	B$STDALCTMP
	externNP	B$STALCTMP
	externNP	B$STGETSTRLEN
	externNP	B$STALCTMPCPY
	externNP	B$LHFDBLOC	
sEnd	;NH_TEXT

sBegin	DK_TEXT
	externNP	B$$RCH
	externNP	B$PtrDispatch	
	externNP	B$ChkFNUM	
sEnd	;DK_TEXT

sBegin	ER_TEXT
	externNP	B$ERR_IFN
	externNP	B$ERR_RPE
	externNP	B$ERR_BFM	
sEnd	;ER_TEXT

sBegin	ST_TEXT
	externFP	B$SCAT 	
sEnd	;ST_TEXT

sBegin	MT_TEXT
	externNP	B$FIN
	externNP	B$STRSCAN	
sEnd	;MT_TEXT

	assumes CS,DK_TEXT
sBegin	DK_TEXT
	SUBTTL	disk input interface -- B$DSKI & B$RD<type>
	page
;***
;B$DSKI -- preamble for disk input
;void B$DSKI(I2 channel)
;
;Purpose:
;	This is the preamble of disk input.  It sets up flags and variables
;	for subsequent calls to B$RD<type>.
;Entry:
;	Parameter is in stack.
;	int	channel
;Exit:
;	[b$PTRFIL]	= *FDB
;	[b$FInput]	= InpDsk
;	[b$GetOneVal]	= OFFSET DskInpVal
;Uses:
;	none
;Exceptions:
;	illegal file number -- B$ERR_IFN
;	read pass end -- B$ERR_RPE
;*******************************************************************************

cProc	B$DSKI,<PUBLIC,FAR>,<SI>
	ParmW	Channel 	;I2 filenum
cBegin
	MOV	BX,Channel	;BX has the file number
	CALL	B$ChkFNUM	; make sure in range 1-255

	CALL	B$LHFDBLOC	;NZ & SI= *FDB if file exists
	JZ	ERCIFN		;Brif not exist, give "illegal file number"
	FDB_PTR ES,SI,SI	;(ES:)[SI] = *FDB
	MOV	AX,FileDB.FD_BUFCNT ; Save current buffer postion
	MOV	B$ENTRY_BUFCNT,AX   ; Used to reset on error
	TEST	FileDB.FD_MODE,MD_SQO+MD_APP	
	JNZ	ERCRPE		;if output mode, give "read pass end"
	TEST	FileDB.FD_MODE,MD_BIN ; binary mode?
	JNZ	ERCBFM		; brif so --  give "bad file mode"

	MOV	[b$PTRFIL],SI	;set up PTRFIL
	MOV	[b$GetOneVal],OFFSET DskInpVal
				;set routine to input one item
	MOV	[b$FInput],InpDsk
				;indicate disk input
cEnd				;pop si and exit to caller

ERCIFN: JMP	B$ERR_IFN	;illegal file number
ERCRPE: JMP	B$ERR_RPE	;read pass end
ERCBFM: JMP	B$ERR_BFM	;bad file mode

	SUBTTL	READ/disk [LINE] INPUT supporting routines
	page
;***
;DskInpVal -- input one item from a disk file or from a device
;
;Purpose:
;	This routine is to get one value for disk (device) input.
;
;	After the input preamble, the succeeding calls will assign values
;	into variables.  The functionality of those assignment routines,
;	B$RD<type>, may be roughly split into two parts -- namely, getting
;	one value and then assigning it to the variable.  In BASCOM 3.0,
;	those assignment routines are shared by READ stmt, input from TTY
;	and input from a disk file (or a device).  Generally speaking,
;	the second part of the assignment routines DOESN'T discriminate
;	among the statements which share its use.  However, the first part
;	of the assignment routines MUST discriminate among the statements
;	which share its use.  In order to achieve this, the first part of
;	the assignment routines uses an indirect call, CALL [b$GetOneVal],
;	to get one value.  [b$GetOneVal] is default to the address of
;	ReadVal, which gets one value for READ stmt, or contains either
;	the address of TTYInpVal for TTY input or the address of DskInpVal
;	for disk (device) input.
;Entry:
;	[b$VTYP]	= types
;Exit:
;	[SI]		= pointer to source
;Uses:
;	none
;Exceptions:
;	B$ERR_RPE -- read pass end (B$FillBuf generates)
;	B$RUNERR handles it
;*******************************************************************************

cProc	DskInpVal,<NEAR>

cBegin
	MOV	DX,"," SHL 8 + " "	;default delimiters for number
	CMP	[b$VTYP],VT_SD	; is string ?
	JNZ	GetVal		;Brif not
	MOV	DL,DH		;both delimiters be "," for string
GetVal:
	cCall	B$FillBuf	;get one value (in the form of character
				; stream in buffer), on return, SI=*sd
	cCall	DeviceFin	;convert it into number if it is
				; B$AC or B$DAC has the result
	MOV	SI,OFFSET DGROUP:B$AC
	TEST	[b$VTYP],8	;R8 or currency (8-byte values)?
	JZ	DskInpExit	;go if not
	SUB	SI,4		;points to B$DAC
DskInpExit:
cEnd				;exit to caller