freepascal.compiler/rtl/morphos/system.pp

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 2004 by Karoly Balogh for Genesi S.a.r.l.

    System unit for MorphOS/PowerPC
  
    Uses parts of the Commodore Amiga/68k port by Carl Eric Codere 
    and Nils Sjoholm

    MorphOS port was done on a free Pegasos II/G4 machine 
    provided by Genesi S.a.r.l. <www.genesi.lu>

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

unit {$ifdef VER1_0}SysMorph{$else}System{$endif};

interface

{$define FPC_IS_SYSTEM}

{$I systemh.inc}

type 
  THandle = LongInt;

{$I heaph.inc}

const
  LineEnding = #10;
  LFNSupport = True;
  DirectorySeparator = '/';
  DriveSeparator = ':';
  PathSeparator = ';';
  maxExitCode = 255;

const
  UnusedHandle    : LongInt = -1;
  StdInputHandle  : LongInt = 0;
  StdOutputHandle : LongInt = 0;
  StdErrorHandle  : LongInt = 0;

  FileNameCaseSensitive : Boolean = False;

  sLineBreak : string[1] = LineEnding;
  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;

  BreakOn : Boolean = True;


var
  MOS_ExecBase   : Pointer; external name '_ExecBase';
  MOS_DOSBase    : Pointer;
  MOS_UtilityBase: Pointer;

  MOS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
  MOS_origDir  : LongInt; { original directory on startup }
  MOS_ambMsg   : Pointer; 
  MOS_ConName  : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT';
  MOS_ConHandle: LongInt;
  
  argc: LongInt;
  argv: PPChar;
  envp: PPChar;


implementation

{$I system.inc}


{*****************************************************************************
                           MorphOS structures
*****************************************************************************}

{$include execd.inc}
{$include timerd.inc}
{$include doslibd.inc}


{*****************************************************************************
                           MorphOS functions
*****************************************************************************}

{ exec.library functions }

{$include execf.inc}
{$include doslibf.inc}


{*****************************************************************************
                    System Dependent Structures/Consts
*****************************************************************************}

const
  CTRL_C           = 20;      { Error code on CTRL-C press }


{*****************************************************************************
                  MorphOS File-handling Support Functions
*****************************************************************************}
type
  { AmigaOS does not automatically close opened files on exit back to  }
  { the operating system, therefore as a precuation we close all files }
  { manually on exit.                                                  }
  PFileList = ^TFileList;
  TFileList = record { no packed, must be correctly aligned }
    handle : LongInt;      { Handle to file    }
    next   : PFileList;      { Next file in list }
  end;

var
  MOS_fileList: PFileList; { List pointer to opened files }

{ Function to be called at program shutdown, to close all opened files }
procedure CloseList(l: PFileList);
var 
  tmpNext   : PFileList;
  tmpHandle : LongInt;
begin
  if l=nil then exit;

  { First, close all tracked files }
  tmpNext:=l^.next;
  while tmpNext<>nil do begin
    tmpHandle:=tmpNext^.handle;
    if (tmpHandle<>StdInputHandle) and (tmpHandle<>StdOutputHandle) 
       and (tmpHandle<>StdErrorHandle) then begin
      dosClose(tmpHandle);
    end;
    tmpNext:=tmpNext^.next;
  end;
 
  { Next, erase the linked list }
  while l<>nil do begin
    tmpNext:=l;
    l:=l^.next;
    dispose(tmpNext);
  end;
end;

{ Function to be called to add a file to the opened file list }
procedure AddToList(var l: PFileList; h: LongInt);
var
  p     : PFileList;
  inList: Boolean;
begin
  inList:=False;
  if l<>nil then begin
    { if there is a valid filelist, search for the value }
    { in the list to avoid double additions }
    p:=l;
    while (p^.next<>nil) and (not inList) do
      if p^.next^.handle=h then inList:=True
                           else p:=p^.next;
    p:=nil;
  end else begin
    { if the list is not yet allocated, allocate it. }
    New(l);
    l^.next:=nil;
  end;

  if not inList then begin
    New(p);
    p^.handle:=h;
    p^.next:=l^.next;
    l^.next:=p;
  end;
