ssproc.asm

[随书类]Dos6.0源代码

page	49,132
	TITLE	ssproc	- Scan support for procedures
;***
;ssproc	- Scan support for procedures
;
;	Copyright <C> 1986, Microsoft Corporation
;
;
;****************************************************************************

	.xlist
	include		version.inc
SSPROC_ASM = ON
	IncludeOnce	context
	IncludeOnce	exint		
	IncludeOnce	extort
	IncludeOnce	opid
	IncludeOnce	opmin
	IncludeOnce	opstmt
	IncludeOnce	optables
	IncludeOnce	names		
	IncludeOnce	pcode
	IncludeOnce	qbimsgs
	IncludeOnce	rtinterp
	IncludeOnce	ssint
	IncludeOnce	txtmgr
	IncludeOnce	variable
	.list


assumes DS, DATA
assumes es, NOTHING
assumes ss, DATA


	extrn	ABSOLUTE:far 		

sBegin	CODE

	extrn	exBranchRel:near	;This executor in exgoto.asm
	extrn	exBranch:near		;This executor in exgoto.asm
	extrn	exNoList1:near		; This executor in exproc.asm
	extrn	exParamCnt:near 	;This executor in exproc.asm
	extrn	exSave87:near		;This executor in exproc.asm
	extrn	exR8ToStack:near	; This executor in exproc.asm

	    extrn   exR4ToStack:near	; This executor in exproc.asm

extrn	exDelLocSD:near
extrn	exDeallocArray:near

extrn	exDelTmpSD:near

;This executor in exrefarg.asm
extrn	exPushSeg:far		;executor to coerce near reference to far ref.


sEnd	CODE


sBegin	DATA


	extrn	b$ULSymSeg:word 	;Zero iff no user library
	extrn	b$TRPTBL:word		;Start of event handler table
	extrn	b$TRPTBLEND:word	;End+1 of event handler table


pbAbsolute	db	'ABSOLUTE'	
CB_Absolute	EQU	$ - pbAbsolute	


SsLastExit	dw	0
SsProcPRS	dw	0
SsDeclSeg	dw	0	
FuncOtyp	db	0

sEnd	DATA


sBegin	SCAN
assumes cs, SCAN

NoParamsFlag=	80H	;No parentheses on declaration:  no type checking
ArrayFlag=	04H	;Current parameter is whole array
DefFnFlag=	40H	;Def Fn:  pass by value
CallSFlag=	20H	;CallS:  pass by far reference
ByValFlag=	ST_ByVal;BYVAL found on current parameter
SegFlag	=	ST_Seg	;SEG found on current parameter
ProcType=	03H	;From PRS_procType
CallFlag=	SegFlag	;Dual use flag - explicit call

TypeMatchFlag	=	FP_ENDPROC	;Set this bit if type mismatch
ResetBits	=	(ByValFlag + SegFlag + ArrayFlag)*100H + TypeMatchFlag
			;Reset for each parameter

.errnz	ByValFlag - HIGH PATR_byVal
.errnz	SegFlag - HIGH PATR_Seg
.errnz	ArrayFlag - HIGH PATR_array

;Verify the SsRefArg flags defined in SSINT.INC
.errnz	Lvalue - ProcType
.errnz	FarArg - (CallSFlag+SegFlag)
.errnz	FScb - ByValFlag

public	ByValMarker,SegMarker		;Put in rule byte

ByValMarker=	ByValFlag
SegMarker=	SegFlag


;executor map to store values in a temp.
tTmpType	label	word
	DWEXT	exStTmp2
	DWEXT	exStTmp4
	DWEXT	exStTmpR4
	DWEXT	exStTmpR8
	DWEXT	exStTmpSD


;*** Ss_LParen
;
; Make sure type of expression on stack is "expression", not
; variable or literal.

SsProc	LParen
	STOSWTX				;Emit no-op executor
	pop	ax			;Get expression type
	and	ax,((ST_ByVal OR ST_Seg) SHL 8) OR ST_Typ_Mask
	push	ax
	jmp	[ScanRet]


;*** Ss_ByVal_Seg
;
; Set flag that indicates Byval or Seg was seen
; Rule table byte has flag bit set

SsProc	ByVal_Seg
	STOSWTX				;Emit it
	shr	bx,1			;Back to byte index
	pop	ax			;Get oTyp and flags
	or	ah,mpOpRule[bx]		;Add ByVal or Seg flag
	push	ax			;Put it back
	jmp	[ScanRet]


;*** Ss_NoList0 - Current PC oText
;
; This opcode indicates location of current PC.  It was swapped in place
; of original opcode just before scanning.

