Changeset 136

Timestamp:

Mar 5, 2022, 4:14:27 PM (3 years ago)

Author:

chronos

Message:

• Modified: Update recent files list in registry immediately.
• Fixed: Regresion in debugging step in and step out.
• Fixed: Of by one index in loop start command interpretation.
• Fixed: Correctly load directory and file name into open and save dialogs.
• Modified: Faster interval for program output refresh.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (6 diffs)
• Languages/LazFuck.cs.po (modified) (3 diffs)
• Languages/LazFuck.pot (modified) (3 diffs)
• Target/UTargetInterpretter.pas (modified) (11 diffs)
• UBFTarget.pas (modified) (1 diff)
• UCore.lfm (modified) (1 diff)
• UCore.pas (modified) (6 diffs)
• UTarget.pas (modified) (2 diffs)

trunk/Forms/UFormMain.lfm

@@ -547 +547 @@
   end
   object TimerRefresh: TTimer
+    Interval = 200
     OnTimer = TimerRefreshTimer
     Left = 70

trunk/Forms/UFormMain.pas

@@ -189 +189 @@
   SFileNotFound = 'File %s not found.';
 
+const
+  ExamplesDir = 'Examples';
+
 { TFormMain }
 
@@ -259 +262 @@
     raise Exception.Create(SCloseProjectFirst);
   FormSourceCode.SynEditSource.Lines.LoadFromFile(FileName);
-  Core.LastOpenedList.AddItem(FileName);
+  Core.AddItemToLastOpenedList(FileName);
   Core.Project.FileName := FileName;
   Core.Project.Openned := True;
@@ -663 +666 @@
   AProjectClose.Execute;
   if Core.Project.Openned then Exit;
-  Core.Project.FileName := CombinePaths(Core.DataDir, 'Examples' + DirectorySeparator + SNewProject + '.b');
+  Core.Project.FileName := CombinePaths(Core.DataDir, ExamplesDir + DirectorySeparator + SNewProject + '.b');
   FormSourceCode.SynEditSource.Clear;
   Core.Project.Openned := True;
@@ -683 +686 @@
 
 procedure TFormMain.AProjectOpenExecute(Sender: TObject);
+var
+  FileName: string;
 begin
   if Core.LastOpenedList.Items.Count > 0 then
-    OpenDialog1.FileName := Core.LastOpenedList.Items[0]
-    else OpenDialog1.FileName := CombinePaths(Core.DataDir, 'Examples');
-  OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);
+    FileName := Core.LastOpenedList.Items[0]
+    else FileName := CombinePaths(Core.DataDir, ExamplesDir);
+  OpenDialog1.InitialDir := ExtractFileDir(FileName);
+  OpenDialog1.FileName := ExtractFileName(FileName);
   if OpenDialog1.Execute then begin
     AProjectClose.Execute;
@@ -697 +703 @@
 procedure TFormMain.AProjectSaveAsExecute(Sender: TObject);
 begin
-  SaveDialog1.FileName := Core.Project.FileName;
+  SaveDialog1.InitialDir := ExtractFileDir(Core.Project.FileName);
+  SaveDialog1.FileName := ExtractFileName(Core.Project.FileName);
   if SaveDialog1.Execute then begin
     FormSourceCode.SynEditSource.Lines.SaveToFile(SaveDialog1.FileName);
     Core.Project.FileName := SaveDialog1.FileName;
-    Core.LastOpenedList.AddItem(SaveDialog1.FileName);
+    Core.AddItemToLastOpenedList(SaveDialog1.FileName);
     Core.Project.Modified := False;
     UpdateInterface;
@@ -711 +718 @@
   if Core.Project.Modified and FileExists(Core.Project.FileName) then begin
     FormSourceCode.SynEditSource.Lines.SaveToFile(Core.Project.FileName);
+    Core.AddItemToLastOpenedList(Core.Project.FileName);
     Core.Project.Modified := False;
     UpdateInterface;

trunk/Languages/LazFuck.cs.po

@@ -619 +619 @@
 msgstr "Zastaveno"
 
+#: utargetinterpretter.sbreakpointindexerror
+#, object-pascal-format
+msgid "Break point index error: %d"
+msgstr "Chyba indexu bodu přerušení: %d"
+
 #: utargetinterpretter.sjumptablecollision
 msgid "Jump table collision"
@@ -628 +633 @@
 msgstr "Nekonzistentní skoková tabulka"
 
-#: utargetinterpretter.sprogramlowerlimit
-msgid "Program run over lower limit"
-msgstr "Program překročil dolní omezení"
+#: utargetinterpretter.sprogramlowermemorylimit
+msgid "Program run over lower memory limit"
+msgstr "Program překročil dolní rozsah paměti"
 
 #: utargetinterpretter.sprogramnotrunning
