exproc.asm

Dos6.0

page	49,132
	TITLE	EXPROC - Executors for procedures
;***
;exproc.asm - executors for procedures
;
;	Copyright <C> 1986, Microsoft Corporation
;
;
;****************************************************************************

	.xlist
	include		version.inc
EXPROC_ASM = ON
	IncludeOnce	architec
	IncludeOnce	context
	IncludeOnce	executor
	IncludeOnce	exint
	IncludeOnce	extort
	IncludeOnce	opcontrl
	IncludeOnce	opid
	IncludeOnce	opstmt
	IncludeOnce	qbimsgs
	IncludeOnce	rtinterp
	IncludeOnce	rtps
	IncludeOnce	scanner
	IncludeOnce	ui
	IncludeOnce	variable
	IncludeOnce	pcode		
	.list


PUSHSS	MACRO
	endm

assumes cs, CODE
assumes es, NOTHING
assumes ss, DATA

sBegin	DATA
	externB	b$ErrInfo

ParamCnt	dw	0		
sEnd	DATA



extrn	B$STMakeTemp:far		;Copy string to temp

	externFP __fpmath		

sBegin	CODE

subttl	exStCall,exStCallLess,exStCallS
page


;***
;exStCall - Execute CALL statement
;
;Purpose:
;	1.  Activate target PRS
;
;	2.  Push return address, allocate and zero frame variables.
;
;	3.  Execute the SUB.
;
;	The stack frame looks like this:
;	<arg 1>
;	<arg 2>
;	. . .
;	<arg n>
;	<oRS of return address>
;	<oText of return address>
; BP-->	<old BP>
;	<old b$curframe>			[2]
;	<local variables and FOR temps>
;
;
;******************************************************************

MakeExe exFuncNArgSD,opAIdLd,ET_SD
	SkipExHeader
MakeExe exFuncNArgI4,opAIdLd,ET_I4
	SkipExHeader
MakeExe exFuncNArgR8,opAIdLd,ET_R8
	SkipExHeader
MakeExe exFuncNArgI2,opAIdLd,ET_I2
	SkipExHeader
MakeExe exFuncNArgR4,opAIdLd,ET_R4
	SkipExHeader
MakeExe exFuncNArgImp,opAIdLd,ET_Imp
	inc	si
	inc	si			;Skip over arg count
	jmp	short Func0Arg

MakeExe exFunc0ArgSD,opIdLd,ET_SD
	SkipExHeader
MakeExe exFunc0ArgI4,opIdLd,ET_I4
	SkipExHeader
MakeExe exFunc0ArgR8,opIdLd,ET_R8
	SkipExHeader
MakeExe exFunc0ArgI2,opIdLd,ET_I2
	SkipExHeader
MakeExe exFunc0ArgR4,opIdLd,ET_R4
	SkipExHeader
MakeExe exFunc0ArgImp,opIdLd,ET_Imp
Func0Arg:
	LODSWTX				;Get oVar
	xchg	ax,bx
	mov	ax,[pVarBx]		;Get oPRS
	jmp	short FuncCall

CallCompiledJ:
	jmp	CallCompiled

MakeExe	exStCallS,opStCallS
	SkipExHeader
MakeExe	exStCallLess,opStCallLess
	SkipExHeader
MakeExe	exStCall,opStCall
	inc	si
	inc	si			;Skip over count of arguments
	LODSWTX				;Get oPRS
FuncCall:
;ax = oPRS of target
	GETRS_SEG es,bx,<SPEED,LOAD>	
	mov	bx,ax
	RS_BASE add,bx			; es:bx points to prs
	test	BPTRRS[bx.PRS_flags],FP_DEFINED   ; Interpreted?
	jz	CallCompiledJ		

CallInterpreted:			

	inc	[b$CurLevel]		;Save any temps from deallocation
	push	[pGosubLast]		;Save current head of Gosub list
	push	[grs.GRS_oRsCur]	;Push current oRS
	xchg	dx,ax			;Save oPRS in dx
	mov	al,0
	xchg	al,[grs.GRS_fDirect]	;Get fDirect and set to FALSE
	or	al,al			;Leaving direct mode?
	jz	NotInDirect
	inc	si			;Set LSB to indicate direct mode
	or	[grs.GRS_flags],FG_RetDir
					;remember there's a ret adr to
					; direct mode buffer on stack.
