ssaid.asm

[随书类]Dos6.0源代码

mpAIdIFLd	label	word			
	DWEXT	exAIdIFRf
	DWEXT	exAIdIFLd2
	DWEXT	exAIdIFLd4
	DWEXT	exAIdIFLdR4
	DWEXT	exAIdIFLdR8			
	DWEXT	exAIdIFRfSD
	DWEXT	exAIdIFLdFS
	.erre	cbContext EQ ($-mpAIdIFLd)	

	;AIdRfImp executor map

mpAIdIRf	label	word			


mpAIdISRf	equ	$-2			
	DWEXT	exAIdISRf
	DWEXT	exAIdISRf
	DWEXT	exAIdISRf
	DWEXT	exAIdISRf
	DWEXT	exAIdISRfSD
	DWEXT	exAIdISRfFS
	.erre	cbContext EQ ($-mpAIdISRf)	

mpAIdICRf	equ	$-2			
	DWEXT	exAIdICRf
	DWEXT	exAIdICRf
	DWEXT	exAIdICRf
	DWEXT	exAIdICRf
	DWEXT	exAIdICRfSD
	DWEXT	exAIdICRfFS
	.erre	cbContext EQ ($-mpAIdICRf)	

mpAIdIIRf	equ	$-2			
	DWEXT	exAIdIIRf
	DWEXT	exAIdIIRf
	DWEXT	exAIdIIRf
	DWEXT	exAIdIIRf
	DWEXT	exAIdIIRfSD
	DWEXT	exAIdIIRfFS
	.erre	cbContext EQ ($-mpAIdIIRf)	

mpAIdIFRf	equ	$-2			
	DWEXT	exAIdIFRf
	DWEXT	exAIdIFRf
	DWEXT	exAIdIFRf
	DWEXT	exAIdIFRf
	DWEXT	exAIdIFRfSD
	DWEXT	exAIdIFRfFS
	.erre	cbContext EQ ($-mpAIdIFRf)	

	;Function call executors

	DWFILL					
	DWEXT	exFuncNArgImp
	DWEXT	exFuncNArgImp
	DWEXT	exFuncNArgImp
	DWEXT	exFuncNArgImp
	DWEXT	exFuncNArgImp


	;Optimized 1-dimension load

mpA1IdESLd	equ	$ - 2			
	DWEXT	exA1IdESLdI2

mpA1IdEFLd	equ	$ - 2			
	DWEXT	exA1IdEFLdI2

	.erre	A1FrameOffset EQ (mpA1IdEFLd - mpA1IdESLd)

	;Note:	The following word is used by MakeRef to
	;find the implicit map from the explicit map.

	DW	mpALdImpOpExe			

	public	mpALdExpOpExe
mpALdExpOpExe	label	word			


	.erre	A1SOffset EQ (mpA1IdESLd - $)	

mpAIdESLd	label	word			
	DWFILL					
	DWEXT	exAIdESLdI2
	DWEXT	exAIdESLdI4
	DWEXT	exAIdESLdR4
	DWEXT	exAIdESLdR8
	DWEXT	exAIdESRfSD
	DWEXT	exAIdESLdFS
	.erre	cbContext EQ ($-mpAIdESLd)	

mpAIdECLd	label	word			
	DWFILL					
	DWEXT	exAIdECLdI2
	DWEXT	exAIdECLdI4
	DWEXT	exAIdECLdR4
	DWEXT	exAIdECLdR8
	DWEXT	exAIdECRfSD
	DWEXT	exAIdECLdFS
	.erre	cbContext EQ ($-mpAIdECLd)	

mpAIdEILd	label	word			
	DWFILL					
	DWEXT	exAIdEILdI2
	DWEXT	exAIdEILdI4
	DWEXT	exAIdEILdR4
	DWEXT	exAIdEILdR8
	DWEXT	exAIdEIRfSD
	DWEXT	exAIdEILdFS
	.erre	cbContext EQ ($-mpAIdEILd)	

	.erre	FrameOffset EQ (mpAIdESLd - $)	

