strfcn.asm

[随书类]Dos6.0源代码

	TITLE	STRFCN - String function package
	PAGE	56,132
;***
; STRFCN - String function package
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
;	BASIC intrinsic string function support.
;
; BASIC Syntax mapping to included runtime entry points:
;
;
; INSTR Function - calls B$INS3 if optional parameter given, otherwise B$INS2:
;
;   v = INSTR(5, a$, b$)  v = INSTR (x$, y$)
;	   |			 |
;	B$INS3		      B$INS2
;
;
; LEFT$ Statement:	LEN Function:		LSET Statement:
;
;   v$ = LEFT$(x$,n)	  v = LEN(x$)		  LSET v$ = x$
;	  |		       |		       |
;	B$LEFT		    B$FLEN		     B$LSET
;
;
; MID$ Function:	RIGHT$ Function:	SPACE$ Function:
;
;   v$ = MID$(x$,n,[m])   v$ = RIGHT$(x$,n)	  v$ = SPACE$(n)
;	  |			|			 |
;      B$FMID		     B$RGHT		      B$SPAC
;
;
; STRING$ Function - Two possible syntaxes map to two runtime entry points:
;
;   v$ = STRING$(n,m)	  v$ = STRING$(n,x$)
;	    |			 |
;	B$STRI		      B$STRS
;
;
; VARPTR$ Function:-	       ASC Function:
;
;   v$ = VARPTR$(a)		 v = ASC(string)
;	    |			       |
;	B$VARP(addr, type)	    B$FASC
;
;******************************************************************************
	INCLUDE switch.inc
	INCLUDE rmacros.inc	; Runtime Macro Defintions

	useSeg	_DATA		
	useSeg	NH_TEXT 	
	useSeg	ST_TEXT 	

	INCLUDE seg.inc 	
	INCLUDE baslibma.inc
	INCLUDE files.inc
	INCLUDE devdef.inc
	INCLUDE const.inc	

sBegin	_DATA

externW b$nuldes 		;[6]

sEnd	_DATA			

sBegin	ST_TEXT 		
assumes CS,ST_TEXT		

externNP B$STALCTMP		
externNP B$STALCTMPSUB		

externNP B$ERR_FC		
externNP B$ERR_FC		
externNP B$STDALCTMP		


	SUBTTL	B$SADD & B$FLEN - get address & length of string
	PAGE
;***
;B$SADD - get address of string
;char * pascal B$SADD(sd *psd)
;
;Function:
; Implement SADD function by returning the address of the specified string.
;
;Inputs:
; psd	= ptr to sdesc
;
;Outputs:
; [AX]	= integer address (0 if null string)
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$SADD,<FAR,PUBLIC>	
parmW	psd			; Pointer to sd to get address from
cBegin				
	MOV	BX,psd		; [BX] = pointer to sd
	MOV	CX,[BX] 	; [CX] = length of string
	JCXZ	FLEN_10 	; If zero length, just return 0
	PUSH	[BX+2]		; Put address on stack
	JMP	SHORT FLEN_20	; go share some code
cEnd	nogen			

;***
;B$FLEN - Compute LEN function
;I2 pascal B$FLEN(sd *psd)
;
;Inputs:
; psd	= Address of string descriptor
;
;Outputs:
; [AX]	= Value of LEN function
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$FLEN,<FAR,PUBLIC>	
parmW	psd			
cBegin				
	MOV	BX,psd		; get string descriptor
FLEN_10:
	PUSH	[BX]		;Put length on stack
FLEN_20:			
	CALL	B$STDALCTMP	;Delete if temp string
	POP	AX		; [AX] has length/addr
FLEN_90:			
cEnd				

	SUBTTL	B$FASC - Compute ASC function
	PAGE
