ssproc.asm

[随书类]Dos6.0源代码

public	CopyOps
	cli				;Double prefix! No interrupts!
rep	movs	PTRTX[si],PTRTX[di]	;Copy remaining operands
	sti
	jmp	[ScanRet]

SetHead:
	mov	bx,dx
	mov	[bx],di			;Set head pointer
	jmp	CopyOps

;***
;Ss_StSub,Ss_StFunction,SsStDefFn - Scan SUB, FUNCTION, and DEF FN statements
;
;Purpose:
;	Two functions are performed:
;
;	1.  Look up executor and copy operands unchanged
;
;	2.  Assign oBP to the parameters.
;
;	The stack looks like this at execution time:
;	<arg 1>
;	<arg 2>
;	. . .
;	<arg n>
;	<oRS of return address>
;	<oText of return address>
;	<old BP>
;
;	At this point, the MOV BP,SP is done.  <arg n> is at offset
;	FR_MinFrame from BP.  Arguments are passed by reference, with
;	the size of the pointer determined by memory model (SizeD).
;	Offsets are assigned in the variable table in a loop starting 
;	with <arg n>.  Since Def Fn arguments are passed by value, 
;	the references are always to temporaries already allocated
;	in the stack.
;	
;******************************************************************


SsProc	StDefFn,rude,local
	STOSWTX

	;Make entry on scan stack

	pop	ax
	push	ax
	or	ax,ax			;Scan frame already on stack?
	jz	DefFnFrame
	mov	ax,MSG_DefFnCtrl
	call	SsError
DefFnFrame:
	push	di
	PushI	ax,STYP_DefFn

	push	PTRTX[si+8]		;Save count of parameters
	mov	[SsBosStack],sp 	; Reset BOS SP mark for 1 Line Fn
	push	PTRTX[si+4]		;Put oPRS on stack
	mov	ax,SCANOFFSET ContDefFn
	xchg	ax,[ScanRet]
	push	ax
	xor	dh,dh
	jmp	LinkDefFn		;"call" scan routine with ret. addr.
					;  in [ScanRet]

ContDefFn:
	pop	[ScanRet]		;Restore original [ScanRet]
	mov	[SsOTxStart],di 	; Reset DOS oTx mark for 1 Line Fn
	call	PrsActivate		; oPRS pushed earlier
	REFRESH_ES			
	jmp	short FuncDef


SsProc	StFunction,rude
	STOSWTX				;Emit executor
	push	PTRTX[si+6]		;Save count of parameters
	mov	ax,PTRTX[si+2]		;Get oPRS
	call	ReLinkScan		;Re-link decl. and copy operands
FuncDef:
	cmp	prsCur.PRS_cbFrameVars,-FR_FirstVar	
					; Any frame space already allocated?
	jnz	SubFuncDef
	mov	al,prsCur.PRS_oType	;Get oTyp of return value
	and	al,M_PT_OTYPE		; mask out possible flag bits
	DbAssertRelB	al,b,ET_FS,SCAN,<Ss_StFunction: oTyp is invalid>
	cbw
	call	CbTypOTypSCAN		; Get size of this type
	add	prsCur.PRS_cbFrameVars,ax ; Allocate space for return value
	jmp	short SubFuncDef


SsProc	StSub,rude
	STOSWTX				;Emit executor
	push	PTRTX[si+6]		;Save count of parameters
	mov	ax,PTRTX[si+2]		;Get oPRS
	call	ReLinkScan		;Re-link decl. and copy operands
SubFuncDef:
	mov	[SsLastExit],0
	pop	cx			;Count of parameters
	mov	ax,cx
	jcxz	NoParams
	push	di			;Save oTx
	mov	ax,FR_MinFrame		;First oBP
AssignBP:
	sub	di,6			;Back up to next oVar
		mov	bx,[MrsCur.MRS_bdVar.BD_pb]
	    add     bx,PTRTX[di]
	.errnz	AFORMAL_oFrame
	mov	[bx].VAR_value,ax	;Assign oBP
	    inc     ax
	    inc     ax			;Offsets need two bytes
	.errnz	LOW FV_STATICSET	;Assure byte is ok
	or	byte ptr [bx].VAR_flags+1,HIGH FV_STATICSET ; Flag as dynamic array
	loop	AssignBP
	pop	di			;Recover oTx
	sub 	ax,FR_MinFrame		;cb of parameters
	shr	ax,1			;Word count of parameters
