strfcn.asm

[随书类]Dos6.0源代码

cProc	B$FMID,<FAR,PUBLIC>	
parmW	psdSource		
parmW	iStart			
parmW	cbLen			
cBegin				

	MOV	BX,psdSource	
	MOV	CX,cbLen	
	OR	CX,CX		;test string length
	JL	ARGER2		;error if negative
	MOV	DX,iStart	
	DEC	DX		;Offset should start at zero, not 1
	XCHG	DX,CX		;Set up for future call
	JL	ARGER2		;Error if now negative
	JNZ	MID_10		
	CALL	LEFRIG		; Offset is zero, so treat just like LEFT$
	JMP	SHORT MID_90	
MID_10: 			
	MOV	AX,[BX] 	;Get length of string
	SUB	AX,CX		;Reduce length by the offset
	JNLE	MID_20		
	CALL	B$STDALCTMP	;Delete if temp string
	MOV	AX,OFFSET DGROUP:b$nuldes ; Null string descriptor
	JMP	SHORT MID_90	
MID_20: 			
	CMP	AX,DX		;Need smaller of request and amount remaining
	JGE	MIDLEN
	MOV	DX,AX		;Limited by length of string
MIDLEN:
	CALL	B$STALCTMPSUB	;Create temp string from descriptor
	XCHG	AX,BX		; [AX] has return value
MID_90:

cEnd				


;***
; LEFRIG - support routine
;
;Purpose:
; This subroutine is used for $LEF, $RIG, and some $MID.
;
;Entry:
; [BX]	 = Address of string descriptor
; [DX]	 = Length requested
; [CX]	 = Starting offset
;
;Exit:
; [AX]	 = new descriptor
;
;Uses:
; CX   - only for special RIGHT$ case
;
;Preserves: (optional)
;
;Exceptions:
;
;******************************************************************************
cProc	LEFRIG,NEAR
cBegin

	OR	DX,DX		;Test requested length
	JL	ARGERR		;If negative, give error
	JNZ	LEFRIG_10	;If zero, return null string
	CALL	B$STDALCTMP	;ensure we get rid of any temps
	MOV	AX,OFFSET DGROUP:b$nuldes 
	RET
LEFRIG_10:
	CMP	DX,[BX] 	;See if requested length is shorter than string
	JLE	MAKTMP		;  Yes - create temp string
	MOV	DX,[BX] 	;  No - use actual string length
	OR	CX,CX		;If offset is negative from RIGHT$
	JGE	MAKTMP		;  No - OK
	XOR	CX,CX		;  Yes - just make it zero
MAKTMP:
	CALL	B$STALCTMPSUB	;Create temp from string descriptor
	XCHG	AX,BX		; [AX] = new descriptor
cEnd				


	SUBTTL	B$SPAC - SPACE$ function
	PAGE
;***
;B$SPAC - SPACE$ function
;sd * pascal B$SPAC(I2 cbDesired)
;
;Function:
; Produce temporary string with a blank (' ') character repeated BX times.
;
;Inputs:
; cbDesired = Length of string desired
;
;Outputs:
; [AX]	= Address of result temp string descriptor
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$SPAC,<FAR,PUBLIC>	
parmW	cbDesired		
cbegin

	MOV	DL," "		;Provide a space to be repeated
	MOV	BX,cbDesired	; [BX] = count
	CALL	STRING		; [AX] = pointer to sd

cEnd

;***
; STRING - Create a temp string of length n containing something.
;
;Purpose:
;	Creates a temp string of n characters, where character is specified.
;	If we are compiled with KANJI enabled, DL contains the first byte
;	of the character to go into the string.  DH contains the second byte
;	unless it is 0 in which case it is a single byte character.
;
;Entry:
; [DL]	= Character (DX for kanji)
; [BX]	= desired length
;
;Exit:
; [AX]	= pointer to temp sd
;
;Uses:
; Per convention
;
;******************************************************************************
cProc	STRING,NEAR,ES
cBegin
	MOV	AX,OFFSET DGROUP:b$nuldes ;[7]
	OR	BX,BX		;Check character count
	JZ	STRING_90	; Return null string if zero
	JL	ARGERR		;Error if negative


