www.pudn.com > tp60src.zip > ARITH.ASM
model large compiler_text,pascal include compiler.inc extrn ExtAdd:far extrn ExtSub:far extrn ExtMul:far extrn ExtDiv:far extrn ExtCmp:far extrn Ext2Double:far extrn Ext2Single:far extrn Double2Ext:far extrn Single2Ext:far extrn Ext2Comp:far extrn Ext2Long:far extrn Comp2Ext:far extrn Long2Ext:far extrn Ext2Real:far extrn Real2Ext:far extrn Str2Ext:far extrn Ext2Str:far .code compiler_text public MulLong public DivLong public Str2Long public Str2DecLong public CheckFpu public ArithExtended public CompareExtended public Str2Extended public Extended2Str public Long2Extended public TruncExtended public Real2Extended public Extended2Real public Float2Extended public Extended2Float MulLong proc near push si di mov si,ax mov di,dx mul cx push ax dx mov ax,si mul bx mov bx,ax mov ax,di mul cx mov cx,ax pop dx ax add dx,bx add dx,cx pop di si ret MulLong endp DivLong proc near push si di bp mov bp,cx or bp,bx jz @@8 or bx,bx pushf jns @@1 not cx not bx add cx,1 adc bx,0 @@1: or dx,dx pushf jns @@2 not ax not dx add ax,1 adc dx,0 @@2: mov si,cx mov di,bx xor cx,cx xor bx,bx mov bp,33 @@3: rcl cx,1 rcl bx,1 sub cx,si sbb bx,di jnc @@4 add cx,si adc bx,di @@4: cmc rcl ax,1 rcl dx,1 dec bp jnz @@3 popf jns @@5 not cx not bx add cx,1 adc bx,0 popf jns @@6 jmp short @@7 @@5: popf jns @@7 @@6: not ax not dx add ax,1 adc dx,0 @@7: pop bp di si ret @@8: mov ax,62 Chain CompileError DivLong endp Str2Long proc near cmp byte ptr [si],'$' jne Str2DecLong inc si jmp Str2HexLong Str2Long endp Str2DecLong proc near xor ax,ax xor dx,dx mov bx,si @@1: mov cl,[si] xor ch,ch sub cl,'0'+10 add cl,10 jnc @@2 test dx,0f000h jnz @@3 push cx shl ax,1 rcl dx,1 push dx push ax shl ax,1 rcl dx,1 shl ax,1 rcl dx,1 pop cx add ax,cx pop cx adc dx,cx pop cx add ax,cx adc dx,0 js @@3 inc si jmp @@1 @@2: cmp si,bx ja @@4 @@3: stc @@4: ret Str2DecLong endp Str2HexLong proc near xor ax,ax xor dx,dx mov bx,si @@1: mov cl,[si] cmp cl,'a' jb @@2 sub cl,'a'-'A' @@2: sub cl,'0'+10 add cl,10 jc @@3 sub cl,'F'-'0'+1 add cl,'F'-'A'+1 jnc @@5 add cl,10 @@3: mov ch,4 @@4: shl ax,1 rcl dx,1 jc @@6 dec ch jnz @@4 or al,cl inc si jmp @@1 @@5: cmp si,bx ja @@7 @@6: stc @@7: ret Str2HexLong endp CheckFpu proc near noemul fninit push bx xor bx,bx push bx mov bx,sp fnstcw [bx] mov bx,20 @@1: dec bx jnz @@1 pop bx and bx,0f3fh cmp bx,033fh pop bx ret CheckFpu endp ArithExtended proc near push es bx ds bx ds cx cmp al,opPlus je @@1 cmp al,opMinus je @@2 cmp al,opTimes je @@3 call ExtDiv jmp short @@4 @@1: call ExtAdd jmp short @@4 @@2: call ExtSub jmp short @@4 @@3: call ExtMul @@4: cld pop bx es mov ax,[bx].W8 and ax,7fffh cmp ax,7fffh je @@5 ret @@5: mov ax,140 Chain CompileError ArithExtended endp CompareExtended proc near push es ds bx ds cx call ExtCmp cld pop es add al,80h cmp al,80h ret CompareExtended endp Str2Extended proc near push es bx ds si ds bx call Str2Ext cld pop bx es add si,ax mov ax,[bx].W8 and ax,7fffh inc ax shl ax,1 ret Str2Extended endp Extended2Str proc near push es bx dx mov dx,sp push ds bx ax ds dx ds si call Ext2Str cld pop dx bx es ret Extended2Str endp Long2Extended proc near push es bx push dword ptr [bx] push ds bx call Long2Ext cld pop bx es ret Long2Extended endp TruncExtended proc near push es or al,al jz @@3 push bx ds bx lea ax,@@5 push cs ax test [bx].B9,80h jz @@1 call ExtSub jmp short @@2 @@1: call ExtAdd @@2: pop bx @@3: push bx ds bx call Ext2Long cld pop bx mov [bx].W0,ax mov [bx].W2,dx shl dx,1 jnc @@4 or ax,dx jnz @@4 mov ax,76 Chain CompileError @@4: pop es ret @@5 dt 0.5 TruncExtended endp Real2Extended proc near push es bx ds bx ds bx call Real2Ext cld pop bx es ret Real2Extended endp Extended2Real proc near push es bx ds bx ds bx call Ext2Real cld pop bx es mov ax,[bx].W0 and ax,[bx].W2 and ax,[bx].W4 inc ax jz @@1 ret @@1: mov ax,76 Chain CompileError Extended2Real endp Float2Extended proc near cmp al,emExtended je @@4 push es bx ds bx ds bx cmp al,emSingle je @@1 cmp al,emDouble je @@2 call Comp2Ext jmp short @@3 @@1: call Single2Ext jmp short @@3 @@2: call Double2Ext @@3: cld pop bx es @@4: ret Float2Extended endp Extended2Float proc near cmp al,emExtended je @@5 push es bx ds bx ds bx cmp al,emSingle je @@2 cmp al,emDouble je @@3 call Ext2Comp cld pop bx es mov ax,[bx].W6 shl ax,1 jnc @@5 or ax,[bx].W0 or ax,[bx].W2 or ax,[bx].W4 jnz @@5 @@1: mov ax,76 Chain CompileError @@2: call Ext2Single cld pop bx es mov ax,[bx].W2 mov dx,7f80h jmp short @@4 @@3: call Ext2Double cld pop bx es mov ax,[bx].W6 mov dx,7ff0h @@4: and ax,dx cmp ax,dx je @@1 @@5: ret Extended2Float endp end