NoParams:
	mov	prsCur.PRS_cwParams,al
	jmp	[ScanRet]

SsProc	StExitProc
	STOSWTX
	inc	si
	inc	si			;Skip over operand
	mov	ax,di
	xchg	ax,[SsLastExit]
	STOSWTX				;Link this with last EXIT
	test	byte ptr [grs.GRS_oRsCur+1],80H	;In a procedure?
	jnz	ExitX
	mov	ax,MSG_InvMain		;Illegal outside procedure
	call	SsError
ExitX:
	jmp	[ScanRet]

SsProc	StEndProc
	call	LinkExit		;Point all EXIT statements to here

	;ife SizeD Insert pcode to release local strings and arrays
	;if  SizeD and FV_FORMS Insert pcode to release Forms and Menus

	push	ax			;Save executor
	call	far ptr RelLocalVars	
	GETSEGTXTCUR			
	pop	ax			;Restore END executor

	STOSWTX
	jmp	[ScanRet]


SsProc	EndSingleDef,rude,local
	STOSWTX
	mov	al,[prsCur.PRS_oType]	;Get result type
	and	ax,M_PT_OTYPE		; mask out possible flag bits
	call	EnsureArgType
;Update count of temps needed
	xor	ax,ax
	xchg	ax,[SsCbFrameTemp]	;Get count of temps needed
	mov	[prsCur.PRS_cbFrameTemp],ax	;Set temp count
	jmp	short EndDef

SsProc	StEndDef,rude,local
	call	LinkExit
	STOSWTX				;Emit executor
EndDef:
	pop	ax			;Get stack entry
	cmp	ax,STYP_DefFn		;Is it our DefFn?
	jnz	ExtraEndDef
	pop	ax			;Clean oTx off stack
EndDefX:
	call	PrsDeActivateFar	
	REFRESH_ES			
	jmp	LinkEndDef

ExtraEndDef:
	test	byte ptr [grs.GRS_oRsCur+1],80H	;In procedure?
	jnz	GetFrame		;If so, go analyze frame
	push	ax			;Restore frame
	mov	ax,MSG_EndNoDef
	call	SsError
	jmp	EndDefX

GetFrame:
	call	SsFrameType
	jmp	EndDefX


LinkExit:
;Set operand of all EXIT statements to point to current emit oTx
	mov	cx,[SsLastExit] 	; Head of list of EXITs
LinkLoop:
	jcxz	LinkX			; Brif end of list
	mov	bx,cx			;BX = Link to next
	mov	cx,di			;CX = Current oTx
	xchg	PTRTX[bx],cx		;Set oTx operand, get link to next
	jmp	LinkLoop

LinkX:
	ret


subttl	Ss_StCall
page
;***
;Ss_StCall - Scan CALL statement
;
;Purpose:
;	1.  Look up executor, copy operands unchanged.
;
;	2.  Using oPRS of target, get oRS of declaration,
;	    then actual far address of declaration.
;
;	3.  Check count of arguments, then compare types of actual
;	    arguments with declared parameters.
;
;	4.  Adapt form of each parameter as required: near reference,
;	    far reference, or value.  Interpreted SUBs and FUNCTIONs
;	    always pass by near reference, DEF FN's by value.
;
;
;******************************************************************


	public	SsCallFunc