mpAIdEFLd	label	word			
	DWFILL					
	DWEXT	exAIdEFLdI2
	DWEXT	exAIdEFLdI4
	DWEXT	exAIdEFLdR4
	DWEXT	exAIdEFLdR8
	DWEXT	exAIdEFRfSD
	DWEXT	exAIdEFLdFS
	.erre	cbContext EQ ($-mpAIdEFLd)	

	;AIdRfExp executor map


mpAIdESRf	equ	$-2			
	DWEXT	exAIdESRfI2
	DWEXT	exAIdESRfI4
	DWEXT	exAIdESRfR4
	DWEXT	exAIdESRfR8
	DWEXT	exAIdESRfSD
	DWEXT	exAIdESRfFS
	.erre	cbContext EQ ($-mpAIdESRf)	

mpAIdECRf	equ	$-2			
	DWEXT	exAIdECRfI2
	DWEXT	exAIdECRfI4
	DWEXT	exAIdECRfR4
	DWEXT	exAIdECRfR8
	DWEXT	exAIdECRfSD
	DWEXT	exAIdECRfFS
	.erre	cbContext EQ ($-mpAIdECRf)	

mpAIdEIRf	equ	$-2			
	DWEXT	exAIdEIRfI2
	DWEXT	exAIdEIRfI4
	DWEXT	exAIdEIRfR4
	DWEXT	exAIdEIRfR8
	DWEXT	exAIdEIRfSD
	DWEXT	exAIdEIRfFS
	.erre	cbContext EQ ($-mpAIdEIRf)	

mpAIdEFRf	equ	$-2			
	DWEXT	exAIdEFRfI2
	DWEXT	exAIdEFRfI4
	DWEXT	exAIdEFRfR4
	DWEXT	exAIdEFRfR8
	DWEXT	exAIdEFRfSD
	DWEXT	exAIdEFRfFS
	.erre	cbContext EQ ($-mpAIdEFRf)	

	;Function call executors

	DWFILL					
	DWEXT	exFuncNArgI2
	DWEXT	exFuncNArgI4
	DWEXT	exFuncNArgR4
	DWEXT	exFuncNArgR8
	DWEXT	exFuncNArgSD


;Table mpAStImpOpExe is a list of AIdStImp executors.  The list is ordered
;as follows:
;	exAId<I|E><I|S|F|C>St<type>
;This table is then followed by AIdStExp executors.
;Type "0" entries are used for record executors (implicit types only).

	;Optimized 1-dimension store

mpA1IdISSt	equ	$ - 2			
	DWEXT	exA1IdISStI2

mpA1IdIFSt	equ	$ - 2			
	DWEXT	exA1IdIFStI2

	.erre	A1FrameOffset EQ (mpA1IdIFSt - mpA1IdISSt)

	;Note:	The following word fills space used by MakeRef
	;before the explicit map to find the implicit map.

	DW	0				

	public	mpAStImpOpExe
mpAStImpOpExe	label	word


	.erre	A1SOffset EQ (mpA1IdISSt - $)	

mpAIdISSt	label	word			
	DWEXT	exAIdISStTyp
	DWEXT	exAIdISSt2
	DWEXT	exAIdISSt4
	DWEXT	exAIdISStR4
	DWEXT	exAIdISStR8			
	DWEXT	exAIdISStSD
	DWEXT	exAIdISStFS
	.erre	cbContext EQ ($-mpAIdISSt)	

mpAIdICSt	label	word			
	DWEXT	exAIdICStTyp
	DWEXT	exAIdICSt2
	DWEXT	exAIdICSt4
	DWEXT	exAIdICStR4
	DWEXT	exAIdICStR8			
	DWEXT	exAIdICStSD
	DWEXT	exAIdICStFS
	.erre	cbContext EQ ($-mpAIdICSt)	

mpAIdIISt	label	word			
	DWEXT	exAIdIIStTyp
	DWEXT	exAIdIISt2
	DWEXT	exAIdIISt4
	DWEXT	exAIdIIStR4
	DWEXT	exAIdIIStR8			
	DWEXT	exAIdIIStSD
	DWEXT	exAIdIIStFS
	.erre	cbContext EQ ($-mpAIdIISt)	

	.erre	FrameOffset EQ (mpAIdISSt - $)	

