sscase.asm

[随书类]Dos6.0源代码

;***
;Ss_EndSelect
;Purpose:
;	Scan entry END SELECT.
;
;	Scan tasks for END SELECT include:
;	- emitting the END SELECT executor.
;	- ensuring correct SELECT nesting.
;	- If this is 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.
;	- Bind the exBranch chain.
;	- remove the SELECT CASE frame.
;Input:
;	Standard scan entrypoint
;Output:
;	Standard scan exit
;***************************************************************************
SsProc	EndSelect
	xor	cx,cx			; Rule table byte is 0
	mov	bx,sp			;set up frame ptr
	cmp	[bx].FCASE_Id,STYP_Case ;is this a select case frame?
	mov	ax,MSG_EndSelect	
	jnz	CaseErrorExit		; Brif not a select case
	mov	ax,[bx].FCASE_oTyp	; AX = oTyp of Select expression
	call	MapEmitExe		; Emit executor
	mov	bx,sp			; Restore frame pointer
	xor	cx,cx			;looks like CASE ELSE varient
	call	InsertCaseBranches	;insert exBranch before BOS for previous
					;true branch
	mov	bx,[bx].FCASE_oTxBranch ;start of exBranch chain
	call	BindExitCur		;bind list of address to current emit address
	add	sp,SIZE FCASE		;pop off Case frame
	jmp	[ScanRet]