SsCallFunc:
extrn	IdLdtoFuncMap:abs
;Enter here from IdLd and AIdLd with FVFUN set
;
;	ds:bx = pVar
;	cx = count of arguments (0 means from IdLd, non-zero means AIdLd)
;	dx = base of executor map for IdLd or AIdLd

	push	cx
	call	SsIndexType		;Index into executor map based on oTyp
	pop	cx
	add	dx,IdLdtoFuncMap
	mov	al,[bx].VAR_flags
	and	al,FV_TYP_MASK
	DbAssertFlags	nz,SCAN,<SsProc: function RetVal oTyp = 0>
	mov	[FuncOtyp],al
	mov	ax,[bx].VAR_Value	;fetch oPrs
	push	ax			;Save oPRS
	push	es			
	call	PPrsOPrsSCAN		;[22] ax = oPrs, es:bx = pPrs
	cmp	BPTRRS[bx.PRS_procType],PT_DEFFN 
	pop	es			
	mov	bx,dx
	mov	ax,cs:[bx]		;Get executor
	STOSWTX				;Emit
	MOVSWTX				;Copy one operand
	pop	ax			;Recover oPRS
	mov	dx,PT_FUNCTION*100H + PT_FUNCTION
	jnz	CallFunc		;brif not a DEF FN
	mov	dx,(DefFnFlag+PT_DEFFN)*100H+PT_DEFFN
;Make sure DefFn is not calling itself recursively
	cmp	ax,[grs.GRS_oPrsCur]	;Same as the one we're in?
	jnz	CallFunc		;If not, then not recursive
	inc	[SsDelayCnt]		;First delayed error on line?
	jnz	CallFunc		;If not, don't update its oTx
	mov	[SsDelayLoc],si		;Save source oTx of error
	mov	[SsDelayErr],ER_UF	;Undefined function
CallFunc:
	jcxz	ParamCheck		;If no arguments, only one operand
	MOVSWTX				;Copy 2nd operand of AIdLd
	jmp	short ParamCheck


ssProc	StCallS
	mov	dh,CallSFlag+PT_SUB
	jmp	short StCall


SsProc	StCall
	mov	dh,CallFlag+PT_SUB
	jmp	short StCall

ssProc	StCallLess
	mov	dh,PT_SUB
StCall:
	mov	dl,PT_SUB
	STOSWTX 			;Emit it

	LODSWTX				;Get operand count
	STOSWTX
	mov	[FuncOtyp],ah		;Set to zero - no RetVal
	xchg	cx,ax			;Save count in cx
	LODSWTX				;Get oPRS
	STOSWTX
ParamCheck:

	;Start of [39]

	;   During an Edit and Continue operation, the pcode may contain
	;opNoList1 opcodes to point to return addresses on the stack
	;that must be updated with the execute state pcode addresses of
	;the current location.	If the current "Call" opcode requires
	;executors to discard temporaries or copy array elements back
	;to far memory, the return address must point immediately after
	;the call and before the inserted executors.  Normal scanning
	;would not process the opNoList1s until the "Call" and it's
	;parameters are finished with.	This results in the stack
	;being updated with the wrong return address.  To solve this
	;problem, the scanner looks ahead to see if the following
	;opcode is opNoList1 and if so, processes it immediately.  Note,
	;there may be more than one occurance for recursive procedures.
	;After this is complete, the parameters are coerced and any
	;necessary insertions are performed.
	;   The processing of a opNoList1 results in an exNoList1 being
	;emitted.  This is necessary in case text is inserted before the
	;"Call" executor.  opBos processing in ssbos.asm will scan the
	;statement for exNoList1s and update the return addresses with
	;the correct oTx.  The update is still performed here because
	;the Bos search and update will not occur unless there is an
	;insertion.

	cmp     [grs.GRS_otxCONT],UNDEFINED	
	jz	IgnoreOpList1		; If can't continue, ignore it

	push	ax			;Save oPrs
@@:
	LODSWTX 			;Look ahead at next opcode
	cmp	ax,opNoList1		;Is this a PC update?
	jnz	@F

	mov	ax,codeOFFSET exNoList1
	STOSWTX 			;Emit executor
	LODSWTX				;Get operand, offset into stack
	STOSWTX
	xchg	bx,ax
	mov	[bx],di			;Set oTx of return address to here
	or	[SsBosFlags],SSBOSF_PcUpdate	;Remember that update occured
	jmp	@B			;Look for another PC update

@@:
	dec	si			;Backup before next opcode
	dec	si
	pop	ax			;Restore oPrs

