ssrefarg.asm

[随书类]Dos6.0源代码

page	49,132
	TITLE	ssrefarg - Scan pcodes for executors that require Rf Arguments
;***
;ssrefarg - Scan pcodes for executors that require Rf Arguments
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
;
;   The pcodes scanned by this module have executors that require the
;   address of a variable as an argument.
;
;
;****************************************************************************

	.xlist
	include 	version.inc
SSREFARG_ASM = ON
	IncludeOnce	context
	IncludeOnce	qbimsgs
	IncludeOnce	rtps
	IncludeOnce	ssint
	IncludeOnce	variable
	.list


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

subttl	opcode to executor maps for opcodes with executors with Rf Args
page
;These tables are used by scan routines to map opcodes to executors.

sBegin	SCAN
assumes cs, SCAN


;INPUT Statement
PUBLIC	mStInputOpExe
mStInputOpExe:
mStInputFirst:
	DWEXT	exStInputI2
	DWEXT	exStInputI4
	DWEXT	exStInputR4
	DWEXT	exStInputR8
	DWEXT	exStInputSD
	DWEXT	exStInputFS		    ;In the table twice for easy mapping

;Table index offset for near references
omNear	= $ - mStInputFirst

	DWEXT	exStInputI2Near
	DWEXT	exStInputI4Near
	DWEXT	exStInputR4Near
	DWEXT	exStInputR8Near
	DWEXT	exStInputSD		    ;In the table twice for easy mapping
	DWEXT	exStInputFS


	;READ Statement

	public	mStReadOpExe
mStReadOpExe:
	DWEXT	exStReadI2
	DWEXT	exStReadI4
	DWEXT	exStReadR4
	DWEXT	exStReadR8
	DWEXT	exStReadSD
	DWEXT	exStReadFS

	DWEXT	exStReadI2Near
	DWEXT	exStReadI4Near
	DWEXT	exStReadR4Near
	DWEXT	exStReadR8Near
	DWEXT	exStReadSD
	DWEXT	exStReadFS




	;Maps for LSET/RSET/MID use LSB only for indexing

	;LSet

	public	mStLsetOpExe
mStLsetOpExe:
	DWEXT	exStLset,
	DWEXT	exStLsetFS

	;RSet

	public	mStRsetOpExe
mStRsetOpExe:
	DWEXT	exStRset
	DWEXT	exStRsetFS

	;Mid$

	public	mStMid_2OpExe
mStMid_2OpExe:
	DWEXT	exStMid_2
	DWEXT	exStMid_FS2

	;Mid$

	public	mStMid_3OpExe
mStMid_3OpExe:
	DWEXT	exStMid_3
	DWEXT	exStMid_FS3
					

	;Swap


	public	mStSwapOpExe
mStSwapOpExe	label	word
	DWEXT	exStSwapTyp
	DWEXT	exStSwap2
	DWEXT	exStSwap4
	DWEXT	exStSwap4
	DWEXT	exStSwap8
	DWEXT	exStSwapSD


sEnd	SCAN

sBegin	DATA

oTxInputType	DW (?)
cInputType	DW 0

sEnd	DATA

sBegin	CODE

	extrn	exPushOp:near
	extrn	exStLSetRec:near
	extrn	exFnLenTyp:near
	extrn	exStLineInputFS:near
	extrn	exAddStack:near 	;Add constant to sp


sEnd	CODE

sBegin	SCAN
assumes cs, SCAN

	subttl	Ss_FPutGet<2|3>
	page
;***
;Ss_FPutGet<2|3>
;Purpose:
;	Scan file PUT and GET varients that require an Rf
;
;	Special tasks include:
;	- make the variable an Rf
;	- Make sure the Rf will result in a far address
;	- emit the size of the variable as an operand
;Input:
;	standard scanner entry
;Output:
;	standard scanner exit
;
;*******************************************************************************
SsProc	FPutGet3
	call	FPutGetCom
	mov	ax,ET_I4
	call	EnsureArgType		;Ensure stack has an I4 variable
	jmp	short FPutGetI2

SsProc	FPutGet2
	call	FPutGetCom
FPutGetI2:
	mov	ax,ET_I2
	call	EnsureArgType		;Ensure stack has an I2 variable
	jmp	[ScanRet]		;And back to main loop

;***
;FPutGetCom
;Purpose:
;	Emit the executor
;	Make stack variable an Rf
;	Make sure the Rf will result in a far address
;	Emit the stack variable size as the operand
;Input:
;	ax = executor
;Output:
;	none
;
;*******************************************************************************

FPutGetCom:
	STOSWTX 			    ;Emit executor
	inc	si
	inc	si			    ;Skip source side SIZE operand
	pop	dx			    ;Get return address
	pop	ax			    ;Get oType
	pop	bx			    ;  and oTx
	push	dx			    ;Put return address back
	mov	dx,ax			    ; DX = oTyp w/flags
	.erre	ST_Typ_Mask EQ 0ffh	    ; Assure we can use AL
	cmp	dl,ET_SD		    ;SD/TX/FS/FT handled special
	jb	NotString		    ; Brif not a string type
	xor	ax,ax			    ;Signal SD with length of zero
	.erre	ST_Typ_Mask EQ 0ffh	    ; Assure we can use DL
	cmp	dl,ET_FS		    ; FS/FT?
	jb	GotSize 		    ; Brif not fixed
	dec	ax			    ;Signal FS with length FFFF
	jmp	short GotSize		    

