1 files changed, 0 insertions, 620 deletions
diff --git a/nim/nos.pas b/nim/nos.pas
deleted file mode 100755
index 7c74ba1bc..000000000
--- a/nim/nos.pas
+++ /dev/null
@@ -1,620 +0,0 @@
-//
-//
-//           The Nimrod Compiler
-//        (c) Copyright 2009 Andreas Rumpf
-//
-//    See the file "copying.txt", included in this
-//    distribution, for details about the copyright.
-//
-unit nos;
-
-// This module provides Nimrod's os module in Pascal
-// Note: Only implement what is really needed here!
-
-interface
-
-{$include 'config.inc'}
-
-uses
-  sysutils,
-{$ifdef mswindows}
-  windows,
-{$else}
-  dos,
-  unix,
-{$endif}
-  strutils,
-  nsystem;
-
-type
-  EOSError = class(exception)
-  end;
-  
-  TSplitFileResult = record
-    dir, name, ext: string;
-  end;
-  TSplitPathResult = record
-    head, tail: string;
-  end;
-
-const
-  curdir = '.';
-{$ifdef mswindows}
-  dirsep = '\'; // seperator within paths
-  altsep = '/';
-  exeExt = 'exe';
-{$else}
-  dirsep = '/';
-  altsep = #0; // work around fpc bug
-  exeExt = '';
-{$endif}
-  pathSep = ';'; // seperator between paths
-  sep = dirsep; // alternative name
-  extsep = '.';
-
-function executeShellCommand(const cmd: string): int;
-// like exec, but gets a command
-
-function FileNewer(const a, b: string): Boolean;
-// returns true if file a is newer than file b
-// i.e. a was modified before b
-// if a or b does not exist returns false
-
-function getEnv(const name: string): string;
-procedure putEnv(const name, val: string);
-
-function JoinPath(const head, tail: string): string; overload;
-function JoinPath(const parts: array of string): string; overload;
-
-procedure SplitPath(const path: string; out head, tail: string); overload;
-
-function extractDir(const f: string): string;
-function extractFilename(const f: string): string;
-
-function getApplicationDir(): string;
-function getApplicationFilename(): string;
-
-function getCurrentDir: string;
-function GetConfigDir(): string;
-
-
-procedure SplitFilename(const filename: string; out name, extension: string);
-
-function ExistsFile(const filename: string): Boolean;
-function AddFileExt(const filename, ext: string): string;
-function ChangeFileExt(const filename, ext: string): string;
-
-procedure createDir(const dir: string);
-function expandFilename(filename: string): string;
-
-function UnixToNativePath(const path: string): string;
-
-function sameFile(const path1, path2: string): boolean;
-
-
-function extractFileTrunk(const filename: string): string;
-
-function splitFile(const path: string): TSplitFileResult;
-function splitPath(const path: string): TSplitPathResult; overload;
-
-
-implementation
-
-function splitFile(const path: string): TSplitFileResult;
-var
-  sepPos, dotPos, i: int;
-begin
-  if (path = '') or (path[length(path)] in [dirSep, altSep]) then begin
-    result.dir := path;
-    result.name := '';
-    result.ext := '';
-  end
-  else begin
-    sepPos := 0;
-    dotPos := length(path)+1;
-    for i := length(path) downto 1 do begin
-      if path[i] = ExtSep then begin
-        if (dotPos = length(path)+1) and (i > 1) then dotPos := i
-      end
-      else if path[i] in [dirsep, altsep] then begin
-        sepPos := i; break
-      end
-    end;
-    result.dir := ncopy(path, 1, sepPos-1);
-    result.name := ncopy(path, sepPos+1, dotPos-1);
-    result.ext := ncopy(path, dotPos)
-  end
-end;
-
-function extractFileTrunk(const filename: string): string;
-var
-  f, e, dir: string;
-begin
-  splitPath(filename, dir, f);
-  splitFilename(f, result, e);
-end;
-
-function GetConfigDir(): string;
-begin
-{$ifdef windows}
-  result := getEnv('APPDATA') + '\';
-{$else}
-  result := getEnv('HOME') + '/.config/';
-{$endif}
-end;
-
-function getCurrentDir: string;
-begin
-  result := sysutils.GetCurrentDir();
-end;
-
-function UnixToNativePath(const path: string): string;
-begin
-  if dirSep <> '/' then
-    result := replace(path, '/', dirSep)
-  else
-    result := path;
-end;
-
-function expandFilename(filename: string): string;
-begin
-  result := sysutils.expandFilename(filename)
-end;
-
-function sameFile(const path1, path2: string): boolean;
-begin
-  result := cmpIgnoreCase(expandFilename(UnixToNativePath(path1)),
-                          expandFilename(UnixToNativePath(path2))) = 0;
-end;
-
-procedure createDir(const dir: string);
-var
-  i: int;
-begin
-  for i := 2 to length(dir) do begin
-    if dir[i] in [sep, altsep] then sysutils.createDir(ncopy(dir, 1, i-1));
-  end;
-  sysutils.createDir(dir);
-end;
-
-function searchExtPos(const s: string): int;
-var
-  i: int;
-begin
-  result := -1;
-  for i := length(s) downto 2 do
-    if s[i] = extsep then begin
-      result := i;
-      break
-    end
-    else if s[i] in [dirsep, altsep] then break
-end;
-
-function normExt(const ext: string): string;
-begin
-  if (ext = '') or (ext[1] = extSep) then
-    result := ext // no copy needed here
-  else
-    result := extSep + ext
-end;
-
-function AddFileExt(const filename, ext: string): string;
-var
-  extPos: int;
-begin
-  extPos := searchExtPos(filename);
-  if extPos < 0 then
-    result := filename + normExt(ext)
-  else
-    result := filename
-end;
-
-function ChangeFileExt(const filename, ext: string): string;
-var
-  extPos: int;
-begin
-  extPos := searchExtPos(filename);
-  if extPos < 0 then
-    result := filename + normExt(ext)
-  else
-    result := ncopy(filename, strStart, extPos-1) + normExt(ext)
-end;
-
-procedure SplitFilename(const filename: string; out name, extension: string);
-var
-  extPos: int;
-begin
-  extPos := searchExtPos(filename);
-  if extPos > 0 then begin
-    name := ncopy(filename, 1, extPos-1);
-    extension := ncopy(filename, extPos);
-  end
-  else begin
-    name := filename;
-    extension := ''
-  end
-end;
-
-procedure SplitPath(const path: string; out head, tail: string);
-var
-  sepPos, i: int;
-begin
-  sepPos := 0;
-  for i := length(path) downto 1 do
-    if path[i] in [sep, altsep] then begin
-      sepPos := i;
-      break
-    end;
-  if sepPos > 0 then begin
-    head := ncopy(path, 1, sepPos-1);
-    tail := ncopy(path, sepPos+1)
-  end
-  else begin
-    head := '';
-    tail := path
-  end
-end;
-
-function SplitPath(const path: string): TSplitPathResult;
-begin
-  SplitPath(path, result.head, result.tail);
-end;
-
-function getApplicationFilename(): string;
-{$ifdef darwin}
-var
-  tail: string;
-  p: int;
-  paths: TStringSeq;
-begin
-  // little heuristic that may works on Mac OS X:
-  result := ParamStr(0); // POSIX guaranties that this contains the executable
-                         // as it has been executed by the calling process
-  if (length(result) > 0) and (result[1] <> '/') then begin
-    // not an absolute path?
-    // iterate over any path in the $PATH environment variable
-    paths := split(getEnv('PATH'), [':']);
-    for p := 0 to high(paths) do begin
-      tail := joinPath(paths[p], result);
-      if ExistsFile(tail) then begin result := tail; exit end
-    end
-  end
-end;
-{$else}
-begin
-  result := ParamStr(0);
-end;
-{$endif}
-
-function getApplicationDir(): string;
-begin
-  result := extractDir(getApplicationFilename());
-end;
-
-function extractDir(const f: string): string;
-var
-  tail: string;
-begin
-  SplitPath(f, result, tail)
-end;
-
-function extractFilename(const f: string): string;
-var
-  head: string;
-begin
-  SplitPath(f, head, result);
-end;
-
-function JoinPath(const head, tail: string): string;
-begin
-  if head = '' then
-    result := tail
-  else if head[length(head)] in [sep, altsep] then
-    if (tail <> '') and (tail[1] in [sep, altsep]) then
-      result := head + ncopy(tail, 2)
-    else
-      result := head + tail
-  else
-    if (tail <> '') and (tail[1] in [sep, altsep]) then
-      result := head + tail
-    else
-      result := head + sep + tail
-end;
-
-function JoinPath(const parts: array of string): string;
-var
-  i: int;
-begin
-  result := parts[0];
-  for i := 1 to high(parts) do
-    result := JoinPath(result, parts[i])
-end;
-
-{$ifdef mswindows}
-function getEnv(const name: string): string;
-var
-  len: Cardinal;
-begin
-  // get the length:
-  len := windows.GetEnvironmentVariable(PChar(name), nil, 0);
-  if len = 0 then
-    result := ''
-  else begin
-    setLength(result, len-1);
-    windows.GetEnvironmentVariable(PChar(name), @result[1], len);
-  end
-end;
-
-procedure putEnv(const name, val: string);
-begin
-  windows.SetEnvironmentVariable(PChar(name), PChar(val));
-end;
-
-function GetDateStr: string;
-var
-  st: SystemTime;
-begin
-  Windows.GetLocalTime({$ifdef fpc} @ {$endif} st);
-  result := IntToStr(st.wYear, 4) + '/' + IntToStr(st.wMonth, 2) + '/'
-    + IntToStr(st.wDay, 2)
-end;
-
-procedure GetDate(var Day, Month, Year: int);
-var
-  st: SystemTime;
-begin
-  Windows.GetLocalTime({$ifdef fpc} @ {$endif} st);
-  Day := st.wDay;
-  Month := st.wMonth;
-  Year := st.wYear
-end;
-
-procedure GetTime(var Hours, Minutes, Seconds, Millisec: int);
-var
-  st: SystemTime;
-begin
-  Windows.GetLocalTime({$ifdef fpc} @ {$endif} st);
-  Hours := st.wHour;
-  Minutes := st.wMinute;
-  Seconds := st.wSecond;
-  Millisec := st.wMilliseconds
-end;
-{$else} // not windows
-
-function setenv(var_name, new_value: PChar;
-                change_flag: Boolean): Integer; cdecl; external 'libc';
-
-type
-  TPair = record
-    key, val: string;
-  end;
-  TPairs = array of TPair;
-var
-  myEnv: TPairs; // this is a horrible fix for Posix systems!
-
-function getMyEnvIdx(const key: string): int;
-var
-  i: int;
-begin
-  for i := 0 to high(myEnv) do
-    if myEnv[i].key = key then begin result := i; exit end;
-  result := -1
-end;
-
-function getMyEnv(const key: string): string;
-var
-  i: int;
-begin
-  i := getMyEnvIdx(key);
-  if i >= 0 then result := myEnv[i].val
-  else result := ''
-end;
-
-procedure setMyEnv(const key, val: string);
-var
-  i: int;
-begin
-  i := getMyEnvIdx(key);
-  if i < 0 then begin
-    i := length(myEnv);
-    setLength(myEnv, i+1);
-    myEnv[i].key := key
-  end;
-  myEnv[i].val := val
-end;
-
-procedure putEnv(const name, val: string);
-begin
-  setEnv(pchar(name), pchar(val), true);
-  setMyEnv(name, val);
-//  writeln('putEnv() is not supported under this OS');
-//  halt(3);
-end;
-
-function getEnv(const name: string): string;
-begin
-  result := getMyEnv(name);
-  if result = '' then result := dos.getEnv(name);
-end;
-
-function GetDateStr: string;
-var
-  wMonth, wYear, wDay: Word;
-begin
-  SysUtils.DecodeDate(Date, wYear, wMonth, wDay);
-  result := IntToStr(wYear, 4) + '/' + IntToStr(wMonth, 2) + '/'
-    + IntToStr(wDay, 2)
-end;
-
-procedure GetDate(var Day, Month, Year: int);
-var
-  wMonth, wYear, wDay: Word;
-begin
-  SysUtils.DecodeDate(Date, wYear, wMonth, wDay);
-  Day := wDay;
-  Month := wMonth;
-  Year := wYear
-end;
-
-procedure GetTime(var Hours, Minutes, Seconds, Millisec: int);
-var
-  wHour, wMin, wSec, wMSec: Word;
-begin
-  SysUtils.DecodeTime(Time, wHour, wMin, wSec, wMSec);
-  Hours := wHour; Minutes := wMin; Seconds := wSec; Millisec := wMSec;
-end;
-{$endif}
-
-function GetTimeStr: string;
-var
-  Hour, Min, Sec, MSec: int;
-begin
-  GetTime(Hour, min, sec, msec);
-  result := IntToStr(Hour, 2) + ':' + IntToStr(min, 2) + ':' + IntToStr(Sec, 2)
-end;
-
-function DateAndTime: string;
-begin
-  result := GetDateStr() + ' ' + getTimeStr()
-end;
-
-{$ifdef windows}
-
-function executeShellCommand(const cmd: string): int;
-var
-  SI: TStartupInfo;
-  ProcInfo: TProcessInformation;
-  process: THandle;
-  L: DWORD;
-begin
-  FillChar(SI, Sizeof(SI), 0);
-  SI.cb := SizeOf(SI);
-  SI.hStdError := GetStdHandle(STD_ERROR_HANDLE);
-  SI.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
-  SI.hStdOutput := GetStdHandle(STD_OUTPUT_HANDLE);
-  if not Windows.CreateProcess(nil, PChar(cmd), nil, nil, false,
-    NORMAL_PRIORITY_CLASS, nil {Windows.GetEnvironmentStrings()},
-    nil, SI, ProcInfo)
-  then
-    result := getLastError()
-  else begin
-    Process := ProcInfo.hProcess;
-    CloseHandle(ProcInfo.hThread);
-    if WaitForSingleObject(Process, INFINITE) <> $ffffffff then begin
-      GetExitCodeProcess(Process, L);
-      result := int(L)
-    end
-    else
-      result := -1;
-    CloseHandle(Process);
-  end;
-end;
-
-{$else}
-  {$ifdef windows}
-function executeShellCommand(const cmd: string): int;
-begin
-  result := dos.Exec(cmd, '')
-end;
-//C:\Eigenes\compiler\MinGW\bin;
-  {$else}
-// fpc has a portable function for this
-function executeShellCommand(const cmd: string): int;
-begin
-  result := shell(cmd);
-end;
-  {$endif}
-{$endif}
-
-{$ifdef windows}
-type
-  TFileAge = packed record
-    Low, High: Longword;
-  end;
-{$else}
-type
-  TFileAge = dos.DateTime;
-  {DateTime = packed record
-    Year: Word;
-    Month: Word;
-    Day: Word;
-    Hour: Word;
-    Min: Word;
-    Sec: Word;
-  end;}
-{$endif}
-
-function GetLastWriteTime(Filename: PChar): TFileAge;
-{$ifdef windows}
-var
-  Handle: THandle;
-  FindRec: Win32_Find_Data;
-begin
-  Handle := FindFirstFile(Filename, FindRec);
-  FindClose(Handle);
-  result := TFileAge(FindRec.ftLastWriteTime)
-end;
-{$else}
-var
-  f: file;
-  time: longint;
-begin
-  AssignFile(f, AnsiString(Filename));
-  Reset(f);
-  GetFTime(f, time);
-  unpackTime(time, result);
-  CloseFile(f);
-end;
-{$endif}
-
-function Newer(file1, file2: PChar): Boolean;
-var
-  Time1, Time2: TFileAge;
-begin
-  Time1 := GetLastWriteTime(file1);
-  Time2 := GetLastWriteTime(file2);
-{$ifdef windows}
-  if Time1.High <> Time2.High then
-    result := Time1.High > Time2.High
-  else
-    result := Time1.Low > Time2.Low
-{$else}
-  if time1.year <> time2.year then
-    result := time1.year > time2.year
-  else if time1.month <> time2.month then
-    result := time1.month > time2.month
-  else if time1.day <> time2.day then
-    result := time1.day > time2.day
-  else if time1.hour <> time2.hour then
-    result := time1.hour > time2.hour
-  else if time1.min <> time2.min then
-    result := time1.min > time2.min
-  else if time1.sec <> time2.sec then
-    result := time1.sec > time2.sec
-{$endif}
-end;
-
-{$ifopt I+} {$define I_on} {$I-} {$endif}
-function ExistsFile(const filename: string): Boolean;
-var
-  txt: TextFile;
-begin
-  AssignFile(txt, filename);
-  Reset(txt);
-  if IOResult = 0 then begin
-    result := true;
-    CloseFile(txt)
-  end
-  else result := false
-end;
-{$ifdef I_on} {$I+} {$endif}
-
-function FileNewer(const a, b: string): Boolean;
-begin
-  if not ExistsFile(PChar(a)) or not ExistsFile(PChar(b)) then
-    result := false
-  else
-    result := newer(PChar(a), PChar(b))
-end;
-
-end.