IgnoreOpList1:				

	;End of [39]

	mov	[SsOtxHeapMove],di	;Procedures can cause heap movement
	mov	[SsParmCnt],cx
	mov	[SsProcPRS],ax		;Save oPRS
	call	PPrsOPrsSCAN		;[22] oPRS in ax --> pPRS in es:bx
					; if FV_SBSWAP, sets up sbRsScan
	cmp	dl,BPTRRS[bx].PRS_ProcType ; Use consistent with PRS?
	jz	PrsOK
	push	ax			
	mov	ax,ER_DD		;Duplicate definition
	call	SsError
	pop	ax			
PrsOK:
	mov	dl,BPTRRS[bx].PRS_flags 
	mov	cl,dl

;***** Start revision [36]
;***** End revision [36]

	push	bx			;Save pPRS
	push	es			; save seg of prs
	GETSEGTXTCUR			
	and	dl,not FP_CDECL		;Reset CDECL for now
	mov	PTRTX[di],si		;Save si in the emitted text
	xor	ax,ax			;Indicate no alias if no decl.
	mov	[SsCbParmCur],ax
	test	cl,FP_DEFINED+FP_DECLARED  ;Is there a declaration?
	mov	cx,-1			;Indicate no declared params
	pop	es			; seg of prs
	jz	NoDecl

	push	es			; save seg of prs
	call	GetDecl 		; returns with ds = seg of declare
	assumes DS,nothing		
	pop	es			; seg of prs
	pop	bx
	push	ax			;Save oRS of declaration

	;ds:si points to delcaration of SUB/FUNCTION/DEF FN
	;es:bx = pPRS of the procedure		
	;dx = flags

	lodsw				;Get oTypFn
	or	ah,ah			;CDECL bit set?
.errnz	DCLA_cdecl - 8000H
	jns	NoCDECLbit
	or	dl,FP_CDECL
NoCDECLbit:
	push	ax			;Save oTypFn
	lodsw				;Get count of parameters
	mov	[SsDeclSeg],ds		; preserve segment of declaration
	push	ss
	pop	ds			;Restore ds = ss
	assumes DS,DATA 		
	mov	cx,ax
	inc	ax			;UNDEFINED same as zero params
	jz	HavAlias
	dec	ax
	shl	ax,1			;ax = cnt*2
	add	ax,cx			;ax = cnt*3
	shl	ax,1			;ax = cnt*6
	add	si,ax			;si points to alias, if any
HavAlias:
	pop	ax			;oTypFn and attributes
NoDecl:
;oRS of decl. on stack (pPRS of procedure if no decl.)
	mov	BPTRRS[bx].PRS_flags,dl ; Update CDECL bit
	push	cx			;Declared count of params
	push	dx			;Flags

	push	bx			; parm to Ss_UL_Support: oPrs
	push	ax			; parm to Ss_UL_Support: cbAlias
	push	dx			; parm to Ss_UL_Support: flags
	call	far ptr Ss_UL_Support	; this chunk is in CP to support
					;	some calls that must be made
					;	from CP
	inc	dx			; error occurred?
	jnz	@F			;	brif not

	GETSEGTXTCUR			;Restore es
	xchg	si,PTRTX[di]		;Restore source pointer
	call	SsError 		; ax contains error code
	xchg	si,PTRTX[di]		;Resave source pointer
@@:
	dec	dx			
	mov	cx,dx			;Save segment of UL proc.
	push	ax			;Save offset
	mov	ax,[SsProcPRS]		;PRS may have moved--get pointer again
	call	PPrsOPrsSCAN		;[22] oPRS in ax --> pPRS in es:bx
	pop	ax
NoUL:
	push	es			; save seg of prs
	GETSEGTXTCUR			;Restore es
	xchg	si,PTRTX[di]		;Restore source pointer
	pop	es			; seg of prs
	pop	dx			;Get flags
	test	dl,FP_DEFINED		;Already defined in interpreter?
	    jnz     InterpProc		
	test	dl,FP_DECLARED		;Was procedure declared?
	    jnz     OKtoUse
	    test    dh,CallFlag + CallSFlag ;Explicit CALL of undeclared proc?
	    jnz     OKtoUse
	    mov     ax,ER_SN		    ;Syntax error if non-existant
	    jcxz    ULError
DeclError:
	mov	ax,ER_US		;Undefined subprogram
ULError:
	call	SsError
	jmp	short CheckParams