SsProc	NoList0
	mov	[grs.GRS_otxCont],di	;Set new CONT otx
	dec	si
	dec	si			;Point back to opcode
	mov	ax,[SsErrOpcode]	;Get original opcode
	mov	PTRTX[si],ax		;Put it back so we can scan it now
	jmp	[ScanRet]


;*** Ss_NoList1 - Pcode reference to update
;
; This opcode identifies a spot in the pcode that is referenced by a static
; location in DS.  Its operand is the offset in DS where the oTx is stored.
; This location is updated to contain the current emit oTx if it is possible
; to continue.  Otherwise, this opcode is deleted.
;
; This opcode is used for return addresses on the stack, event table
; entries, and pcode references in the MRS.
;
; In the case of DefFn/Function return addresses, there will be a scan
; stack frame for the return value.  The oTx of this entry must be updated
; to point AFTER this return address opcode, so that any coercions, etc.,
; will be performed AFTER the DefFn/Function returns.
;
; The opNoList1 for error and event handlers is inserted after the opBol
; so that the text manager won't get confused.  A check is made for these
; handlers so they can be updated to the oTx of the saved opBos.  The opcode
; is deleted so that it won't be updated if a coercion takes place later on
; the line.

SsProc	NoList1
	    cmp     [grs.GRS_otxCONT],-1
	jz	EatNoList		;If can't continue, delete pcode
	STOSWTX
	LODSWTX				;Get operand, offset into stack
	STOSWTX
	xchg	bx,ax

	;See if we're dealing with an error or event handler

	test	byte ptr es:[si-3],HIGH (OPCODE_MASK+1)
	jnz	UpdateBOS		; Brif error/event handler

	;   The processing of a opNoList1 results in an exNoList1 being
	;emitted.  This is necessary in case text is inserted before the
	;current location.  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.

	mov	[bx],di			;Set oTx of return address to here
	or	[SsBosFlags],SSBOSF_PcUpdate	;Remember that update occured
	pop	ax
	or	ax,ax			;Scan stack entry present?
	jz	PushAx

	;Analyze stack entry to see if oTx needs updating

	pop	bx			;Get oTx
	lea	dx,[bx+4]		; Size of this opcode
	cmp	di,dx			;Did it point just in front of us?
	jnz	RestoreEntry
	mov	bx,di			;Use current emit oTx for entry
RestoreEntry:
	push	bx			;Restore oTx
PushAx:
	push	ax			;Restore oTyp
NoListRet:
	jmp	[ScanRet]

EatNoList:
	inc	si
	inc	si			;Skip over operand
	jmp	NoListRet

UpdateBOS:
	mov	ax,[SsOtxBos]
	mov	[bx],ax
	sub	di,4			;Eat opNoList1 for error/event handler
	jmp	NoListRet

subttl	StDeclare,StSub,StFunction,StDefFn - Scan procedure headers
page

;***
;Ss_StDeclare - Scan the DECLARE statement
;
;Make sure this is the same as the official declaration
;
;***********************************************************************

SsProc	StDeclare,rude
	STOSWTX
	test	[SsExecFlag],OPA_fExecute ;Already seen executable stmt?
	jz	@F
	mov	ax,MSG_COM		;DECLARE must precede executable stmts
	call	SsError
@@:
	mov	ax,PTRTX[si+2]		;Get oPRS
	push	di			;Save current position
	call	ReLinkScan		;Copy operands, adjust PRS if def.
	mov	es,cx			;Segment of PRS to es
	pop	ax
	push	si
	push	di			;Save source and emit oTx
	xchg	ax,di			;Get oTx of declare to di
	add	di,DCL_cParms		;Point to parameter count field
	xor	dh,dh			;Not a DefFn
	call	GetDecl			;Get declaration
	assumes ds,NOTHING

	;ds:si points to declaration of SUB/FUNCTION/DEF FN
	;ax = oRS of declaration

	xchg	ax,bx			;oRS to bx
	lodsw				;Get attributes
	mov	dx,ax			;Preserve length of alias
	xor	ax,es:[di-2]		;Compare attributes
	and	ax,DCLA_cdecl+DCLA_procType+DCLA_oTyp+DCLA_cbAlias
					;Make sure proc type, alias length,
					;CDECL, and fcn return type match
	jnz	DeclareDD
	lodsw				;Get count of parameters
	scasw				;Same as this declare?
	xchg	cx,ax			;Count to cx
	mov	ax,ER_AC
	jnz	DeclareX		;Argument count error?
	inc	cx
	jz	CompAlias		;No parameter list?
	dec	cx
	jz	CompAlias		;No arguments
CompareArgs:
	cmpsw				;Skip over oVar
	lodsw				;Get ParamAtr
