* first steps to have a morphos system unit

rtl/morphos/system.pp

@@ -21,57 +21,306 @@
 { If you use an aout system, set the conditional AOUT}
 { $Define AOUT}
 
-Unit {$ifdef VER1_0}Sysmorph{$else}System{$endif};
+unit {$ifdef VER1_0}SysMorph{$else}System{$endif};
 
-Interface
+interface
 
 {$define FPC_IS_SYSTEM}
 
-{$I sysunixh.inc}
+{$I systemh.inc}
 
-Implementation
+type 
+  THandle = DWord;
 
+{$I heaph.inc}
+
+const
+  LineEnding = #10;
+  LFNSupport = True;
+  DirectorySeparator = '/';
+  DriveSeparator = ':';
+  PathSeparator = ';';
+
+const
+  UnusedHandle    : LongInt = -1;
+  StdInputHandle  : LongInt = 0;
+  StdOutputHandle : LongInt = 0;
+  StdErrorHandle  : LongInt = 0;
+
+  FileNameCaseSensitive : Boolean = False;
+
+  sLineBreak : string[1] = LineEnding;
+  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
+
+var
+  MOS_ExecBase : DWord; External Name '_ExecBase';  
+
+implementation
 
 {$I system.inc}
 
 { OS dependant parts  }
 
-{$I errno.inc}                          // error numbers
-{$I bunxtype.inc}                       // c-types, unix base types, unix
+{ $I errno.inc}                          // error numbers
+{ $I bunxtype.inc}                       // c-types, unix base types, unix
                                         //    base structures
 
 
-{$I ossysc.inc}                         // base syscalls
-{$I osmain.inc}                         // base wrappers *nix RTL (derivatives)
+{ $I ossysc.inc}                         // base syscalls
+{ $I osmain.inc}                         // base wrappers *nix RTL (derivatives)
 
-{ more OS independant parts}
 
-{$I text.inc}
+const 
+  REG_D0 = 0;
+  REG_D1 = 4;
+  REG_D2 = 8;
+  REG_D3 = 12;
+  REG_D4 = 16;
+  REG_D5 = 20;
+  REG_D6 = 24;
+  REG_D7 = 28;
+  REG_A0 = 32;
+  REG_A1 = 36;
+  REG_A2 = 40;
+  REG_A3 = 44;
+  REG_A4 = 48;
+  REG_A5 = 52;
+  REG_A6 = 56;
+
+const 
+  LVOOpenLibrary = -552;
+
+
+function Exec_OpenLibrary(LibName: PChar; LibVer: LongInt) : LongInt; Assembler;
+asm
+  stw   r3,(REG_A0)(r2)
+  stw   r4,(REG_D0)(r2)
+
+  lis   r3,(MOS_ExecBase)@ha
+  ori   r3,r3,(MOS_ExecBase)@l
+  stw   r3,(REG_A6)(r2)
+
+  li    r3,LVOOpenLibrary
+  mtlr  r3
+  blrl
+
+  mr    r3,r16
+end;
+
+{*****************************************************************************
+                       Misc. System Dependent Functions
+*****************************************************************************}
+
+//procedure haltproc(e:longint);cdecl;external name '_haltproc';
+
+procedure System_exit;
+begin
+//  haltproc(ExitCode);
+End;
+
+
+{*****************************************************************************
+                              ParamStr/Randomize
+*****************************************************************************}
+
+{ number of args }
+function paramcount : longint;
+begin
+  {paramcount := argc - 1;}
+  paramcount:=0;
+end;
+
+{ argument number l }
+function paramstr(l : longint) : string;
+begin
+  {if (l>=0) and (l+1<=argc) then
+   paramstr:=strpas(argv[l])
+  else}
+   paramstr:='';
+end;
+
+{ set randseed to a new pseudo random value }
+procedure randomize;
+begin
+  {regs.realeax:=$2c00;
+  sysrealintr($21,regs);
+  hl:=regs.realedx and $ffff;
+  randseed:=hl*$10000+ (regs.realecx and $ffff);}
+  randseed:=0;
+end;
+
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+{ first address of heap }
+function getheapstart:pointer;{assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];}
+begin
+   getheapstart:=NIL;
+end;
+
+{ current length of heap }
+function getheapsize:longint;{assembler;
+asm
+        movl    HEAPSIZE,%eax
+end ['EAX'];}
+begin
+   getheapsize:=0;
+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;{assembler;
+asm
+        movl    size,%eax
+        pushl   %eax
+        call    ___sbrk
+        addl    $4,%esp
+end;}
+begin
+  Sbrk:=nil;
+end;
+
 {$I heap.inc}
 