sEnd	SCAN
sBegin	CP
assumes cs,CP


DbPub	Ss_UL_Support			
cProc	Ss_UL_Support,<FAR>		
	parmW	oPrs			
	parmW	cbAlias 		
	parmW	flags			
cBegin					
	call	RtPushHandler		;Blasts cx
	mov	ax,cpOFFSET MakeSDFail	
	call	RtSetTrap		;Set trap, errSP at this level
	mov	cx,[cbAlias]		
	mov	cl,ch			
	and	cx,HIGH DCLA_cbAlias	;Mask to cbAlias
.errnz	DCLA_cbAlias - 7C00H
	shr	cl,1			
	shr	cl,1			
;the next four instructions don't alter the flags
	mov	dx,si			;Save pointer to alias
	pushf				;Remember if we found an alias
	GETRS_SEG es			
	mov	bx,[oPrs]		
	mov	ax,PTRRS[bx].PRS_ogNam	;[3] assume no alias

	mov	es,[SsDeclSeg]		; restore es as seg of declaration
	jnz	UseAlias		;Have alias, so copy to SD
;No alias, copy proc. name to SD
	cCall	FpNamOfOgNam,<ax>	; es:dx points to name, cx is cbName
UseAlias:
	; for LQB, all we have to do is compare against "ABSOLUTE"
	pop	ax			; discard flags on stack
	push	si			; save register
	mov	bx,offset DGROUP:pbAbsolute	; DS:BX = "ABSOLUTE"
	mov	si,dx			; ES:SI = proc name

	xor	dx,dx			; assume failure (DX:AX = 0)
	xor	ax,ax			
	cmp	cx,CB_Absolute		; length must be right
	jnz	NotAbsolute		; brif not -- exit

ChkForAbsolute:				
	lods	byte ptr es:[si]	; AL = proc name char
	cmp	al,[bx]			; does it match char of "ABSOLUTE"
	jz	NextChar		; brif so -- do next char
	and	al,0dfh			; make upper case
	cmp	al,[bx]			; match now?
	jnz	NotAbsolute		; brif not -- exit
NextChar:				
	inc	bx			; advance to next char
	loop	ChkForAbsolute		; compare next char

	mov	dx,SEG ABSOLUTE		; return the address of ABSOLUTE
	mov	ax,OFFSET ABSOLUTE	
NotAbsolute:				
	pop	si			; restore reg
NoName:
	call	RtPopHandler		;preserves ax,dx
cEnd					

MakeSdFail:
;Error handler should B$LDFS or B$ULGetProc fail
;Error code in ax
	mov	dx,UNDEFINED		
	jmp	short NoName


; emit code to release local strings and arrays - - - part of proc exit
; must be in CP for calls to FirstVar, NextVar

cProc	RelLocalVars,<FAR>		
cBegin
	call	FirstVar		;Get a variable in this proc
Deallocate:
	or	ax,ax
	jz	DoneDealloc
	mov	cx,PTRVAR[bx].VAR_flags ;[6]
FRAME=	    FVCOMMON+FVSTATIC+FVSHARED+FVFORMAL+FVFUN+FVVALUESTORED+FVREDIRECT
	    TestX   cx,FRAME		;Is it a local variable?
	jnz	GetNextVar

	    TestX   cx,FVARRAY		;Is it an array?
	    mov     ax,codeOFFSET exDeallocArray
	    jnz     @F
	    and     cx,FV_TYP_MASK	;Mask to oTyp
	    .errnz  HIGH FV_TYP_MASK	; Assure we can use CL
	    cmp     cl,ET_SD		;Is it a string?
	    jne     GetNextVar
	    mov     ax,codeOFFSET exDelLocSD
@@:
	    .errnz  AFRAME_oFrame
	mov	cx,PTRVAR[bx].VAR_value ;Get oBP of local
	jcxz	GetNextVar		;If oBP is zero, phantom variable
	call	far ptr Insert1Op_Far	; call to SCAN to call Insert1Op
GetNextVar:
	call	NextVar			;ax = oVar, bx = pVar
	jmp	Deallocate

DoneDealloc:
cEnd					

sEnd	CP
sBegin	SCAN