NotInDirect:
; Warning:	SI is assumed to be at [bp+2] for out of stack error recovery.
; We need to make sure that fDirect gets reset correctly if we couldn't
; transfer control to the procedure.

	push	si			;Push current oTx
	push	bp
	mov	bp,sp			;Set up frame pointer
	push	[b$curframe]		; set up BASIC-frame chain
	mov	cx,PTRRS[bx].PRS_cbFrameVars ; Local variables
	add	cx,PTRRS[bx].PRS_cbFrameTemp ; Plus temps
	dec	cx			; cbFrameVars includes 2 bytes to
	dec	cx			;  account for pushed b$curframe
	mov	di,sp
	sub	di,cx			;Allocate local variables and temps
	jc	OutOfStack		;Underflow?
	cmp	di,[b$pEndChk]
	jbe	OutOfStack		;Not enough stack space left
	mov	sp,di
	mov	[b$CurFrame],bp 	;must change b$CurFrame AFTER this chk
					; there will always be a block fill
					; needed
	jcxz	NoLocals
	xor	ax,ax
	push	es			
	push	ss
	pop	es			;es = ss
	shr	cx,1			;Word count
	rep	stosw			;Zero out local variables
	pop	es			
NoLocals:
	mov	si,PTRRS[bx.PRS_otxDef] ; si points to procedure header
	xchg	ax,dx			;Restore oPRS to ax
	or	ah,80H			;oPrs ==> oRs
	call	RsActivateCODE		;Activate called proc
	RestorePcodeVar 		
	inc	si
	inc	si
	LODSWTX				;Get cbEOS
	add	si,ax			;Start execution after definition
	DispMac

OutOfStack:
	mov	ax,[bp+2]		;LSB is fDirect flag before
					;we started building the frame
	ror	al,1			;move lsb to msb
	cbw				;replicate msb into ah
	mov	[grs.GRS_fDirect],ah	;Set fDirect back to entry state
	mov	al,ER_OM
	mov	[b$ErrInfo],OMErr_STK	;note that this is really Out of Stack
					;  space, not Out of Memory
	call	RtErrorCODE

;Branched to when user is tracing through a native code call.  Since
;native code can cause screen output, we need to swap to output screen
;just in case.
;
ShowOutputScr:
	push	bx			;save pPrs
	call	ShowOutScr
	GETRS_SEG es,bx,<SIZE,LOAD>	;[4] restore seg of Rs table
	pop	bx			;restore pPrs
	DbAssertRelB [fDebugScr],e,0,CODE,<exproc: ShowOutScr failed>
;bx = pPrs of procedure to be called
CallCompiled:
	cmp	[fDebugScr],0
	jne	ShowOutputScr		;brif debug screen is visible
	DbAssertRel fNonQBI_Active,z,0,CODE,<exproc: fNonQBI_Active should be 0>
	mov	[fNonQBI_Active],bp	;save pointer to most recent QBI frame
	inc	[b$cNonQBIFrames]
	mov	ax,[b$curlevel]
	mov	[bcurlevel_QBI],ax	;if we end up having to blast the stack
					;  back to the most recent QBI frame,
					;  we need this to restore the proper
					;  setting of b$curlevel
;Save si and cbParam in last temp
	mov	di,[grs.GRS_oRsCur]	
	and	di,07FFFH		; mask off high bit
	RS_BASE add,di			
.errnz	MRS_cbFrameTemp - PRS_cbFrameTemp
	mov	ax,PTRRS[di].MRS_cbFrameTemp ; Get no. of temps for module
	neg	ax			;Make it oBP
	add	ax,bp
	sub	ax,PTRRS[di.MRS_cbFrameVars] ; Point to last temp
	xchg	di,ax
	mov	[di],si
	xor	ax,ax			;Always leave ParamCnt zero
	xchg	ax,[ParamCnt]		
	mov	[di+2],ax		;Amount of stack to clean up
	mov	[grs.GRS_otxCur],si	;Save here in case of error

	cmp	BPTRRS[bx.PRS_procType],PT_SUB	
	jnz	CallCompiledFunc	;call a User Library SUB
	call	dword ptr [bx.PRS_txd.TXD_oCompiled]	 
	call	RestoreFromCall
CallX:
	DispMac

CallCompiledFunc:
	test	BPTRRS[bx].PRS_flags,FP_CDECL	
	jnz	MakeCall			;Don't push addr. for C
	mov	cl,BPTRRS[bx.PRS_oType] 	
	and	cl,M_PT_OTYPE			; mask out possible flags
	cmp	cl,ET_SD			;[15][4] Value returned in regs?
	jae	MakeCall			;[14]
	cmp	cl,ET_I4			;[15][4] Value returned in regs?
	jbe	MakeCall			
; Type is R4, R8, or CY
;Return value is always just before saved si in temps
;di = pointer to last temp
;cl = PRS_oType
	add	di,4			;Make room for si and cbParam
	push	di
	    cmp     cl,ET_R4		;[14] R4 ? Before ES loaded
	    mov     ax,0		;NOTE: CY flag preserved

	push	ss			
	pop	es			;es:di points to return temp
	stosw
	stosw				;Zero return value if R4
	    je	    @F			;brif R4. Only clear two words
	stosw
	stosw				;Zero rest of R8 or CY