@@ -636 +641 @@
 msgstr "Program neběşí"
 
-#: utargetinterpretter.sprogramupperlimit
-msgid "Program run over upper limit"
-msgstr "Program překročil horní omezení"
+#: utargetinterpretter.sprogramuppermemorylimit
+msgid "Program run over upper memory limit"
+msgstr "Program překročil horní rozsah paměti"
 
 #: utargetinterpretter.sunsupportedcommand

trunk/Languages/LazFuck.pot

@@ -609 +609 @@
 msgstr ""
 
+#: utargetinterpretter.sbreakpointindexerror
+#, object-pascal-format
+msgid "Break point index error: %d"
+msgstr ""
+
 #: utargetinterpretter.sjumptablecollision
 msgid "Jump table collision"
@@ -618 +623 @@
 msgstr ""
 
-#: utargetinterpretter.sprogramlowerlimit
-msgid "Program run over lower limit"
+#: utargetinterpretter.sprogramlowermemorylimit
+msgid "Program run over lower memory limit"
 msgstr ""
 
@@ -626 +631 @@
 msgstr ""
 
-#: utargetinterpretter.sprogramupperlimit
-msgid "Program run over upper limit"
+#: utargetinterpretter.sprogramuppermemorylimit
+msgid "Program run over upper memory limit"
 msgstr ""
 

trunk/Target/UTargetInterpretter.pas

@@ -16 +16 @@
   private
     FNewState: TRunState;
+    FMessage: string;
+    procedure DoMessage;
     procedure DoSetState;
     procedure SetStateSafe(State: TRunState);
@@ -81 +83 @@
 
 resourcestring
-  SProgramLowerLimit = 'Program run over lower limit';
-  SProgramUpperLimit = 'Program run over upper limit';
+  SProgramLowerMemoryLimit = 'Program run over lower memory limit';
+  SProgramUpperMemoryLimit = 'Program run over upper memory limit';
   SJumpTableInconsistent = 'Jump table is inconsistent';
   SJumpTableCollision = 'Jump table collision';
   SProgramNotRunning = 'Program not running';
   SUnsupportedCommand = 'Unsupported command';
+  SBreakPointIndexError = 'Break point index error: %d';
 
 { TTargetInterpretterThread }
@@ -93 +96 @@
 var
   BreakPoint: TBreakPoint;
-begin
+  Index: Integer;
+begin
+  try
   with Parent do
   repeat
@@ -100 +105 @@
         if FProgramBreakpoints[FProgramIndex] then begin
           BreakPoint := BreakPoints.SearchByTargetPos(FProgramIndex);
-          if BreakPoint.System then BreakPoints.Delete(BreakPoints.IndexOf(BreakPoint));
+          if BreakPoint.System then begin
+            Index := BreakPoints.IndexOf(BreakPoint);
+            if Index <> -1 then BreakPoints.Delete(Index)
+            else raise Exception.Create(Format(SBreakPointIndexError, [Index]));
+          end;
           SetStateSafe(rsPaused);
         end else begin
@@ -114 +123 @@
     if State <> rsStopped then SetStateSafe(rsStopped);
   until Terminated or (State = rsStopped);
+
+  except
+    on E: Exception do begin
+      FMessage := E.Message;
+      Synchronize(DoMessage);
+    end;
+  end;
+end;
+
+procedure TTargetInterpretterThread.DoMessage;
+begin
+  Parent.SendMessage(FMessage);
 end;
 
@@ -123 +144 @@
 procedure TTargetInterpretterThread.SetStateSafe(State: TRunState);
 begin
+  if Parent.State = State then Exit;
   FNewState := State;
   Synchronize(DoSetState);
@@ -212 +234 @@
 begin
   if Memory[MemoryPosition + FProgram[FProgramIndex].RelIndex] = 0 then
-    FProgramIndex := FProgram[FProgramIndex].Parameter;
+    FProgramIndex := FProgram[FProgramIndex].Parameter - 1;
 end;
 
@@ -245 +267 @@
   if MemoryPosition < MemorySize then
     Inc(MemoryPosition, FProgram[FProgramIndex].Parameter)
-    else raise Exception.Create(SProgramUpperLimit);
+    else raise Exception.Create(SProgramUpperMemoryLimit);
 end;
 
@@ -252 +274 @@
   if MemoryPosition > 0 then
     Dec(MemoryPosition, FProgram[FProgramIndex].Parameter)
-    else raise Exception.Create(SProgramLowerLimit);
+    else raise Exception.Create(SProgramLowerMemoryLimit);
 end;
 
@@ -319 +341 @@
 procedure TTargetInterpretter.CheckMemoryBounds(Address: Integer);
 begin