+{****************************************************************************
+                        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
+  InOutRes:=1;
+end;
+
+procedure do_erase(p : pchar);
+begin
+  InOutRes:=1;
+end;
+
+procedure do_rename(p1,p2 : pchar);
+begin
+  InOutRes:=1;
+end;
+
+function do_write(h,addr,len : longint) : longint;
+begin
+  InOutRes:=1;
+end;
+
+function do_read(h,addr,len : longint) : longint;
+begin
+  InOutRes:=1;
+end;
+
+function do_filepos(handle : longint) : longint;
+begin
+  InOutRes:=1;
+end;
+
+procedure do_seek(handle,pos : longint);
+begin
+  InOutRes:=1;
+end;
+
+function do_seekend(handle:longint):longint;
+begin
+  InOutRes:=1;
+end;
+
+function do_filesize(handle : longint) : longint;
+begin
+  InOutRes:=1;
+end;
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+begin
+  InOutRes:=1;
+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)
+}
+begin
+  InOutRes:=1;
+end;
+
+function do_isdevice(handle:longint):boolean;
+begin
+  do_isdevice:=false;
+end;
+
 {*****************************************************************************
-                 UnTyped File Handling
+                          UnTyped File Handling
 *****************************************************************************}
 
 {$i file.inc}
 
 {*****************************************************************************
-                 Typed File Handling
+                           Typed File Handling
 *****************************************************************************}
 
 {$i typefile.inc}
 
+{*****************************************************************************
+                           Text File Handling
+*****************************************************************************}
+
+{$I text.inc}
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+procedure mkdir(const s : string);[IOCheck];
+begin
+  InOutRes:=1;
+end;
+
+procedure rmdir(const s : string);[IOCheck];
+begin
+  InOutRes:=1;
+end;
+
+procedure chdir(const s : string);[IOCheck];
+begin
+  InOutRes:=1;
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+
+begin
+  InOutRes := 1;
+end;
+
+
+
+
 
 procedure SysInitStdIO;
 begin
   OpenStdIO(Input,fmInput,StdInputHandle);
   OpenStdIO(Output,fmOutput,StdOutputHandle);
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+ 
+  { * MorphOS doesn't have a separate stderr, just like AmigaOS (???) * }
+  StdErrorHandle:=StdOutputHandle;
+  // OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 end;
 
 
-procedure SysInitExecPath;
+{procedure SysInitExecPath;
 var
   hs   : string[16];
   link : string;
@@ -88,7 +337,7 @@ begin
      ExecPathStr:=link;
    end;
 end;
-
+}
 
 Begin
   IsConsole := TRUE;
@@ -96,13 +345,13 @@ Begin
   StackLength := InitialStkLen;
   StackBottom := Sptr - StackLength;
 { Set up signals handlers }
-  InstallSignals;
+//  InstallSignals;
 { Setup heap }
   InitHeap;
   SysInitExceptions;
 { Arguments }
-  SetupCmdLine;
-  SysInitExecPath;
+//  SetupCmdLine;
+//  SysInitExecPath;
 { Setup stdin, stdout and stderr }
   SysInitStdIO;
 { Reset IO Error }
@@ -117,7 +366,10 @@ End.
 
 {
   $Log$
-  Revision 1.1  2004-02-13 07:19:53  karoly
+  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