sscase.asm

[随书类]Dos6.0源代码

page	49,132
TITLE	sscase - scan support for SELECT/CASE related opcodes
;***
;sscase.asm
;
;	Copyright <C> 1987, Microsoft Corporation
;
;Purpose:
;	Scan SELECT CASE statement opcodes.
;
;   Runtime behavior of SELECT CASE executors:
;   ------------------------------------------
;	<exp> exStSelectCase<2|4|8> (oText)
;	      - Push an additional copy of <exp> on the stack
;		and unconditionally branch to oText.
;
;	<exp> <exp1> exStCase<Lt|Le|Eq|Ge|Gt|Ne|><I2|I4|R4|R8|CY|SD|TX>
;	      - Evaluates and consumes top two expressions on stack
;		and emits TRUE or FALSE on stack based upon result.
;		These executors share code with the MathOp executors,
;		except for the SD variants which will not cause
;		the <exp> SD to be released if it was a temp.
;
;	<exp> <exp1> <exp2> exStCaseTo<I2|I4|R4|R8|CY|SD|TX>
;	      - Evaluates <exp> and determines if it falls within
;		the range defined by <exp1> and <exp2>.  All three
;		expressions are consumed, and a TRUE or FALSE is
;		emitted to the stack based on the result of the
;		evaluation.
;
;	<exp> exCaseBranch<2|4|8|SD> (oTextF, oTextT)
;	      - Branches to oTextF or oTextT based on TRUE or FALSE
;		condition on stack.  Before taking a false branch, an
;		additional copy of the exStSelectCase expression is
;		placed on the stack. Before taking a TRUE branch, the
;		saved copy of the exStSelectCase exp is consumed and
;		deallocated if it is a string temp. This is non-listable
;		and inserted by the scanner.
;
;	exStCaseElse<2|4|8|SD>
;	      - Consume copy of exStSelectCase exp and deallocate if it
;		is a string temp.
;
;	exStEndSelect
;	      - Consume copy of exStSelectCase exp and deallocate if it
;		is a string temp.
;
;	exBranch (oText)
;	      - Unconditionally branch to oText.  This is non-listable
;		and inserted by the scanner at the beginning of each
;		line containing an exStCase* executor.
;
;
;   SELECT CASE/END SELECT statement syntax to pcode mappings:
;   ----------------------------------------------------------
;
;      Syntax:	SELECT CASE <exp>
;
;      Pcode:	<exSelexp> opStSelectCase(oTx to <exp> before first CASE)
;
;      ============================================================
;      Syntax:	CASE [IS <relop>] <const>
;
;      Pcode:	[opBol] <const> opStCase[<relop>]
;
;				 +-to beyond END SELECT
;				 |
;      Bound:	[exBol exBranch(oTx)] <const> exStCase[<relop>]<type>
;		exCaseBranch<type>(oTxF, oTxT)
;				    |	  |
;				    |	  +-To next exBol
;				    |
;				    +-To next CASE,ELSE CASE,or END SELECT
;
;      NOTE: The scanner inserts the non-listable exBranch and exStCaseBranch
;	     pcodes.
;
;      ============================================================
;      Syntax:	CASE IS <const> TO <const>
;
;      Pcode:	[opBol] <const> <const> opStCaseTo
;
;				 +-to beyond END SELECT
;				 |
;      Bound:	[exBol exBranch(oTx)] <const> <const> exStCaseTo<type>
;		exCaseBranch<type>(oTxF, oTxT)
;				    |	  |
;				    |	  +-To next exBol
;				    |
;				    +-To next CASE,ELSE CASE,or END SELECT
;
;      NOTE: The scanner inserts the non-listable exBranch and exStCaseBranch
;	     pcodes.
;
;      ============================================================
;      Syntax:	CASE ELSE
;
;      Pcode:	opBol opStCaseElse
;
;      ============================================================
;      Syntax:	END SELECT
;
;      Pcode:	opBol opStEndSelect
;
;
;
;****************************************************************************

	.xlist
	include		version.inc
	IncludeOnce	qbimsgs
	IncludeOnce	ssint
	IncludeOnce	txtmgr
	.list

assumes ds, DATA
assumes es, NOTHING
assumes ss, DATA
assumes cs, SCAN

sBegin	SCAN

	subttl	SELECT scan support.
	page
;***
;Ss_Select
;Purpose:
;	Scan entries for SELECT.
;
;	Scan tasks for SELECT include:
;	- ensuring the entry type is a fundamental data type.
;	- selecting the SELECT executor varient for the argument data type.
;	- pushing a SELECT CASE frame on the scan stack as follows:
;		push  oTx of SELECT operand for oTxFalse branch
;		push  UNDEFINED for start of oTxTrue chain
;		push  UNDEFINED for start of exBranch chain
;		push  oTyp of Select expression
;		push  CASE frame label
;Input:
;	Standard scan entrypoint
;Output:
;	Standard scan exit
;***************************************************************************

SsProc	Select
	pop	ax		;Get oTyp of select expression (Record = ET_RC)

	if	ET_MaxStr NE ET_MAX	; Something defined beyond ET_Fx
	    .erre   ST_Typ_Mask EQ 0ffh ; Assure we can use AL
	    cmp     al,ET_MaxStr	
	    jbe     @F			
	    .erre   ET_RC EQ 0		; Assure XOR is sufficient
	    xor     ax,ax		; Treat as if a record