;***
;B$FASC - Compute ASC function
;I2 pascal B$FASC(sd *psd)
;DBCS-callback
;
;Purpose:
;	This routine is used to support the ASC() function.
;
;Entry:
;	psd   = Address of string descriptor
;
;Exit:
;	[AX]  = Value of ASC function
;
;Uses:
;	Per convention
;
;Preserves:
;	None.
;
;Exceptions:
;	B$ERR_FC for an empty string or illegal double byte character.
;******************************************************************************
cProc	B$FASC,<FAR,PUBLIC>,SI 
parmW	psd			
cBegin				
	MOV	BX,psd		
	CMP	WORD PTR[BX],0	;See if nul string
	JZ	ERRFC


	MOV	SI,[BX+2]	;Get pointer to string data
	MOV	SI,[SI] 	;Save first char of string
	CALL	B$STDALCTMP	;Delete if temp string
	XCHG	AX,SI		; [AL] = first character of string


ONEBYT: XOR	AH,AH		; [AX] = character
TWOBYT:

cEnd				
ERRFC:	JMP	B$ERR_FC	  ;Report illegal function call


	SUBTTL	B$INS3 - INSTR function for three arguments
	PAGE
;***
;B$INS3 - INSTR function for three arguments
;I2 pascal B$INS3(I2 start, sd *psdSource, sd *psdMatch)
;
;Function:
; Perform INSTR(I,A$,B$).
;
;Inputs:
; start     = Starting position in A$ of search (I)
; psdSource = Address of descriptor of string to be searched (A$)
; psdMatch  = Address of search string descriptor (B$)
;
;Outputs:
; [AX]	    = Position of B$ in A$; zero if not found.
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$INS3,<FAR,PUBLIC>,<DI,SI,ES> 
parmW	start			
parmW	psdSource		
parmW	psdMatch		
cBegin				
	MOV	BX,start	
	OR	BX,BX
	JLE	ERRFC		

	MOV	DI,psdSource	;Get A$ descriptor where we can address with it
	MOV	SI,psdMatch	;Get B$ descriptor where we can address with it
	LODSW			;Length of B$
	XCHG	AX,DX		;Length of B$ in DX
	MOV	SI,[SI] 	;Address of B$ data
	MOV	CX,[DI] 	;Length of A$
	JCXZ	NOTFND		;IF	LEN(A$) = 0  - return zero
	DEC	DX		;DX = LEN(B$)-1
	JNS	instr1		;  B$ is not null string
	CMP	BX,CX		;Offset : LEN(A$)
	JG	NOTFND		;  > - return 0
	JMP	short EXITFND	; <= - return Offset
instr1:
	MOV	DI,[DI+2]	;Address of A$ data
	DEC	BX		;Starting offset in A$
	ADD	DI,BX		;Add in starting offset
	SUB	CX,DX		;Last pos. search position
	XCHG	AX,BX		;AX = offset
	MOV	BX,CX		;Save in BX
	SUB	CX,AX		;Number of 1st chars to search
	JLE	NOTFND		;If search string won't fit, say not found
	LODSB			;Get first character of search string

; Top of search loop. The following conditions exist here:
;	AL = First character of search string (B$).
;	BX = Last position in A$ for 1st char match
;	CX = Amount of A$ left for first-character scan.
;	DX = Length of B$-1, used for string compares.
;	SI = Address of B$+1, used for string compares.
;	DI = Current position to scan in A$.

SEARCH:
	PUSH	DS		
	POP	ES		; [ES] = [DS]
	JCXZ	NOTFND		;If nothing left in A$, not found
	REPNE	SCASB		;Scan for first letter
	JNZ	NOTFND		;Was first letter found?

;Found a match in first letter. Do string compare on remaining letters

	PUSH	CX		;Save condition should compare be unsuccessful
	PUSH	SI		;  and we need to continue first-character
	PUSH	DI		;  search.
	MOV	CX,DX		;Get length of B$-1 for string compare
	REPE	CMPSB
	POP	DI
	POP	SI
	POP	CX
	JNZ	SEARCH		;If it didn't match, just continue searching
	SUB	BX,CX		;Compute position of match from start of string
