ssfor.asm

DOS 6.22 的源代码

;		<Id|>		separate executor map
;				(mStNextOpExe or mStNextIdOpExe)
;		type		from scan stack entry/previous IdRf
;		<Step|> 	from scan stack entry and type
;	4. Link For to Next and Next to For
;
;	([IdLd|]) opStNext<Id|> (UNDEFINED,UNDEFINED)
;	(IdRf) exStNext<Id|><Step|><I2|I4|R4|R8|CY>
;Input:
;	Standard Scanner dispatch entrypoint
;	[SP] =	For stack frame
;		For identifier flags
;			STYP_For
;			STYP_Step
;		oTx of For statement
;		oTx for EXIT For chain start
;		For block allocation
;		oTx of exIdLd executor
;		oTyp of for index
;Output:
;
;Exceptions:
;	Errors detected during Next scanning are:
;	- Nesting errors (Next without For).
;
;*******************************************************************
SsProc	NextId,Rude
;Make the preceding IdLd an IdRf
	xchg	cx,ax			;Save executor map in cx
	pop	ax			;Get oTyp of index (Record = ET_RC)
	pop	bx			;IdLd operand address + 2
	call	MakeRef 		;Convert IdLd to IdRf
	mov	ax,PTRTX[bx-2]		; Fetch operand

;Frame the stack for easy For entry referencing
	push	bp
	mov	bp,sp
	push	cx			;Save executor map
	mov	cx,6			;Bind EXIT For beyond the Next executor
	call	BindExitFor		;Find For entry on stack, binding EXITs
	jz	NextWOForErrNoFrame	;For entry not found - error

;Check for compatible IdRf between For and Next
	mov	bx,[bp+2].FFor_oTxIdRf	;oTx of IdRf executor
	sub	ax,PTRTX[bx-2]		; Same operand (variable)?
	jz	NextCom 		;Next matches For - cont through Ss_Next

NextWOForErr:
	pop	bx			;Get executor map
	call	NextErrorCommon
	jmp	Unframe

NextErrorCommon:
	mov	ax,ER_NF		;Next without For error
	call	SsError
	mov	ax,word ptr cs:[bx]	;Get any old executor
	STOSWTX				;And emit it
	mov	ax,-1
	STOSWTX				;Indicate no oBP
	STOSWTX 			;Flag Next without IdRf
	add	si,4			;Skip oBP and oTx in source
	ret

NextWOForErrNoFrame:			;No For Frame to tear down
	pop	bx			;Get executor map
	call	NextErrorCommon
	pop	bp
	jmp	[ScanRet]


SsProc	Next,Rude
;Frame stack for easy reference
	push	bp
	mov	bp,sp
	push	ax			;Save executor map

;Get For stack entry
	mov	cx,10			;bind EXIT For past IdRf executor and
					;Next executor
	call	BindExitFor		;Find For entry on stack, binding EXITs
	jz	NextWOForErrNoFrame	;For entry not found - error

;Emit IdRf
	mov	bx,[bp+2].FFor_oTxIdRf	;Get the IdRf executor address
	mov	ax,PTRTX[bx-4]		;Load the IdRf executor
	mov	cx,PTRTX[bx-2]		;Load the IdRf operand
	mov	bx,di			;Insert at emit oTx
	call	Insert1Op
	mov	al,1			;Set flag that no IdRf is present
	jc	NextCom
	dec	al			;Success, so zero al

;Calculate and emit the executor
;	bp+2 = pointer to For frame
;	al = 1 if Next with no Id and insertion of Id failed, else 0
;
;Uses:
;	type from the For frame
;	flags from For frame to distinguish between
;		<Step|> 	from scan stack entry and type
;	map on top of stack (distinguishes between exStNext and exStNextId)
NextCom:
	pop	bx			;Executor map
	push	ax
	mov	dx,[bp+2].FFor_oTyp	;For/Next type
	dec	dx			;Zero relative for indexing
	shl	dx,1			;To word offset
	test	[bp+2].FFor_Id,STYP_Step	;<Step|> variant differentiation
	jz	NextGotStepInfo 	;Not Step
	inc	dx			;Offset compensation for Step variants
NextGotStepInfo:
	shl	dx,1
	add	bx,dx			;bx = cs relative Next executor offset
	mov	ax,word ptr cs:[bx]	;ax = executor
	STOSWTX 			;Emit the executor

;Emit the frame offset for this Next
	mov	bx,[bp+2].FFor_oTx	;For oTx operand address
	mov	ax,PTRTX[bx-2]		;Get oBP from For
	cmp	ax,-1			;Valid?
	jnz	SetOBp
;See if Next has a valid oBP
	mov	cx,[bp+2].FFor_Id	;Step flag
	mov	dx,[bp+2].FFor_oTyp	;   and oTyp needed to allocate a block
	mov	ax,PTRTX[si]		;Get Next oBP
	inc	ax			;Valid?
	jz	NewForBlock
	dec	ax			;Restored oBP
	cmp	dl,es:[si+2]		;Has For type changed?
	jnz	NewForBlock
	cmp	dx,ET_I2		;I2 may or may not have step
	jnz	SetOBp
.errnz	HIGH STYP_Step			;Verify Step flag in low byte
	mov	ch,cl			;Copy Step flag
	xor	ch,es:[si+3]		;Step flag match?
	test	ch,STYP_Step
	jz	SetOBp
NewForBlock:
	call	ForBlockAlloc