@@:					
	endif				; ET_MaxStr NE ET_MAX
	and	ax,ST_Typ_Mask		
	.erre	ET_RC EQ 0		; Assure JNZ is sufficient
	jnz	@F			
	call	TMError 		
	inc	ax			; Force valid type (ET_I2)
@@:					
	.erre	ST_Typ_Mask EQ 0ffh	; Assure we can use AL
	cmp	al,ET_FS		
	jb	@F			

	    .erre   ET_FS EQ ET_MaxStr	;[1]
	    .erre   ET_SD EQ ET_FS-1	; Assure difference is 1
	    dec     ax			; Map fixed to non-fixed types
@@:					
	push	ax			; Save for later but clear flags
	call	MapEmitExe		;Map and emit executor
	pop	ax			;oTyp of Select expression
	pop	cx			;Throw away exp address
	push	di			;FCASE_oTxFalse

	; initially bind FALSE branch to after this executor in case of
	; multiple case items on a single line.

	MOVSWTX 		;skip operand for SELECT
	mov	PTRTX[di-2],di	;bind operand to next executor
	mov	cx,UNDEFINED
	push	cx		;start of FCASE_oTxTrue chain
	push	cx		;start of FCASE_oTxBranch chain
	push	ax		;FCASE_oTyp of select expression
	PUSHI	ax,STYP_Case	;FCASE_Id - SELECT CASE frame identifier
	or	[SsFlags],SSF_StSelect ;We need to verify no executable
				;statements come before nexe CASE, CASE ELSE,
				;or END SELECT
	jmp	[ScanRet]

subttl	CASE item scan support.
page
;***
;Ss_Case, Ss_CaseTo, Ss_CaseElse
;Purpose:
;	Scan entries for CASE [IS <relop>] const, CASE IS const TO const,
;	and CASE ELSE.
;
;	Scan tasks for CASE and CASE TO include:
;	- ensuring correct CASE item nesting.
;	- coercing arguments to SELECT CASE expression oTyp.
;	- selecting the CASE item executor variant.
;	- If this is first CASE item after BOS
;	  +  Insert an exBranch after BOS
;	  +  link exBranch operand into exBranch chain.
;	  +  binding previous CASE item (SELECT CASE) false branch.
;	     This is only necessary for the BOS case, The false
;	     branch is initially bound to the immediately following executor.
;	- Insert exCaseBranch variant with two operands.
;	- link True branch operand into oTxTrue branch chain.
;	- set oTxFalse branch to False branch operand and bind operand to next
;	  executor.
;	- set CaseItem processed flag
;
;	Note:  The exBranch operand chain is bound at END SELECT.  The
;	exCaseBranch chain is bound at BOS.
;
;	Scan tasks for CASE ELSE include:
;	- ensuring correct CASE item nesting.
;	- selecting the CASE ELSE executor variant.
;	- If this is first CASE item after BOS
;	  +  Insert an exBranch after BOS
;	  +  link exBranch operand into exBranch chain.
;	  +  binding previous CASE item (SELECT CASE) false branch.
;	     This is only necessary for the BOS case, The false
;	     branch is initially bound to the immediately following executor.
;Input:
;	Standard scan entrypoint
;Output:
;	Standard scan exit
;***************************************************************************
SsProc	CaseElse
	xor	bx,bx			;no expressions on stack
	mov	cx,bx			;this is a CASE ELSE varient
	jmp	short CaseCommon

SsProc	CaseTo
	mov	bx,2*(SIZE FEXP)	;we have 2 expressions on the stack
	mov	cl,STYP_CaseTo		;this is a CASE TO Varient
	jmp	short CaseCommon

SsProc	Case
	mov	bx,SIZE FEXP		;we have 1 expression on the stack for CASE
	mov	cl,STYP_CaseRel 	;normal CASE varient

CaseCommon:
	add	bx,sp			;point past expressions on stack to Select frame
	cmp	[bx].FCASE_Id,STYP_Case ;is this a select case frame?
	jnz	CaseScopeError		;brif not
	mov	ax,[bx].FCASE_oTyp	;get oTyp of SELECT expression
	DbAssertRel ax,be,ET_MAX,SCAN,<CaseCommon: Invalid oTyp>  
	jcxz	NoCoerce		;brif CASE ELSE, no coersion of operands

	cmp	cl,STYP_CaseRel 	;is this a standard CASE?
	je	Coerce1Op		;brif so, only one op to coerce
	call	EnsureArgType		;coerce the arg to the requested type

Coerce1Op:
	call	EnsureArgType		;coerce the arg

NoCoerce:
	push	cx			;preserve CASE type
	push	bx			;preserve frame ptr
	call	MapEmitExe		;map and emit Case executor varient
	pop	bx			;recover frame ptr
	pop	cx
	call	InsertCaseBranches	;insert exBranches/exCaseBranches
CaseX:
	jmp	[ScanRet]

CaseScopeError:
	mov	sp,bx			;eat the stack expressions
	mov	ax,MSG_Case		;Case without Select error
CaseErrorExit:				
	call	SsError
	mov	ax,ET_I2		;emit I2 varient...
	call	MapEmitExe		;...of executor...
	jmp	short CaseX		;...and return

subttl	END SELECT scan support.
page