LitePascal/LitePascal.pas at main · wanderlan/LitePascal · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
// Based on XD Pascal (2020) original code by Vasiliy Tereshkov
// Refactoring and extensions by Wanderlan
{$APPTYPE CONSOLE}
{$I-,H-} // /(^(\r\n|\n|\r)$)|(^(\r\n|\n|\r))|^\s*$/gm
program LitePascal;

uses
  SysUtils, Common, Scanner, Parser, CodeGen, Linker;

procedure SplitPath(const Path: TString; var Folder, Name, Ext: TString);
var
  DotPos, SlashPos, i: Integer;
begin
  Folder   := '';
  Name     := Path;
  Ext      := '';
  DotPos   := 0;
  SlashPos := 0;
  for i := Length(Path) downto 1 do
    if (Path[i] = '.') and (DotPos = 0) then
      DotPos := i
    else
      if (Path[i] = '\') and (SlashPos = 0) then
        SlashPos := i;
  if DotPos > 0 then begin
    Name := Copy(Path, 1, DotPos - 1);
    Ext  := Copy(Path, DotPos, Length(Path) - DotPos + 1);
  end;
  if SlashPos > 0 then begin
    Folder := Copy(Path, 1, SlashPos);
    Name   := Copy(Path, SlashPos + 1, Length(Name) - SlashPos);
  end;
end;

procedure NoticeProc(ClassInstance: Pointer; const Msg: TString);
begin
  WriteLn(Msg);
end;

procedure WarningProc(ClassInstance: Pointer; const Msg: TString);
begin
  if NumUnits >= 1 then
    Notice(ScannerFileName + ' (' + IntToStr(ScannerLine) + ') Warning: ' + Msg)
  else
    Notice('Warning: ' + Msg);
end;

procedure ErrorProc(ClassInstance: Pointer; const Msg: TString);
begin
  if NumUnits >= 1 then
    Notice(ScannerFileName + ' (' + IntToStr(ScannerLine) + ') Error: ' + Msg)
  else
    Notice('Error: ' + Msg);  readln;
  Halt(1);
end;

var
  CompilerPath, CompilerFolder, CompilerName, CompilerExt, PasPath, PasFolder, PasName, PasExt, ExePath: TString;

begin
  SetWriteProcs(nil, @NoticeProc, @WarningProc, @ErrorProc); // Eliminar
  Notice('Lite Pascal ' + VERSION + ' for ' + TARGET);
  if ParamCount < 1 then begin
    Notice('Usage: LitePascal <file.pas>');
    Halt(1);
  end;
  CompilerPath := TString(ParamStr(0));
  SplitPath(CompilerPath, CompilerFolder, CompilerName, CompilerExt);
  PasPath := TString(ParamStr(1));
  SplitPath(PasPath, PasFolder, PasName, PasExt);
  InitializeCommon;
  InitializeLinker;
  InitializeCodeGen;
  Folders[1] := PasFolder;
  Folders[2] := CompilerFolder + 'units\';
  NumFolders := 2;
  Compile('system.pas');
  Compile(PasName + PasExt);
  ExePath := PasFolder + PasName + '.exe';
  Link(ExePath);
  Notice('Complete. Code size: ' + IntToStr(GetCodeSize) + ' bytes. Data size: ' + IntToStr(InitializedGlobalDataSize + UninitializedGlobalDataSize) + ' bytes');
  // repeat
  // FinalizeScanner
  // until not RestoreScanner;
  // FinalizeCommon;
end.