mpAIdIFSt	label	word			
	DWEXT	exAIdIFStTyp
	DWEXT	exAIdIFSt2
	DWEXT	exAIdIFSt4
	DWEXT	exAIdIFStR4
	DWEXT	exAIdIFStR8			
	DWEXT	exAIdIFStSD
	DWEXT	exAIdIFStFS
	.erre	cbContext EQ ($-mpAIdIFSt)	


	;Optimized 1-dimension store

mpA1IdESSt	equ	$ - 2			
	DWEXT	exA1IdESStI2

mpA1IdEFSt	equ	$ - 2			
	DWEXT	exA1IdEFStI2

	.erre	A1FrameOffset EQ (mpA1IdEFSt - mpA1IdESSt)

	;Note:	The following word fills space used by MakeRef
	;before the explicit map to find the implicit map.

	DW	0				

	public	mpAStExpOpExe
mpAStExpOpExe	label	word


	.erre	A1SOffset EQ (mpA1IdESSt - $)	

mpAIdESSt	label	word			
	DWFILL					
	DWEXT	exAIdESStI2
	DWEXT	exAIdESStI4
	DWEXT	exAIdESStR4
	DWEXT	exAIdESStR8
	DWEXT	exAIdESStSD
	DWEXT	exAIdESStFS
	.erre	cbContext EQ ($-mpAIdESSt)	

mpAIdECSt	label	word			
	DWFILL					
	DWEXT	exAIdECStI2
	DWEXT	exAIdECStI4
	DWEXT	exAIdECStR4
	DWEXT	exAIdECStR8
	DWEXT	exAIdECStSD
	DWEXT	exAIdECStFS
	.erre	cbContext EQ ($-mpAIdECSt)	

mpAIdEISt	label	word			
	DWFILL					
	DWEXT	exAIdEIStI2
	DWEXT	exAIdEIStI4
	DWEXT	exAIdEIStR4
	DWEXT	exAIdEIStR8
	DWEXT	exAIdEIStSD
	DWEXT	exAIdEIStFS
	.erre	cbContext EQ ($-mpAIdEISt)	

	.erre	FrameOffset EQ (mpAIdESSt - $)	

mpAIdEFSt	label	word			
	DWFILL					
	DWEXT	exAIdEFStI2
	DWEXT	exAIdEFStI4
	DWEXT	exAIdEFStR4
	DWEXT	exAIdEFStR8
	DWEXT	exAIdEFStSD
	DWEXT	exAIdEFStFS
	.erre	cbContext EQ ($-mpAIdEFSt)	

	;AdRf executor map

	public	mpAdRf				
mpAdRf	label	word				
	DWEXT	exAdRfImp			
	DWEXT	exAdRfI2			
	DWEXT	exAdRfI4			
	DWEXT	exAdRfR4
	DWEXT	exAdRfR8			
	DWEXT	exAdRfSD			

	page
;***
;MakeArrayRef
;
;Purpose:
;
;   This procedure converts an exAIdLd with cArgs == 0 to an exAdRf.
;
;Input:
;
;   BX = oTx from scan stack of pointer after exAIdLd
;
;Output:
;
;   standard exit
;
;Preserves
;
;   BX, CX, DX
;
;***************************************************************************

	public	MakeArrayRef
MakeArrayRef	proc

	mov	ax,PTRTX[bx-6]		;AX = exAIdLd executor
	xchg	ax,bx			;AX = oTx, BX = executor
	GetCodeIntoDs	SCAN		
	mov     bl,byte ptr [bx-1]	;Get HIGH byte of opcode
	push	ss			
	pop     ds

	.erre	OPCODE_MASK EQ 03ffh
;	and	bx,HIGH (NOT OPCODE_MASK)
	and	bx,0FCh 		;Mask off garbage leaving oTyp * 4
	shr	bx,1			;Convert to word offset
	mov	bx,mpAdRf[bx]		;BX = AdRf executor
	xchg	ax,bx			;AX = executor, BX = oTx
	mov	PTRTX[bx-6],ax
	ret