NotString:				    
	call	GetTypeSize		    ;AX = size, CX = oTyp of variable
GotSize:				    
	STOSWTX 			    ;Emit size
	xchg	ax,dx			    ;AX = oTyp from scan stack
	    mov     dh,FarArg+FScb+Lvalue   ;Signal that it's far, real ptr to FS
	    jmp     SsRefArg		    ;Make a reference argument

;***
;GetTrueType
;Purpose:
;	Get the true type and size of a variable whose scan stack entry is 
;	in ax/bx.
;
;Input
;	ax - type word from scan stack
;	bx - oTx of oVar from scan stack
;Output:
;	cx = True oTyp of variable
;Preserves:
;	ax,bx,dx
;
;***************************************************************************

	;Added with [11]

	public	GetTrueType
GetTrueType:
	mov	cl,al
	mov	ch,0			;Set up type in cx
	jcxz	RecordType		;If not record, that's all there is
	ret

RecordType:
	push	bx
	    mov     bx,PTRTX[bx-2]	;Load oVar/oElem
	    add     bx,[mrsCur.MRS_bdVar.BD_pb] ;Dereference
	mov	cx,[bx].VAR_oTyp	;Assume oVar
	TestX	ax,ST_Record?		;oVar or oElem?
	jz	@F			;Not record variable
	mov	cx,[bx].ELEM_oTyp
@@:
	pop	bx
	ret

	;End of [11]

;***
;GetTypeSize
;Purpose:
;	Get the true type and size of a variable whose scan stack entry is 
;	in ax/bx.
;
;Input
;	ax - type word from scan stack
;	bx - oTx of oVar from scan stack
;Output:
;	ax = size
;	cx = true type
;Preserves:
;	bx,dx
;***************************************************************************
GetTypeSize:

	push	bx				
        mov     bx,PTRTX[bx-2]			; Load oVar/oElem
	add     bx,[mrsCur.MRS_bdVar.BD_pb] 	; Dereference

	TestX	ax,ST_Var?			; Is this a Var or Const?
	jz	@F				; brif const

	TestX	ax,ST_Record?			; oVar or oElem?
	jz	@F				; Brif not record variable
	mov	ax,[bx].ELEM_oTyp		
	mov	cx,ax				; CX = oTyp
	call	CbTypOTypSCAN			;[15]
	jnz	GotTypeSize			; Brif Fixed string
	mov	ax,[bx].ELEM_cbFixed		; Get correct size
	jmp	short GotTypeSize		;[J2] Go get the size and exit

@@:						
	DbChk	pVar,bx 			; Verify this is a variable
	GetOtyp ax,[bx] 			
	mov	cx,ax				; CX = oTyp
	call	CbTypOTypSCAN			;[15]
	jnz	GotTypeSize			; Brif Fixed string
	mov	ax,[bx].VAR_cbFixed		; Get correct size
GotTypeSize:					
	pop	bx				
	ret					


	subttl	Ss_LRSetMid
	page
;***
;Ss_LRSetMid
;Purpose:
;*******************************************************************************

SsProc	Lset
	xchg	cx,ax			;exe map address to cx
	pop	ax			;AX = oTyp of LHS
	.erre	ST_Typ_Mask EQ 0ffh	; Assure we can use AL
	.erre	ET_RC EQ 0		; Assure OR/JNZ is sufficient
	or	al,al			; Is this a record?
   DJMP jnz	LRSetMid		; Brif not a record

	;LSET for records

	pop	bx			; BX = oTx of LHS
	call	GetTypeSize		; AX = Size, CX = oTyp
	DbAssertRel cx,a,ET_MAX,SCAN,<Ss_Lset: LHS should be a record>	  
	xchg	ax,dx			; DX = Size of LHS
	pop	ax			;AX = oTyp of RHS
	pop	bx			; BX = oTx of RHS
	.erre	ST_Typ_Mask EQ 0ffh	; Assure we can use AL
	.erre	ET_RC EQ 0		; Assure OR/JZ is sufficient
	or	al,al			; Is this a record?
	call	TMErrorNZ		; Error if not a record

	push	ax			; Save oTyp on stack
	call	GetTypeSize		; AX = Size, CX = oTyp
	xchg	ax,cx			; CX = Size of RHS
	pop	ax			; Restore oTyp w/flags
	    push    dx			; MakeFarRef trashes dx
	    call    MakeFarRef
	    pop     dx			

	cmp	cx,dx			;Need smallest byte count
	jb	@F			
	xchg	dx,cx			;Smallest in CX
@@:					
	mov	ax,codeOFFSET exPushOp	;Executor for pushing operand
	mov	bx,di			;Insert at di
	call	Insert1Op		;Insert executor and operand
	mov	ax,codeOFFSET exStLsetRec
	STOSWTX 			;Emit executor for rec version of LSET
	jmp	[ScanRet]