end;

{ Function to be called to remove a file from the list }
procedure RemoveFromList(var l: PFileList; h: longint);
var
  p     : PFileList;
  inList: Boolean;
begin
  if l=nil then exit;

  inList:=False;
  p:=l;
  while (p^.next<>nil) and (not inList) do
    if p^.next^.handle=h then inList:=True
                         else p:=p^.next;

  if p^.next<>nil then begin
    dispose(p^.next);
    p^.next:=p^.next^.next;
  end;
end;


{*****************************************************************************
                       Misc. System Dependent Functions
*****************************************************************************}

procedure haltproc(e:longint);cdecl;external name '_haltproc';

procedure System_exit;
begin
  { We must remove the CTRL-C FALG here because halt }
  { may call I/O routines, which in turn might call  }
  { halt, so a recursive stack crash                 }
  if BreakOn then begin
    if (SetSignal(0,0) and SIGBREAKF_CTRL_C)<>0 then
      SetSignal(0,SIGBREAKF_CTRL_C);
  end;

  { Closing opened files }
  CloseList(MOS_fileList);

  if MOS_UtilityBase<>nil then CloseLibrary(MOS_UtilityBase);
  if MOS_DOSBase<>nil then CloseLibrary(MOS_DOSBase);
  if MOS_heapPool<>nil then DeletePool(MOS_heapPool);
  haltproc(ExitCode);
end;

{ Converts a MorphOS dos.library error code to a TP compatible error code }
{ Based on 1.0.x Amiga RTL }
procedure dosError2InOut(errno: LongInt);
begin
  case errno of
    ERROR_BAD_NUMBER,
    ERROR_ACTION_NOT_KNOWN,
    ERROR_NOT_IMPLEMENTED : InOutRes := 1;

    ERROR_OBJECT_NOT_FOUND : InOutRes := 2;
    ERROR_DIR_NOT_FOUND :  InOutRes := 3;
    ERROR_DISK_WRITE_PROTECTED : InOutRes := 150;
    ERROR_OBJECT_WRONG_TYPE : InOutRes := 151;

    ERROR_OBJECT_EXISTS,
    ERROR_DELETE_PROTECTED,
    ERROR_WRITE_PROTECTED,
    ERROR_READ_PROTECTED,
    ERROR_OBJECT_IN_USE,
    ERROR_DIRECTORY_NOT_EMPTY : InOutRes := 5;

    ERROR_NO_MORE_ENTRIES : InOutRes := 18;
    ERROR_RENAME_ACROSS_DEVICES : InOutRes := 17;
    ERROR_DISK_FULL : InOutRes := 101;
    ERROR_INVALID_RESIDENT_LIBRARY : InoutRes := 153;
    ERROR_BAD_HUNK : InOutRes := 153;
    ERROR_NOT_A_DOS_DISK : InOutRes := 157;

    ERROR_NO_DISK,
    ERROR_DISK_NOT_VALIDATED,
    ERROR_DEVICE_NOT_MOUNTED : InOutRes := 152;

    ERROR_SEEK_ERROR : InOutRes := 156;

    ERROR_LOCK_COLLISION,
    ERROR_LOCK_TIMEOUT,
    ERROR_UNLOCK_ERROR,
    ERROR_INVALID_LOCK,
    ERROR_INVALID_COMPONENT_NAME,
    ERROR_BAD_STREAM_NAME,
    ERROR_FILE_NOT_OBJECT : InOutRes := 6;
   else
    InOutres := errno;
  end;
end;