MakeArrayRef	endp

	page
;***
;Ss_Erase
;
;Purpose:
;
;   Scan Erase statement.
;
;   AIdLd scanning has left a stack entry consisting of:
;	oType
;	oTx of point after AIdLd
;
;Parsed state opcode format:
;
;   (AIdLd,...) opStErase(cnt)
;
;      The cnt argument represents the number of preceeding AIdLd opcodes
;   each of which will have left an entry on the stack.
;
;Input:
;
;   opStErase operand has count of AIdLd arguments.
;
;Output:
;
;   standard exit
;
;***************************************************************************

SsProc	Erase
	STOSWTX 			;Emit executor
	LODSWTX 			;Load operand count
	STOSWTX 			;And emit it
	xchg	cx,ax			;CX = operand count
EraseLoop:
	pop	bx			;Discard oType
	pop	bx			;BX = oTx after exAIdLd
	call	MakeArrayRef		;Convert to exAdRf
	loop	EraseLoop		;Go process next array
	jmp	[ScanRet]		; and back to the main loop

	page
;***
;Ss_LUbound - scan LBOUND and UBOUND
;
;Purpose:
;
;   Scan opFn<L|U>bound<1|2>
;
;   Scan stack contains:
;	I2 (for op<L|U>Bound2 case)
;	AIdLd entry:
;	    oType
;	    oTx of point after AIdLd (location of exFn<L|U>Bound<1|2>)
;
;Parsed state opcode format:
;
;   (AIdLd)	 opFn<L|U>bound1
;   (AIdLd,Nexp) opFn<L|U>bound2
;
;Input:
;
;   standard entry
;
;Output:
;
;   standard exit
;
;***************************************************************************

SsProc	LUBound2
	mov	ax,ET_I2		;Index must be I2
	call	EnsureArgType		;Perform the coercion as required
	xchg	ax,dx			
	SKIP2_PSW			; Skip over descan routine address
SsProc	LUBound1			
	STOSWTX
	pop	bx			;Discard oType
	pop	bx			;BX = oTx after exAIdLd
	push	di			;Push oTx of result for coercion
	PushI	ax,ET_I2		;Push oTyp of result. Always I2
FixNoDimArray:
	call	MakeArrayRef		;Convert to exAdRf
	jmp	[ScanRet]		; and back to the main loop

	page
;***
;Ss_GPutGet,PaletteUsing
;
;Purpose:
;
;   Scan graphics PUT, GET and PALETTE USING
;
;Parsed state opcode format:
;
;   (I2exp,...,AIdLd)	opStPalletteUsing
;   (I2exp,...,AIdLd)	opStGraphicsGet
;   (I2exp,...,AIdLd)	opStGraphicsPut(function)
;
;Input:
;
;   standard entry
;
;Output:
;
;   standard exit
;
;***************************************************************************


SsProc	PaletteUsing
	mov	dl,ET_I4		;Max type for PALETTE USING
	jmp	short PutGetUsing

SsProc	GPutGet
	mov	dl,ET_MaxNum		; Max type for PUT/GET
PutGetUsing:
	call	EmitExCopyOps		;Emit executor, copy operands for PUT
	pop	cx			; Get oTyp
	or	cl,cl
	jz	TMErr			;If not simple type, always wrong
	cmp	cl,dl			;Test for valid array type (numeric)
	jbe	PutGetX
TMErr:
	mov	ax,ER_TM		;Type mismatch error
	call	SsError
PutGetX:
	pop	bx			;BX = oTx of insertion point
	cmp	byte ptr es:[bx-4],0	;Is cDims == 0
	je	FixNoDimArray		;Brif yes, convert to AdRf
	xchg	ax,cx			;AX = oTyp w/Flags
	call	MakeRef 		;AX = AIdRf executor
	mov	PTRTX[bx-6],ax		;Update emitted code
	jmp	[ScanRet]		; and back to the main loop


sEnd	SCAN
	end