www.pudn.com > tp60src.zip > OPERS.ASM
model large compiler_text,pascal include compiler.inc .data? Oper db ? Chain1 dw ? Chain2 dw ? .code compiler_text public Operation public SetValue public _SetCondition public StoreBoolean Operation proc near mov Oper,al Invoke GetVarValue xchg si,di Invoke GetVarValue xchg si,di Invoke LoadPackedChar xchg si,di Invoke LoadPackedChar xchg si,di les bx,[di].exType mov al,es:[bx].tdType les bx,[si].exType cmp al,es:[bx].tdType jne @@1 mov ah,Oper cmp ax,ttInteger+opSlash*256 je @@2 cmp ax,ttChar+opPlus*256 jne @@5 @@1: Invoke ConvChar2String xchg si,di Invoke ConvChar2String xchg si,di @@2: cmp [di].exLocation,elImmediate jne @@4 cmp [si].exLocation,elImmediate jne @@4 @@3: Invoke ConvInt2Ext Invoke ConvReal2Ext xchg si,di Invoke ConvInt2Ext Invoke ConvReal2Ext xchg si,di jmp short @@5 @@4: test CompilerOptions,co8087 jnz @@3 Invoke ConvInt2Real Invoke ConvExt2Real xchg si,di Invoke ConvInt2Real Invoke ConvExt2Real xchg si,di @@5: Invoke TypeCompat les bx,[di].exType mov cl,es:[bx].tdType mov ax,1 shl ax,cl mov bl,Oper xor bh,bh shl bx,1 test ax,cs:@@8[bx] jz @@7 mov bl,cl xor bh,bh shl bx,1 shl bx,1 cmp [di].exLocation,elImmediate jne @@6 cmp [si].exLocation,elImmediate jne @@6 inc bx inc bx @@6: jmp cs:@@9[bx] @@7: mov ax,41 Chain CompileError @@8 dw tmSet+tmString+tm8087+tmReal+tmInteger+tmChar dw tmSet+tmPointer+tm8087+tmReal+tmInteger dw tmSet+tm8087+tmReal+tmInteger dw tmInteger dw tmInteger dw tmInteger dw tmInteger dw tmInteger+tmBoolean dw tmInteger+tmBoolean dw tmInteger+tmBoolean dw tmSet+tmPointer+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum dw tmSet+tmPointer+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum dw tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum dw tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum dw tmSet+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum dw tmSet+tmString+tm8087+tmReal+tmInteger+tmBoolean+tmChar+tmEnum dw tm8087+tmReal+tmInteger @@9 dw 0,0 dw 0,0 dw 0,0 dw 0,0 dw 0,0 dw 0,0 dw 0,0 dw SetOper,ISetOper dw OrdinalOper,IOrdinalOper dw StringOper,IStringOper dw Oper8087,IOper8087 dw RealOper,RealOper dw OrdinalOper,IOrdinalOper dw BooleanOper,IOrdinalOper dw OrdinalOper,IOrdinalOper dw OrdinalOper,IOrdinalOper Operation endp SetOper proc near cmp Oper,opEqual jae @@1 Invoke LoadSet jmp short @@2 @@1: Invoke _LoadSet @@2: xchg si,di Invoke _LoadSet xchg si,di cmp Oper,opLEq jne @@3 xchg si,di @@3: Invoke Push2Addrs Invoke Use2Exprs mov cl,Oper cmp cl,opLEq jne @@4 xchg si,di @@4: mov ax,_ZUnion cmp cl,opPlus je @@7 mov ax,_ZDifference cmp cl,opMinus je @@7 mov ax,_ZIntersect cmp cl,opTimes je @@7 mov ax,_ZEqual cmp cl,opEqual je @@5 cmp cl,opNotEqual je @@5 mov ax,_ZRelation @@5: Invoke PutSystemCall Invoke DoneExpr mov [di].exRegsUsed,erAll mov al,cdEqual cmp Oper,opNotEqual jne @@6 mov al,cdNotEqual @@6: jmp _SetCondition @@7: Invoke PutSystemCall Invoke DoneExpr mov [di].exRegsUsed,erAll ret SetOper endp ISetOper proc near push si di mov si,[si].exOffset mov di,[di].exOffset push ds pop es mov cx,16 mov al,Oper cmp al,opPlus je @@6 cmp al,opMinus je @@7 cmp al,opTimes je @@8 cmp al,opEqual je @@2 cmp al,opNotEqual je @@2 cmp al,opLEq jne @@1 xchg si,di @@1: lodsw or ax,[di] scasw jne @@3 loop @@1 jmp short @@3 @@2: rep cmpsw @@3: mov al,0 jne @@4 mov al,1 @@4: cmp Oper,opNotEqual jne @@5 xor al,1 @@5: pop di si jmp StoreBoolean @@6: lodsw or ax,[di] stosw loop @@6 jmp short @@9 @@7: lodsw not ax and ax,[di] stosw loop @@7 jmp short @@9 @@8: lodsw and ax,[di] stosw loop @@8 @@9: pop di si ret ISetOper endp StringOper proc near cmp Oper,opPlus jne @@1 Invoke LoadString xchg si,di Invoke PutImmedString xchg si,di Invoke Push2Addrs Invoke Use2Exprs mov ax,_SConcat Invoke PutSystemCall Invoke DoneExpr mov [di].exRegsUsed,erAll ret @@1: cmp [si].exLocation,elImmediate jne @@2 mov bx,[si].exOffset cmp byte ptr [bx],0 je @@3 @@2: cmp [di].exLocation,elImmediate jne @@4 mov bx,[di].exOffset cmp byte ptr [bx],0 jne @@4 call SwapOperands @@3: Invoke StringLength xor ax,ax mov [si].exModifier,al mov [si].exValue.W0,ax mov [si].exValue.W2,ax call IntCompare Chain DoneExpr @@4: Invoke PutImmedString xchg si,di Invoke PutImmedString xchg si,di Invoke Push2Addrs Invoke Use2Exprs mov ax,_SCompare Invoke PutSystemCall Invoke DoneExpr mov [di].exRegsUsed,erAll lea bx,UnsignedConds jmp SetCondition StringOper endp IStringOper proc near push di si mov di,[di].exOffset mov si,[si].exOffset push ds pop es cmp Oper,opPlus je @@1 xchg si,di Invoke CompareStrings pop si di jmp CheckCondition @@1: mov al,[di] mov dl,al add al,[si] jnc @@2 mov al,-1 @@2: xor ah,ah push ax inc ax Invoke AllocTempBuf pop ax push bx si xor ch,ch mov si,di mov di,bx stosb mov cl,dl inc si rep movsb pop si mov cl,al sub cl,dl inc si rep movsb pop bx si di mov [di].exOffset,bx ret IStringOper endp Oper8087 proc near Invoke Put8087Const xchg si,di Invoke Put8087Const xchg si,di mov al,Oper mov dh,30h ; fdiv cmp al,opSlash je @@1 mov dh,18h ; fcomp cmp al,opEqual jae @@1 mov dh,0 ; fadd cmp al,opPlus je @@1 mov dh,20h ; fsub cmp al,opMinus je @@1 mov dh,8 ; fmul @@1: cmp [di].exLocation,elStack je @@3 cmp [si].exLocation,elStack je @@2 test [di].exModifier,emExtended jnz @@3 test [si].exModifier,emExtended jz @@3 @@2: call Swap8087 @@3: test [si].exModifier,emExtended jz @@4 call Swap8087 push dx Invoke PushExt xchg si,di Invoke PushExt Invoke Use2Exprs xchg si,di Invoke PutEmulInt pop ax or ah,0c1h mov al,3ah Invoke PutWord jmp short @@5 @@4: push dx Invoke PushExt Invoke Use2Exprs pop dx mov dl,0d8h or dl,[si].exModifier xchg si,di Invoke PutFloatRM xchg si,di @@5: mov al,Oper cmp al,opSlash je @@6 cmp al,opEqual jb @@6 mov ax,2 Invoke AllocStack push ax mov dx,3eddh ; fstsw [bp-...] Invoke FloatAddOffset Invoke PutFwait pop ax inc ax mov dx,268ah ; mov ah,[bp-...] Invoke AddOffset mov al,9eh ; sahf Invoke PutByte Invoke DoneExpr mov al,erAX or al,[si].exRegsUsed or [di].exRegsUsed,al lea bx,UnsignedConds jmp SetCondition @@6: mov al,[si].exRegsUsed or [di].exRegsUsed,al Chain DoneExpr Oper8087 endp Swap8087 proc near push dx call SwapOperands pop dx test dh,20h jz @@1 xor dh,8 @@1: ret Swap8087 endp IOper8087 proc near lea bx,[di].exValue lea cx,[si].exValue mov al,Oper cmp al,opEqual jb @@1 cmp al,opSlash je @@1 Invoke CompareExtended jmp CheckCondition @@1: Chain ArithExtended IOper8087 endp RealOper proc near test CompilerOptions,co8087 jz @@1 Invoke ConvReal2Ext xchg si,di Invoke ConvReal2Ext xchg si,di jmp Oper8087 @@1: mov al,Oper cmp al,opSlash je @@3 cmp al,opEqual jae @@2 cmp al,opPlus je @@2 cmp al,opTimes jne @@3 @@2: cmp [si].exRegsUsed,0 je @@3 cmp [di].exRegsUsed,0 jne @@3 call SwapOperands @@3: cmp [si].exRegsUsed,0 jne @@4 Invoke UseExpr mov al,lrR1 Invoke LoadReal xchg si,di Invoke UseExpr mov al,lrR2 Invoke LoadReal xchg si,di jmp short @@5 @@4: xchg si,di Invoke UseExpr mov al,lrR1 Invoke LoadReal xchg si,di mov ax,5352h ; push dx push bx Invoke PutWord mov al,50h ; push ax Invoke PutByte Invoke UseExpr mov al,lrR1 Invoke LoadReal mov ax,59h ; pop cx Invoke PutByte mov ax,5f5eh ; pop si pop di Invoke PutWord @@5: mov al,Oper cmp al,opSlash je @@6 cmp al,opEqual jb @@6 mov ax,_RCmp Invoke PutSystemCall Invoke DoneExpr lea bx,UnsignedConds jmp SetCondition @@6: mov dx,_RAdd cmp al,opPlus je @@7 mov dx,_RSub cmp al,opMinus je @@7 mov dx,_RMul cmp al,opTimes je @@7 mov dx,_RDiv @@7: mov ax,dx Invoke PutSystemCall Chain DoneExpr RealOper endp BooleanOper proc near test CompilerOptions,coBooleanEval jnz @@3 cmp Oper,opOr je @@1 cmp Oper,opAnd jne @@3 @@1: Invoke Number2Cond xchg si,di Invoke Number2Cond xchg si,di Invoke UseExpr mov al,[di].exMisc lea bx,[di].exChain1 lea cx,[di].exChain2 cmp Oper,opOr je @@2 xor al,1 xchg bx,cx @@2: Invoke PutJmp mov bx,cx Invoke PutLabel xchg si,di Invoke UseExpr xchg si,di Invoke DoneExpr mov al,[si].exRegsUsed or [di].exRegsUsed,al lea bx,[di].exChain1 mov ax,[si].exChain1 Invoke AddToChain lea bx,[di].exChain2 mov ax,[si].exChain2 Invoke AddToChain mov al,[si].exMisc mov [di].exMisc,al ret @@3: Invoke Cond2Number xchg si,di Invoke Cond2Number xchg si,di OrdinalOper label near mov al,[di].exLocation mov ah,[si].exLocation cmp ax,elAddress+elImmediate*256 je @@4 cmp ax,elImmediate+elAddress*256 jne @@6 cmp Oper,opPlus jne @@6 call SwapOperands @@4: test [di].exMisc,efSeg jnz @@6 mov dx,[si].exValue.Offs mov al,Oper cmp al,opPlus je @@5 cmp al,opMinus jne @@6 neg dx @@5: add [di].exValue.Offs,dx ret @@6: Invoke LoadAddress xchg si,di Invoke LoadAddress xchg si,di mov al,[di].exModifier mov ah,[si].exModifier Invoke IntExtension cmp Oper,opAnd jae @@7 test al,emX jnz @@7 and al,emSigned or al,emX @@7: push ax Invoke ConvertOrdinal xchg si,di pop ax Invoke ConvertOrdinal xchg si,di call SwapIfNeeded cmp Oper,opEqual jb @@9 test [di].exModifier,emXX jnz @@8 call IntCompare jmp short @@14 @@8: call LongCompare jmp short @@14 @@9: test [di].exModifier,emXX jz @@10 mov al,erAX+erDX Invoke FreeRegs lea bx,LongOps jmp short @@13 @@10: cmp Oper,opTimes jne @@11 cmp [si].exLocation,elImmediate jne @@11 Invoke UseExpr mov al,lvAX mov cx,[si].exValue.W0 Invoke Scale jmp short @@14 @@11: mov al,erAX+erDX cmp Oper,opDiv je @@12 cmp Oper,opMod je @@12 mov al,erAX @@12: Invoke FreeRegs lea bx,WordOps @@13: mov al,Oper xor ah,ah shl ax,1 shl ax,1 add bx,ax mov dx,cs:[bx+2] xchg si,di call word ptr cs:[bx] xchg si,di @@14: Invoke DoneExpr mov al,[si].exRegsUsed or [di].exRegsUsed,al ret BooleanOper endp IOrdinalOper proc near cmp Oper,opEqual jb @@2 mov ax,[di].exValue.W2 add ah,80h mov dx,[si].exValue.W2 add dh,80h cmp ax,dx jne @@1 mov ax,[di].exValue.W0 cmp ax,[si].exValue.W0 @@1: jmp CheckCondition @@2: call LongArith jmp SetValue IOrdinalOper endp LongArith proc near mov bl,Oper xor bh,bh shl bx,1 push cs:@@1[bx] mov ax,[di].exValue.W0 mov dx,[di].exValue.W2 mov cx,[si].exValue.W0 mov bx,[si].exValue.W2 ret @@1 dw @@Add dw @@Sub dw @@Mul dw @@Div dw @@Mod dw @@Shl dw @@Shr dw @@And dw @@Or dw @@Xor @@Add: add ax,cx adc dx,bx ret @@Sub: sub ax,cx sbb dx,bx ret @@Mul: Chain MulLong @@Div: Chain DivLong @@Mod: Invoke DivLong mov ax,cx mov dx,bx ret @@Shl: and cx,1fh jz @@3 @@2: shl ax,1 rcl dx,1 loop @@2 @@3: ret @@Shr: and cx,1fh jz @@5 @@4: shr dx,1 rcr ax,1 loop @@4 @@5: ret @@And: and ax,cx and dx,bx ret @@Or: or ax,cx or dx,bx ret @@Xor: xor ax,cx xor dx,bx ret LongArith endp SetValue proc near mov [di].exValue.W0,ax mov [di].exValue.W2,dx Invoke FitConstType mov [di].exModifier,al ret SetValue endp WordOps dw WordAdd,4000h ; add, inc dw WordAdd,4828h ; sub, dec dw WordMul,20f7h ; mul dw WordDiv,30f7h ; div dw WordMod,30f7h ; div dw WordShl,0e0d1h ; shl dw WordShl,0e8d1h ; shr dw WordAnd,20h ; and dw WordAnd,8 ; or dw WordAnd,30h ; xor WordAdd proc near cmp [di].exLocation,elImmediate jne WordAnd mov ax,[di].exValue.W0 dec ax jz @@1 dec ax jnz WordAnd call @@1 @@1: mov al,dh Chain PutByte WordAdd endp WordAnd proc near Chain PutArOpAX WordAnd endp WordDiv proc near cmp [di].exLocation,elImmediate jne DivMod mov cx,[di].exValue.W0 jcxz @@1 Chain BackScale @@1: mov ax,62 Chain CompileError WordDiv endp DivMod proc near test [di].exModifier,emSigned jz @@1 or dh,8 ; idiv @@1: test [di].exModifier,emUnsigned jz @@2 mov ax,0d231h ; xor dx,dx Invoke PutWord jmp short @@3 @@2: mov al,99h ; cwd Invoke PutByte @@3: cmp [di].exLocation,elImmediate jne @@4 push dx mov al,lvCX Invoke LoadValue pop dx WordMul label near @@4: Invoke AddReg or [di].exRegsUsed,erDX ret DivMod endp WordMod proc near call DivMod mov al,92h ; xchg ax,dx Chain PutByte WordMod endp WordShl proc near cmp [di].exLocation,elImmediate jne @@2 cmp [di].exValue.B0,1 jne @@1 mov ax,dx Chain PutWord @@1: test CompilerOptions,co286Code jz @@2 mov ax,dx and al,0efh Invoke PutWord mov al,[di].exValue.B0 Chain PutByte @@2: push dx mov al,lvCX Invoke LoadValue pop ax or al,2 Chain PutWord WordShl endp IntCompare proc near cmp [di].exLocation,elMemory jne @@1 cmp [si].exLocation,elImmediate jne @@1 Invoke UseExpr mov ax,[si].exValue.W0 mov dl,38h ; cmp Invoke PutArOpRMImm jmp short @@4 @@1: mov al,erAX Invoke FreeRegs cmp [si].exLocation,elImmediate jne @@3 cmp [si].exValue.W0,0 jne @@3 mov ax,0c009h ; or ax,ax test [di].exModifier,emX jnz @@2 mov ax,0c008h ; or al,al @@2: Invoke PutWord jmp short @@4 @@3: xchg si,di mov dl,38h ; cmp Invoke PutArOpAX xchg si,di @@4: lea bx,SignedConds test [di].exModifier,emUnsigned jz @@5 lea bx,UnsignedConds @@5: jmp SetCondition IntCompare endp LongOps dw LongAdd,1000h ; add, adc dw LongAdd,1828h ; sub, sbb dw LongMul,_LongMul dw LongMul,_LongDiv dw LongMod,_LongDiv dw LongMul,_LongShl dw LongMul,_LongShr dw LongAdd,20h ; and dw LongAdd,8 ; or dw LongAdd,30h ; xor LongAdd proc near push dx Invoke PutArOpAX mov ax,2 Invoke SwapSegOfs pop dx or dh,dh jz @@1 mov dl,dh Chain PutArOp @@1: Chain PutLogOp LongAdd endp LongMul proc near push dx mov al,lvCX Invoke LoadValue pop ax Chain PutSystemCall LongMul endp LongMod proc near call LongMul mov ax,0c889h ; mov ax,cx Invoke PutWord mov ax,0da89h ; mov dx,bx Chain PutWord LongMod endp LongCompare proc near xor ax,ax mov Chain1,ax mov Chain2,ax cmp [si].exLocation,elImmediate jne @@4 mov ax,[si].exValue.W0 or ax,[si].exValue.W2 jnz @@3 mov al,Oper cmp al,opEqual je @@1 cmp al,opNotEqual jne @@3 @@1: cmp [di].exLocation,elMemory jne @@2 Invoke UseExpr and [di].exModifier,not emXX mov al,lvAX Invoke LoadReg add [di].exValue.Offs,2 mov dx,8 ; or Invoke PutArOpAX or [di].exRegsUsed,erAX jmp short @@5 @@2: Invoke UseExpr mov ax,0d009h ; or ax,dx Invoke PutWord jmp short @@5 @@3: cmp [di].exLocation,elMemory jne @@4 Invoke UseExpr add [di].exValue.Offs,2 mov ax,[si].exValue.W2 mov dl,38h ; cmp Invoke PutArOpRMImm call TwoConditions sub [di].exValue.Offs,2 mov ax,[si].exValue.W0 mov dl,38h ; cmp Invoke PutArOpRMImm jmp short @@5 @@4: mov al,erAX+erDX Invoke FreeRegs xchg si,di mov ax,2 Invoke SwapSegOfs mov dl,38h ; cmp Invoke PutArOp call TwoConditions mov ax,-2 Invoke SwapSegOfs mov dl,38h ; cmp Invoke PutArOpAX xchg si,di @@5: lea bx,UnsignedConds call SetCondition mov ax,Chain1 mov [di].exChain1,ax mov ax,Chain2 mov [di].exChain2,ax ret LongCompare endp TwoConditions proc near mov bl,Oper xor bh,bh shl bx,1 mov ax,cs:@@3[bx-opEqual*2] or al,al jz @@1 push ax lea bx,Chain1 Invoke PutJmp pop ax @@1: mov al,ah or al,al jz @@2 lea bx,Chain2 Chain PutJmp @@2: ret @@3 dw cdNotEqual*256 dw cdNotEqual dw cdGreater+cdLess*256 dw cdLess+cdGreater*256 dw cdGreater+cdLess*256 dw cdLess+cdGreater*256 TwoConditions endp SwapIfNeeded proc near mov al,Oper cmp al,opEqual jae @@1 cmp al,opPlus je @@1 cmp al,opTimes je @@1 cmp al,opAnd je @@1 cmp al,opOr je @@1 cmp al,opXor jne @@2 @@1: cmp [si].exLocation,elImmediate je @@2 cmp [di].exLocation,elImmediate je SwapOperands cmp [si].exRegsUsed,0 je @@2 cmp [di].exRegsUsed,0 je SwapOperands cmp [si].exRegsUsed,erAll je @@2 cmp [di].exRegsUsed,erAll je SwapOperands @@2: ret SwapIfNeeded endp SwapOperands proc near mov cx,size TExpr shr 1 @@1: mov ax,[si] xchg ax,[di] mov [si],ax add di,2 add si,2 loop @@1 sub di,size TExpr sub si,size TExpr mov al,Oper cmp al,opSlash je @@2 cmp al,opGreater jb @@2 xor Oper,1 @@2: ret SwapOperands endp SetCondition proc near mov al,Oper sub al,opEqual segcs xlat _SetCondition label near mov [di].exLocation,elCondition mov [di].exModifier,emBoolean mov [di].exMisc,al l4b7f: xor ax,ax mov [di].exChain1,ax l4b84: mov [di].exChain2,ax Chain CastBoolean SetCondition endp UnsignedConds db cdEqual,cdNotEqual,cdAfter,cdBelow,cdNotBelow,cdNotAfter SignedConds db cdEqual,cdNotEqual,cdGreater,cdLess,cdNotLess,cdNotGreater CheckCondition proc near lahf mov bl,Oper xor bh,bh shl bx,1 shl bx,1 add bx,offset @@1-opEqual*4 mov al,1 sahf jmp bx @@1: jz @@3 jmp short @@2 jnz @@3 jmp short @@2 ja @@3 jmp short @@2 jb @@3 jmp short @@2 jae @@3 jmp short @@2 jbe @@3 @@2: mov al,0 StoreBoolean label near @@3: cbw cwd mov [di].exModifier,emBoolean mov [di].exValue.W0,ax mov [di].exValue.W2,dx Chain CastBoolean CheckCondition endp end