NOTKAN: MOV	CX,BX		;Put count in count register
	MOV	AL,DL		;Character to copy
	MOV	AH,DL		;Repeat it by words for speed
	CALL	B$STALCTMP	;Allocate string
	INC	CX		;Round up to whole word if odd
ISKAN:	XCHG	DI,DX		;Get address of data in destination register
	SHR	CX,1		;Divide byte count by 2 for word move
	PUSH	DS		
	POP	ES		; [ES] = [DS]
	REP	STOSW
	MOV	DI,DX		;Restore DI
	XCHG	AX,BX		;[AX] has string desc
STRING_90:
cEnd

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

	SUBTTL	B$STRI & B$STRS - STRIN& functions
	PAGE
;***
;B$STRI & B$STRS - STRING$ functions
;sd * pascal B$STRI(I2 cbdesired, I2 ascCode)
;sd * pascal B$STRS(I2 cbDesired, sd *psdChar)
;
;Function:
; Produce temporary string with a single character repeated BX times. B$STRI
; provides the character to be repeated, and B$STRS provides a string
; descriptor, the first character of which is to be repeated.
;
;Inputs:
; cbDesired = Length of string desired
; ascCode   = Character to repeat (B$STRI only)
; psdChar   = Descriptor of string with character to repeat (B$STRS only)
;
;Outputs:
; [AX]	= Address of result temp string descriptor
;
;Registers:
; Per convention
;
;******************************************************************************
cProc	B$STRI,<FAR,PUBLIC>	
parmW	cbDesired		
parmW	ascCode 		
cBegin

	MOV	DX,ascCode	
	JMP	SHORT STRI_10	
cEnd	nogen

cProc	B$STRS,<FAR,PUBLIC>	
parmW	cbDesired		
parmW	psdChar 		
cBegin

	MOV	BX,psdChar	; Put descriptor where we can address with it
	CMP	WORD PTR[BX],0	;Length of string must not be zero
	JZ	ARGERR
	PUSH	BX		
	MOV	BX,[BX+2]	;Get address of string data
	POP	AX		; [AX] = pointer to descriptor

	PUSH	[BX]		; Push first character in string
	XCHG	AX,BX		; [BX] = pointer to descriptor
	CALL	B$STDALCTMP	;Delete if temp string
	POP	DX		; [DX] = character
STRI_10:			
	MOV	BX,cbDesired	; [BX] = length to do it
	CALL	STRING		; [AX] = pointer to sd
cEnd

	SUBTTL	B$VARP - VARPTR$ function
	PAGE

;***
;B$VARP - VARPTR$ function
;sd * pascal B$VARP(U2 addr, I2 type)
;
;Function:
; Create a 3 byte string of following:
;	Byte 1		contains variable type, one of:
;		2 - Integer
;		3 - String
;		4 - Single
;		8 - Double
;	       14h- Long
;	Byte 2 & 3	contain the address of the variable
;
;Inputs:
; addr	= Address of Variable
; typ	= type of the variable
;
;Outputs:
; [AX]	= Address of String Descriptor
;
;Registers:
; Per convention
;******************************************************************************
cProc	B$VARP,<FAR,PUBLIC>	
parmW	addr			
parmW	typ			
cBegin				
	MOV	BX,3
	CALL	B$STALCTMP	;Get a 3 byte string
	XCHG	BX,DX		;[BX] has its address
	MOV	AX,typ		
	MOV	[BX],AL 	
	MOV	AX,addr 	
	MOV	[BX+1],AX	
	XCHG	AX,DX		; [AX]= String Descriptor

cEnd



	SUBTTL	B$LCAS/B$UCAS - convert string to lower/upper case
	PAGE
;***
; B$UCAS - Convert string to upper case
; B$LCAS - Convert string to lower case
;
;Purpose:
; String case conversion.
;
;Entry:
; psd	= Pointer to string descriptor to be converted
;
;Exit:
; [AX]	= Pointer to string descriptor of result
;
;Uses:
; Per convention
;
;******************************************************************************
cProc	B$UCAS,<FAR,PUBLIC>
cBegin
	MOV	AX,'za'
	JMP	SHORT	CASE_5	;go perform case conversion