.errnz	LOW PATR_byVal			
	mov	dl,ah			; Save ByVal flag in dl
	xor	ax,PTRTX[di]		;Compare ParamAtr
	TestX	ax,PATR_Array+PATR_Seg+PATR_ByVal+PATR_oTyp ;Only these count
	jnz	DeclareTM
	mov	ax,PTRTX[di+2]		; Get declared oType

	; Make sure ByVal is only on numeric types

	xchg	cx,ax			; Declared oType to cx, loop cnt to ax
	test	dl,HIGH PATR_ByVal	; ByVal?
	jz	CompType		; Not ByVal - go compare oTyps
	jcxz	DeclareTM		; Don't allow As Any with ByVal
	cmp	cx,ET_MaxNum		;[2] Record or SD type?
	ja	DeclareTM		; Don't allow non-numeric with ByVal
CompType:				
	push	dx
	push	ax			;Save loop count
	push	bx
	push	ds
	lodsw				;Get official oType
	xchg	ax,dx			;oType to dx

	;NOTE: Zero flag still set here if not ByVal!

	push	ss
	pop	ds
assumes	ds,DATA
	jcxz	AsAny			;Always allow ANY to pass--ZF must be set
	mov	ax,[grs.GRS_oRsCur]
	cCall	CompareTyps,<ax,bx,cx,dx>	
	REFRESH_ES				
	or	ax,ax				
AsAny:
	pop	ds
assumes	ds,NOTHING
	pop	bx
	pop	cx
NextArg:
	pop	dx
	jnz	DeclareTM
	add	di,4
	loop	CompareArgs
CompAlias:
;Make sure aliases match
.errnz	DCLA_cbAlias - 07C00H
	mov	cl,dh			;cbAlias to cx
	and	cl,HIGH DCLA_cbAlias
	shr	cl,1
	shr	cl,1
rep	cmpsb				;Compare alias strings (ZF set if none)

DeclareDD:
	mov	ax,ER_DD		;Duplicate def. if aliases don't match
DeclareX:
;Zero flag set if no error, else error code in ax
	pop	di
	pop	si
	push	ss
	pop	ds
assumes	ds,DATA
	jz	NoDeclErr
	call	SsError
NoDeclErr:
	jmp	[ScanRet]

DeclareTM:
;To accurately position error cursor, figure out exact position in pcode
;of error.  di = emit oTx of error.
	mov	dx,di			;Error location to dx
	pop	di
	pop	si
	sub	dx,di			;Distance back to error
	inc	dx			;Set LSB
	add	si,dx			;Position of error in source
	mov	ax,MSG_ParmTM		;Parameter type mismatch
	push	ss
	pop	ds			;Restore ds
	call	SsError
	sub	si,dx			;Restore source oTx
	jmp	short NoDeclErr

;***
;SsReLinkDecl - adjust PRS to point to proc declaration after scan/descan
;
;Purpose:
;	If this is the official definition of the procedure, i.e. it is
;	referred to by PRS_oRsDef and PRS_otxDef, then adjust PRS_otxDef
;	to refer to new (emit side) location.  Set flag bit if this
;	is done.
;
;	Also copies all operands.
;
;Inputs:
;	ax = oPRS
;	bx = opcode * 2
;	si & di = oTx of cbEOS (source & emit, respectively)
;	dh = 0 if scanning, dh = -1 if descanning
;Outputs:
;	cx:bx = pPRS
;	si & di = oTx of next pcode
;Preserves:
;	dl
;***********************************************************************
	public	SsReLinkDecl,SsReLinkNoCopy
ReLinkScan:
	xor	dh,dh
SsReLinkDecl:
	PUSH_ES 			
	push	di			;Save oTx of declar. (emit side)
	push	si
	push	ax			;Save oPRS
	call	CopyOperands
	pop	ax
NoCopy:
	call	PPrsOPrsSCAN		;[22] oPRS in ax --> pPRS in es:bx
	pop	ax			;oTx+2 of declaration (source side)
	pop	cx
	xor	dh,BPTRRS[bx].PRS_flags ; Get flags, adjust for scan vs. descan
	test	dh,FP_DEFSCANNED	;Already scanned/descanned definition?
	jnz	ReLinked		;No work if already in correct state
	dec	ax
	dec	ax
	sub	ax,[SsCbTxExpand]	;Compute original oTx
	cmp	ax,PTRRS[bx].PRS_otxDef ; Is that where defined?
	jnz	ReLinked
	mov	ax,PTRRS[bx].PRS_oRsDef 
	cmp	ax,grs.GRS_oRsCur	;Defined in this RS?
	jnz	ReLinked
	xor	BPTRRS[bx].PRS_flags,FP_DEFSCANNED ; Change scan state
	dec	cx
	dec	cx
	mov	PTRRS[bx].PRS_otxDef,cx ; Adjust oTx to emit location
ReLinked:
	mov	cx,es			;Save segment of PRS
	POP_ES				
	ret