subttl	SELECT CASE helpers
page
;***
;InsertCaseBranches - insert exBranch and exCaseBranch varients
;
;Purpose:
;	Inserts an exBranch after BOS if this is first SELECT CASE item
;	called since last BOS was processed, and binds the preceding false
;	branch after the inserted exBranch. Also inserts exCaseBranch
;	varients for CASE and CASE TO executors.
;
;	Checks to see if a Select Case without any intervening CASE*, or
;	END SELECT statements have been scanned.  If this is true, then
;	the pcode from the preceding SELECT statement is scanned to
;	ensure that only REMs and BOS/BOL opcodes are present.	If not,
;	then an Expected Case error is generated.
;Input:
;	bx = CASE frame ptr
;	cx = CASE varient (STYP_CaseTo, STYP_CaseRel, or 0 for CASE ELSE/END
;		SELECT.
;Output:
;	none.
;Preserves:
;	bx
;****************************************************************************
InsertCaseBranches:

	test	[SsFlags],SSF_StSelect ;was a select processed last?
	jz	CheckBosBranch	;brif not, continue

	and	[SsFlags],NOT SSF_StSelect ;reset SELECT processed flag
	mov	ax,[bx].FCASE_oTxFalse ;get oTx of SELECT CASE operand
	dec	ax
	dec	ax		;backup to Select opcode and start with next.
	PUSH_ES 		
	push	bx		
	push	cx		
	cCall	TxtChkValidOpsExec,<ax,SsoTxBos> ;check for valid ops between
				;end of SELECT CASE and start of Cur statement.
	pop	cx		
	pop	bx		
	POP_ES			
	or	dx,dx		
	jz	CheckBosBranch	;brif opcodes ok

	push	bx		;save frame ptr
	xchg	ax,bx		;set error address returned by TxtChkValidOps
	mov	ax,MSG_ExpectedCase ;issue Expected CASE error
	call	SsErrorBx	;remember error
	pop	bx		;recover source address

CheckBosBranch:
	test	[SsBosFlags],SSBOSF_StCase ;has a case item been processed since BOS?
	jnz	NoInsertBranch	;brif so, exBranch has already been inserted.

	push	cx		;save Case varient
	push	bx		;preserve frame ptr
	mov	cx,[bx].FCASE_oTxBranch ;ptr to start of exBranch chain
	call	InsertBranchBos ;insert exBranch after BOS; BX = oTx after BOS
	xchg	ax,bx		;...exbranch chain for block if
	pop	bx		;recover frame ptr
	pop	cx		;recover case varient
	jc	NoBranchInserted
	dec	ax
	dec	ax		;point to operand for exBranch
	mov	[bx].FCASE_oTxBranch,ax ;update new Branch chain start
	inc	ax
	inc	ax		;point to op after exBranch operand
NoBranchInserted:
	push	bx		;save frame ptr
	mov	bx,[bx].FCASE_oTxFalse ;get ptr to preceding false operand
	inc	bx
	jz	NoFalseBranchBind ;brif no operand to fix up
	dec	bx
	mov	PTRTX[BX],ax	;bind preceding false branch to this CASE op.

NoFalseBranchBind:
	pop	bx		;recover frame ptr

NoInsertBranch:
	mov	[bx].FCASE_oTxFalse,UNDEFINED ;previous false branch has been bound
	jcxz	NoInsertCaseBranch	;don't insert CaseBranch for CASE ELSE

	mov	cx,6			;we need to insert 6 bytes
	mov	bx,[bx].FCASE_oTyp	;get type variant
	dec	bx			;make type zero relative
	shl	bx,1			;and a word index
	mov	ax,WORD PTR cs:mCaseBranch[bx]	;get case branch executor variant
	mov	bx,di			;insert at current position
	call	InsertCx		;insert the executor, bx = oTx after insertion
	jc	NoInsertCaseBranch	;brif if out of memory

	sub	bx,4			;backup to caseBranch oTxFalse operand
	mov	PTRTX[bx],di		;initially bind false branch to next executor
	xchg	ax,bx			;ax = oTx of false operand
	mov	bx,sp			;recover frame ptr
	inc	bx
	inc	bx			;adjust for return address
	mov	[bx].FCASE_oTxFalse,ax	;save ptr to False branch operand in case we
					;need to patch it later
	inc	ax
	inc	ax			;advance to True branch operand
	mov	cx,[bx].FCASE_oTxTrue	;link True branch into true branch chain
	xchg	ax,bx
	mov	PTRTX[bx],cx
	xchg	ax,bx
	mov	[bx].FCASE_oTxTrue,ax
	or	[SsBosFlags],SSBOSF_StCase ;we have binding to do at next BOS
	mov	[SsOTxStart],di 	; Mark clear stack location

NoInsertCaseBranch:
	ret

	page
;***
;MapEmitExe - type explode and emit executor, then return
;
;Purpose:
;
;   Type explode and emit the executor.
;
;Input:
;
;   ax = expression oTyp
;   dx = executor map address
;
;Output:
;
;   none.
;
;****************************************************************************

MapEmitExe:
	dec	ax			;To zero relative
	add	ax,ax			;Convert to word offset
	add	ax,dx			;Offset into executor map
	xchg	ax,bx
	mov	ax,word ptr cs:[bx]	;Executor address
	STOSWTX 			;Emit executor
	ret

	subttl	CASE opcode to executor map tables

	public	mStSelect		;SELECT CASE executors
mStSelect:
	DWEXT	exStSelectCase2 		
	DWEXT	exStSelectCase4 		
	DWEXT	exStSelectCaseR8
	DWEXT	exStSelectCaseR8 		
	DWEXT	exStSelectCase2

	public	mCaseBranch		;Case branch inserted by scanner
mCaseBranch:
	DWEXT	exCaseBranch2			
	DWEXT	exCaseBranch4			
	DWEXT	exCaseBranchR8
	DWEXT	exCaseBranchR8			
	DWEXT	exCaseBranchSD

public mStCaseElse		;CASE ELSE executors
mStCaseElse:
	DWEXT	exStCaseElse2
	DWEXT	exStCaseElse4			
	DWEXT	exStCaseElseR8
	DWEXT	exStCaseElseR8			
	DWEXT	exStCaseElseSD

public mStCaseTo		;CASE IS <const> TO <const> executors
mStCaseTo:
	DWEXT	exStCaseToI2
	DWEXT	exStCaseToI4
	DWEXT	exStCaseToR8
	DWEXT	exStCaseToR8
	DWEXT	exStCaseToSD

public mStCase			;CASE <const> executors
mStCase:
	DWEXT	exStCaseI2
	DWEXT	exStCaseI4
	DWEXT	exStCaseR8
	DWEXT	exStCaseR8
	DWEXT	exStCaseSD

public mStCaseEq		;CASE IS = <const> executors
mStCaseEq:
	DWEXT	exStCaseEqI2
	DWEXT	exStCaseEqI4
	DWEXT	exStCaseEqR8
	DWEXT	exStCaseEqR8
	DWEXT	exStCaseEqSD

public mStCaseNe		;CASE IS <> <const> executors
mStCaseNe:
	DWEXT	exStCaseNeI2
	DWEXT	exStCaseNeI4
	DWEXT	exStCaseNeR8
	DWEXT	exStCaseNeR8
	DWEXT	exStCaseNeSD

public mStCaseLt		;CASE IS < <const> executors
mStCaseLt:
	DWEXT	exStCaseLtI2
	DWEXT	exStCaseLtI4
	DWEXT	exStCaseLtR8
	DWEXT	exStCaseLtR8
	DWEXT	exStCaseLtSD

public mStCaseLe		;CASE IS <= <const> executors
mStCaseLe:
	DWEXT	exStCaseLeI2
	DWEXT	exStCaseLeI4
	DWEXT	exStCaseLeR8
	DWEXT	exStCaseLeR8
	DWEXT	exStCaseLeSD

public mStCaseGt		;CASE IS > <const> executors
mStCaseGt:
	DWEXT	exStCaseGtI2
	DWEXT	exStCaseGtI4
	DWEXT	exStCaseGtR8
	DWEXT	exStCaseGtR8
	DWEXT	exStCaseGtSD

public mStCaseGe		;CASE IS >= <const> executors
mStCaseGe:
	DWEXT	exStCaseGeI2
	DWEXT	exStCaseGeI4
	DWEXT	exStCaseGeR8
	DWEXT	exStCaseGeR8
	DWEXT	exStCaseGeSD

public mStEndSelect		;End Select executors
mStEndSelect:
	DWEXT	exStEndSelect2			
	DWEXT	exStEndSelect4			
	DWEXT	exStEndSelectR8
	DWEXT	exStEndSelectR8			
	DWEXT	exStEndSelectSD 		

sEnd	SCAN
end