Changeset 52
- Timestamp:
- Jul 26, 2012, 3:11:08 PM (12 years ago)
- Location:
- trunk
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormCPU.pas
r38 r52 47 47 if MainForm.CurrentTarget is TTargetInterpretter then 48 48 with TTargetInterpretter(MainForm.CurrentTarget) do begin 49 LabelProgramPointer.Caption := IntToStr( SourcePosition);49 LabelProgramPointer.Caption := IntToStr(ProgramIndex); 50 50 LabelMemoryPointer.Caption := IntToStr(MemoryPosition); 51 51 LabelStepCounter.Caption := IntToStr(StepCount); -
trunk/Forms/UFormMain.lfm
r51 r52 120 120 object ToolButtonTarget: TToolButton 121 121 Left = 345 122 Hint = 'Target select' 122 123 Top = 2 123 Caption = 'T oolButtonTarget'124 Caption = 'Target select' 124 125 DropdownMenu = PopupMenuTargets 125 126 Style = tbsDropDown -
trunk/Forms/UFormMain.lrt
r48 r52 1 1 TMAINFORM.CAPTION=LazFuck 2 TMAINFORM.TOOLBUTTONTARGET.CAPTION=ToolButtonTarget 2 TMAINFORM.TOOLBUTTONTARGET.HINT=Target select 3 TMAINFORM.TOOLBUTTONTARGET.CAPTION=Target select 3 4 TMAINFORM.TABSHEETDEBUG.CAPTION=Debug 4 5 TMAINFORM.TABSHEETSOURCE.CAPTION=Source code -
trunk/Forms/UFormMain.pas
r51 r52 175 175 SProgramStopped = 'Program stopped'; 176 176 SNewProject = 'New project'; 177 SCompileStart = 'Compiling...'; 178 SDone = 'Done'; 177 179 178 180 { TMainForm } … … 298 300 RootKey := Root; 299 301 OpenKey(Key, True); 300 Core.OpenProjectOnStart := ReadBoolWithDefault('OpenProjectOnStart', True);301 if ValueExists('LanguageCode') then302 Core.CoolTranslator1.Language := Core.CoolTranslator1.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))303 else Core.CoolTranslator1.Language := Core.CoolTranslator1.Languages.SearchByCode('');304 302 TargetName := ReadStringWithDefault('TargetName', 'Interpretter'); 305 303 CurrentTarget := Core.Targets.FindByName(TargetName); … … 308 306 Free; 309 307 end; 310 Core.LastOpenedList.LoadFromRegistry(Root, Key);311 Core.Targets.LoadFromRegistry(Root, Key);312 308 end; 313 309 314 310 procedure TMainForm.SaveToRegistry(Root: HKEY; Key: string); 315 311 begin 316 Core.Targets.SaveToRegistry(Root, Key);317 Core.LastOpenedList.SaveToRegistry(Root, Key);318 312 with TRegistryEx.Create do 319 313 try 320 314 RootKey := Root; 321 315 OpenKey(Key, True); 322 WriteBool('OpenProjectOnStart', Core.OpenProjectOnStart);323 if Assigned(Core.CoolTranslator1.Language) and (Core.CoolTranslator1.Language.Code <> '') then324 WriteString('LanguageCode', Core.CoolTranslator1.Language.Code)325 else DeleteValue('LanguageCode');326 316 WriteString('TargetName', CurrentTarget.Name); 327 317 finally … … 465 455 ProjectFileName := Core.ProjectFileName; 466 456 ProgramName := ExtractFileNameOnly(Core.ProjectFileName); 467 CurrentTarget.Messages.AddMessage( 'Compiling...');457 CurrentTarget.Messages.AddMessage(SCompileStart); 468 458 Compile; 469 CurrentTarget.Messages.AppendMessage( 'done');459 CurrentTarget.Messages.AppendMessage(SDone); 470 460 FormTargetCode.MemoTarget.Text := TargetCode; 471 461 UpdateInterface; -
trunk/Languages/LazFuckIDE.cs.po
r50 r52 16 16 #: tform1.caption 17 17 msgid "Form1" 18 msgstr " "18 msgstr "Form1" 19 19 20 20 #: tform2.caption 21 21 msgid "Form2" 22 msgstr " "22 msgstr "Form2" 23 23 24 24 #: tform3.caption 25 25 msgid "Form3" 26 msgstr " "26 msgstr "Form3" 27 27 28 28 #: tformcompilers.caption … … 491 491 492 492 #: tmainform.toolbuttontarget.caption 493 msgid "ToolButtonTarget" 493 msgctxt "tmainform.toolbuttontarget.caption" 494 msgid "Target select" 495 msgstr "" 496 497 #: tmainform.toolbuttontarget.hint 498 msgctxt "tmainform.toolbuttontarget.hint" 499 msgid "Target select" 494 500 msgstr "" 495 501 … … 580 586 msgstr " kroků/s" 581 587 588 #: uformmain.scompilestart 589 msgid "Compiling..." 590 msgstr "PÅekládánÃ..." 591 592 #: uformmain.sdone 593 msgid "Done" 594 msgstr "DokonÄeno" 595 582 596 #: uformmain.snewproject 583 597 msgid "New project" -
trunk/Languages/LazFuckIDE.po
r50 r52 480 480 481 481 #: tmainform.toolbuttontarget.caption 482 msgid "ToolButtonTarget" 482 msgctxt "tmainform.toolbuttontarget.caption" 483 msgid "Target select" 484 msgstr "" 485 486 #: tmainform.toolbuttontarget.hint 487 msgctxt "tmainform.toolbuttontarget.hint" 488 msgid "Target select" 483 489 msgstr "" 484 490 … … 569 575 msgstr "" 570 576 577 #: uformmain.scompilestart 578 msgid "Compiling..." 579 msgstr "" 580 581 #: uformmain.sdone 582 msgid "Done" 583 msgstr "" 584 571 585 #: uformmain.snewproject 572 586 msgid "New project" -
trunk/Target/UTarget.pas
r50 r52 66 66 end; 67 67 68 TBrainFuckCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec, 69 cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug); 70 68 71 { TTarget } 69 72 70 73 TTarget = class 71 pr ivate74 protected 72 75 FCompiled: Boolean; 76 function SourceReadNext: Char; 77 function IsOpcode(Opcode: Char): Boolean; 78 function CheckClear: Boolean; 79 function CheckOccurence(C: TBrainFuckCommand): Integer; 73 80 protected 74 81 FSourceCode: string; 82 FProgram: array of TBrainFuckCommand; 83 FProgramIndex: Integer; 75 84 FTargetCode: string; 85 FTargetIndex: Integer; 76 86 Indent: Integer; 77 87 FState: TRunState; 78 88 FOnChangeState: TNotifyEvent; 89 procedure LoadProgram; 79 90 procedure SetSourceCode(AValue: string); virtual; 80 91 function GetTargetCode: string; virtual; … … 119 130 property Compiled: Boolean read FCompiled write FCompiled; 120 131 property ExecutionPosition: Integer read GetExecutionPosition; 132 property ProgramIndex: Integer read FProgramIndex; 121 133 end; 122 134 … … 377 389 procedure TTarget.Compile; 378 390 begin 391 LoadProgram; 379 392 Compiled := True; 380 393 end; … … 489 502 end; 490 503 504 function TTarget.CheckOccurence(C: TBrainFuckCommand): Integer; 505 begin 506 Result := 1; 507 if Optimization = coNormal then 508 while ((FProgramIndex + 1) <= Length(FProgram)) and (FProgram[FProgramIndex + 1] = C) do begin 509 Inc(Result); 510 Inc(FProgramIndex); 511 end; 512 end; 513 514 procedure TTarget.LoadProgram; 515 var 516 I: Integer; 517 begin 518 inherited; 519 DebugSteps.Clear; 520 SetLength(FProgram, Length(FSourceCode)); 521 FProgramIndex := 0; 522 for I := 1 to Length(FSourceCode) do begin 523 case FSourceCode[I] of 524 '+': begin 525 FProgram[FProgramIndex] := cmInc; 526 DebugSteps.AddStep(I - 1, FProgramIndex, soNormal); 527 end; 528 '-': begin 529 FProgram[FProgramIndex] := cmDec; 530 DebugSteps.AddStep(I - 1, FProgramIndex, soNormal); 531 end; 532 '>': begin 533 FProgram[FProgramIndex] := cmPointerInc; 534 DebugSteps.AddStep(I - 1, FProgramIndex, soNormal); 535 end; 536 '<': begin 537 FProgram[FProgramIndex] := cmPointerDec; 538 DebugSteps.AddStep(I - 1, FProgramIndex, soNormal); 539 end; 540 ',': begin 541 FProgram[FProgramIndex] := cmInput; 542 DebugSteps.AddStep(I - 1, FProgramIndex, soNormal); 543 end; 544 '.': begin 545 FProgram[FProgramIndex] := cmOutput; 546 DebugSteps.AddStep(I - 1, FProgramIndex, soNormal); 547 end; 548 '[': begin 549 FProgram[FProgramIndex] := cmLoopStart; 550 DebugSteps.AddStep(I - 1, FProgramIndex, soStepIn); 551 end; 552 ']': begin 553 FProgram[FProgramIndex] := cmLoopEnd; 554 DebugSteps.AddStep(I - 1, FProgramIndex, soStepOut); 555 end 556 else Dec(FProgramIndex); 557 end; 558 Inc(FProgramIndex); 559 end; 560 SetLength(FProgram, FProgramIndex); 561 end; 562 563 function TTarget.SourceReadNext: Char; 564 begin 565 // while FProgramIndex; 566 end; 567 568 function TTarget.IsOpcode(Opcode: Char): Boolean; 569 begin 570 Result := (Opcode = '+') or (Opcode = '-') or (Opcode = '<') or (Opcode = '>') or 571 (Opcode = '[') or (Opcode = ']') or (Opcode = ',') or (Opcode = '.'); 572 end; 573 574 function TTarget.CheckClear: Boolean; 575 begin 576 Result := (FProgram[FProgramIndex] = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and 577 (FProgram[FProgramIndex + 1] = cmDec) and (FProgram[FProgramIndex + 2] = cmLoopEnd); 578 end; 579 491 580 end. 492 581 -
trunk/Target/UTargetC.pas
r48 r52 35 35 Capabilities := [tcCompile, tcRun]; 36 36 {$IFDEF Windows} 37 CompilerPath := 'c:\Program Files\MinGW\bin\gcc.exe -o %1:s';37 CompilerPath := 'c:\Program Files\MinGW\bin\gcc.exe'; 38 38 {$ENDIF} 39 39 {$IFDEF Linux} … … 44 44 procedure TTargetC.Compile; 45 45 var 46 I: Integer;47 46 Sum: Integer; 48 49 function CheckOccurence(C: Char): Integer;50 begin51 Result := 1;52 if Optimization = coNormal then53 while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin54 Inc(Result);55 Inc(I)56 end;57 end;58 59 47 begin 60 48 inherited; … … 72 60 AddLine(''); 73 61 AddLine('Pos = 0;'); 74 I := 1;75 while ( I <= Length(FSourceCode)) do begin76 case F SourceCode[I] of77 '>': begin78 Sum := CheckOccurence( '>');62 FProgramIndex := 0; 63 while (FProgramIndex < Length(FProgram)) do begin 64 case FProgram[FProgramIndex] of 65 cmPointerInc: begin 66 Sum := CheckOccurence(cmPointerInc); 79 67 AddLine('Pos = Pos + ' + IntToStr(Sum) + ';'); 80 68 end; 81 '<': begin82 Sum := CheckOccurence( '<');69 cmPointerDec: begin 70 Sum := CheckOccurence(cmPointerDec); 83 71 AddLine('Pos = Pos - ' + IntToStr(Sum) + ';'); 84 72 end; 85 '+': begin86 Sum := CheckOccurence( '+');73 cmInc: begin 74 Sum := CheckOccurence(cmInc); 87 75 AddLine('Memory[Pos] = Memory[Pos] + ' + IntToStr(Sum) + ';'); 88 76 end; 89 '-': begin90 Sum := CheckOccurence( '-');77 cmDec: begin 78 Sum := CheckOccurence(cmDec); 91 79 AddLine('Memory[Pos] = Memory[Pos] - ' + IntToStr(Sum) + ';'); 92 80 end; 93 '.': AddLine('putchar(Memory[Pos]);'); 94 ',': AddLine('Memory[Pos] = getchar();'); 95 '[': begin 96 AddLine('while(Memory[Pos] != 0)'); 97 AddLine('{'); 98 Inc(Indent); 81 cmOutput: AddLine('putchar(Memory[Pos]);'); 82 cmInput: AddLine('Memory[Pos] = getchar();'); 83 cmLoopStart: begin 84 if CheckClear then begin 85 AddLine('Memory[Pos] = 0;'); 86 Inc(FProgramIndex, 2); 87 end else begin 88 AddLine('while(Memory[Pos] != 0)'); 89 AddLine('{'); 90 Inc(Indent); 91 end; 99 92 end; 100 ']': begin93 cmLoopEnd: begin 101 94 Dec(Indent); 102 95 AddLine('}'); 103 96 end; 104 97 end; 105 Inc( I);98 Inc(FProgramIndex); 106 99 end; 107 100 AddLine('return 0;'); -
trunk/Target/UTargetDelphi.pas
r48 r52 39 39 procedure TTargetDelphi.Compile; 40 40 var 41 I: Integer;42 41 Sum: Integer; 43 44 function CheckOccurence(C: Char): Integer;45 begin46 Result := 1;47 if Optimization = coNormal then48 while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin49 Inc(Result);50 Inc(I)51 end;52 end;53 54 function CheckClear: Boolean;55 begin56 Result := (FSourceCode[I] = '[') and (Length(FSourceCode) >= I + 2) and57 (FSourceCode[I + 1] = '-') and (FSourceCode[I + 2] = ']');58 end;59 60 42 begin 61 43 inherited; … … 74 56 Inc(Indent); 75 57 AddLine('Pos := 0;'); 76 I := 1;77 while ( I <= Length(FSourceCode)) do begin78 case F SourceCode[I] of79 '>': begin80 Sum := CheckOccurence( '>');58 FProgramIndex := 0; 59 while (FProgramIndex < Length(FProgram)) do begin 60 case FProgram[FProgramIndex] of 61 cmPointerInc: begin 62 Sum := CheckOccurence(cmPointerInc); 81 63 AddLine('Inc(Pos, ' + IntToStr(Sum) + ');'); 82 64 end; 83 '<': begin84 Sum := CheckOccurence( '<');65 cmPointerDec: begin 66 Sum := CheckOccurence(cmPointerDec); 85 67 AddLine('Dec(Pos, ' + IntToStr(Sum) + ');'); 86 68 end; 87 '+': begin88 Sum := CheckOccurence( '+');69 cmInc: begin 70 Sum := CheckOccurence(cmInc); 89 71 AddLine('Memory[Pos] := Memory[Pos] + ' + IntToStr(Sum) + ';'); 90 72 end; 91 '-': begin92 Sum := CheckOccurence( '-');73 cmDec: begin 74 Sum := CheckOccurence(cmDec); 93 75 AddLine('Memory[Pos] := Memory[Pos] - ' + IntToStr(Sum) + ';'); 94 76 end; 95 '.': AddLine('Write(Chr(Memory[Pos]));');96 ',': AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);');97 '[': begin77 cmOutput: AddLine('Write(Chr(Memory[Pos]));'); 78 cmInput: AddLine('Read(ReadChar); Memory[Pos] := Ord(ReadChar);'); 79 cmLoopStart: begin 98 80 if CheckClear then begin 99 81 AddLine('Memory[Pos] := 0;'); 100 Inc( I, 2);82 Inc(FProgramIndex, 2); 101 83 end else begin 102 84 AddLine('while Memory[Pos] <> 0 do begin'); … … 104 86 end; 105 87 end; 106 ']': begin88 cmLoopEnd: begin 107 89 Dec(Indent); 108 90 AddLine('end;'); 109 91 end; 110 92 end; 111 Inc( I);93 Inc(FProgramIndex); 112 94 end; 113 95 Dec(Indent); -
trunk/Target/UTargetInterpretter.pas
r48 r52 22 22 procedure Execute; override; 23 23 end; 24 25 TBrainFuckCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,26 cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug);27 24 28 25 TCommandHandler = procedure of object; … … 55 52 function GetExecutionPosition: Integer; override; 56 53 public 57 FProgram: array of TBrainFuckCommand;58 54 FProgramBreakpoints: array of Boolean; 59 55 SourceJump: array of Integer; 60 SourcePosition: Integer;61 56 SourceBreakpoint: array of Boolean; 62 57 Memory: array of Integer; … … 109 104 with Parent do 110 105 repeat 111 while ( SourcePosition< Length(FProgram)) and (State <> rsStopped) do begin106 while (FProgramIndex < Length(FProgram)) and (State <> rsStopped) do begin 112 107 if State = rsRunning then begin 113 if FProgramBreakpoints[ SourcePosition] then begin114 BreakPoint := BreakPoints.SearchByTargetPos( SourcePosition);108 if FProgramBreakpoints[FProgramIndex] then begin 109 BreakPoint := BreakPoints.SearchByTargetPos(FProgramIndex); 115 110 if BreakPoint.System then BreakPoints.Delete(BreakPoints.IndexOf(BreakPoint)); 116 111 SetStateSafe(rsPaused); 117 112 end else begin 118 FCommandTable[FProgram[ SourcePosition]];119 Inc( SourcePosition);113 FCommandTable[FProgram[FProgramIndex]]; 114 Inc(FProgramIndex); 120 115 Inc(FStepCount); 121 116 end; … … 155 150 begin 156 151 SetLength(Memory, AValue); 157 end;158 159 procedure TTargetInterpretter.Compile;160 var161 I: Integer;162 Pos: Integer;163 begin164 inherited;165 DebugSteps.Clear;166 SetLength(FProgram, Length(FSourceCode));167 Pos := 0;168 for I := 1 to Length(FSourceCode) do begin169 case FSourceCode[I] of170 '+': begin171 FProgram[Pos] := cmInc;172 DebugSteps.AddStep(I - 1, Pos, soNormal);173 end;174 '-': begin175 FProgram[Pos] := cmDec;176 DebugSteps.AddStep(I - 1, Pos, soNormal);177 end;178 '>': begin179 FProgram[Pos] := cmPointerInc;180 DebugSteps.AddStep(I - 1, Pos, soNormal);181 end;182 '<': begin183 FProgram[Pos] := cmPointerDec;184 DebugSteps.AddStep(I - 1, Pos, soNormal);185 end;186 ',': begin187 FProgram[Pos] := cmInput;188 DebugSteps.AddStep(I - 1, Pos, soNormal);189 end;190 '.': begin191 FProgram[Pos] := cmOutput;192 DebugSteps.AddStep(I - 1, Pos, soNormal);193 end;194 '[': begin195 FProgram[Pos] := cmLoopStart;196 DebugSteps.AddStep(I - 1, Pos, soStepIn);197 end;198 ']': begin199 FProgram[Pos] := cmLoopEnd;200 DebugSteps.AddStep(I - 1, Pos, soStepOut);201 end202 else Dec(Pos);203 end;204 Inc(Pos);205 end;206 SetLength(FProgram, Pos);207 152 end; 208 153 … … 293 238 begin 294 239 if Memory[MemoryPosition] = 0 then 295 SourcePosition := SourceJump[SourcePosition];240 FProgramIndex := SourceJump[FProgramIndex]; 296 241 end; 297 242 … … 299 244 begin 300 245 if Memory[MemoryPosition] > 0 then 301 SourcePosition := SourceJump[SourcePosition] - 1;246 FProgramIndex := SourceJump[FProgramIndex] - 1; 302 247 end; 303 248 … … 308 253 inherited; 309 254 PrepareJumpTable; 310 SourcePosition:= 0;255 FProgramIndex := 0; 311 256 InputPosition := 1; 312 257 Output := ''; … … 320 265 end; 321 266 267 procedure TTargetInterpretter.Compile; 268 begin 269 inherited; 270 end; 271 322 272 procedure TTargetInterpretter.PrepareBreakPoints; 323 273 var … … 343 293 function TTargetInterpretter.GetExecutionPosition: Integer; 344 294 begin 345 Result := SourcePosition;295 Result := FProgramIndex; 346 296 end; 347 297 … … 379 329 begin 380 330 if State = rsPaused then begin 381 Step := DebugSteps.SearchByTargetPos( SourcePosition);331 Step := DebugSteps.SearchByTargetPos(FProgramIndex); 382 332 if Step.Operation = soStepOut then begin 383 333 BreakPoints.SetSystem(Step.TargetPosition + 1); … … 401 351 begin 402 352 if State = rsPaused then begin 403 Step := DebugSteps.SearchByTargetPos( SourcePosition);353 Step := DebugSteps.SearchByTargetPos(FProgramIndex); 404 354 if Step.Operation = soStepOut then begin 405 355 BreakPoints.SetSystem(Step.TargetPosition + 1); … … 422 372 begin 423 373 if State = rsPaused then begin 424 Step := DebugSteps.SearchByTargetPos( SourcePosition);374 Step := DebugSteps.SearchByTargetPos(FProgramIndex); 425 375 StepIndex := DebugSteps.IndexOf(Step); 426 376 Nesting := 1; -
trunk/Target/UTargetJava.pas
r48 r52 45 45 procedure TTargetJava.Compile; 46 46 var 47 I: Integer;48 47 Sum: Integer; 49 50 function CheckOccurence(C: Char): Integer;51 begin52 Result := 1;53 if Optimization = coNormal then54 while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin55 Inc(Result);56 Inc(I)57 end;58 end;59 60 48 begin 61 49 inherited; … … 75 63 AddLine('Memory = new char[30000];'); 76 64 AddLine('Pos = 0;'); 77 I := 1;78 while ( I <= Length(FSourceCode)) do begin79 case F SourceCode[I] of80 '>': begin81 Sum := CheckOccurence( '>');65 FProgramIndex := 0; 66 while (FProgramIndex < Length(FProgram)) do begin 67 case FProgram[FProgramIndex] of 68 cmPointerInc: begin 69 Sum := CheckOccurence(cmPointerInc); 82 70 AddLine('Pos = Pos + ' + IntToStr(Sum) + ';'); 83 71 end; 84 '<': begin85 Sum := CheckOccurence( '<');72 cmPointerDec: begin 73 Sum := CheckOccurence(cmPointerDec); 86 74 AddLine('Pos = Pos - ' + IntToStr(Sum) + ';'); 87 75 end; 88 '+': begin89 Sum := CheckOccurence( '+');76 cmInc: begin 77 Sum := CheckOccurence(cmInc); 90 78 AddLine('Memory[Pos] = (char)((int)Memory[Pos] + ' + IntToStr(Sum) + ');'); 91 79 end; 92 '-': begin93 Sum := CheckOccurence( '-');80 cmDec: begin 81 Sum := CheckOccurence(cmDec); 94 82 AddLine('Memory[Pos] = (char)((int)Memory[Pos] - ' + IntToStr(Sum) + ');'); 95 83 end; 96 '.': AddLine('System.out.print(Memory[Pos]);'); 97 ',': AddLine('Memory[Pos] = (char)System.in.read();'); 98 '[': begin 99 AddLine('while(Memory[Pos] != 0)'); 100 AddLine('{'); 101 Inc(Indent); 84 cmOutput: AddLine('System.out.print(Memory[Pos]);'); 85 cmInput: AddLine('Memory[Pos] = (char)System.in.read();'); 86 cmLoopStart: begin 87 if CheckClear then begin 88 AddLine('Memory[Pos] = 0;'); 89 Inc(FProgramIndex, 2); 90 end else begin 91 AddLine('while(Memory[Pos] != 0)'); 92 AddLine('{'); 93 Inc(Indent); 94 end; 102 95 end; 103 ']': begin96 cmLoopEnd: begin 104 97 Dec(Indent); 105 98 AddLine('}'); 106 99 end; 107 100 end; 108 Inc( I);101 Inc(FProgramIndex); 109 102 end; 110 103 Dec(Indent); -
trunk/Target/UTargetPHP.pas
r49 r52 44 44 procedure TTargetPHP.Compile; 45 45 var 46 I: Integer;47 46 Sum: Integer; 48 49 function CheckOccurence(C: Char): Integer;50 begin51 Result := 1;52 if Optimization = coNormal then53 while ((I + 1) <= Length(FSourceCode)) and (FSourceCode[I + 1] = C) do begin54 Inc(Result);55 Inc(I)56 end;57 end;58 59 function CheckClear: Boolean;60 begin61 Result := (FSourceCode[I] = '[') and (Length(FSourceCode) >= I + 2) and62 (FSourceCode[I + 1] = '-') and (FSourceCode[I + 2] = ']');63 end;64 65 47 begin 66 48 inherited; … … 72 54 AddLine('$Memory = str_repeat("\0", 30000);'); 73 55 AddLine('$Position = 0;'); 74 I := 1;75 while ( I <= Length(FSourceCode)) do begin76 case F SourceCode[I] of77 '>': begin78 Sum := CheckOccurence( '>');56 FProgramIndex := 0; 57 while (FProgramIndex < Length(FProgram)) do begin 58 case FProgram[FProgramIndex] of 59 cmPointerInc: begin 60 Sum := CheckOccurence(cmPointerInc); 79 61 AddLine('$Position = $Position + ' + IntToStr(Sum) + ';'); 80 62 end; 81 '<': begin82 Sum := CheckOccurence( '<');63 cmPointerDec: begin 64 Sum := CheckOccurence(cmPointerDec); 83 65 AddLine('$Position = $Position - ' + IntToStr(Sum) + ';'); 84 66 end; 85 '+': begin86 Sum := CheckOccurence( '+');67 cmInc: begin 68 Sum := CheckOccurence(cmInc); 87 69 AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) + ' + IntToStr(Sum) + ');'); 88 70 end; 89 '-': begin90 Sum := CheckOccurence( '-');71 cmDec: begin 72 Sum := CheckOccurence(cmDec); 91 73 AddLine('$Memory[$Position] = chr(ord($Memory[$Position]) - ' + IntToStr(Sum) + ');'); 92 74 end; 93 '.': AddLine('echo($Memory[$Position]);');94 ',': AddLine('$Memory[$Position] = fgetc(STDIN);');95 '[': begin75 cmOutput: AddLine('echo($Memory[$Position]);'); 76 cmInput: AddLine('$Memory[$Position] = fgetc(STDIN);'); 77 cmLoopStart: begin 96 78 if CheckClear then begin 97 79 AddLine('$Memory[$Position] = "\0";'); 98 Inc( I, 2);80 Inc(FProgramIndex, 2); 99 81 end else begin 100 82 AddLine('while($Memory[$Position] != "\0") {'); … … 102 84 end; 103 85 end; 104 ']': begin86 cmLoopEnd: begin 105 87 Dec(Indent); 106 88 AddLine('}'); 107 89 end; 108 90 end; 109 Inc( I);91 Inc(FProgramIndex); 110 92 end; 111 93 AddLine(''); -
trunk/UCore.pas
r51 r52 7 7 uses 8 8 Classes, SysUtils, FileUtil, UApplicationInfo, ULastOpenedList, 9 UCoolTranslator, UTarget ;9 UCoolTranslator, UTarget, URegistry, Registry; 10 10 11 11 type … … 25 25 Targets: TTargetList; 26 26 OpenProjectOnStart: Boolean; 27 procedure LoadFromRegistry(Root: HKEY; Key: string); 28 procedure SaveToRegistry(Root: HKEY; Key: string); 27 29 end; 28 30 … … 48 50 Targets.Add(TTargetC.Create); 49 51 Targets.Add(TTargetJava.Create); 52 LoadFromRegistry(HKEY(ApplicationInfo.RegistryRoot), ApplicationInfo.RegistryKey); 50 53 end; 51 54 52 55 procedure TCore.DataModuleDestroy(Sender: TObject); 53 56 begin 57 SaveToRegistry(HKEY(ApplicationInfo.RegistryRoot), ApplicationInfo.RegistryKey); 54 58 Targets.Free; 59 end; 60 61 procedure TCore.LoadFromRegistry(Root: HKEY; Key: string); 62 var 63 TargetName: string; 64 begin 65 with TRegistryEx.Create do 66 try 67 RootKey := Root; 68 OpenKey(Key, True); 69 OpenProjectOnStart := ReadBoolWithDefault('OpenProjectOnStart', True); 70 if ValueExists('LanguageCode') then 71 CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', '')) 72 else CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(''); 73 finally 74 Free; 75 end; 76 LastOpenedList.LoadFromRegistry(Root, Key); 77 Targets.LoadFromRegistry(Root, Key); 78 end; 79 80 procedure TCore.SaveToRegistry(Root: HKEY; Key: string); 81 begin 82 Targets.SaveToRegistry(Root, Key); 83 LastOpenedList.SaveToRegistry(Root, Key); 84 with TRegistryEx.Create do 85 try 86 RootKey := Root; 87 OpenKey(Key, True); 88 WriteBool('OpenProjectOnStart', OpenProjectOnStart); 89 if Assigned(CoolTranslator1.Language) and (CoolTranslator1.Language.Code <> '') then 90 WriteString('LanguageCode', CoolTranslator1.Language.Code) 91 else DeleteValue('LanguageCode'); 92 finally 93 Free; 94 end; 55 95 end; 56 96
Note:
See TracChangeset
for help on using the changeset viewer.