@@:
MakeCall:
	    call    dword ptr [bx.PRS_txd.TXD_oCompiled]
	call	RestoreFromCall
;Returning from function - restore 8087 stack
	pop	cx			;Get no. of 8087 registers saved
	jcxz	NoTemps
RestoreLoop:
	mov	bx,sp
	fld	tbyte ptr DGROUP:[bx]	;Put back on stack
	add	sp,10			;Move pointer up
	loop	RestoreLoop
NoTemps:
	mov	bx,PTRTX[si-2]		;Get oVar
	mov	cl,[pVarBx].VAR_flags	;oTyp in low bits
	and	cl,FV_TYP_MASK
	cmp	cl,ET_I4		;Value in (dx:)ax?
	jb	PushI2
	je	PushI4
	cmp	cl,ET_SD
	jae	PushI2			;If string, push near address in ax
;ax points to R4 or R8
	xchg	ax,bx			;ds:bx points to return value
	cmp     cl,ET_R4
	jnz	PushR8			
	fld	dword ptr [bx]		; copy retval to 87 stack
	jmp	CallX

PushR8:
	fld	qword ptr [bx]		; copy retval to 87 stack
	jmp	CallX

PushI4:
	push	dx
PushI2:
	push	ax
	jmp	CallX

RestoreFromCall:
;Restore es, si, di and NonQBI flags after native code call
;Possible return value in dx:ax preserved
;cx preserved
;Restore return oTx to si
	GETRS_SEG es,bx,<SPEED,LOAD>	;[4] restore seg of Rs table
	mov	bx,[grs.GRS_oRsCur]	
	and	bh,07FH 		; mask off high bit
	RS_BASE add,bx			
.errnz	MRS_cbFrameTemp - PRS_cbFrameTemp
	mov	si,PTRRS[bx].MRS_cbFrameTemp	; Get no. of temps for module
	neg	si			;Make it oBP
	sub	si,PTRRS[bx.MRS_cbFrameVars]	; Point to last temp
	pop	bx			; bx = ret address
	add	sp,[si+bp+2]		;Clean off parameters
	push	bx			; push ret address back
	mov	si,[si+bp]		;Restore return oTx
	DbAssertRel b$cNonQBIFrames,nz,0,CODE,<exproc: b$cNonQBIFrames == 0>
	dec	[b$cNonQBIFrames]
	DbAssertRel fNonQBI_Active,z,bp,CODE,<exproc: fNonQBI_Active not == bp>
	mov	[fNonQBI_Active],0	;reset - - QBI code is active again
	call	GetEsDi
	ret

MakeExe	exStFunction,opStFunction
	SkipExHeader
MakeExe	exStSub,opStSub
	LODSWTX				;Get cntEOS
	add	si,ax
	DispMac


MakeExe	exStDefFN,opStDefFN
	mov	si,PTRTX[si+2]		;Get link to EndDef
	inc	si
	inc	si			;Skip past link to next DefFn
	DispMac

MakeExe	exEndSingleDef,opEndSingleDef
	;Move return value from top of stack to expected location

	mov	bx,[grs.GRS_oPrsCur]	; bx points to active prs in table
	RS_BASE add,bx			
	GETRS_SEG  es			
	mov	cx,PTRRS[bx].PRS_cbFrameVars	;[2] Size of return value + 2
	mov	di,bp
	sub	di,cx			;Location for return value
.erre	FR_FirstVar EQ -2
	dec	cx			; make cx the size of the return 
	dec	cx			; value
	mov	al,BPTRRS[bx].PRS_oType 
	and	al,M_PT_OTYPE		; mask out possible flag bits
	cmp	al, ET_SD		;[4] Returning a string?
	jae	CopySD			
	mov	si,sp			;for integer ret vals
;Added with [35]
	cmp	al,ET_R4
	jb	DefFnInt
	jz	DefFnR4
	fstp	qword ptr [di]		;Store R8 return value in stack
	jmp	short EndProc

DefFnR4:
	fstp	dword ptr [di]		;Store R4 return value in stack
	jmp	short EndProc

DefFnInt:
;End of [35]
	push	ss			
	pop	es
rep	movsb				;Move up return value
	jmp	short EndProc

CopySD:
	;pSD already on stack
	push	di			;Assign string to here
	CALLRT	B$SASS,Mov		;es is now invalid!!

	;Fall into EndDef

	SkipExHeader
MakeExe	exStEndDef,opStEndDef
	SkipExHeader


MakeExe exStEndProc,opStEndProc



	mov	bx,[grs.GRS_oPrsCur]	; bx points to active prs in table
	RS_BASE add,bx			

