atari: an incomplete, but still large cleanup of the atari system unit

git-svn-id: trunk@34664 -

rtl/atari/gemdos.inc

@@ -116,6 +116,8 @@ function gemdos_dgetpath(path: pchar; driveno: smallint): smallint; syscall 1 71
 function gemdos_malloc(number: dword): pointer; syscall 1 72;
 function gemdos_free(block: pointer): dword; syscall 1 73;
 
+procedure gemdos_pterm(returncode: smallint); syscall 1 76;
+
 function gemdos_fsfirst(filename: pchar; attr: smallint): longint; syscall 1 78;
 function gemdos_fsnext: smallint; syscall 1 79;
 

rtl/atari/system.pp

@@ -1,5 +1,8 @@
 {
     This file is part of the Free Pascal run time library.
+    Copyright (c) 2016 the Free Pascal development team
+
+    Portions based on the Atari RTL for FPC 1.x
     Copyright (c) 1999-2000 by Carl Eric Codere
     member of the Free Pascal development team
 
@@ -28,43 +31,49 @@ unit System;
 
 {Platform specific information}
 const
- LineEnding = #10;
- LFNSupport = true;
- CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
- DirectorySeparator = '/';
- DriveSeparator = ':';
- ExtensionSeparator = '.';
- PathSeparator = ';';
- AllowDirectorySeparators : set of char = ['\','/'];
- AllowDriveSeparators : set of char = [':'];
- FileNameCaseSensitive = false;
- FileNameCasePreserving = false;
- maxExitCode = 255;
- MaxPathLen = 255;
- AllFilesMask = '*';
-
- sLineBreak: string [1] = LineEnding;
-    { used for single computations }
-    const BIAS4 = $7f-1;
+    LineEnding = #13#10;
+    LFNSupport = false;
+    CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+    DirectorySeparator = '/';
+    DriveSeparator = ':';
+    ExtensionSeparator = '.';
+    PathSeparator = ';';
+    AllowDirectorySeparators : set of char = ['\','/'];
+    AllowDriveSeparators : set of char = [':'];
+    FileNameCaseSensitive = false;
+    FileNameCasePreserving = false;
+    maxExitCode = 255;
+    MaxPathLen = 255;
+    AllFilesMask = '*';
+
+    sLineBreak = LineEnding;
+    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
 
 const
-  UnusedHandle    = $ffff;
-  StdInputHandle  = 0;
-  StdOutputHandle = 1;
-  StdErrorHandle  = $ffff;
+    UnusedHandle    = $ffff;
+    StdInputHandle  = 0;
+    StdOutputHandle = 1;
+    StdErrorHandle  = $ffff;
+
+var
+    args: Pointer; external name '__ARGS'; { Defined in the startup code }
+    argc: LongInt;
+    argv: PPChar;
+    envp: PPChar;
 
-    {$if defined(CPUARM) or defined(CPUM68K)}
+
+    {$if defined(FPUSOFT)}
 
     {$define fpc_softfpu_interface}
     {$i softfpu.pp}
     {$undef fpc_softfpu_interface}
 
-    {$endif defined(CPUARM) or defined(CPUM68K)}
+    {$endif defined(FPUSOFT)}
 
 
   implementation
 
-    {$if defined(CPUARM) or defined(CPUM68K)}
+    {$if defined(FPUSOFT)}
 
     {$define fpc_softfpu_implementation}
     {$i softfpu.pp}
@@ -82,27 +91,20 @@ const
     {$define FPC_SYSTEM_HAS_extractFloat32Exp}
     {$define FPC_SYSTEM_HAS_extractFloat32Sign}
 
-    {$endif defined(CPUARM) or defined(CPUM68K)}
+    {$endif defined(FPUSOFT)}
 
     {$I system.inc}
-    {$I lowmath.inc}
-
 
 function GetProcessID:SizeUInt;
 begin
-{$WARNING To be checked by platform maintainer}
- GetProcessID := 1;
+  {$WARNING To be checked by platform maintainer}
+   GetProcessID := 1;
 end;
 
-    const
-      argc : longint = 0;
 
 
-    var
-      errno : integer;
-
 {$S-}
-    procedure Stack_Check; assembler;
+(*    procedure Stack_Check; assembler;
     { Check for local variable allocation }
     { On Entry -> d0 : size of local stack we are trying to allocate }
          asm
@@ -115,58 +117,7 @@ end;
            move.l  #202,d0
            jsr     HALT_ERROR
          @st1nosweat:
-         end;
-
-
-    Procedure Error2InOut;
-    Begin
-     if (errno <= -2) and (errno >= -11) then
-       InOutRes:=150-errno  { 150+errno }
-     else
-      Begin
-        case errno of
-          -32 : InOutRes:=1;
-          -33 : InOutRes:=2;
-          -34 : InOutRes:=3;
-          -35 : InOutRes:=4;
-          -36 : InOutRes:=5;
-          -37 : InOutRes:=8;
-          -39 : InOutRes:=8;
-          -40 : InOutRes:=9;
-          -46 : InOutRes:=15;
-          -67..-64 : InOutRes:=153;
-          -15 : InOutRes:=151;
-          -13 : InOutRes:=150;
-        else
-           InOutres := word(errno);
-         end;
-     end;
-     errno:=0;
-    end;
-
-
-
-    procedure halt(errnum : byte);
-
-      begin
-         do_exit;
-         flush(stderr);
-         asm
-            clr.l   d0
-            move.b  errnum,d0
-            move.w  d0,-(sp)
-            move.w  #$4c,-(sp)
-            trap    #1
-         end;
-      end;
-
-
-      function args : pointer; assembler;
-      asm
-         move.l __ARGS,d0
-      end;
-
-
+         end;*)
 
 
    Function GetParamCount(const p: pchar): longint;
@@ -260,37 +211,6 @@ end;
       end;
 
 
-
-
-    procedure randomize;
-
-      var
-         hl : longint;
-
-      begin
-         asm
-           movem.l d2/d3/a2/a3, -(sp)     { save OS registers }
-           move.w #17,-(sp)
-           trap   #14         { call xbios - random number }
-           add.l  #2,sp
-           movem.l (sp)+,d2/d3/a2/a3
-           move.l d0,hl       { result in d0 }
-         end;
-         randseed:=hl;
-      end;
-
-function getheapstart:pointer;assembler;
-asm
-        lea.l   HEAP,a0
-        move.l  a0,d0
-end;
-
-
-function getheapsize:longint;assembler;
-asm
-       move.l   HEAP_SIZE,d0
-end ['D0'];
-
   { This routine is used to grow the heap.  }
   { But here we do a trick, we say that the }
   { heap cannot be regrown!                 }
@@ -300,62 +220,56 @@ end ['D0'];
    sbrk:=nil;
   end;
 
-{$I heap.inc}
-
-{*****************************************************************************
-                           UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
-{*****************************************************************************
-                           Text File Handling
-*****************************************************************************}
 
-{$i text.inc}
+  procedure randomize;
+  begin
+    {$WARNING: randseed initial value is 24bit}
+    randseed:=xbios_random;
+  end;
 
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
 Procedure system_exit;
 begin
+  gemdos_pterm(ExitCode);
 end;
 
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
 
+procedure SysInitStdIO;
+begin
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+end;
+
 function CheckInitialStkLen (StkLen: SizeUInt): SizeUInt;
 begin
   CheckInitialStkLen := StkLen;
 end;
 
+
 begin
   StackLength := CheckInitialStkLen (InitialStkLen);
 { Initialize ExitProc }
   ExitProc:=Nil;
 { Setup heap }
   InitHeap;
-{$ifdef HASWIDESTRING}
+  SysInitExceptions;
   InitUnicodeStringManager;
-{$endif HASWIDESTRING}
 { Setup stdin, stdout and stderr }
-  OpenStdIO(Input,fmInput,StdInputHandle);
-  OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  SysInitStdIO;
 { Reset IO Error }
   InOutRes:=0;
 (* This should be changed to a real value during *)
 (* thread driver initialization if appropriate.  *)
   ThreadID := 1;
-  errno := 0;
 { Setup command line arguments }
-  argc:=GetParamCount(args);
+//  argc:=GetParamCount(args);
 end.