{ Used for CTRL_C checking in I/O calls }
procedure checkCTRLC;
begin
  if BreakOn then begin
    if (SetSignal(0,0) And SIGBREAKF_CTRL_C)<>0 then begin
      { Clear CTRL-C signal }
      SetSignal(0,SIGBREAKF_CTRL_C);
      Halt(CTRL_C);
    end;
  end;
end;

{ Generates correct argument array on startup } 
procedure GenerateArgs;
var
  argvlen : longint;

  procedure allocarg(idx,len:longint);
    var
      i,oldargvlen : longint;
    begin
      if idx>=argvlen then
        begin
          oldargvlen:=argvlen;
          argvlen:=(idx+8) and (not 7);
          sysreallocmem(argv,argvlen*sizeof(pointer));
          for i:=oldargvlen to argvlen-1 do
            argv[i]:=nil;
        end;
      { use realloc to reuse already existing memory }
      sysreallocmem(argv[idx],len+1);
    end;

var
  count: word;
  start: word;
  localindex: word;
  p : pchar;
  temp : string;

begin
  p:=GetArgStr;
  argvlen:=0;

  { Set argv[0] }
  temp:=paramstr(0);
  allocarg(0,length(temp));
  move(temp[1],argv[0]^,length(temp));
  argv[0][length(temp)]:=#0;

  { check if we're started from Ambient }
  if MOS_ambMsg<>nil then 
    begin
      argc:=0;
      exit;
    end;

  { Handle the other args }
  count:=0;
  { first index is one }
  localindex:=1;
  while (p[count]<>#0) do
    begin
      while (p[count]=' ') or (p[count]=#9) or (p[count]=LineEnding) do inc(count);
      start:=count;
      while (p[count]<>#0) and (p[count]<>' ') and (p[count]<>#9) and (p[count]<>LineEnding) do inc(count);
      if (count-start>0) then
        begin
          allocarg(localindex,count-start);
          move(p[start],argv[localindex]^,count-start);
          argv[localindex][count-start]:=#0;
          inc(localindex);
        end;
    end;
  argc:=localindex;
end;

function GetProgDir: String;
var
  s1     : String;
  alock  : LongInt;
  counter: Byte;
begin
  GetProgDir:='';
  FillChar(s1,255,#0);
  { GetLock of program directory }
  alock:=GetProgramDir;
  if alock<>0 then begin
    if NameFromLock(alock,@s1[1],255) then begin
      counter:=1;
      while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
      s1[0]:=Char(counter-1);
      GetProgDir:=s1;
    end;
  end;
end;

function GetProgramName: String;
{ Returns ONLY the program name }
var
  s1     : String;
  counter: Byte;
begin
  GetProgramName:='';
  FillChar(s1,255,#0);
  if GetProgramName(@s1[1],255) then begin

      { now check out and assign the length of the string }
      counter := 1;
      while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
      s1[0]:=Char(counter-1);

      { now remove any component path which should not be there }
      for counter:=length(s1) downto 1 do
          if (s1[counter] = '/') or (s1[counter] = ':') then break;
      { readjust counterv to point to character }
      if counter<>1 then Inc(counter);

      GetProgramName:=copy(s1,counter,length(s1));
  end;
end;


{*****************************************************************************
                             ParamStr/Randomize
*****************************************************************************}

{ number of args }
function paramcount : longint;
begin
  if MOS_ambMsg<>nil then
    paramcount:=0
  else
    paramcount:=argc-1;
end;

{ argument number l }
function paramstr(l : longint) : string;
var
  s1: String;
begin
  paramstr:='';  
  if MOS_ambMsg<>nil then exit;

  if l=0 then begin
    s1:=GetProgDir;
    if s1[length(s1)]=':' then paramstr:=s1+GetProgramName
                          else paramstr:=s1+'/'+GetProgramName;
  end else begin
    if (l>0) and (l+1<=argc) then paramstr:=strpas(argv[l]);
  end;
end;

{ set randseed to a new pseudo random value }
procedure randomize;
var tmpTime: TDateStamp;
begin
  DateStamp(@tmpTime);
  randseed:=tmpTime.ds_tick;
end;


{*****************************************************************************
                              Heap Management
*****************************************************************************}

var
  int_heap     : LongInt; external name 'HEAP';
  int_heapsize : LongInt; external name 'HEAPSIZE';

{ first address of heap }
function getheapstart:pointer;
begin
  getheapstart:=@int_heap;
end;

{ current length of heap }
function getheapsize:longint;
begin
  getheapsize:=int_heapsize;
end;

{ function to allocate size bytes more for the program }
{ must return the first address of new data space or nil if fail }
function Sbrk(size : longint):pointer;
begin
  Sbrk:=AllocPooled(MOS_heapPool,size);
end;

{*****************************************************************************
      OS Memory allocation / deallocation 
 ****************************************************************************}

function SysOSAlloc(size: ptrint): pointer;
begin
  result := sbrk(size);
end;

{$define HAS_SYSOSFREE}

procedure SysOSFree(p: pointer; size: ptrint);
begin
  FreePooled(MOS_heapPool,p,size);
end;

{$I heap.inc}


{*****************************************************************************
                           Directory Handling
*****************************************************************************}
procedure mkdir(const s : string);[IOCheck];
var
  buffer : array[0..255] of char;
  j : Integer;
  tmpStr : string;
  tmpLock : LongInt;
begin
  checkCTRLC;
  if (s='') or (InOutRes<>0) then exit;
  tmpStr:=s;

  for j:=1 to length(tmpStr) do
    if tmpStr[j]='\' then tmpStr[j]:='/';
  move(tmpStr[1],buffer,length(tmpStr));
  buffer[length(tmpStr)]:=#0;

  tmpLock:=CreateDir(buffer);
  if tmpLock=0 then begin
    dosError2InOut(IoErr);
    exit;
  end;
  UnLock(tmpLock);
end;

procedure rmdir(const s : string);[IOCheck];
var
  buffer : array[0..255] of char;
  j : Integer;
  tmpStr : string;
begin
  checkCTRLC;
  if (s='.') then InOutRes:=16;
  If (s='') or (InOutRes<>0) then exit;
  tmpStr:=s;
  for j:=1 to length(tmpStr) do
    if tmpStr[j] = '\' then tmpStr[j] := '/';
  move(tmpStr[1],buffer,length(tmpStr));
  buffer[length(tmpStr)]:=#0;
  if not DeleteFile(buffer) then
    dosError2InOut(IoErr);
end;

procedure chdir(const s : string);[IOCheck];
var
  buffer : array[0..255] of char;
  alock : LongInt;
  FIB : PFileInfoBlock;
  j : Integer;
  tmpStr : string;
begin
  checkCTRLC;
  If (s='') or (InOutRes<>0) then exit;
  tmpStr:=s;

  for j:=1 to length(tmpStr) do
    if tmpStr[j]='\' then tmpStr[j]:='/';

  { Return parent directory }
  if s='..' then begin
    getdir(0,tmpStr);
    j:=length(tmpStr);
    { Look through the previous paths }
    while (tmpStr[j]<>'/') and (tmpStr[j]<>':') and (j>0) do
      dec(j);
    if j>0 then
      tmpStr:=copy(tmpStr,1,j);
  end;
  alock:=0;

  move(tmpStr[1],buffer,length(tmpStr));
  buffer[length(tmpStr)]:=#0;
  { Changing the directory is a pretty complicated affair }
  {   1) Obtain a lock on the directory                   }
  {   2) CurrentDir the lock                              }
  alock:=Lock(buffer,SHARED_LOCK);
  if alock=0 then begin
    dosError2InOut(IoErr);
    exit;
  end;

  FIB:=nil;
  new(FIB);
 
  if (Examine(alock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
    alock := CurrentDir(alock);
    if MOS_OrigDir=0 then begin
      MOS_OrigDir:=alock;
      alock:=0;
    end;
  end;

  if alock<>0 then Unlock(alock);
  if assigned(FIB) then dispose(FIB)
end;

procedure GetDir (DriveNr: byte; var Dir: ShortString);
var tmpbuf: array[0..255] of char;
begin
  checkCTRLC;
  Dir:='';
  if not GetCurrentDirName(tmpbuf,256) then
    dosError2InOut(IoErr)
  else
    Dir:=strpas(tmpbuf);
end;


{****************************************************************************
                        Low level File Routines
               All these functions can set InOutRes on errors
****************************************************************************}

{ close a file from the handle value }
procedure do_close(handle : longint);
begin
  RemoveFromList(MOS_fileList,handle);
  { Do _NOT_ check CTRL_C on Close, because it will conflict 
    with System_Exit! }
  if not dosClose(handle) then
    dosError2InOut(IoErr);
end;

procedure do_erase(p : pchar);
begin
  checkCTRLC;
  if not DeleteFile(p) then
    dosError2InOut(IoErr);
end;

procedure do_rename(p1,p2 : pchar);
begin
  checkCTRLC;
  if not dosRename(p1,p2) then
    dosError2InOut(IoErr);
end;

function do_write(h:longint; addr: pointer; len: longint) : longint;
var dosResult: LongInt;
begin
  checkCTRLC;
  do_write:=0; 
  if len<=0 then exit; 
  
  dosResult:=dosWrite(h,addr,len);
  if dosResult<0 then begin
    dosError2InOut(IoErr);
  end else begin
    do_write:=dosResult;
  end;
end;

function do_read(h:longint; addr: pointer; len: longint) : longint;
var dosResult: LongInt;
begin
  checkCTRLC;
  do_read:=0; 
  if len<=0 then exit; 
  
  dosResult:=dosRead(h,addr,len);
  if dosResult<0 then begin
    dosError2InOut(IoErr);
  end else begin
    do_read:=dosResult;
  end
end;

function do_filepos(handle : longint) : longint;
var dosResult: LongInt;
begin
  checkCTRLC;
  do_filepos:=0;
  
  { Seeking zero from OFFSET_CURRENT to find out where we are }
  dosResult:=dosSeek(handle,0,OFFSET_CURRENT);
  if dosResult<0 then begin
    dosError2InOut(IoErr);
  end else begin
    do_filepos:=dosResult;
  end;
end;

procedure do_seek(handle,pos : longint);
begin
  checkCTRLC;
  { Seeking from OFFSET_BEGINNING }
  if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then
    dosError2InOut(IoErr);
end;

function do_seekend(handle:longint):longint;
var dosResult: LongInt;
begin
  checkCTRLC;
  do_seekend:=0;
  
  { Seeking to OFFSET_END }
  dosResult:=dosSeek(handle,0,OFFSET_END);
  if dosResult<0 then begin
    dosError2InOut(IoErr);
  end else begin
    do_seekend:=dosResult;
  end
end;

function do_filesize(handle : longint) : longint;
var currfilepos: longint;
begin
  checkCTRLC;
  currfilepos:=do_filepos(handle);
  { We have to do this twice, because seek returns the OLD position }
  do_filesize:=do_seekend(handle);
  do_filesize:=do_seekend(handle);
  do_seek(handle,currfilepos)
end;

{ truncate at a given position }
procedure do_truncate (handle,pos:longint);
begin
  checkCTRLC;
  { Seeking from OFFSET_BEGINNING }
  if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
    dosError2InOut(IoErr);
end;

procedure do_open(var f;p:pchar;flags:longint);
{
  filerec and textrec have both handle and mode as the first items so
  they could use the same routine for opening/creating.
  when (flags and $10)   the file will be append
  when (flags and $100)  the file will be truncate/rewritten
  when (flags and $1000) there is no check for close (needed for textfiles)
}
var
  i,j : LongInt;
  openflags : LongInt;
  path : String;
  buffer : array[0..255] of Char;
  index : Integer;
  s : String;
begin
  path:=strpas(p);
  for index:=1 to length(path) do
    if path[index]='\' then path[index]:='/';
  { remove any dot characters and replace by their current }
  { directory equivalent.                                  }

  { look for parent directory }
  if pos('../',path) = 1 then
    begin
      delete(path,1,3);
      getdir(0,s);
      j:=length(s);
      while (s[j]<>'/') and (s[j]<>':') and (j>0) do
        dec(j);
      if j > 0 then
        s:=copy(s,1,j);
      path:=s+path;
    end
  else

  { look for current directory }
  if pos('./',path) = 1 then
    begin
      delete(path,1,2);
      getdir(0,s);
      if (s[length(s)]<>'/') and (s[length(s)]<>':') then
        s:=s+'/';
      path:=s+path;
    end;

  move(path[1],buffer,length(path));
  buffer[length(path)]:=#0;

   { close first if opened }
  if ((flags and $10000)=0) then 
    begin
      case filerec(f).mode of
        fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
        fmclosed : ;
        else begin
          inoutres:=102; {not assigned}
          exit;
        end;
      end;
    end;

  { reset file handle }
  filerec(f).handle:=UnusedHandle;

  { convert filemode to filerec modes }
  { READ/WRITE on existing file }
  { RESET/APPEND                }
  openflags := 1005;
  case (flags and 3) of
    0 : filerec(f).mode:=fminput;
    1 : filerec(f).mode:=fmoutput;
    2 : filerec(f).mode:=fminout;
  end;

  { rewrite (create a new file) }
  if (flags and $1000)<>0 then openflags := 1006;

  { empty name is special }
  if p[0]=#0 then 
    begin
      case filerec(f).mode of
        fminput : 
          filerec(f).handle:=StdInputHandle;
        fmappend,
        fmoutput : begin
          filerec(f).handle:=StdOutputHandle;
          filerec(f).mode:=fmoutput; {fool fmappend}
        end;
      end;
      exit;
    end;
  
  i:=Open(buffer,openflags);
  if i=0 then 
    begin
      dosError2InOut(IoErr);
    end else begin
      AddToList(MOS_fileList,i);
      filerec(f).handle:=i;
    end;

  { append mode }
  if ((Flags and $100)<>0) and (FileRec(F).Handle<>UnusedHandle) then
    begin
      do_seekend(filerec(f).handle);
      filerec(f).mode:=fmoutput; {fool fmappend}
    end;
end;

function do_isdevice(handle:longint):boolean;
begin
  if (handle=StdOutputHandle) or (handle=StdInputHandle) or
     (handle=StdErrorHandle) then
    do_isdevice:=True
  else
    do_isdevice:=False;
end;

{*****************************************************************************
                          UnTyped File Handling
*****************************************************************************}

{$i file.inc}

{*****************************************************************************
                           Typed File Handling
*****************************************************************************}

{$i typefile.inc}

{*****************************************************************************
                           Text File Handling
*****************************************************************************}

{$I text.inc}


{ MorphOS specific startup }
procedure SysInitMorphOS;
var self: PProcess;
begin
 self:=PProcess(FindTask(nil));
 if self^.pr_CLI=0 then begin
   { if we're running from Ambient/Workbench, we catch its message }
   WaitPort(@self^.pr_MsgPort);
   MOS_ambMsg:=GetMsg(@self^.pr_MsgPort);
 end;

 MOS_DOSBase:=OpenLibrary('dos.library',50);
 if MOS_DOSBase=nil then Halt(1);
 MOS_UtilityBase:=OpenLibrary('utility.library',50);
 if MOS_UtilityBase=nil then Halt(1);

 { Creating the memory pool for growing heap }
 MOS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
 if MOS_heapPool=nil then Halt(1);

 if MOS_ambMsg=nil then begin
   StdInputHandle:=dosInput;
   StdOutputHandle:=dosOutput;
 end else begin
   MOS_ConHandle:=Open(MOS_ConName,1005);
   if MOS_ConHandle<>0 then begin
     StdInputHandle:=MOS_ConHandle;
     StdOutputHandle:=MOS_ConHandle;
   end else
     Halt(1);
 end;
end;


procedure SysInitStdIO;
begin
  OpenStdIO(Input,fmInput,StdInputHandle);
  OpenStdIO(Output,fmOutput,StdOutputHandle);
  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
 
  { * MorphOS doesn't have a separate stderr, just like AmigaOS (???) * }
  StdErrorHandle:=StdOutputHandle;
  // OpenStdIO(StdErr,fmOutput,StdErrorHandle);
end;


begin
  IsConsole := TRUE;
  IsLibrary := FALSE;
  StackLength := InitialStkLen;
  StackBottom := Sptr - StackLength;
{ OS specific startup }
  MOS_ambMsg:=nil;
  MOS_origDir:=0;
  MOS_fileList:=nil;
  envp:=nil;
  SysInitMorphOS;
{ Set up signals handlers }
//  InstallSignals;
{ Setup heap }
  InitHeap;
  SysInitExceptions;
{ Setup stdin, stdout and stderr }
  SysInitStdIO;
{ Reset IO Error }
  InOutRes:=0;
{ Arguments }
  GenerateArgs;
(* This should be changed to a real value during *)
(* thread driver initialization if appropriate.  *)
  ThreadID := 1;
{$ifdef HASVARIANT}
  initvariantmanager;
{$endif HASVARIANT}
end.

{
  $Log$
  Revision 1.19  2004-09-03 19:26:15  olle
    + added maxExitCode to all System.pp
    * constrained error code to be below maxExitCode in RunError et. al.

  Revision 1.18  2004/08/09 00:12:40  karoly
    * changes to work with updated doslib includes

  Revision 1.17  2004/08/03 15:59:41  karoly
    * more cleanup & more includes

  Revision 1.16  2004/06/26 20:48:24  karoly
    * more cleanup + changes to use new includes

  Revision 1.15  2004/06/23 13:27:32  karoly
    * fixed system unit for the new heap manager

  Revision 1.14  2004/06/17 16:16:14  peter
    * New heapmanager that releases memory back to the OS, donated
      by Micha Nelissen

  Revision 1.13  2004/06/13 22:50:47  karoly
    * cleanup and changes to use new includes

  Revision 1.12  2004/06/06 23:31:13  karoly
    * fixed dos_UnLockDosList from being nonsense, and some cleanup

  Revision 1.11  2004/06/06 19:18:05  karoly
    + added support for paramstr(0)

  Revision 1.10  2004/06/05 19:49:19  karoly
    + added console I/O support when running from Ambient

  Revision 1.9  2004/05/12 23:18:54  karoly
    * fixed do_read and dos_Read from being nonsense

  Revision 1.8  2004/05/12 20:26:04  karoly
    + added syscalls and structures necessary for DOS unit

  Revision 1.7  2004/05/12 15:34:16  karoly
    * fixed startup code from endless wait when not started from Ambient

  Revision 1.6  2004/05/09 14:42:59  karoly
    * again, few more new things added

  Revision 1.5  2004/05/09 02:02:42  karoly
    * more things got implemented

  Revision 1.4  2004/05/02 02:06:57  karoly
    + most of file I/O calls implemented

  Revision 1.3  2004/05/01 15:09:47  karoly
    * first working system unit (very limited yet)

  Revision 1.2  2004/04/08 06:28:29  karoly 
    * first steps to have a morphos system unit

  Revision 1.1  2004/02/13 07:19:53  karoly
    * quick hack from Linux system unit
}