SsProc	LRSetMid
	xchg	cx,ax			;exe map address to cx
	pop	ax			;AX = oTyp of LHS (Record = ET_RC)
LRSetMid:
	shr	bx,1			;bx = opcode
	mov	bl,mpOpRule[bx] 	;bx = count of integer exp's needed
	xor	bh,bh			
	xchg	bx,cx			;bx = exe map address, cx = rule byte
	mov	dx,ax			;Save copy of oTyp
	.erre	ST_Typ_Mask EQ 0ffh	; Assure we can use AL
	sub	al,ET_SD		; Maps start with ET_SD
	    .erre   ET_FS EQ ET_SD+1	; Assure LSB distinguishes fixed
	    shl     ax,1		; Convert to word offset
	and	ax,2			;[13] String = 0 / Fixed = 2
	add	bx,ax

	mov	ax,cs:[bx]		;Load and emit the executor
	STOSWTX
	pop	bx
	push	bx
	push	dx
	mov	ax,ET_SD
	call	EnsureArgType
	xchg	dx,ax			    ;oTyp to ax
	    mov     dh,Lvalue+FScb+FarArg
	    call    SsRefArg		    ;Make the id an RfId
	mov	ax,ET_SD
	call	EnsureArgType
	jcxz	LRSetMidArg		;No I2 expressions to eat
NextI2:
	mov	ax,ET_I2
	call	EnsureArgType		;Eat an I2 argument
	loop	NextI2			;Go get next I2 arg

LRSetMidArg:
	jmp	[ScanRet]		;and exit to main loop

subttl	Ss_Input
page
;***
;Ss_Input
;Purpose:
;	Scan routine for INPUT and READ
;
;	Algorithm:
;
;	1. Eat an Rf
;	   produce the Rf from an Ld
;
;	3. Copy operands
;*******************************************************************************
SsProc	Input
	xchg	bx,ax		 	;Get exe map address
	pop	ax			;AX = oTyp of operand (Record = ET_RC)
	push	ax

	;Get coercion index for near/far explosion

	    mov     cx,ax		; Save oTyp with flags
	and	ax,ST_Typ_Mask		; Clear scan stack flags
	.erre	ET_RC EQ 0		; Assure JNZ is sufficient
	jnz	InputTypOk		; Brif not a record
	call	TMError
	inc	ax			; Use any valid type (ET_I2)
InputTypOK:
	    .erre   ST_Typ_Mask EQ 0ffh ; Assure we can use CH
	    or	    ch,ch		; Is this an expression?
	    jz	    NearRef		; Expr means fcn RetVal (always near)
	    cmp     ch,HIGH ST_SimpVar	;Is it a far reference?
	    jnz     FarRef		;No special FAR executor
NearRef:				
	    add     ax,omNear SHR 1	;Adjust for near/far explosion
FarRef:
	shl	ax,1			;To word offset
	add	bx,ax
        mov     ax,cs:[bx-2]            ;Load executor
	STOSWTX 			;Emit the executor

	cmp	[cInputType],0		;Is there an active type list?
	jz	NoInPrompt		;Brif not.  Must be Read or Input #n.

	pop	ax			;ax = scan stack variable type entry
	push	ax
	call	RTTypETTyp		;Map ET Type to RT Type
	mov	bx,[oTxInputType]	;oTx of next type byte
	mov	es:[bx],al		;Put current type in type list
	inc	[oTxInputType]		;Move to next type byte
	dec	[cInputType]		;Indicate 1 fewer types
NoInPrompt:
	pop	ax
	pop	bx
	call	MakeRef 		;Make id a Rf type id
	jmp	[ScanRet]


;***
;RTTypETTyp
;Purpose:
;	Map ET types to RT types.
;
;Input:
;	ax = ET type
;Output:
;	ax = RT type
;Preserves:
;	cx,dx
;****************************************************************************
Public	RTTypETTyp
RTTypETTyp:
	mov	bx,SCANOFFSET mRTTyp - 1 ;Adjust for 1 relative indexing
	xlat	cs:[bx]
	ret

	;Runtime constants for ET types

mRtTyp:
	db	VT_I2			
	db	VT_I4			
	db	VT_R4			
	db	VT_R8			
	db	VT_SD			
	db	VT_SD			; Pass SD type for FS


	subttl	Ss_Swap
	page
;***
;Ss_Swap
;
;	When swapping FS types, they are always assigned to temporary SD
;	variables in the stack.  This costs nothing if one of arguments was
;	SD, the other FS.  If both were FS, this should only be done if
;	evaluation of the second argument could cause heap movement
;	(invalidating the pointer to the first arguement).  However, the
;	existing mechanism cannot determine if this is the case--all FS 
;	operations are assumed to cause heap movement.  So SD is always used.
;
;*******************************************************************************


	.errnz	SizeD			; Won't work in SizeD

SsProc	Swap
	inc	si
	inc	si			;Ignore operand to opStSwap
	pop	ax			;AX = oTyp of 2nd arg (Record = ET_RC)