{*******************************************************} { } { WHY not a compiler? by Y [05-04-00] } { 386 assembler code generator } { } { Copyright (c) 1999-2000 CROWELL, Inc. } { All Rights Reserved. } { } {*******************************************************} unit CCodeGenerator; {.$DEFINE DEBUG} interface uses Objects, CConstants; const cRegisterNameLength = 3; type TCacheRegister = String[cRegisterNameLength]; TCacheRegisterValue = record Stored: Boolean; {True if Value contains valid information} Value: LongInt; {32-bit register content} end; {TCacheRegisterValue} const cBufferSize = 16384; cMaxCachedElements = 5; cValidCacheRegisters: array [1..cMaxCachedElements] of TCacheRegister = ('EAX', 'EBX', 'ECX', 'EDX', 'EDI'); type PCodeGenerator = ^TCodeGenerator; TCodeGenerator = object(TObject) FileName: String; OutStream: TBufStream; Status: Integer; LastLabel, LastVariable, LastLineNumber: Integer; DebugInfoEmitted: Boolean; {optimization feature: cache} CachedElements: Integer; {0 thru cMaxCachedElements} CacheRegisters: array [1..cMaxCachedElements] of TCacheRegister; CacheValues: array[1..cMaxCachedElements] of TCacheRegisterValue; {private} procedure LoadCache(Elements: Integer); procedure FlushCache(Elements: Integer); function IsFreeCacheRegister: Boolean; function GetFreeCacheRegister: TCacheRegister; function IsCacheRegisterFree(Register1: TCacheRegister): Boolean; function CacheRegisterPosition(Register1: TCacheRegister): Integer; procedure PreserveCacheRegister(Register1: TCacheRegister); procedure RestoreCacheRegister(Register1: TCacheRegister); procedure SwapCacheRegisters(Register1, Register2: TCacheRegister); procedure FreeCacheRegister(Register1: TCacheRegister); procedure FlushCacheValue(Number: Integer); procedure FlushTopCacheValues(Count: Integer); procedure FlushDebugLineNumber; {public} constructor Init(aFileName: String); destructor Done; virtual; function GetNewLabel: String; function GetNewVariable: String; procedure Emit(Line: String); procedure EmitLine(Line: String); procedure EmitFirst; virtual; procedure EmitLast; virtual; procedure CodeSegment; procedure DataSegment; procedure EmitDebugLineNumber(LineNumber: LongInt); procedure EmitDebugSourceFile(aFileName: String); procedure EmitDataByte(Value: Byte); procedure EmitStringConstant(ConstantName: String; Value: String); procedure EmitDWordVariable(VariableName: String; Value: LongInt); procedure EmitStringVariable(VariableName: String; Value: String); procedure EmitDWordArray(VariableName: String; ArraySize: LongInt); procedure EmitStringArray(VariableName: String; ArraySize: LongInt); procedure EmitPublicSymbol(SymbolName: String); procedure EmitExternalSymbol(SymbolName: String; SymbolType: String); procedure EmitIncludeDirective(aFileName: String); procedure EmitIntegerEquate(Name: String; Value: LongInt); procedure EmitLabel(LabelName: String); procedure EmitComment(Comment: String); procedure EmitJmp(LabelName: String); procedure EmitWhileCode(LabelName: String; CacheState: String); procedure EmitUntilCode(LabelName: String; CacheState: String); function EmitToCode(LabelName1, LabelName2: String): String; {returns cache state} function EmitDoCode(LabelName1, LabelName2: String): String; {returns cache state} function EmitDowntoCode(LabelName1, LabelName2: String): String; {returns cache state} procedure EmitLoopCode(LabelName1, LabelName2: String; CacheState: String); function EmitIfCode(LabelName: String): String; {returns cache state} procedure EmitDropCode(Drops: Integer); procedure EmitDupCode; procedure EmitRotCode; procedure EmitSwapCode; procedure PushIntegerConstant(Value: Longint); procedure PushStringConstant(Value: String); procedure PushVariable(VariableName: String); procedure PushVariablePointer(VariableName: String); procedure PushVariablePointerUncached(VariableName: String); procedure PushLocalVariable(ProcedureName, VariableName: String); procedure Call(ProcedureName: String); procedure StartProcedureDefinition(ProcedureName: String); procedure FinishProcedureDefinition; procedure InitLocals(ProcedureName: String); procedure DoneLocals; procedure PerformOperation(Operation: String); {important optimization control routines} function GetCacheState: String; procedure SetCacheState(CacheState: String); procedure SetCacheTo(CacheState: String); end; type PHeaderGenerator = ^THeaderGenerator; THeaderGenerator = object(TCodeGenerator) procedure EmitFirst; virtual; procedure EmitLast; virtual; end; function ValidCacheString(S: String): String; implementation function ValidCacheString(S: String): String; var i, Position, MinPosition, FirstRegister: Integer; Temp: String; begin Temp := ''; for i := 1 to Length(S) do if (UpCase(S[i]) in Letters) then Temp := Temp + UpCase(S[i]); S := ''; MinPosition := Length(Temp); FirstRegister := 0; while (MinPosition <> 0) do begin for i := 1 to cMaxCachedElements do begin Position := Pos(cValidCacheRegisters[i], Temp); if (Position <> 0) then begin if Position < MinPosition then begin MinPosition := Position; FirstRegister := i; end; end; end; if (MinPosition <> Length(Temp)) then begin S := S + Copy(Temp, MinPosition, cRegisterNameLength); Delete(Temp, MinPosition, cRegisterNameLength); MinPosition := Length(Temp); FirstRegister := 0; end else MinPosition := 0; end; ValidCacheString := S; end; {ValidCacheString} procedure TCodeGenerator.LoadCache(Elements: Integer); var Delta, i, j: Integer; Temp: TCacheRegister; begin if (Elements > cMaxCachedElements) then Elements := cMaxCachedElements; if (Elements > CachedElements) then begin {how many extra elements} Delta := (Elements - CachedElements); {fill in cache} for i := Delta downto 1 do begin {get free cache register} Temp := GetFreeCacheRegister; {move cache and add one element} for j := CachedElements downto 1 do begin CacheRegisters[j + 1] := CacheRegisters[j]; CacheValues[j + 1] := CacheValues[j]; end; {put top astack element to cache} Inc(CachedElements); CacheRegisters[1] := Temp; CacheValues[1].Stored := False; {generate code to read top element from astack} EmitLine( #9#9'MOV'#9 + Temp + ', [EBP + ' + IntToStr((Delta - i) * 4) + ']' ); end; {update astack counter} EmitLine( #9#9'ADD'#9'EBP, ' + IntToStr(Delta * 4) ); end; end; {TCodeGenerator.LoadCache} procedure TCodeGenerator.FlushCache; var i: Integer; begin if (Elements > CachedElements) then Elements := CachedElements; if (Elements <> 0) then begin {push some elements} EmitLine( #9#9'SUB'#9'EBP, ' + IntToStr(Elements * 4) {4 is EAX size in bytes} ); for i := 1 to Elements do if CacheValues[i].Stored then EmitLine( #9#9'MOV'#9'[EBP + ' + IntToStr((Elements - i) * 4) + '], dword ptr ' + IntToStr(CacheValues[i].Value) ) else EmitLine( #9#9'MOV'#9'[EBP + ' + IntToStr((Elements - i) * 4) + '], ' + CacheRegisters[i] ); {move the cache} for i := 1 to CachedElements - Elements do begin CacheRegisters[i] := CacheRegisters[Elements + i]; CacheValues[i] := CacheValues[Elements + i]; end; Dec(CachedElements, Elements); end; end; {TCodeGenerator.FlushCache} function TCodeGenerator.IsFreeCacheRegister: Boolean; begin IsFreeCacheRegister := (CachedElements < cMaxCachedElements); end; {TCodeGenerator.IsFreeCacheRegister} function TCodeGenerator.GetFreeCacheRegister: TCacheRegister; var Temp: TCacheRegister; Found, Busy: Boolean; Number, i: Integer; begin if (IsFreeCacheRegister) then begin Number := 1; Found := False; while (Number <= 4) and not Found do begin Busy := False; if (CachedElements <> 0) then for i := 1 to CachedElements do if (CacheRegisters[i] = cValidCacheRegisters[Number]) then Busy := True; if not Busy then Found := True else Inc(Number); end; Temp := cValidCacheRegisters[Number]; end else Temp := 'SUX'; GetFreeCacheRegister := Temp; end; {TCodeGenerator.GetFreeCacheRegister} function TCodeGenerator.IsCacheRegisterFree(Register1: TCacheRegister): Boolean; var Temp: Boolean; i: Integer; begin Temp := True; if (CachedElements <> 0) then for i := 1 to CachedElements do if (CacheRegisters[i] = Register1) then Temp := False; IsCacheRegisterFree := Temp; end; {TCodeGenerator.IsCacheRegisterFree} function TCodeGenerator.CacheRegisterPosition(Register1: TCacheRegister): Integer; var Temp: Integer; i: Integer; begin Temp := -1; if (CachedElements <> 0) then for i := 1 to CachedElements do if (CacheRegisters[i] = Register1) then Temp := i; CacheRegisterPosition := Temp; end; {TCodeGenerator.CacheRegisterPosition} procedure TCodeGenerator.PreserveCacheRegister(Register1: TCacheRegister); begin if not IsCacheRegisterFree(Register1) then begin FlushCacheValue(CacheRegisterPosition(Register1)); EmitLine( #9#9'PUSH'#9 + Register1 ); end; end; {TCodeGenerator.PreserveCacheRegister} procedure TCodeGenerator.RestoreCacheRegister(Register1: TCacheRegister); begin if not IsCacheRegisterFree(Register1) then EmitLine( #9#9'POP'#9 + Register1 ); end; {TCodeGenerator.RestoreCacheRegister} procedure TCodeGenerator.SwapCacheRegisters(Register1, Register2: TCacheRegister); var Pos1, Pos2, i: Integer; TempValue: TCacheRegisterValue; begin {perform a test} if (Register1 = Register2) then Exit; Pos1 := -1; Pos2 := -1; {find registers in the cache} for i := 1 to CachedElements do if CacheRegisters[i] = Register1 then Pos1 := i; for i := 1 to CachedElements do if CacheRegisters[i] = Register2 then Pos2 := i; {swap in cache} if (Pos1 <> -1) then if (Pos2 <> -1) then begin CacheRegisters[Pos1] := Register2; CacheRegisters[Pos2] := Register1; {TempValue := CacheValues[Pos1]; // we don't need to do it!!!!! CacheValues[Pos1] := CacheValues[Pos2]; CacheValues[Pos2] := TempValue;} end else begin {register1 found} FlushCacheValue(Pos1); CacheRegisters[Pos1] := Register2; end else if (Pos2 <> -1) then begin {register2 found} FlushCacheValue(Pos2); CacheRegisters[Pos2] := Register1; end else begin {no registers found} {nothing to do!} end; {exchange registers} {TODO: do we really need to do this every time???} EmitLine( #9#9'XCHG'#9 + Register1 + ', ' + Register2 ); end; {TCodeGenerator.SwapCacheRegisters} procedure TCodeGenerator.FreeCacheRegister(Register1: TCacheRegister); begin if (not IsCacheRegisterFree(Register1)) then begin if IsFreeCacheRegister then SwapCacheRegisters(Register1, GetFreeCacheRegister) else begin {free up single register} FlushCache(1); {free one cache register} {move it to the top} SwapCacheRegisters(Register1, GetFreeCacheRegister); end; end; end; {TCodeGenerator.FreeCacheRegister} procedure TCodeGenerator.FlushCacheValue(Number: Integer); begin if (Number > 0) and (Number <= CachedElements) then begin {$IFDEF DEBUG} EmitComment('FlushCacheValue(' + CacheRegisters[Number] + ')'); {$ENDIF DEBUG} if CacheValues[Number].Stored then begin FlushDebugLineNumber; CacheValues[Number].Stored := False; EmitLine( #9#9'MOV'#9 + CacheRegisters[Number] + ', ' + IntToStr(CacheValues[Number].Value) ); end; end; end; {TCodeGenerator.FlushCacheValue} procedure TCodeGenerator.FlushTopCacheValues(Count: Integer); var i: Integer; begin for i := CachedElements downto CachedElements - Count + 1 do if (i > 0) then FlushCacheValue(i); end; {TCodeGenerator.FlushTopCacheValues} {GetCacheState and SetCacheState used for cache sync. Example: // astack is: [EBP] ECX EDX "to" Sequence // astack is: EAX EBX ECX EDX "loop" Astack state after JMP instruction produced by EmitLoopCode() WILL NOT match the astack state before "to" code. Get/SetCacheState pair solves this problem: ... Sequence // astack is: EAX EBX ECX EDX SetCacheState('ECXEDX'); // astack is: [EBP] ECX EDX "loop" } function TCodeGenerator.GetCacheState: String; var Temp: String; i: Integer; begin Temp := ''; for i := 1 to CachedElements do Temp := Temp + CacheRegisters[i]; {$IFDEF DEBUG} EmitComment('GetCacheState() returns ' + Temp); {$ENDIF DEBUG} GetCacheState := Temp; end; {TCodeGenerator.GetCacheState} procedure TCodeGenerator.SetCacheState(CacheState: String); var i: Integer; Temp: String; begin {$IFDEF DEBUG} EmitComment('SetCacheState() performs ' + CacheState); {$ENDIF DEBUG} GetCacheState; {how many registers in cache?} i := Length(CacheState) div cRegisterNameLength; if (i = 0) then FlushCache(cMaxCachedElements) else begin if (i > CachedElements) then LoadCache(i); {TODO: remove this shit and implement optimal code} if (i < CachedElements) then FlushCache(CachedElements - i); {i = CachedElements} for i := 1 to CachedElements do begin {match registers} Temp := Copy(CacheState, (i - 1) * 3 + 1, 3); {ith register in cache} if (CacheRegisters[i] <> Temp) then SwapCacheRegisters(Temp, CacheRegisters[i]); end; end; end; {TCodeGenerator.SetCacheState} procedure TCodeGenerator.SetCacheTo(CacheState: String); var i: Integer; begin {how many registers in cache?} CachedElements := Length(CacheState) div cRegisterNameLength; for i := 1 to CachedElements do begin CacheRegisters[i] := Copy(CacheState, (i - 1) * 3 + 1, 3); CacheValues[i].Stored := False; end; end; {TCodeGenerator.SetCacheTo} constructor TCodeGenerator.Init(aFileName: String); begin FileName := aFileName; OutStream.Init(FileName, stCreate, cBufferSize); if (OutStream.Status = 0) then begin EmitLine( '; TCodeGenerator ' + Version + ' by Y [13-12-99]'#13#10 + '; Do not edit manually.'); EmitFirst; end; LastLabel := 0; LastVariable := 0; LastLineNumber := -1; CachedElements := 0; DebugInfoEmitted := False; end; {TCodeGenerator.Init} destructor TCodeGenerator.Done; begin EmitLast; EmitLine( '; End of file.'); OutStream.Done; Status := OutStream.Status; end; {TCodeGenerator.Done} procedure TCodeGenerator.EmitFirst; begin EmitLine(#13#10 + 'IFNDEF ??version'#13#10 + ' IF1'#13#10 + ' %out *** Error(1): assemble with TASM /m3'#13#10 + ' ENDIF'#13#10 + ' .ERR'#13#10 + 'ELSE'#13#10#13#10 + '.386p'#13#10 + '.MODEL FLAT'#13#10 + 'INCLUDE WHYRTL32.INC' ); if not (LowerCase(FileName) = 'system.asm') then EmitLine('INCLUDE SYSTEM.INC'); EmitLine( '.CODE'#13#10#13#10 + #9#9'?debug V 100h' ); end; {TCodeGenerator.EmitFirst} procedure TCodeGenerator.EmitLast; begin EmitLine( 'ENDIF'#13#10#13#10 + #9#9'END'#13#10); end; {TCodeGenerator.EmitLast} procedure TCodeGenerator.EmitDebugLineNumber(LineNumber: LongInt); var Temp: String; begin if (LineNumber > LastLineNumber) then begin LastLineNumber := LineNumber; {Str(LineNumber, Temp); EmitLine( #9#9'?debug L ' + Temp );} DebugInfoEmitted := True; end; end; {TCodeGenerator.EmitDebugLineNumber} procedure TCodeGenerator.FlushDebugLineNumber; var Temp: String; begin if DebugInfoEmitted then begin DebugInfoEmitted := False; Str(LastLineNumber, Temp); EmitLine( #9#9'?debug L ' + Temp ); end; end; {TCodeGenerator.FlushDebugLineNumber} procedure TCodeGenerator.EmitDebugSourceFile(aFileName: String); begin EmitLine( #9#9'?debug S "' + aFileName + '"' ); end; {TCodeGenerator.EmitDebugSourceFile} function TCodeGenerator.GetNewLabel: String; var Temp: String; begin Inc(LastLabel); Str(LastLabel, Temp); GetNewLabel := 'LBL' + Temp; end; {TCodeGenerator.GetNewLabel} function TCodeGenerator.GetNewVariable: String; var Temp: String; begin Inc(LastVariable); Str(LastVariable, Temp); GetNewVariable := 'VAR' + Temp; end; {TCodeGenerator.GetNewVariable} procedure TCodeGenerator.Emit(Line: String); begin if (OutStream.Status = 0) then OutStream.Write(Line[1], Length(Line)); Status := OutStream.Status; end; {TCodeGenerator.Emit} procedure TCodeGenerator.EmitLine(Line: String); const Temp: String = #13#10; begin if (OutStream.Status = 0) then begin {write line} OutStream.Write(Line[1], Length(Line)); {write CR/LF} if (OutStream.Status = 0) then OutStream.Write(Temp[1], 2); end; Status := OutStream.Status; end; {TCodeGenerator.EmitLine} procedure TCodeGenerator.CodeSegment; begin EmitLine( '.CODE' ); end; {TCodeGenerator.CodeSegment} procedure TCodeGenerator.DataSegment; begin EmitLine( '.DATA' ); end; {TCodeGenerator.DataSegment} procedure TCodeGenerator.EmitDataByte(Value: Byte); var Temp: String; begin Str(Value, Temp); EmitLine( #9#9'DB'#9 + Temp ); end; {TCodeGenerator.EmitDataByte} procedure TCodeGenerator.EmitStringConstant(ConstantName: String; Value: String); var i: Integer; Temp, S: String; Mode: (mString, mByte, mStart); {'"hello there"' - mString, '13, 10, 0' - mByte, '' - mStart} const cBytesPerString = 10; cMaxStringLength = 50; begin {EmitLine('PUBLIC'#9#9 + ConstantName);} EmitLine( ConstantName + #9#9'LABEL BYTE' ); Temp := ''; Mode := mStart; for i := 1 to Length(Value) do begin if Value[i] = '"' then begin if (Mode = mString) then Temp := Temp + '""' else if (Mode = mByte) then Temp := Temp + ', """' else {Mode = mStart} Temp := Temp + '"""'; Mode := mString; end else if (Value[i] in [#0..#$1F, #$F2..#$FF]) then begin Str(Byte(Value[i]), S); if (Mode = mByte) then Temp := Temp + ', ' + S else if (Mode = mString) then Temp := Temp + '", ' + S else {Mode = mStart} Temp := Temp + S; Mode := mByte; end else begin if (Mode = mString) then Temp := Temp + Value[i] else if (Mode = mByte) then Temp := Temp + ', "' + Value[i] else {Mode = mStart} Temp := Temp + '"' + Value[i]; Mode := mString; end; if (Length(Temp) >= cMaxStringLength) then begin if (Mode = mString) then EmitLine(#9#9'DB'#9 + Temp + '"') else EmitLine(#9#9'DB'#9 + Temp); Temp := ''; Mode := mStart; end; end; if (Temp <> '') then if (Mode = mString) then EmitLine(#9#9'DB'#9 + Temp + '", 0') else EmitLine(#9#9'DB'#9 + Temp + ', 0') else EmitLine(#9#9'DB'#9'0'); end; {TCodeGenerator.EmitStringConstant} procedure TCodeGenerator.EmitDWordVariable(VariableName: String; Value: LongInt); var Temp: String; begin Str(Value, Temp); EmitLine( VariableName + #9#9'DD'#9 + Temp ); end; {TCodeGenerator.EmitDWordVariable} procedure TCodeGenerator.EmitStringVariable(VariableName: String; Value: String); var Temp: String; begin if (Value <> '') then begin Temp := GetNewVariable; EmitLine( VariableName + #9#9'DD'#9 + Temp ); EmitStringConstant(Temp, Value); end else EmitLine( VariableName + #9#9'DD'#9'0'#9'; null string' ); end; {TCodeGenerator.EmitStringVariable} procedure TCodeGenerator.EmitDWordArray(VariableName: String; ArraySize: LongInt); var Temp: String; begin Str(ArraySize, Temp); EmitLine( VariableName + #9#9'DD'#9 + Temp + ' dup (?)' ); end; {TCodeGenerator.EmitDWordArray} procedure TCodeGenerator.EmitStringArray(VariableName: String; ArraySize: LongInt); var Temp: String; begin Str(ArraySize, Temp); EmitLine( VariableName + #9#9'DD'#9 + Temp + ' dup (0)'#9'; null strings' ); end; {TCodeGenerator.EmitStringArray} procedure TCodeGenerator.EmitPublicSymbol(SymbolName: String); begin EmitLine( 'PUBLIC'#9#9 + SymbolName ); end; {TCodeGenerator.EmitPublicSymbol} procedure TCodeGenerator.EmitExternalSymbol(SymbolName: String; SymbolType: String); begin EmitLine( 'EXTRN'#9#9'_' + SymbolName + ': ' + SymbolType ); end; {TCodeGenerator.EmitExternalSymbol} procedure TCodeGenerator.EmitIncludeDirective(aFileName: String); begin EmitLine( 'INCLUDE'#9#9 + aFileName ); end; {TCodeGenerator.EmitIncludeDirective} procedure TCodeGenerator.EmitIntegerEquate(Name: String; Value: LongInt); var Temp: String; begin Str(Value, Temp); EmitLine( #9#9 + Name + ' = ' + Temp ); end; {TCodeGenerator.EmitIntegerEquate} procedure TCodeGenerator.EmitLabel(LabelName: String); begin EmitLine( LabelName + ':' ); end; {TCodeGenerator.EmitLabel} procedure TCodeGenerator.EmitComment(Comment: String); begin EmitLine( '; ' + Comment ); end; {TCodeGenerator.EmitLabel} {code generation functions start here} procedure TCodeGenerator.EmitJmp(LabelName: String); begin FlushDebugLineNumber; EmitLine( #9#9'JMP'#9 + LabelName ); end; {TCodeGenerator.EmitJmp} {ATTENTION: CacheState must match GetCacheState() after "do"} procedure TCodeGenerator.EmitWhileCode(LabelName: String; CacheState: String); var Label1: String; MyCacheState: String; begin {$IFDEF DEBUG} EmitComment('EmitWhileCode()'); {$ENDIF DEBUG} FlushDebugLineNumber; Label1 := GetNewLabel; LoadCache(1); if CacheValues[CachedElements].Stored then {stack top register value} begin if (CacheValues[CachedElements].Value = 0) then begin EmitDropCode(1); EmitLine( #9#9'JMP'#9 + Label1 ); MyCacheState := GetCacheState; end else begin EmitDropCode(1); SetCacheState(CacheState); EmitLine( #9#9'JMP'#9 + LabelName ); MyCacheState := GetCacheState; end; end else begin EmitLine( #9#9'TEST'#9 + CacheRegisters[CachedElements] + ', ' + CacheRegisters[CachedElements] ); EmitDropCode(1); EmitLine( #9#9'JZ'#9 + Label1 ); MyCacheState := GetCacheState; SetCacheState(CacheState); EmitLine( #9#9'JMP'#9 + LabelName ); end; EmitLabel(Label1); SetCacheTo(MyCacheState); end; {TCodeGenerator.EmitWhileCode} {ATTENTION: CacheState must match GetCacheState() after "repeat"} procedure TCodeGenerator.EmitUntilCode(LabelName: String; CacheState: String); var Label1: String; MyCacheState: String; begin {$IFDEF DEBUG} EmitComment('EmitUntilCode()'); {$ENDIF DEBUG} FlushDebugLineNumber; Label1 := GetNewLabel; LoadCache(1); if CacheValues[CachedElements].Stored then {stack top register value} begin if (CacheValues[CachedElements].Value <> 0) then begin EmitDropCode(1); EmitLine( #9#9'JMP'#9 + Label1 ); MyCacheState := GetCacheState; end else begin EmitDropCode(1); SetCacheState(CacheState); EmitLine( #9#9'JMP'#9 + LabelName ); MyCacheState := GetCacheState; end; end else begin EmitLine( #9#9'TEST'#9 + CacheRegisters[CachedElements] + ', ' + CacheRegisters[CachedElements] ); EmitDropCode(1); EmitLine( #9#9'JNZ'#9 + Label1 ); MyCacheState := GetCacheState; SetCacheState(CacheState); EmitLine( #9#9'JMP'#9 + LabelName ); end; EmitLabel(Label1); SetCacheTo(MyCacheState); end; {TCodeGenerator.EmitUntilCode} function TCodeGenerator.EmitDoCode(LabelName1, LabelName2: String): String; var Temp: String; begin {$IFDEF DEBUG} EmitComment('EmitDoCode()'); {$ENDIF DEBUG} FlushDebugLineNumber; Temp := GetCacheState; LoadCache(2); if (CacheValues[CachedElements].Stored and CacheValues[CachedElements - 1].Stored) then begin if (CacheValues[CachedElements].Value >= CacheValues[CachedElements - 1].Value) then EmitLine( LabelName1 + ':'#13#10 + #9#9'JMP'#9 + LabelName2 ) else begin FlushCacheValue(CachedElements - 1); FlushCacheValue(CachedElements); EmitLine( LabelName1 + ':'#13#10 + #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] + #13#10 + #9#9'JLE'#9 + LabelName2 ); end; end else begin FlushCacheValue(CachedElements - 1); FlushCacheValue(CachedElements); EmitLine( LabelName1 + ':'#13#10 + #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] + #13#10 + #9#9'JLE'#9 + LabelName2 ); end; EmitDoCode := Temp; end; {TCodeGenerator.EmitDoCode} function TCodeGenerator.EmitDowntoCode(LabelName1, LabelName2: String): String; var Temp: String; begin {$IFDEF DEBUG} EmitComment('EmitDowntoCode()'); {$ENDIF DEBUG} FlushDebugLineNumber; Temp := GetCacheState; LoadCache(2); if (CacheValues[CachedElements].Stored and CacheValues[CachedElements - 1].Stored) then begin if (CacheValues[CachedElements].Value < CacheValues[CachedElements - 1].Value) then EmitLine( LabelName1 + ':'#13#10 + #9#9'JMP'#9 + LabelName2 ) else begin FlushCacheValue(CachedElements - 1); FlushCacheValue(CachedElements); EmitLine( LabelName1 + ':'#13#10 + #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] + #13#10 + #9#9'JG'#9 + LabelName2 ); end; end else begin FlushCacheValue(CachedElements - 1); FlushCacheValue(CachedElements); EmitLine( LabelName1 + ':'#13#10 + #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] + #13#10 + #9#9'JG'#9 + LabelName2 ); end; EmitDowntoCode := Temp; end; {TCodeGenerator.EmitDowntoCode} function TCodeGenerator.EmitToCode(LabelName1, LabelName2: String): String; var Temp: String; begin {$IFDEF DEBUG} EmitComment('EmitToCode()'); {$ENDIF DEBUG} FlushDebugLineNumber; Temp := GetCacheState; LoadCache(2); if (CacheValues[CachedElements].Stored and CacheValues[CachedElements - 1].Stored) then begin if (CacheValues[CachedElements].Value > CacheValues[CachedElements - 1].Value) then EmitLine( LabelName1 + ':'#13#10 + #9#9'JMP'#9 + LabelName2 ) else begin FlushCacheValue(CachedElements - 1); FlushCacheValue(CachedElements); EmitLine( LabelName1 + ':'#13#10 + #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] + #13#10 + #9#9'JL'#9 + LabelName2 ); end; end else begin FlushCacheValue(CachedElements - 1); FlushCacheValue(CachedElements); EmitLine( LabelName1 + ':'#13#10 + #9#9'CMP'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] + #13#10 + #9#9'JL'#9 + LabelName2 ); end; EmitToCode := Temp; end; {TCodeGenerator.EmitToCode} procedure TCodeGenerator.EmitLoopCode(LabelName1, LabelName2: String; CacheState: String); begin {$IFDEF DEBUG} EmitComment('EmitLoopCode()'); {$ENDIF DEBUG} FlushDebugLineNumber; SetCacheState(CacheState); EmitLine( #9#9'JMP'#9 + LabelName1 ); EmitLabel(LabelName2); end; {TCodeGenerator.EmitLoopCode} function TCodeGenerator.EmitIfCode(LabelName: String): String; var Temp: String; begin {$IFDEF DEBUG} EmitComment('EmitIfCode()'); {$ENDIF DEBUG} FlushDebugLineNumber; LoadCache(1); if CacheValues[CachedElements].Stored then begin if (CacheValues[CachedElements].Value = 0) then {False if} begin EmitDropCode(1); FlushTopCacheValues(cMaxCachedElements); Temp := GetCacheState; EmitLine( #9#9'JMP'#9 + LabelName ); end else {True if} begin EmitDropCode(1); FlushTopCacheValues(cMaxCachedElements); Temp := GetCacheState; end; end else begin FlushTopCacheValues(cMaxCachedElements); EmitLine( #9#9'TEST'#9 + CacheRegisters[CachedElements] + ', ' + CacheRegisters[CachedElements] ); EmitDropCode(1); Temp := GetCacheState; EmitLine( #9#9'JZ'#9 + LabelName ); end; EmitIfCode := Temp; end; {TCodeGenerator.EmitIfCode} procedure TCodeGenerator.EmitDropCode; var Delta, i: Integer; begin Delta := 0; for i := 1 to Drops do if CachedElements = 0 then Inc(Delta, 4) else Dec(CachedElements); if (Delta <> 0) then begin FlushDebugLineNumber; EmitLine( #9#9'ADD'#9'EBP, ' + IntToStr(Delta) ); end; end; {TCodeGenerator.EmitDropCode} procedure TCodeGenerator.EmitDupCode; var Temp: TCacheRegister; i: Integer; begin LoadCache(1); if (IsFreeCacheRegister) then begin Temp := GetFreeCacheRegister; if (CacheValues[CachedElements].Stored) then begin CacheValues[CachedElements + 1].Stored := True; CacheValues[CachedElements + 1].Value := CacheValues[CachedElements].Value; end else begin FlushDebugLineNumber; CacheValues[CachedElements + 1].Stored := False; EmitLine( #9#9'MOV'#9 + Temp + ', ' + CacheRegisters[CachedElements] ); end; CacheRegisters[CachedElements + 1] := Temp; Inc(CachedElements); end else begin Temp := CacheRegisters[1]; FlushDebugLineNumber; if CacheValues[1].Stored then EmitLine( #9#9'SUB'#9'EBP, 4'#13#10 + #9#9'MOV'#9'[EBP], dword ptr ' + IntToStr(CacheValues[1].Value) ) else EmitLine( #9#9'SUB'#9'EBP, 4'#13#10 + #9#9'MOV'#9'[EBP], ' + Temp ); for i := 1 to CachedElements - 1 do begin CacheRegisters[i] := CacheRegisters[i + 1]; CacheValues[i] := CacheValues[i + 1]; end; if (CacheValues[CachedElements - 1].Stored) then begin CacheValues[CachedElements].Stored := True; CacheValues[CachedElements].Value := CacheValues[CachedElements - 1].Value; end else begin CacheValues[CachedElements].Stored := False; EmitLine( #9#9'MOV'#9 + Temp + ', ' + CacheRegisters[CachedElements - 1] ); end; CacheRegisters[CachedElements] := Temp; end; end; {TCodeGenerator.EmitDupCode} procedure TCodeGenerator.EmitRotCode; var Temp: TCacheRegister; TempValue: TCacheRegisterValue; begin LoadCache(3); Temp := CacheRegisters[CachedElements]; TempValue := CacheValues[CachedElements]; CacheRegisters[CachedElements] := CacheRegisters[CachedElements - 1]; CacheValues[CachedElements] := CacheValues[CachedElements - 1]; CacheRegisters[CachedElements - 1] := CacheRegisters[CachedElements - 2]; CacheValues[CachedElements - 1] := CacheValues[CachedElements - 2]; CacheRegisters[CachedElements - 2] := Temp; CacheValues[CachedElements - 2] := TempValue; end; {TCodeGenerator.EmitRotCode} procedure TCodeGenerator.EmitSwapCode; var Temp: String; TempValue: TCacheRegisterValue; begin LoadCache(2); Temp := CacheRegisters[CachedElements]; TempValue := CacheValues[CachedElements]; CacheRegisters[CachedElements] := CacheRegisters[CachedElements - 1]; CacheValues[CachedElements] := CacheValues[CachedElements - 1]; CacheRegisters[CachedElements - 1] := Temp; CacheValues[CachedElements - 1] := TempValue; end; {TCodeGenerator.EmitSwapCode} procedure TCodeGenerator.PushIntegerConstant(Value: Longint); var Temp: String; begin if not (IsFreeCacheRegister) then FlushCache(1); {free one cache register} Temp := GetFreeCacheRegister; {must always succeed} Inc(CachedElements); CacheRegisters[CachedElements] := Temp; CacheValues[CachedElements].Stored := True; CacheValues[CachedElements].Value := Value; end; {TCodeGenerator.PushIntegerConstant} procedure TCodeGenerator.PushStringConstant(Value: String); var Variable1: String; begin Variable1 := GetNewVariable; DataSegment; EmitStringConstant(Variable1, Value); CodeSegment; PushVariablePointer(Variable1); end; {TCodeGenerator.PushStringConstant} procedure TCodeGenerator.PushVariable(VariableName: String); var Temp: TCacheRegister; begin if not (IsFreeCacheRegister) then FlushCache(1); {free one cache register} Temp := GetFreeCacheRegister; {must always succeed} FlushDebugLineNumber; EmitLine( #9#9'MOV'#9 + Temp + ', [' + VariableName + ']' ); Inc(CachedElements); CacheRegisters[CachedElements] := Temp; CacheValues[CachedElements].Stored := False; end; {TCodeGenerator.PushVariable} procedure TCodeGenerator.PushVariablePointer(VariableName: String); var Temp: TCacheRegister; begin if not (IsFreeCacheRegister) then FlushCache(1); {free one cache register} Temp := GetFreeCacheRegister; {must always succeed} FlushDebugLineNumber; EmitLine( #9#9'LEA'#9 + Temp + ', [' + VariableName + ']' ); Inc(CachedElements); CacheRegisters[CachedElements] := Temp; CacheValues[CachedElements].Stored := False; end; {TCodeGenerator.PushVariablePointer} procedure TCodeGenerator.PushVariablePointerUncached(VariableName: String); var Temp: TCacheRegister; begin FlushDebugLineNumber; EmitLine( #9#9'LEA'#9'EAX, [' + VariableName + ']'#13#10 + #9#9'SUB'#9'EBP, 4'#13#10 + #9#9'MOV'#9'[EBP], EAX' ); end; {TCodeGenerator.PushVariablePointerUncached} procedure TCodeGenerator.PushLocalVariable(ProcedureName, VariableName: String); var Temp: TCacheRegister; begin if not (IsFreeCacheRegister) then FlushCache(1); {free one cache register} Temp := GetFreeCacheRegister; {must always succeed} FlushDebugLineNumber; EmitLine( #9#9'LEA'#9 + Temp + ', [ESI - ' + ProcedureName + '_' + VariableName + ']' ); Inc(CachedElements); CacheRegisters[CachedElements] := Temp; CacheValues[CachedElements].Stored := False; end; {TCodeGenerator.PushLocalVariable} procedure TCodeGenerator.Call(ProcedureName: String); begin FlushDebugLineNumber; FlushCache(cMaxCachedElements); EmitLine( #9#9'CALL'#9'_' + ProcedureName ); end; {TCodeGenerator.Call} procedure TCodeGenerator.StartProcedureDefinition(ProcedureName: String); begin EmitComment('------------------------------------------------'); EmitLine('PUBLIC'#9#9 + '_' + ProcedureName); EmitLine( '_' + ProcedureName + #9#9'PROC' ); end; {TCodeGenerator.StartProcedureDefinition} procedure TCodeGenerator.FinishProcedureDefinition; begin FlushDebugLineNumber; EmitLine( #9#9'RET'#13#10 + #9#9'ENDP' ); end; {TCodeGenerator.FinishProcedureDefinition} procedure TCodeGenerator.InitLocals(ProcedureName: String); begin FlushDebugLineNumber; EmitLine( #9#9'PUSH'#9'ESI'#13#10 + #9#9'MOV'#9'ESI, ESP'#13#10 + #9#9'SUB'#9'ESP, ' + ProcedureName + '_LOCALS' ); end; {TCodeGenerator.InitLocals} procedure TCodeGenerator.DoneLocals; begin FlushDebugLineNumber; FlushCache(cMaxCachedElements); EmitLine( #9#9'MOV'#9'ESP, ESI'#13#10 + #9#9'POP'#9'ESI' ); end; {TCodeGenerator.DoneLocals} procedure TCodeGenerator.PerformOperation(Operation: String); var Temp: String; {simple binary operation template ;} procedure PerformBinaryOperation(Operation: SmallString); function CalculateValue(Value1, Value2: LongInt; Operation: SmallString): LongInt; var Temp: LongInt; begin if (Operation = '+') then Temp := Value1 + Value2 else if (Operation = '-') then Temp := Value1 - Value2 else if (Operation = '*') then Temp := Value1 * Value2 else if (Operation = '/') then if (Value2 <> 0) then Temp := Value1 div Value2 else Temp := -1 {divide by zero} else if (Operation = '%') then if (Value2 <> 0) then Temp := Value1 mod Value2 else Temp := -1 {divide by zero} else if (Operation = '&') then Temp := Value1 and Value2 else if (Operation = '|') then Temp := Value1 or Value2 else if (Operation = '^') then Temp := Value1 xor Value2 else if (Operation = '<<') then Temp := Value1 shl Value2 else if (Operation = '>>') then Temp := Value1 shr Value2 else Temp := 0; CalculateValue := Temp; end; {CalculateValue} {returns 'ADD' for '+' etc} function GetOperationString(Operation: SmallString): String; var Temp: String; begin if (Operation = '+') then Temp := 'ADD' else if (Operation = '-') then Temp := 'SUB' else if (Operation = '*') then Temp := 'IMUL' else if (Operation = '/') then Temp := 'IDIV' else if (Operation = '%') then Temp := 'IDIV' else if (Operation = '&') then Temp := 'AND' else if (Operation = '|') then Temp := 'OR' else if (Operation = '^') then Temp := 'XOR' else if (Operation = '<<') then Temp := 'SHL' else if (Operation = '>>') then Temp := 'SHR' else Temp := 'ADD'; GetOperationString := Temp; end; {GetOperationString} begin if (CacheValues[CachedElements].Stored) then if (CacheValues[CachedElements - 1].Stored) then {all values are known at compile time} CacheValues[CachedElements - 1].Value := {perform compile-time operation} CalculateValue(CacheValues[CachedElements - 1].Value, CacheValues[CachedElements].Value, Operation) else {value of [CachedElements - 1] element is unknown at compile time} begin FlushDebugLineNumber; EmitLine( #9#9 + GetOperationString(Operation) + #9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end else {no values are known at compile time} begin FlushDebugLineNumber; EmitLine( #9#9 + GetOperationString(Operation) + #9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] ); end; EmitDropCode(1); end; {PerformComparisonOperation} {comparison operation template ;} procedure PerformComparisonOperation(Operation: SmallString); function CompareValues(Value1, Value2: LongInt; Operation: SmallString): LongInt; var Temp: Boolean; begin if (Operation = '>') then Temp := Value1 > Value2 else if (Operation = '<') then Temp := Value1 < Value2 else if (Operation = '>=') then Temp := Value1 >= Value2 else if (Operation = '<=') then Temp := Value1 <= Value2 else if (Operation = '==') then Temp := Value1 = Value2 else if (Operation = '!=') or (Operation = '<>') then Temp := Value1 <> Value2 else Temp := False; CompareValues := LongInt(Temp); end; {CompareValues} {returns 'E' for '==', 'GE' for '>=', 'NE' for '!=' etc} function GetOperationString(Operation: SmallString): SmallString; var Temp: SmallString; begin if (Operation = '>') then Temp := 'G' else if (Operation = '<') then Temp := 'L' else if (Operation = '>=') then Temp := 'GE' else if (Operation = '<=') then Temp := 'LE' else if (Operation = '==') then Temp := 'E' else if (Operation = '!=') or (Operation = '<>') then Temp := 'NE' else Temp := 'E'; GetOperationString := Temp; end; {GetOperationString} begin if (CacheValues[CachedElements].Stored) then if (CacheValues[CachedElements - 1].Stored) then {all values are known at compile time} CacheValues[CachedElements - 1].Value := {perform compile-time comparison} CompareValues(CacheValues[CachedElements - 1].Value, CacheValues[CachedElements].Value, Operation) else {value of [CachedElements - 1] element is unknown at compile time} begin SwapCacheRegisters('ECX', CacheRegisters[CachedElements - 1]); FlushDebugLineNumber; EmitLine( #9#9'CMP'#9'ECX, ' + IntToStr(CacheValues[CachedElements].Value) + #13#10 + #9#9'MOV'#9'ECX, 0'#13#10 + #9#9'SET' + GetOperationString(Operation) + #9'CL'); end else {values are known at compile time} begin SwapCacheRegisters('ECX', CacheRegisters[CachedElements - 1]); Temp := CacheRegisters[CachedElements]; FlushDebugLineNumber; EmitLine( #9#9'CMP'#9'ECX, ' + Temp + #13#10 + #9#9'MOV'#9'ECX, 0'#13#10 + #9#9'SET' + GetOperationString(Operation) + #9'CL'); end; EmitDropCode(1); end; {PerformComparisonOperation} begin {TODO: place things here} {$IFDEF DEBUG} EmitComment('PerformOperation(): ' + Operation); {$ENDIF DEBUG} {load cache with one or two top astack element(s)} if (Operation <> '->') and (Operation <> '.>') and (Operation <> '++') and (Operation <> '--') and (Operation <> '!') then LoadCache(2) else LoadCache(1); if (Operation = '+') then {add} begin if (CacheValues[CachedElements].Stored) then if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value + CacheValues[CachedElements].Value else begin FlushDebugLineNumber; EmitLine( #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); FlushDebugLineNumber; EmitLine( #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] ); end; EmitDropCode(1); end else if (Operation = '-') then {substract} begin if (CacheValues[CachedElements].Stored) then if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value - CacheValues[CachedElements].Value else begin FlushDebugLineNumber; EmitLine( #9#9'SUB'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); FlushDebugLineNumber; EmitLine( #9#9'SUB'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] ); end; EmitDropCode(1); end else if (Operation = '*') then {multiply} begin if (CacheValues[CachedElements].Stored and CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value * CacheValues[CachedElements].Value else if (CacheValues[CachedElements].Stored) then begin FlushCacheValue(CachedElements - 1); {will never be performed ;} EmitLine( #9#9'IMUL'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); EmitLine( #9#9'IMUL'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] ); end; EmitDropCode(1); end else if (Operation = '/') then {divide} begin if (CacheValues[CachedElements].Stored and CacheValues[CachedElements - 1].Stored) then if (CacheValues[CachedElements].Value <> 0) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value div CacheValues[CachedElements].Value else CacheValues[CachedElements - 1].Value := -1 {divide by zero} else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); FreeCacheRegister('EDX'); SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]); Temp := CacheRegisters[CachedElements]; FlushDebugLineNumber; EmitLine( #9#9'CDQ'#13#10 + #9#9'IDIV'#9 + Temp ); end; EmitDropCode(1); end else if (Operation = '%') then {get division remainder} begin if (CacheValues[CachedElements].Stored and CacheValues[CachedElements - 1].Stored) then begin if (CacheValues[CachedElements].Value <> 0) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value mod CacheValues[CachedElements].Value else CacheValues[CachedElements - 1].Value := -1; {divide by zero} EmitDropCode(1); end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); FreeCacheRegister('EDX'); SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]); Temp := CacheRegisters[CachedElements]; FlushDebugLineNumber; EmitDropCode(1); EmitLine( #9#9'CDQ'#13#10 + #9#9'IDIV'#9 + Temp ); CacheRegisters[CachedElements] := 'EDX'; end; end else if (Operation = '&') then {bitwise and} begin if (CacheValues[CachedElements].Stored) then if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value and CacheValues[CachedElements].Value else begin FlushDebugLineNumber; EmitLine( #9#9'AND'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); FlushDebugLineNumber; EmitLine( #9#9'AND'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] ); end; EmitDropCode(1); end else if (Operation = '|') then {bitwise or} begin if (CacheValues[CachedElements].Stored) then if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value or CacheValues[CachedElements].Value else begin FlushDebugLineNumber; EmitLine( #9#9'OR'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); FlushDebugLineNumber; EmitLine( #9#9'OR'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] ); end; EmitDropCode(1); end else if (Operation = '~') then {bitwise not} begin if CacheValues[CachedElements].Stored then CacheValues[CachedElements].Value := not CacheValues[CachedElements].Value else begin FlushDebugLineNumber; EmitLine( #9#9'NOT'#9 + CacheRegisters[CachedElements] ); end; end else if (Operation = '<-') then {dword ptr assign} begin FlushCacheValue(CachedElements); if CacheValues[CachedElements - 1].Stored then begin FlushDebugLineNumber; EmitLine( #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], dword ptr ' + IntToStr(CacheValues[CachedElements - 1].Value) ) end else begin FlushDebugLineNumber; EmitLine( #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], ' + CacheRegisters[CachedElements - 1] ); end; EmitDropCode(2); end else if (Operation = '->') then {get dword ptr value} begin FlushCacheValue(CachedElements); FlushDebugLineNumber; EmitLine( #9#9'MOV'#9 + CacheRegisters[CachedElements] + ', [' + CacheRegisters[CachedElements] + ']' ); end else if (Operation = '<.') then {byte ptr assign} begin FlushCacheValue(CachedElements); if CacheValues[CachedElements - 1].Stored then begin FlushDebugLineNumber; EmitLine( #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], byte ptr ' + IntToStr(Byte(CacheValues[CachedElements - 1].Value)) ); end else begin SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]); FlushDebugLineNumber; EmitLine( #9#9'MOV'#9'[' + CacheRegisters[CachedElements] + '], AL' ); end; EmitDropCode(2); end else if (Operation = '.>') then {get byte ptr value} begin FlushCacheValue(CachedElements); FlushDebugLineNumber; EmitLine( #9#9'MOV'#9 + CacheRegisters[CachedElements] + ', [' + CacheRegisters[CachedElements] + ']'#13#10 + #9#9'AND'#9 + CacheRegisters[CachedElements] + ', 0FFh' ); end else if (Operation = '++') then {increase} begin if CacheValues[CachedElements].Stored then Inc(CacheValues[CachedElements].Value) else begin FlushDebugLineNumber; EmitLine( #9#9'INC'#9 + CacheRegisters[CachedElements] ); end; end else if (Operation = '--') then {decrease} begin if CacheValues[CachedElements].Stored then Dec(CacheValues[CachedElements].Value) else begin FlushDebugLineNumber; EmitLine( #9#9'DEC'#9 + CacheRegisters[CachedElements] ); end; end else if (Operation = '--') then {decrease} begin if CacheValues[CachedElements].Stored then Dec(CacheValues[CachedElements].Value) else begin FlushDebugLineNumber; EmitLine( #9#9'DEC'#9 + CacheRegisters[CachedElements] ); end; end else if (Operation = '<<') then {shift left} begin if (CacheValues[CachedElements].Stored) then begin if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value shl CacheValues[CachedElements].Value else begin FlushDebugLineNumber; EmitLine( #9#9'SHL'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end end else begin FlushCacheValue(CachedElements - 1); SwapCacheRegisters(CacheRegisters[CachedElements], 'ECX'); FlushDebugLineNumber; EmitLine( #9#9'SHL'#9 + CacheRegisters[CachedElements - 1] + ', CL'); end; EmitDropCode(1); end else if (Operation = '>>') then {shift right} begin if (CacheValues[CachedElements].Stored) then begin if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value shr CacheValues[CachedElements].Value else begin FlushDebugLineNumber; EmitLine( #9#9'SHR'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value) ); end end else begin FlushCacheValue(CachedElements - 1); SwapCacheRegisters(CacheRegisters[CachedElements], 'ECX'); FlushDebugLineNumber; EmitLine( #9#9'SHR'#9 + CacheRegisters[CachedElements - 1] + ', CL'); end; EmitDropCode(1); end else if (Operation = '&&') then {logical and} begin if (CacheValues[CachedElements].Stored) then begin if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := LongInt(CacheValues[CachedElements - 1].Value <> 0) and LongInt(CacheValues[CachedElements].Value <> 0) else begin SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]); if (CacheValues[CachedElements].Value <> 0) then begin FlushDebugLineNumber; EmitLine( #9#9'TEST'#9'EAX, EAX'#13#10 + #9#9'SETNZ'#9'AL'#13#10 + #9#9'AND'#9'AL, 1' ); end else begin CacheValues[CachedElements - 1].Stored := True; CacheValues[CachedElements - 1].Value := 0; end; end; end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); SwapCacheRegisters(CacheRegisters[CachedElements - 1], 'EAX'); SwapCacheRegisters(CacheRegisters[CachedElements], 'EBX'); FlushDebugLineNumber; EmitLine( #9#9'TEST'#9'EAX, EAX'#13#10 + #9#9'SETNZ'#9'AL'#13#10 + #9#9'TEST'#9'EBX, EBX'#13#10 + #9#9'SETNZ'#9'BL'#13#10 + #9#9'AND'#9'EAX, 0Fh'#13#10 + #9#9'AND'#9'AL, BL'); end; EmitDropCode(1); end else if (Operation = '||') then {logical or} begin if (CacheValues[CachedElements].Stored) then begin if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := LongInt(CacheValues[CachedElements - 1].Value <> 0) or LongInt(CacheValues[CachedElements].Value <> 0) else begin SwapCacheRegisters('EAX', CacheRegisters[CachedElements - 1]); if (CacheValues[CachedElements].Value <> 1) then begin FlushDebugLineNumber; EmitLine( #9#9'TEST'#9'EAX, EAX'#13#10 + #9#9'SETNZ'#9'AL'#13#10 + #9#9'OR'#9'AL, 1' ); end else begin CacheValues[CachedElements - 1].Stored := True; CacheValues[CachedElements - 1].Value := 1; end; end; end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); SwapCacheRegisters(CacheRegisters[CachedElements - 1], 'EAX'); SwapCacheRegisters(CacheRegisters[CachedElements], 'EBX'); FlushDebugLineNumber; EmitLine( #9#9'TEST'#9'EAX, EAX'#13#10 + #9#9'SETNZ'#9'AL'#13#10 + #9#9'TEST'#9'EBX, EBX'#13#10 + #9#9'SETNZ'#9'BL'#13#10 + #9#9'AND'#9'EAX, 0Fh'#13#10 + #9#9'OR'#9'AL, BL'); end; EmitDropCode(1); end else if (Operation = '!') then {logical not} begin if CacheValues[CachedElements].Stored then CacheValues[CachedElements].Value := LongInt(CacheValues[CachedElements].Value = 0) else begin FlushCacheValue(CachedElements); SwapCacheRegisters(CacheRegisters[CachedElements], 'EAX'); FlushDebugLineNumber; EmitLine( #9#9'TEST'#9'EAX, EAX'#13#10 + #9#9'SETZ'#9'AL'#13#10 ); end; end else if (Operation = '[]') then {index} begin if (CacheValues[CachedElements].Stored) then if (CacheValues[CachedElements - 1].Stored) then CacheValues[CachedElements - 1].Value := CacheValues[CachedElements - 1].Value + CacheValues[CachedElements].Value shl 2 else begin FlushDebugLineNumber; EmitLine( #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' + IntToStr(CacheValues[CachedElements].Value shl 2) ); end else begin FlushCacheValue(CachedElements); FlushCacheValue(CachedElements - 1); FlushDebugLineNumber; EmitLine( #9#9'SHL'#9 + Temp + ', 2'#13#10 + #9#9'ADD'#9 + CacheRegisters[CachedElements - 1] + ', ' + CacheRegisters[CachedElements] ); end; EmitDropCode(1); end {comparison operations} else if ((Operation = '>') or (Operation = '<') or (Operation = '>=') or (Operation = '<=') or (Operation = '==') or (Operation = '<>') or (Operation = '!=')) then PerformComparisonOperation(Operation) else EmitComment('PerformOperation() failed: unknown operation ' + Operation); end; {TCodeGenerator.PerformOperation} procedure THeaderGenerator.EmitFirst; begin EmitLine(''); EmitComment('Assembly public declarations'); end; {THeaderGenerator.EmitFirst} procedure THeaderGenerator.EmitLast; begin EmitLine(''); end; {THeaderGenerator.EmitLast} end.