ssoperat.asm

Microsoft MS-DOS6.0 完整源代码

;	    change the integer constant to the appropriate single constant
;	Else
;	    Enter the coercion executor table to find the coercion
;	    routine (or an error, if the types are not compatible).
;   Emit executor for current opcode
;   Push emit type entry on stack
;
;Input:
;
;   es:si = pcode emission address
;
;Output:
;
;   si updated
;
;Modifies:
;
;Exceptions:
;
;   Ss_Error
;
;******************************************************************
;
	page


SsProc	PaintWidth
	mov	ax,ET_I2
	call	EnsureArgType		;Eat an integer from the stack
	SKIP2_PSW			;Complete through Ss_1FnPExe


SsProc	1FnPExe
	;Get EXE map address and rule address for this opcode

	;Get output type indicator and coercion table address for this rule

	shr	bx,1			;Get opcode (for StWidth2, too)
	call	GetRuleInfo		;Get rule byte and word for opcode bx
					;ax = rule byte
					;bx = rule word
	xchg	ax,cx			; CX = Rule byte

	;Determine coercion required by expression fragment in stack entry

CoerceOk:
	pop	ax			;Type of consumed expression + high bits
	push	ax			; and preserve
	call	MSdFs
	xlat	BYTE PTR cs:[bx]	;Enter coercion table on type in al
	cbw
CoerceField:
	call	EnsureArgType		;Perform the coercion as required
	jmp	EmitTypeExeIdFrameX	;ax = argument type
					;cx = rule table byte
					;dx = executor map address

SsProc	1FnPExeR8
	    pop     ax			;AX = Type of operand + high bits
	    push    ax			;Preserve for EnsureArgType
	    .erre   ET_I2 and 1
	    .errnz  ET_I4 and 1
	    .erre   ET_R4 and 1
	    .errnz  ET_R8 and 1
	    shr     ax,1		;Carry set for I2, R4, and SD
	    mov     ax,ET_R8
	    .erre   ET_R4 EQ ET_R8 - 1
	    sbb     al,0		;AX = ET_R4 if source is I2, R4, or SD
	call	EnsureArgType		;Perform the coercion as required
	xchg	ax,cx			;Result type is operand type
	jmp	EmitDxIdFrameX		;Emit executor


	subttl	Ss_Coerce
	page
;***
;Ss_Coerce - Scan routine for explicit type coercion functionsd
;
;Purpose:
;
;   This scan routine handles intrinsic coercion functions.
;
;Algorithm:
;
;   Get target type from opcode
;   Index into executor map and fetch either new map or executor address
;   Get source operand type from scan stack entry
;   If target type is numeric
;      Coerce operand and emit executor.  Force error if source not numeric.
;   Else target type is string
;      Report error if source type is not string
;      Emit executor
;
;Input:
;
;   es:si = pcode emission address
;
;Output:
;
;   si updated
;
;Modifies:
;
;Exceptions:
;
;   Ss_Error
;
;******************************************************************

SsProc	Coerce
	xchg	ax,bx			;BX = Executor map map address
	mov	cl,byte ptr es:[si-1]	;CL = MSB of opcode
	shr	cl,1
	shr	cl,1
	xor	ch,ch			;CX = ET type of target
	add	bx,cx
	add	bx,cx
	mov	dx,cs:[bx]		;DX = address of executor or map


	mov	bx,scanOFFSET tCo1toNotSD


	jmp	short CoerceOk		;Continue

	subttl	Ss_Format
	page
;***
;Ss_Format - Scan routine for the Format$ function
;
;Purpose:
;
;   This scan routine handles opFnFormat_
;
;Algorithm:
;
;
;Input:
;
;   es:si = pcode emission address
;
;Output:
;
;   si updated
;
;Modifies:
;
;Exceptions:
;
;   Ss_Error
;
;******************************************************************



	subttl	MSdFs
	page
;***
;MSdFs	- map FS to SD
;Purpose:
;	Map type ET_FS to ET_SD
;
;Input:
;	ax = type with high bits set
;Output:
;	ax = input type - 1, but FS mapped to SD for
;	valid lookup in coercion tables
;Preserves:
;	All
;Exceptions:
;	If record type, type mismatch error is generated
;*******************************************************************************
;Rewritten with [11]

	public	MSdFs
MSdFs:
	push	bx
	xor	ah,ah
	mov	bx,scanOFFSET mpScanType
	xlat	mpScanType		;Map to coercion table index
	pop	bx
	or	al,al			;Valid type?
	js	TmErrorJ
	ret

TmErrorJ:
	xor	al,al			;Return valid index
	jmp	TmError

	;End of [11]