;New For block means can't continue if it's in an active procedure or module
	push	ax
	push	bx
	mov	bx,dataOffset b$CurFrame
	PUSH_ES 			
	cCall	ActiveORs_Frame,<bx>	; See if frame on stack
	POP_ES
	or	ax,ax			
	jnz	Active			; brif frame is (probably) active

	mov	ax,[grs.GRS_oRsCONT]	
	cmp	ax,[grs.GRS_oRsCur]	; Is current one active?
	jnz	StillCont
Active:
	or	[SsFlags],SSF_CantCont	;Call CantCont at end of scan
StillCont:
	pop	bx
	pop	ax
SetOBp:
	STOSWTX 			;Set For block oBP in Next
	mov	PTRTX[bx-2],ax		;Set oBP in For

;Link For to Next and Next to For
	mov	PTRTX[bx],di		;Link For to Next oTx operand address
	mov	ax,bx
	inc	ax
	inc	ax			;Move to address beyond For operand
	pop	bx			;Get IdRf flag
	or	al,bl			;Set bit 0 if no IdRf was inserted
	STOSWTX 			;Link Next to executor after For
	add	si,4			;Skip source pointer over operands

Unframe:
;Now unframe the stack, pop the For frame, and exit
	pop	bp
	add	sp,SIZE FFor		;Size of For stack frame entry
	jmp	[ScanRet]		; and back to main loop

subttl	Next Opcode to Executor maps
page
public	mStNextOpExe
mStNextOpExe:
	DWEXT exStNextI2
	DWEXT exStNextStepI2
	DWEXT exStNextStepI4
	DWEXT exStNextStepI4
	DWEXT exStNextStepR4
	DWEXT exStNextStepR4
	DWEXT exStNextStepR8
	DWEXT exStNextStepR8

public	mStNextIdOpExe
mStNextIdOpExe:
	DWEXT exStNextIdI2
	DWEXT exStNextIdStepI2
	DWEXT exStNextIdStepI4
	DWEXT exStNextIdStepI4
	DWEXT exStNextIdStepR4
	DWEXT exStNextIdStepR4
	DWEXT exStNextIdStepR8
	DWEXT exStNextIdStepR8

subttl	EXIT For Support
page
;***
;Ss_Exit
;Purpose:
;	Scan EXIT For and EXIT DO.
;
;	These cases are handled by building a linked list of EXIT
;	entries in the associated For or DO stack frame.  These
;	entries will be bound at Next / DO time, when the opcode
;	that closes the block is bound.  For example, EXIT For is
;	bound at Next.
;
;	Ss_Exit ensures that there is a stack entry to match the
;	current block type that is reachable from the context of the
;	EXIT.  This requires walking frames back on the stack until
;	The appropriate control structure is found, or until the end
;	of the stack is encountered.  There is no stack entry type
;	that would cause the search to stop other than finding the
;	base of the scan stack.
;
;	The rule table index byte contains the bits for the current
;	EXIT structure type.
;
;	The mpOpExe table word carries the executor for the EXIT.
;
;	There is no other required context.
;
;Input:
;	Standard scanner dispatch.
;Output:
;	Standard scanner exit.
;***************************************************************************

;The following is an error as the bit must be in the specified byte
; as placed in PEROPCOD.TXT
.erre	low STYP_Step

SsProc	Exit
;Fetch EXIT type
	STOSWTX 			;Emit the executor
	LODSWTX 			;Skip over operand in source
	shr	bx,1			;bx = opcode (byte offset to mpOpRule)
	xor	ax,ax
	mov	ah,mpOpRule[bx] 	;Load rule byte for this For
					;ax now has correct value for STYP_For
	call	FindFrame		;Find frame type ax
	xchg	ax,cx			;cx = frame type
	jnz	ScopeOK 		;Frame type found
	mov	ax,MSG_ExitDo		;assume it's a DO frame
	cmp	cx,STYP_Do		;is it a DO?
	jz	SsExitErr		;brif so, issue error
	mov	ax,MSG_ExitScope	;EXIT not within For/Next
SsExitErr:
	call	SsError
ScopeOK:
;assert that Exit chains are at same frame offset for For and DO
.errnz	FFor_oTxExit - FDO_oTxExit

	mov	ax,[bx].FFor_oTxExit	;link this exit into the Exit chain
	mov	[bx].FFor_oTxExit,di	;new start of list is this EXIT For
	STOSWTX 			;store previous start in pcode.
	jmp	[ScanRet]		; and on to next opcode

page
;BindExitFor - bind stack entries back to For
;Purpose:
;	Look at the last scan stack frame to determine if it is a For.
;	If not a For, then a nesting error has occurred.
;
;	If a For entry is found, then bind the EXIT For list to the
;	pcode location of the opcode after the current Next.
;
;Input:
;	bp = frame of For entry (if present)
;	cx = offset from current emit address (di) for end of this Next
;
;Output:
;	PSW.Z if For block not found
;
;Preserves:
;	ax,dx

BindExitFor:
	push	ax
	test	[bp+2].FFor_Id,STYP_For ;Is it a For entry?
	jz	BindNoForErr		;No For found

;Bind EXIT For
	add	cx,di			;Address of opcode past Next
	mov	bx,[bp+2].FFor_oTxExit	;Load head pointer of EXIT list
	call	BindExit		;Jmp to common code to bind Exit chains
	or	sp,sp			;PSW.NZ
BindNoForErr:
	pop	ax
	ret

sEnd	SCAN
end