EXITFND:
	XCHG	BX,DX		;[DX] = result return
	MOV	BX,psdSource	
	CALL	B$STDALCTMP	;Get rid of temporary strings
	MOV	BX,psdMatch	
	CALL	B$STDALCTMP	
	XCHG	AX,DX		; [AX] = result

cEnd

NOTFND:
	XOR	BX,BX
	JMP	EXITFND

	SUBTTL	B$INS2 - INSTR function with 2 arguments
	PAGE
;***
;B$INS2 - INSTR function with 2 arguments
;I2 pascal B$INS2(sd *psdSource, sd *psdMatch)
;
;Function:
; Perform INSTR(A$,B$).
;
;Inputs:
; psdSource = Address of descriptor of string to be searched (A$)
; psdMatch  = Address of search string descriptor (B$)
;
;Outputs:
; [AX]	    = Position of B$ in A$; zero if not found.
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$INS2,<FAR,PUBLIC>	
parmW	psdSource		
parmW	psdMatch		
cBegin				
	MOV	BX,1		;Start with position 1
	cCall	<FAR PTR B$INS3>,<BX,psdSource,psdMatch>	
cEnd				

	SUBTTL	B$LEFT & B$RGHT - Compute LEFT$ & RIGHT$ functions
	PAGE
;***
;B$LEFT - Compute LEFT$ function
;sd * pascal B$LEFT(sd * pas, I2 len)
;
;Function:
; Return a string made up of the leftmost ($LEF) characters of the source
; string. If the requested length is less than zero, then give error; if
; greater than the length of the source string, the source string itself is
; returned; otherwise, a temporary string is created.
;
; NOTE: The characters are assumed to be 1 byte characters.  It is possible
;	for the user to split a KANJI character with this function.
;
;Inputs:
; psd	= Address of string descriptor
; len	= Length of string wanted
;
;Outputs:
; [AX]	= Address of result string descriptor
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$LEFT,<FAR,PUBLIC>	
parmW	psd			
parmW	len			
cBegin				
	XOR	CX,CX		;Start at left end
	MOV	BX,psd		
	MOV	DX,len		
	JMP	SHORT RIG1	;Go to common code
cEnd	nogen			

;***
;B$RGHT - Compute RIGHT$ function
;sd * pascal B$RGHT(sd * pas, I2 len)
;
;Function:
; Return a string made up of the rightmost ($RIG) characters of the source
; string. If the requested length is less than zero, then give error; if
; greater than the length of the source string, the source string itself is
; returned; otherwise, a temporary string is created.
;
; NOTE: The characters are assumed to be 1 byte characters.  It is possible
;	for the user to split a KANJI character with this function.
;
;Inputs:
; psd	= Address of string descriptor
; len	= Length of string wanted
;
;Outputs:
; [AX]	= Address of result string descriptor
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$RGHT,<FAR,PUBLIC>	
parmW	psd			
parmW	len			
cBegin				
	MOV	BX,psd		
	MOV	DX,len		
	MOV	CX,[BX] 	;Get length
	SUB	CX,DX		;Starting point (from left)
RIG1:
	CALL	LEFRIG
cEnd				

ARGER2: JMP	B$ERR_FC	  ;Clean stack and report illegal function call

	SUBTTL	B$FMID - Compute MID$ function
	PAGE
;***
;B$FMID - Compute MID$ function
;sd * pascal B$FMID(sd *psdSource, I2 iStart, I2 cbLen)
;
;Function:
; If (iStart < 1) or (cbLen < 0) then give error; if (iStart = 1) and
; (cbLen >= length of source string) then return source string; otherwise
; create a temp string of length CX with the specified portion of the source
; string.
;
; NOTE: The characters are assumed to be 1 byte characters.  It is possible
;	for the user to split a KANJI character with this function. See the
;	MID\ (MID yen) function for a version that works with double byte
;	characters.
;
;Inputs:
; psdSource = Address of string descriptor
; iStart    = Starting offset in string (1 is first)
; cbLen     = Length of string desired
;
;Outputs:
; [AX] = Address of result string descriptor
;
;Registers:
; Per convention
;
;******************************************************************************