;===============================================================================
subttl	opcode to executor maps for math routines
page
;These tables are used by scan routines to map opcodes to executors.


	public	mptyppexFnStr_
mptyppexFnStr_	label	word
	DWEXT	exFnStr_I2
	DWEXT	exFnStr_I4
	DWEXT	exFnStr_R4
	DWEXT	exFnStr_R8

	public	mptyppexFnEnviron_
mptyppexFnEnviron_  label   word
	DWEXT	exFnEnviron_I2
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWEXT	exFnEnviron_SD



	public	mptyppexStWidth2
mptyppexStWidth2    label   word
	DWEXT	exStWidth2I2
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWEXT	exStWidth2SD

	public	mptyppexFnFre
mptyppexFnFre	label	word
	DWEXT	exFnFreI2
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWEXT	exFnFreSD


	public	mptyppexPrintItemComma
mptyppexPrintItemComma	label	word
	DWEXT	exPrintItemCommaI2
	DWEXT	exPrintItemCommaI4
	DWEXT	exPrintItemCommaR4
	DWEXT	exPrintItemCommaR8
	DWEXT	exPrintItemCommaSD

	public	mptyppexPrintItemSemi
mptyppexPrintItemSemi	label	word
	DWEXT	exPrintItemSemiI2
	DWEXT	exPrintItemSemiI4
	DWEXT	exPrintItemSemiR4
	DWEXT	exPrintItemSemiR8
	DWEXT	exPrintItemSemiSD

	public	mptyppexPrintItemEos
mptyppexPrintItemEos	label	word
	DWEXT	exPrintItemEosI2
	DWEXT	exPrintItemEosI4
	DWEXT	exPrintItemEosR4
	DWEXT	exPrintItemEosR8
	DWEXT	exPrintItemEosSD

	public	mptyppexStPaint
mptyppexStPaint label	word
	DWEXT	exStPaint2
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWFILL					; placeholder
	DWEXT	exStPaint2Tile

	public	mptyppexCoord
mptyppexCoord	label	word
	DWEXT	exCoordI2
	DWFILL					; placeholder
	DWEXT	exCoordR4

	public	mptyppexCoordStep
mptyppexCoordStep   label   word
	DWEXT	exCoordStepI2
	DWFILL					; placeholder
	DWEXT	exCoordStepR4

	public	mptyppexCoordSecond
mptyppexCoordSecond label   word
	DWEXT	exCoordSecondI2
	DWFILL					; placeholder
	DWEXT	exCoordSecondR4

	public	mptyppexCoordStepSecond
mptyppexCoordStepSecond label	word
	DWEXT	exCoordStepSecondI2
	DWFILL					; placeholder
	DWEXT	exCoordStepSecondR4

	public	mptyppexFnPoint2
mptyppexFnPoint2    label   word
	DWEXT	exFnPoint2I2
	DWFILL					; placeholder
	DWEXT	exFnPoint2R4


	public	mptyppexWatchExp
mptyppexWatchExp    label   word
	DWEXT	exWatchExpI2
	DWEXT	exWatchExpI4
	DWEXT	exWatchExpR4
	DWEXT	exWatchExpR8
	DWEXT	exWatchExpSD

	public	mptyppexFnHex_
mptyppexFnHex_	label	word
	DWEXT	exFnHex_I2
	DWEXT	exFnHex_I4

	public	mptyppexFnOct_
mptyppexFnOct_	label	word
	DWEXT	exFnOct_I2
	DWEXT	exFnOct_I4




	public	mptyppexCoerce				
mptyppexCoerce	 equ	 $-2				
	DW	scanOFFSET mptyppexFnCInt		
	DW	scanOFFSET mptyppexFnCLng		
	DW	scanOFFSET mptyppexFnCSng
	DW	scanOFFSET mptyppexFnCDbl		

mptyppexFnCInt	label	word
	DWEXT	exFnCIntI2
	DWEXT	exFnCIntI4
	DWEXT	exFnCIntR8
	DWEXT	exFnCIntR8

mptyppexFnCLng	label	word
	DWEXT	exFnCLngI2
	DWEXT	exFnCLngI4
	DWEXT	exFnCLngR8
	DWEXT	exFnCLngR8

mptyppexFnCSng	label	word
	DWEXT	exFnCSngI2
	DWEXT	exFnCSngI4
	DWEXT	exFnCSngR8
	DWEXT	exFnCSngR8

mptyppexFnCDbl	label	word
	DWEXT	exFnCDblI2
	DWEXT	exFnCDblI4
	DWEXT	exFnCDblR8
	DWEXT	exFnCDblR8

sEnd	SCAN
end