EndProc:
	GETRS_SEG es,di,<SPEED,LOAD>	;[4] fetch seg of Rs table
	dec	[b$CurLevel]
	mov	ax,[bp].FR_pGosubLast
	mov	[pGosubLast],ax
	mov	al,BPTRRS[bx.PRS_cwParams]	; cw of parameters
	xor	ah,ah
	shl	ax,1			;Change to cb
	add	ax,FR_MinFrame		;Remove frame
	add	ax,bp			;Compute sp w/o arguments
	xchg	ax,di			;destination in stack of return value
	mov	al,BPTRRS[bx.PRS_oType] ; oTyp of return value
	and	al,M_PT_OTYPE		; mask out possible flag bits
	mov	ah,BPTRRS[bx.PRS_procType]	
	push	ax
	mov	si,[bp].FR_otxRet	;Get oTx of return addr
	test	si,1			;LSB = returning to direct mode?
	jz	NotDirect
	mov	[grs.GRS_fDirect],-1	;Going back to direct mode
	dec	si			;Back to true oTx
	and	[grs.GRS_flags],NOT FG_RetDir
					;remember there's no ret adr to
	push	ss
	pop	ds			;ds=DGROUP
					; direct mode buffer on stack.
NotDirect:
	mov	ax,[bp].FR_oRsRet	;oRs of return addr
	call	RsActivateCODE		;Activate caller
	pop	ax			;ah=procType, al=oTyp of RetVal
	lea	bx,[bp-2].FR_FirstVar	;Point to high end of return value
	push	[bp].FR_basBpLink	;[33] Restore old b$curframe
	pop	[b$CurFrame]		
	mov	bp,[bp].FR_bpLink	;Restore old bp
	cmp	ah,PT_SUB		;Is it a SUB?
	jz	NoRetVal		;If a SUB, no return value to copy
	xchg	bx,si			;Save return oTx in bx
;Added with [32]
;Restore values to 8087 stack
	mov	cx,[di]			;Number of temp reals to restore
	jcxz	No87Temps
Restore87Loop:
	fld	tbyte ptr DGROUP:[di+2]	;Put back on stack
	add	di,10			;Move pointer up
	loop	Restore87Loop
No87Temps:
;End of [32]
	push	ss
	pop	es			;es = ss
	std				;Reverse order--possibly overlapping
	cmp	al,ET_SD		;String?
	jae	ReturnSD		
	.erre	ET_SD EQ (ET_MaxNum+1)	
;Rewritten with [24]
	    cmp     al,ET_R4
	    je	    RetR4
	cmp	al,ET_R8
	jz	RetR8

	;Have I2, I4, or CY

	cbw
	xchg	cx,ax
.erre	ET_I2 EQ 1			;cw of I2
.erre	ET_I4 EQ 2			;cw of I4

rep	movsw				;Copy return value

SetSi:
	mov	si,bx			;Return oTx
ValInPlace:
	inc	di
	inc	di
	cld
NoRetVal:
	mov	sp,di			;Return val on top of stack
	RestorePcodeVar 		
	DispMac

ReturnSD:
	dec	si
	dec	si			;Point to low byte of SD
	push	si
	mov	si,bx			;Return oTx
	mov	[grs.GRS_otxCur],si	;Save in case of error
	call	B$STMakeTemp		;Make SD a temp - ax = pSD
	stosw				;pSD/handle to its place in stack
	jmp	ValInPlace

;Added with [24]
RetR4:
	fld	dword ptr DGROUP:[si-2]
	jmp	SetSi

RetR8:
	fld	qword ptr DGROUP:[si-6]
	jmp	SetSi
;End of [24]



MakeExe	exNoList1,opNoList1
	inc	si
	inc	si			;Eat one operand
	SkipExHeader
MakeExe	exSeg,opSeg
	SkipExHeader
MakeExe	exByVal,opByVal
	DispMac

;Added with [32]
MakeExe exSave87,opNoList0
	;The following special interface is used to obtain the number
	;of items on the 87/em stack.  This allows us to account for
	;the extended stack with the emulator, with or without an 80x87.
	mov	bx,10			;arg to __fpmath to get count
	call	__fpmath		;AX = # items on the 87/em stack
	mov	cx,ax			;Count to cx
	jcxz	EmptyStack		;go if nothing to do
Save87Loop:
	sub	sp,10			;Make room for a temp real
	mov	bx,sp
	fstp	tbyte ptr DGROUP:[bx]
	loop	Save87Loop
EmptyStack:
	push	ax			;Remember how much we saved
	DispMac

MakeExe	exParamCnt,opNoList1
	LODSWTX
	mov	[ParamCnt],ax		;Remember how much to release
	DispMac
;End of [32]

MakeExe	exAddStack,opNoList1
	LODSWTX
	add	sp,ax			;De-allocate stack space
	DispMac

MakeExe	exDeallocArray,opNoList1	;oBP
;De-allocate local array va