-  if Address < 0 then raise Exception.Create(SProgramLowerLimit);
-  if Address >= MemorySize then raise Exception.Create(SProgramUpperLimit);
+  if Address < 0 then raise Exception.Create(SProgramLowerMemoryLimit);
+  if Address >= MemorySize then raise Exception.Create(SProgramUpperMemoryLimit);
 end;
 
@@ -428 +450 @@
     Nesting := 1;
     while (StepIndex < DebugSteps.Count) and (Nesting > 0) do begin
-      if TDebugStep(DebugSteps[StepIndex]).Operation = soStepIn then Inc(Nesting);
-      if TDebugStep(DebugSteps[StepIndex]).Operation = soStepOut then Dec(Nesting);
+      if DebugSteps[StepIndex].Operation = soStepIn then Inc(Nesting);
+      if DebugSteps[StepIndex].Operation = soStepOut then Dec(Nesting);
       Inc(StepIndex);
     end;
     if StepIndex < DebugSteps.Count then begin
-      Breakpoints.SetSystem(TDebugStep(DebugSteps[StepIndex]).ProgramPosition);
+      Breakpoints.SetSystem(DebugSteps[StepIndex].ProgramPosition);
     end;
     Run;

trunk/UBFTarget.pas

@@ -589 +589 @@
       ']': FProgram.Write(TMachineOperation.Create(cmLoopEnd, 0));
     end;
-    if DebugEnabled and (FProgram.Index <> LastIndex) then
-      DebugSteps.AddStep(I - 1, FProgram.Index - 1, soNormal);
+    if DebugEnabled and (FProgram.Index <> LastIndex) then begin
+      case FSourceCode[I] of
+        '[': DebugSteps.AddStep(I - 1, FProgram.Index - 1, soStepIn);
+        ']': DebugSteps.AddStep(I - 1, FProgram.Index - 1, soStepOut);
+        else DebugSteps.AddStep(I - 1, FProgram.Index - 1, soNormal);
+      end;
+    end;
     LastIndex := FProgram.Index;
   end;

trunk/UCore.lfm

@@ -21 +21 @@
     AppName = 'LazFuck'
     Description = 'A simple BrainFuck IDE written in Lazarus/FPC.'
-    ReleaseDate = 44575
+    ReleaseDate = 44625
     RegistryKey = '\Software\Chronosoft\LazFuck'
     RegistryRoot = rrKeyCurrentUser

trunk/UCore.pas

@@ -29 +29 @@
     FCurrentTarget: TTarget;
     StoredDimension: TControlDimension;
+    RecentFileRegistryContext: TRegistryContext;
     procedure InitTargets;
     procedure SetCurrentTarget(AValue: TTarget);
@@ -46 +47 @@
     Optimizations: TOptimizations;
     procedure Init;
+    procedure AddItemToLastOpenedList(FileName: string);
     procedure LoadFromRegistry(Context: TRegistryContext);
     procedure SaveToRegistry(Context: TRegistryContext);
@@ -69 +71 @@
 
 { TCore }
+
+procedure TCore.AddItemToLastOpenedList(FileName: string);
+begin
+  with LastOpenedList do begin
+    LoadFromRegistry(RecentFileRegistryContext);
+    AddItem(FileName);
+    SaveToRegistry(RecentFileRegistryContext);
+  end;
+end;
 
 procedure TCore.DataModuleCreate(Sender: TObject);
@@ -91 +102 @@
   StoredDimension := TControlDimension.Create;
   InitTargets;
+  RecentFileRegistryContext := TRegistryContext.Create(ApplicationInfo.RegistryRoot,
+    ApplicationInfo.RegistryKey + '\' + RecentFilesRegKey);
   LoadFromRegistry(Core.ApplicationInfo.GetRegistryContext);
 end;
@@ -149 +162 @@
     Free;
   end;
-  LastOpenedList.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + RecentFilesRegKey));
   Targets.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Compiler'));
+  LastOpenedList.LoadFromRegistry(RecentFileRegistryContext);
   PersistentForm1.RegistryContext := Context;
 end;
@@ -157 +170 @@
 begin
   Targets.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Compiler'));
-  LastOpenedList.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\' + RecentFilesRegKey));
   with TRegistryEx.Create do
   try

trunk/UTarget.pas

@@ -113 +113 @@
     DebugEnabled: Boolean;
     Selected: Boolean;
+    procedure SendMessage(Text: string);
     constructor Create; virtual;
     destructor Destroy; override;
@@ -427 +428 @@
 end;
 
+procedure TTarget.SendMessage(Text: string);
+begin
+  if Assigned(FOnMessage) then
+    FOnMessage(Text);
+end;
+
 procedure TTarget.SetSourceCode(AValue: string);
 begin