cEnd	nogen

cProc	B$LCAS,<FAR,PUBLIC>
cBegin
	MOV	AX,'ZA'
cEnd	nogen			

cProc	CASE_5,FAR,<DI,SI,ES>	
parmW	psd			
cBegin				

	MOV	BX,psd		;get string descriptor
	MOV	DX,[BX] 	;(DX) = length of string to convert
	OR	DX,DX		;is this a null string ?
	JZ	uca_ret 	;yes, just return it
	XOR	CX,CX
	CALL	B$STALCTMPSUB	;no, copy string to temporary
	PUSH	BX
	XCHG	CX,DX		;(CX) = length of string to convert
	MOV	SI,[BX+2]	;(SI) = ptr to string data
	MOV	DI,SI		;ditto for DI
	XCHG	AX,BX		;(BX) = chars to check
	PUSH	DS		; set ES=DS
	POP	ES
uca_loop:
	LODSB			;fetch next char from string
	CMP	AL,BL
	JB	uca_cont	;ignore if not wrong case
	CMP	AL,BH
	JA	uca_cont	;ignore if not wrong case
	XOR	AL,20H		;flip upper case bit
uca_cont:
	STOSB			;put character back
	LOOP	uca_loop	;repeat until entire string is checked
uca_abort:
	POP	BX		;restore descriptor address
uca_ret:
	XCHG	AX,BX		;return sd in AX

cEnd

	SUBTTL	$TRL/$TRM/$TRR - Trim blanks off string
	PAGE
;***
; B$TRIM, B$LTRM, B$RTRM - Trim family
;
;Purpose:
; Trim leading, trailing or both blanks from a string.
;
;Entry:
; psd	= Pointer to string descriptor to be converted
;
;Exit:
; [AX]	= Pointer to string descriptor of result
;
;Uses:
; Per convention
;
;******************************************************************************
TR_LEFT= 1
TR_RIGHT= 2

; cProc	B$TRIM,<PUBLIC,FAR>
; cBegin
; 	MOV	AH,TR_LEFT+TR_RIGHT
; 	SKIP	2		; fall into TRIM
; cEnd	nogen

cProc	B$LTRM,<PUBLIC,FAR>
cBegin				
	MOV	AH,TR_LEFT
	SKIP	2		; fall into TRIM
cEnd	nogen

cProc	B$RTRM,<PUBLIC,FAR>
cBegin				
	MOV	AH,TR_RIGHT
cEnd	nogen			; fall into TRIM

cProc	TRIM,FAR,<DI,ES>	
parmW	psd			
cBegin				

;When scanning for a blank character, we know that we will never take
;any part of a KANJI character as a space, as this value is illegal in
;a KANJI.

	PUSH	DS		; set es=ds
	POP	ES		
	MOV	BX,psd		;Get source SD
	MOV	CX,[BX] 	; get string length
	JCXZ	trim_ret	;   null string - return
	MOV	DI,[BX+2]	; (DI) = address of string contents
	MOV	AL,' '		; AL = blank - trim char
	TEST	AH,TR_LEFT	; trim left blanks?
	JZ	trim_right	;   no - trim right
trim_left:			
	REPE	SCASB		; scan blanks off front
	JZ	trim_done	;   all blanks

	INC	CX		; backup one character
	DEC	DI

trim_right:
	MOV	DX,DI		; (DX) = 1st nonblank address
	SUB	DX,[BX+2]	; (DX) = offset of 1st nonblank
	TEST	AH,TR_RIGHT	; trim right blanks?
	JZ	trim_done	;   no - done
	ADD	DI,CX
	DEC	DI		; (DI) = last char in string
re_trim_right:
	STD			; direction is down
	REPE	SCASB		; scan blanks off back
	CLD			; direction is up
	JZ	trim_done	;   all blanks
	INC	CX		; backup one character

trim_done:
	XCHG	CX,DX		; CX=offset , DX=length , BX=sdesc
	CALL	B$STALCTMPSUB	; copy into temp string

trim_ret:
	XCHG	AX,BX		;Return sd in AX
cEnd

sEnd	ST_TEXT

	END