SsReLinkNoCopy:
;Same as SsReLinkDecl except does not copy operands
;si & di unchanged
	PUSH_ES 			
	push	di
	push	si
	jmp	NoCopy

subttl	StData,StDefType,StType,StEndType,StDefFn,StEndDef
page
;***
;StData,StDefType,StType,StEndType,StDefFn,StEndDef
;
;	These scan routines manage linked lists across the
;	source/emit boundary.
;
;Algorithm:
;	TXLNK is a data structure with a tail pointer for each list.
;	When another item to be linked is encountered, we simply
;	find the previous one with TXLNK and point it to the new one.
;	TXLNK is updated to point to our new one, too.  TXLNK = 0
;	means there is no previous element.
;
;	These routines are generally used for both scan and descan.
;	The exception is StDefFn/StEndDef, which is descan only.  During
;	scan to execute state a stack entry is used to link Def to End.
;	End is not linked in execute state.
;
;	Reasons why these guys are linked in Parse state:
;
;	DEF FN/END DEF - Used to keep track of what is within the definition.
;
;	DATA - NOT linked by parser in Parse state.
;
;	DEFtyp - Used to figure out what type something is, given a pcode
;		location.
;
;	TYPE/END TYPE - Used to keep track of what is within the type definition
;
;
;	Reasons why these guys are linked in Execute state:
;
;	DEF FN/END DEF - Need to know what is within a definition, to 
;		prevent GOTO, etc. to/from DefFn during scan.
;
;	DATA - to find the rest of the data.
;
;	DEFtyp - Used to assign types to direct mode things, using DEFtyp
;		status of the current PC or the last statement.
;
;	TYPE/END TYPE - Used to jump over the type definition.  End is linked
;		to next Type, but not needed.


SsDProc	StDefFn
	STOSWTX
	mov	dh,-1			;Set Descan direction
LinkDefFn:
	mov	ax,PTRTX[si+4]		;Get oPRS
	call	SsReLinkNoCopy		;Adjust PRS_otxDef
	jmp	short LinkDef

SsDProc	EndSingleDef
SsDProc	StEndDef
	STOSWTX
LinkEndDef:
	mov	PTRTX[si],2		;Set filler to cbEOS
LinkDef:
	mov	bx,TXLNK_DefFn
	mov	dx,dataOFFSET mrsCur.MRS_otxDefFnLink
	cmp	PTRTX[si+2],-1		;End of list?
	jz	VarLenLink		;If so, don't change it
	inc	PTRTX[si+2]		;Set LSB of link to indicate end
	jmp	short VarLenLink

ssProc	StData,,Local
SsD_StData:
	mov	bx,TXLNK_Data		;Link field for DATA link list
	mov	dx,dataOFFSET mrsCur.MRS_data_otxFirst
	STOSWTX 			;Emit executor
	mov	PTRTX[si+2],UNDEFINED	;In case this is last, mark end
VarLenLink:
	LODSWTX 			;Load cbEos
	mov	cx,ax
	inc	cx
	shr	cx,1			;Words to EOS including link field
	jmp	short EmitAndAdjLinks	; Emit cbEos and link


SsProc	StDefType,rude,Local
SsD_StDefType:
	mov	cx,3			;Link field plus 1 Dword operand
	mov	bx,TXLNK_DefType
	mov	dx,dataOFFSET txdCur.TXD_otxDefTypeLink
	jmp	short EmitAndAdjLinks	;Emit executor and link


SsProc	StType,rude,Local
	or	[SsFlags],SSF_InType	;Remember we're in TYPE declarationt
	test	byte ptr [grs.GRS_oRsCur+1],80H	;In procedure?
	jz	SsD_StType		;Better not be
	push	ax			;Save executor
	mov	ax,MSG_InvProc		;Illegal in procedure
	call	SsError
	pop	ax
SsD_StType:
	mov	cx,2			;Link field plus 1 word operand
	jmp	short FixType

SsProc	StEndType,rude,Local
	and	[SsFlags],not SSF_InType;No longer within TYPE declaration
SsD_StEndType:
	mov	cx,1			;Link field w/no additional operands
FixType:
	mov	bx,TXLNK_Type
	mov	dx,dataOFFSET txdCur.TXD_otxTypeLink

EmitAndAdjLinks:

	;AX = Word to be emitted
	;BX = offset into LinkCtl
	;CX = remaining cw of operands to copy
	;DX = pointer to head of list

	STOSWTX
	add	bx,[ssLinkCtl]		;Get pointer to link control struc
	mov	ax,di
	xchg	ax,[bx] 		;Get last item, set new "last"
	or	ax,ax			;First item?
	jz	SetHead
	xchg	bx,ax			;Pointer to previous item in bx
	mov	PTRTX[bx],di		;Fix up pointer to current value
CopyOps: