浏览代码

* moved getopts to inc/, all supported OS's need argc,argv exported
+ strpas, strlen are now exported in the systemunit
* removed logs
* removed $ifdef ver_above

peter 27 年之前
父节点
当前提交
e64becf81c

+ 6 - 37
rtl/i386/cpu.pp

@@ -34,7 +34,7 @@ unit cpu;
 
 
       {
       {
         Check if the ID-flag can be changed, if changed then CpuID is supported.
         Check if the ID-flag can be changed, if changed then CpuID is supported.
-        Tested under go32v1 and Linux on c6x86 with CpuID enabled and disabled (Syn)
+        Tested under go32v1 and Linux on c6x86 with CpuID enabled and disabled (PFV)
       }
       }
       asm
       asm
          pushf
          pushf
@@ -70,41 +70,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:42  root
-  Initial revision
-
-  Revision 1.6  1998/03/03 23:20:14  florian
-    * mov eax,cr0 isn't yet recognized by the asm parser, removed
-
-  Revision 1.5  1998/03/03 22:47:00  florian
-    * small problems fixed
-
-  Revision 1.4  1998/02/04 23:00:58  florian
-    - mmx stuff moved to mmx unit
-
-  Revision 1.3  1998/01/26 11:59:17  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/i386/cpu.pp
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:34:37;  author: michael;  state: Exp;  lines: +12 -6
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 22:49:04;  author: florian;  state: Exp;
-  - CPU.PP added
-  - some bugs in DOS fixed (especially for go32v1)
-  - the win32 system unit is now compilable
-  =============================================================================
-
- History:
-   6th november 1997:
-      + inital version (FK)
-  27th november 1997:
-      + cpuid_support, thanks to synopsis (FK)
+  Revision 1.2  1998-05-12 10:42:41  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
 }
 }

+ 0 - 456
rtl/i386/getopts.pp

@@ -1,456 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by Michael Van Canneyt,
-    member of the Free Pascal development team.
-
-    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 getopts;
-
-{$I os.inc}
-
-{ --------------------------------------------------------------------
-  Getopt implementation for FPK pascal, modeled after GNU getopt.
-  Tested under Linux.
-  Tested under DOS
-  Michael Van Canneyt, 1997
-
-  *NOTE*
-  The routines are a more or less straightforward conversion 
-  of the GNU C implementation of getopt. One day they should be 
-  replaced by some 'real pascal code'.
-  --------------------------------------------------------------------
-}
-
-Interface
-
-Const No_Argument       = 0;
-      Required_Argument = 1;
-      Optional_Argument = 2; 
-      EndOfOptions      = #255;
-    
-Type Option = Record
-       Name    : String;
-       Has_arg : Integer;
-       Flag    : ^char;
-       Value   : Char;
-      end;
-     POption  = ^Option;
-     Orderings = (require_order,permute,return_in_order);
-
-Var OptArg : String;
-    OptInd : Integer;
-    OptErr : Boolean;
-    OptOpt : Char;
-      
-Function GetOpt (ShortOpts : String) : char;
-Function GetLongOpts (ShortOpts : String; 
-                      LongOpts : POption; 
-                      var Longind : Integer) : char;
-
-Implementation
-
-Var NextChar : integer;
-    first_nonopt,last_nonopt,Nrargs : Integer;
-    Ordering : orderings;
-{$ifndef linux}
-    argv : ^pchar;
-{$endif}
-{ Copied straight from strings.pp, avoids the 'uses strings'  }
-
-function strpas(p : pchar) : string;
-
-      begin
-         asm
-            cld
-            movl 12(%ebp),%edi
-            movl %edi,%esi               
-            movl $0xffffffff,%ecx        
-            xorb %al,%al
-            repne
-            scasb
-            notl %ecx
-            decl %ecx
-            movl 8(%ebp),%edi          
-            movb %cl,%al
-            stosb
-            rep                         
-            movsb                       
-         end ['ECX','EAX','ESI','EDI'];
-      end;
-
-    
-Procedure Exchange;
-
-var bottom,middle,top,i,len : integer;
-    temp : pchar;
-
-begin
-  bottom:=first_nonopt;
-  middle:=last_nonopt;
-  top:=optind;
-  while (top>middle) and (middle>bottom) do
-    begin
-    if (top-middle>middle-bottom) then
-      begin
-      len:=middle-bottom;
-      for i:=1 to len-1 do
-        begin
-        temp:=argv[bottom+i];
-        argv[bottom+i]:=argv[top-(middle-bottom)+i];
-        argv[top-(middle-bottom)+i]:=temp;
-        end;
-      top:=top-len;
-      end
-    else
-      begin
-      len:=top-middle;
-      for i:=0 to len-1 do
-        begin
-        temp:=argv[bottom+i];
-        argv[bottom+i]:=argv[middle+i];
-        argv[middle+i]:=temp;
-        end;
-      bottom:=bottom+len;
-      end;
-    end;
-  first_nonopt:=first_nonopt + optind-last_nonopt;
-  last_nonopt:=optind;
-end; { exchange }
-
-procedure getopt_init (var opts : string);
-
-begin
-  { Initialize some defaults. }
-  Optarg:='';
-  Optind:=1;
-  First_nonopt:=1;
-  Last_nonopt:=1;
-  OptOpt:='?';
-  Nextchar:=0;
-  if opts[1]='-' then 
-    begin
-    ordering:=return_in_order;
-    delete(opts,1,1);
-    end
-  else if opts[1]='+' then
-    begin
-    ordering:=require_order;
-    delete(opts,1,1);
-    end
-  else ordering:=permute;
-end;
-      
-Function Internal_getopt (Var Optstring : string;
-                          LongOpts : POption;
-                          LongInd : pointer;
-                          Long_only : boolean ) : char;
-
-type pint=^integer; 
-
-var temp,endopt,option_index : byte;
-    indfound: integer;
-    currentarg,optname : string;
-    p,pfound : POption;
-    exact,ambig : boolean;
-    c : char; 
-    
-begin
-optarg:='';
-if optind=0 then getopt_init(optstring);
-{ Check if We need the next argument. }
-if optind<nrargs then currentarg:=strpas(argv[optind]) else currentarg:='';
-if (nextchar=0) then 
-  begin
-  if ordering=permute then
-    begin
-    { If we processed options following non-options : exchange }
-    if (first_nonopt<>last_nonopt) and (last_nonopt<>optind) then
-      exchange
-    else
-      if last_nonopt<>optind then first_nonopt:=optind;
-    while (optind<nrargs) and ((argv[optind][0]<>'-') 
-                                or (length(strpas(argv[optind]))=1)) do
-      begin
-      inc(optind);
-      end;
-    last_nonopt:=optind;
-    end;
-  { Check for '--' argument }
-  if optind<nrargs then currentarg:=strpas(argv[optind]) else currentarg:='';
-  if (optind<>nrargs) and (currentarg='--') then
-    begin
-    inc(optind);
-    if (first_nonopt<>last_nonopt) and (last_nonopt<>optind) then
-      exchange
-    else 
-      if first_nonopt=last_nonopt then first_nonopt:=optind;
-    last_nonopt:=nrargs;
-    optind:=nrargs;
-    end; 
-  { Are we at the end of all arguments ? }
-  if optind>=nrargs then
-    begin
-    if first_nonopt<>last_nonopt then
-      optind:=first_nonopt;
-    Internal_getopt:=EndOfOptions;
-    exit;
-    end;
-  if optind<nrargs then currentarg:=strpas(argv[optind]) else currentarg:='';
-  { Are we at a non-option ? }
-  if (currentarg[1]<>'-') or (currentarg='-') then
-    begin
-    if ordering=require_order then
-       begin
-       Internal_getopt:=EndOfOptions;
-       exit;
-       end
-    else
-       begin
-       optarg:=strpas(argv[optind]);
-       inc(optind);
-       Internal_getopt:=#1;
-       exit;
-       end;
-    end;
-  { At this point we're at an option ...}
-  nextchar:=2;
-  if (longopts<>nil) and (currentarg[2]='-') then inc(nextchar);
-  { So, now nextchar points at the first character of an option }
-  end;
-{ Check if we have a long option }
-if longopts<>nil then 
-  if length(currentarg)>1 then
-  if (currentarg[2]='-') or
-    ((not long_only) and (pos(currentarg[2],optstring)<>0)) then
-    begin
-    { Get option name }
-    endopt:=pos('=',currentarg);
-    if endopt=0 then endopt:=length(currentarg)+1;
-    optname:=copy(currentarg,nextchar,endopt-nextchar);
-    { Match partial or full }
-    p:=longopts;
-    pfound:=nil;
-    exact:=false;
-    ambig:=false;
-    option_index:=0;
-    indfound:=0;
-    while (p^.name<>'') and (not exact) do
-      begin
-      if pos(optname,p^.name)<>0 then
-        begin
-        if length(optname)=length(p^.name) then
-          begin
-          exact:=true;
-          pfound:=p;
-          indfound:=option_index;
-          end
-        else
-          if pfound=nil then
-            begin
-            indfound:=option_index;
-            pfound:=p
-            end
-          else
-            ambig:=true;
-        end;
-      inc (longint(p),sizeof(option));
-      inc (option_index);
-      end;
-    if ambig and not exact then 
-      begin
-      if opterr then
-         writeln (paramstr(0),': option "',optname,'" is ambiguous');
-      nextchar:=0;
-      inc(optind);
-      Internal_getopt:='?';
-      end;
-    if pfound<>nil then
-      begin
-      inc(optind);
-      if endopt<=length(currentarg) then
-        begin
-        if pfound^.has_arg>0 then
-          begin
-          optarg:=copy(currentarg,endopt+1,length(currentarg)-endopt);
-          end
-        else
-          begin
-          if opterr then
-            if currentarg[2]='-' then
-              writeln (paramstr(0),': option "--',pfound^.name,'" doesn''t allow an argument')
-            else  
-              writeln (paramstr(0),': option "',currentarg[1],pfound^.name,'" doesn''t allow an argument');
-          nextchar:=0;
-          internal_getopt:='?';
-          exit;
-          end;
-        end 
-      else { argument in next paramstr...  } 
-        begin
-        if pfound^.has_arg=1 then
-          begin
-          if optind<nrargs then
-            begin
-            optarg:=strpas(argv[optind]);
-            inc(optind);
-            end { required argument }
-          else
-            begin { no req argument}
-            if opterr then
-              writeln (paramstr(0),': option ',pfound^.name,' requires an argument');
-            nextchar:=0;
-            if optstring[1]=':' then
-              Internal_getopt:=':'
-            else
-              Internal_getopt:='?';
-            exit;
-            end;
-          end; 
-        end; { argument in next parameter end;}
-        nextchar:=0;
-      if longind<>nil then pint(longind)^:=indfound+1;
-      if pfound^.flag<>nil then 
-        begin
-        pfound^.flag^:=pfound^.value;
-        internal_getopt:=#0;
-        exit
-        end;
-      internal_getopt:=pfound^.value;
-      exit
-      end; { pfound<>nil }
-    { We didn't find it as an option }
-    if (not long_only) or ((currentarg[2]='-') or 
-                           (pos(CurrentArg[nextchar],optstring)=0)) then
-      begin
-      if opterr then
-        if currentarg[2]='-' then
-          writeln (paramstr(0),' unrecognized option "--',optname,'"')
-        else
-          writeln (paramstr(0),' unrecognized option "',currentarg[1],optname,'"');
-      nextchar:=0;
-      inc(optind);
-      Internal_getopt:='?';
-      exit;
-      end;              
-    end; { Of long options.}
-{ We check for a short option. }
-temp:=pos(currentarg[nextchar],optstring);
-c:=currentarg[nextchar];
-inc (nextchar);
-if nextchar>length(currentarg) then 
-  begin
-  inc(optind);
-  nextchar:=0;
-  end;
-if (temp=0) or (c=':') then
-  begin
-  if opterr then
-    writeln (paramstr(0),': illegal option -- ',c);
-  optopt:=currentarg[nextchar-1];
-  internal_getopt:='?';
-  exit;
-  end;
-Internal_getopt:=optstring[temp];
-if optstring[temp+1]=':' then 
-  if currentarg[temp+2]=':' then
-    begin { optional argument }
-      optarg:=copy (currentarg,nextchar,length(currentarg)-nextchar+1);
-      nextchar:=0;
-    end
-  else
-    begin { required argument }
-    if nextchar>0 then 
-      begin
-      optarg:=copy (currentarg,nextchar,length(currentarg)-nextchar+1);
-      inc(optind)
-      end
-    else if (optind=nrargs) then
-      begin
-      if opterr then
-        writeln (paramstr(0),': option requires an argument -- ',optstring[temp]);
-      optopt:=optstring[temp];
-      if optstring[1]=':' then 
-        Internal_getopt:=':'
-      else
-        Internal_Getopt:='?'  
-      end
-    else
-      begin
-      optarg:=strpas(argv[optind]);
-      inc (optind)
-      end;
-    nextchar:=0;
-    end; { End of required argument}
-end; { End of internal getopt...}
-
-
-Function GetOpt (ShortOpts : String) : char;
-
-begin
-  getopt:=internal_getopt (shortopts,nil,nil,false);
-end;
-
-Function GetLongOpts (ShortOpts : String; 
-                      LongOpts : POption; 
-                      var Longind : Integer) : char;
-begin
-  getlongopts:=internal_getopt ( shortopts,longopts,@longind,true);
-end;
-
-{$ifndef linux}
-function args : pointer;
-
-begin
-  asm
-  movl _args,%eax
-  leave
-  ret
-  end ['EAX'];
-end;
-{$endif}                                                                                     
-                                                                                     
-
-begin
-  { Needed to detect startup } 
-  Opterr:=true;
-  Optind:=0;
-  nrargs:=paramcount+1;
-{$ifndef linux}
-  argv:=args;
-{$endif}  
-end.     
-    
-{
-  $Log$
-  Revision 1.1  1998-03-25 11:18:42  root
-  Initial revision
-
-  Revision 1.3  1998/01/26 11:58:56  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/i386/getopts.pp
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:34:38;  author: michael;  state: Exp;  lines: +15 -2
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
-}

+ 180 - 298
rtl/i386/i386.inc

@@ -5,7 +5,8 @@
 
 
     Processor dependent implementation for the system unit for
     Processor dependent implementation for the system unit for
     intel i386+
     intel i386+
-    
+
+
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
 
 
@@ -87,7 +88,7 @@ begin
 end;
 end;
 
 
 
 
-Procedure FillChar(var x;count:longint;value:byte);[alias: '.L_FILL_OBJECT'];
+Procedure FillChar(var x;count:longint;value:byte);[alias: 'FILL_OBJECT'];
 begin
 begin
         asm
         asm
         cld
         cld
@@ -159,47 +160,47 @@ asm
      0 %ebp
      0 %ebp
 }
 }
       { eax isn't touched anywhere, so it doesn't have to reloaded }
       { eax isn't touched anywhere, so it doesn't have to reloaded }
-	movl	8(%ebp),%eax
+        movl    8(%ebp),%eax
       { initialise self ? }
       { initialise self ? }
-	orl	%esi,%esi
-	jne	.LHC_4
+        orl     %esi,%esi
+        jne     .LHC_4
       { get memory, but save register first temporary variable }
       { get memory, but save register first temporary variable }
-        subl	$4,%esp
-        movl	%esp,%esi
+        subl    $4,%esp
+        movl    %esp,%esi
       { Save Register}
       { Save Register}
         pushal
         pushal
       { Memory size }
       { Memory size }
-        pushl	(%eax)
-        pushl	%esi
-        call	GETMEM
+        pushl   (%eax)
+        pushl   %esi
+        call    GETMEM
         popal
         popal
       { Memory size to %esi }
       { Memory size to %esi }
-        movl	(%esi),%esi
-        addl	$4,%esp
+        movl    (%esi),%esi
+        addl    $4,%esp
       { If no memory available : fail() }
       { If no memory available : fail() }
-        orl	%esi,%esi
-        jz	.LHC_5
+        orl     %esi,%esi
+        jz      .LHC_5
       { init self for the constructor }
       { init self for the constructor }
-        movl	%esi,12(%ebp)
+        movl    %esi,12(%ebp)
 .LHC_4:
 .LHC_4:
       { is there a VMT address ? }
       { is there a VMT address ? }
-        orl	%eax,%eax
-        jnz	.LHC_7
+        orl     %eax,%eax
+        jnz     .LHC_7
       { In case the constructor doesn't do anything, the Zero-Flag }
       { In case the constructor doesn't do anything, the Zero-Flag }
       { can't be put, because this calls Fail() }
       { can't be put, because this calls Fail() }
-        incl	%eax
+        incl    %eax
         ret
         ret
 .LHC_7:
 .LHC_7:
       { set zero inside the object }
       { set zero inside the object }
         pushal
         pushal
-        pushw	$0
-        pushl	(%eax)
-        pushl	%esi
-        call	.L_FILL_OBJECT
+        pushw   $0
+        pushl   (%eax)
+        pushl   %esi
+        call    FILL_OBJECT
         popal
         popal
       { set the VMT address for the new created object }
       { set the VMT address for the new created object }
-        movl	%eax,(%esi)
-        orl	%eax,%eax
+        movl    %eax,(%esi)
+        orl     %eax,%eax
 .LHC_5:
 .LHC_5:
 end;
 end;
 
 
@@ -284,44 +285,45 @@ asm
      0 %ebp
      0 %ebp
 }
 }
       { temporary Variable }
       { temporary Variable }
-	subl 	$4,%esp
-        movl 	%esp,%edi
+        subl    $4,%esp
+        movl    %esp,%edi
         pushal
         pushal
       { Should the object be resolved ? }
       { Should the object be resolved ? }
-        movl 	8(%ebp),%eax
-        orl 	%eax,%eax
-        jz 	.LHD_3
+        movl    8(%ebp),%eax
+        orl     %eax,%eax
+        jz      .LHD_3
       { Yes, get size from SELF! }
       { Yes, get size from SELF! }
-        movl 	12(%ebp),%eax
+        movl    12(%ebp),%eax
       { get VMT-pointer (from Self) to %ebx }
       { get VMT-pointer (from Self) to %ebx }
-        movl 	(%eax),%ebx
+        movl    (%eax),%ebx
       { And put size on the Stack }
       { And put size on the Stack }
-        pushl 	(%ebx)
+        pushl   (%ebx)
       { SELF }
       { SELF }
       { I think for precaution }
       { I think for precaution }
       { that we should clear the VMT here }
       { that we should clear the VMT here }
-        movl 	$0,(%eax)
-        movl 	%eax,(%edi)
-        pushl 	%edi
-        call 	FREEMEM
+        movl    $0,(%eax)
+        movl    %eax,(%edi)
+        pushl   %edi
+        call    FREEMEM
 .LHD_3:
 .LHD_3:
         popal
         popal
-        addl	$4,%esp
+        addl    $4,%esp
 end;
 end;
 
 
 
 
 {****************************************************************************
 {****************************************************************************
-                                 String 
+                                 String
+
 ****************************************************************************}
 ****************************************************************************}
 
 
-procedure strcopy(dstr,sstr:pointer;len:longint);[public,alias:'STRCOPY'];
+procedure int_strcopy(len:longint;sstr,dstr:pointer);[public,alias:'STRCOPY'];
 {
 {
   this procedure must save all modified registers except EDI and ESI !!!
   this procedure must save all modified registers except EDI and ESI !!!
 }
 }
 begin
 begin
   asm
   asm
-        pushl %eax
-        pushl %ecx
+        pushl   %eax
+        pushl   %ecx
         cld
         cld
         movl    16(%ebp),%edi
         movl    16(%ebp),%edi
         movl    12(%ebp),%esi
         movl    12(%ebp),%esi
@@ -350,13 +352,13 @@ begin
         movl    %eax,%ecx
         movl    %eax,%ecx
         rep
         rep
         movsb
         movsb
-        popl %ecx
-        popl %eax
+        popl    %ecx
+        popl    %eax
   end ['ECX','EAX','ESI','EDI'];
   end ['ECX','EAX','ESI','EDI'];
 end;
 end;
 
 
 
 
-procedure strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
+procedure int_strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
 begin
 begin
   asm
   asm
         xorl    %ecx,%ecx
         xorl    %ecx,%ecx
@@ -395,7 +397,7 @@ begin
 end;
 end;
 
 
 
 
-procedure strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
+procedure int_strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
 begin
 begin
   asm
   asm
         cld
         cld
@@ -443,6 +445,9 @@ begin
   end ['EDX','ECX','EBX','EAX','ESI','EDI'];
   end ['EDX','ECX','EBX','EAX','ESI','EDI'];
 end;
 end;
 
 
+{****************************************************************************
+                                  PChar
+****************************************************************************}
 
 
 function strpas(p:pchar):string;
 function strpas(p:pchar):string;
 begin
 begin
@@ -480,6 +485,7 @@ begin
   end ['ECX','EAX','ESI','EDI'];
   end ['ECX','EAX','ESI','EDI'];
 end;
 end;
 
 
+
 function strlen(p:pchar):longint;assembler;
 function strlen(p:pchar):longint;assembler;
 asm
 asm
         movl    p,%edi
         movl    p,%edi
@@ -492,26 +498,35 @@ asm
         subl    %ecx,%eax
         subl    %ecx,%eax
 end ['EDI','ECX','EAX'];
 end ['EDI','ECX','EAX'];
 
 
+
 {****************************************************************************
 {****************************************************************************
-                                 Other 
+                                 Other
+
 ****************************************************************************}
 ****************************************************************************}
 
 
+Function Sptr : Longint;assembler;
+asm
+        movl    %esp,%eax
+        addl    $4,%eax         // Don't count the Call
+end ['EAX'];
+
+
 function get_addr(addrbp:longint):longint;assembler;
 function get_addr(addrbp:longint):longint;assembler;
 asm
 asm
-	movl	addrbp,%eax
-	orl	%eax,%eax
-	jz	.Lg_a_null
-        movl	4(%eax),%eax
+        movl    addrbp,%eax
+        orl     %eax,%eax
+        jz      .Lg_a_null
+        movl    4(%eax),%eax
 .Lg_a_null:
 .Lg_a_null:
 end ['EAX'];
 end ['EAX'];
 
 
 
 
 function get_next_frame(framebp:longint):longint;assembler;
 function get_next_frame(framebp:longint):longint;assembler;
 asm
 asm
-	movl	framebp,%eax
-	orl	%eax,%eax
-	jz	.Lgnf_null
-        movl	(%eax),%eax
+        movl    framebp,%eax
+        orl     %eax,%eax
+        jz      .Lgnf_null
+        movl    (%eax),%eax
 .Lgnf_null:
 .Lgnf_null:
 end ['EAX'];
 end ['EAX'];
 
 
@@ -546,14 +561,16 @@ procedure runerror(w : word);[alias: 'runerror'];
      halt(errorcode);
      halt(errorcode);
   end;
   end;
 
 
-procedure io1(addr : longint);[public,alias: 'IOCHECK'];
+
+
+procedure int_iocheck(addr : longint);[public,alias: 'IOCHECK'];
 var
 var
   l : longint;
   l : longint;
 begin
 begin
 { Since IOCHECK is called directly and only later the optimiser }
 { Since IOCHECK is called directly and only later the optimiser }
 { Maybe also save global registers  }
 { Maybe also save global registers  }
   asm
   asm
-	pushal
+        pushal
   end;
   end;
   l:=ioresult;
   l:=ioresult;
   if l<>0 then
   if l<>0 then
@@ -562,179 +579,158 @@ begin
      halt(l);
      halt(l);
    end;
    end;
   asm
   asm
-	popal
-   end;
+        popal
+  end;
 end;
 end;
 
 
 
 
-procedure re_overflow;[public,alias: 'RE_OVERFLOW'];
+procedure int_re_overflow;[public,alias: 'RE_OVERFLOW'];
 var
 var
   addr : longint;
   addr : longint;
 begin
 begin
 { Overflow was shortly before the return address }
 { Overflow was shortly before the return address }
    asm
    asm
-	movl	4(%ebp),%edi
-        movl	%edi,addr
+        movl    4(%ebp),%edi
+        movl    %edi,addr
    end;
    end;
    writeln('Overflow at ',addr);
    writeln('Overflow at ',addr);
    RunError(215);
    RunError(215);
 end;
 end;
 
 
 
 
+procedure int_flush_stdout;[public,alias: 'FLUSH_STDOUT'];
+begin
+  asm
+        pushal
+  end;
+  FileFunc(textrec(output).flushfunc)(textrec(output));
+  asm
+        popal
+  end;
+end;
+
+
+
+{****************************************************************************
+                                 Math Functions
+****************************************************************************}
+
 function abs(l:longint):longint;assembler;
 function abs(l:longint):longint;assembler;
 asm
 asm
-	movl	l,%eax
-        orl	%eax,%eax
-        jns	.LMABS1
-        negl	%eax
+        movl    l,%eax
+        orl     %eax,%eax
+        jns     .LMABS1
+        negl    %eax
 .LMABS1:
 .LMABS1:
 end ['EAX'];
 end ['EAX'];
 
 
 
 
 function odd(l:longint):boolean;assembler;
 function odd(l:longint):boolean;assembler;
 asm
 asm
-       movl	l,%eax
-       andl	$1,%eax
-       setnz	%al
+       movl     l,%eax
+       andl     $1,%eax
+       setnz    %al
 end ['EAX'];
 end ['EAX'];
 
 
 
 
 function sqr(l:longint):longint;assembler;
 function sqr(l:longint):longint;assembler;
 asm
 asm
-        mov	l,%eax
-        imull	%eax,%eax
+        mov     l,%eax
+        imull   %eax,%eax
 end ['EAX'];
 end ['EAX'];
 
 
 
 
-{$ifndef str_intern }
-    procedure str(l : longint;var s : string);
-{$else str_intern }
-    procedure int_str(l : longint;var s : string);
-{$endif str_intern }
-
-      var
-         buffer : array[0..11] of byte;
-
-      begin
-         { Workaround: }
-         if l=$80000000 then
-           begin
-              s:='-2147483648';
-              exit;
-           end;
-         asm
-            movl 8(%ebp),%eax    // load Integer
-            movl 12(%ebp),%edi      // Load String address
-            xorl %ecx,%ecx    // String length=0
-            xorl %ebx,%ebx    // Buffer length=0
-            movl $0x0a,%esi      // load 10 as dividing constant.
-            or %eax,%eax        // Sign ?
-            jns .LM2
-            neg %eax
-            movb $0x2d,1(%edi)   // put '-' in String
-            incl %ecx
-         .LM2:
-            cdq
-            idivl %esi,%eax
-            addb $0x30,%dl    // convert Rest to ASCII.
-            movb %dl,-12(%ebp,%ebx)
-            incl %ebx
-            cmpl $0,%eax
-            jnz .LM2
-                        // copy String
-         .LM3:
-            movb -13(%ebp,%ebx),%al    // -13 because EBX is decreased only
-                                       // later.
-            movb %al,1(%edi,%ecx)
-            incl %ecx
-            decl %ebx
-            jnz .LM3
-            movb %cl,(%edi)      // Copy String length
-         end;
-      end;
-
-{$ifndef str_intern }
-    procedure str(c : cardinal;var s : string);
-{$else str_intern }
-    procedure int_str(c : cardinal;var s : string);
-{$endif str_intern }
-
-      var
-         buffer : array[0..14] of byte;
-
-      begin
-         asm
-            movl 8(%ebp),%eax       // load CARDINAL
-            movl 12(%ebp),%edi      // Load String address
-            xorl %ecx,%ecx          // String length=0
-            xorl %ebx,%ebx          // Buffer length=0
-            movl $0x0a,%esi         // load 10 as dividing constant.
-         .LM4:
-            xorl %edx,%edx
-            divl %esi,%eax
-            addb $0x30,%dl          // convert Rest to ASCII.
-            movb %dl,-12(%ebp,%ebx)
-            incl %ebx
-            cmpl $0,%eax
-            jnz .LM4
-            { now copy the string }
-         .LM5:
-            movb -13(%ebp,%ebx),%al    // -13 because EBX is decreased only
-                                       // later.
-            movb %al,1(%edi,%ecx)
-            incl %ecx
-            decl %ebx
-            jnz .LM5
-            movb %cl,(%edi)            // Copy String length
-         end;
-      end;
-
-    procedure f1;[public,alias: 'FLUSH_STDOUT'];
-
-      begin
-         asm
-            pushal
-         end;
-         FileFunc(textrec(output).flushfunc)(textrec(output));
-         asm
-            popal
-         end;
-      end;
-
-      
-Function Sptr : Longint;
+procedure int_str(l : longint;var s : string);
+var
+  buffer : array[0..11] of byte;
 begin
 begin
+{ Workaround: }
+  if l=$80000000 then
+   begin
+     s:='-2147483648';
+     exit;
+   end;
   asm
   asm
-    movl %esp,%eax
-    addl $8,%eax
-    movl %eax,-4(%ebp)
-  end ['EAX'];
+        movl    8(%ebp),%eax            // load Integer
+        movl    12(%ebp),%edi           // Load String address
+        xorl    %ecx,%ecx               // String length=0
+        xorl    %ebx,%ebx               // Buffer length=0
+        movl    $0x0a,%esi              // load 10 as dividing constant.
+        or      %eax,%eax               // Sign ?
+        jns     .LM2
+        neg     %eax
+        movb    $0x2d,1(%edi)           // put '-' in String
+        incl    %ecx
+.LM2:
+        cdq
+        idivl   %esi,%eax
+        addb    $0x30,%dl               // convert Rest to ASCII.
+        movb    %dl,-12(%ebp,%ebx)
+        incl    %ebx
+        cmpl    $0,%eax
+        jnz     .LM2
+.LM3:
+        movb    -13(%ebp,%ebx),%al      // -13 because EBX is decreased only later
+        movb    %al,1(%edi,%ecx)
+        incl    %ecx
+        decl    %ebx
+        jnz     .LM3
+        movb    %cl,(%edi)              // Copy String length
+  end;
 end;
 end;
 
 
 
 
+procedure int_str(c : cardinal;var s : string);
+var
+  buffer : array[0..14] of byte;
+begin
+  asm
+        movl 8(%ebp),%eax       // load CARDINAL
+        movl 12(%ebp),%edi      // Load String address
+        xorl %ecx,%ecx          // String length=0
+        xorl %ebx,%ebx          // Buffer length=0
+        movl $0x0a,%esi         // load 10 as dividing constant.
+.LM4:
+        xorl %edx,%edx
+        divl %esi,%eax
+        addb $0x30,%dl          // convert Rest to ASCII.
+        movb %dl,-12(%ebp,%ebx)
+        incl %ebx
+        cmpl $0,%eax
+        jnz .LM4
+.LM5:                           // now copy the string
+        movb -13(%ebp,%ebx),%al    // -13 because EBX is decreased only later
+        movb %al,1(%edi,%ecx)
+        incl %ecx
+        decl %ebx
+        jnz .LM5
+        movb %cl,(%edi)            // Copy String length
+  end;
+end;
+
 {$I386_ATT}
 {$I386_ATT}
 
 
 Function Random(L: LongInt): LongInt;assembler;
 Function Random(L: LongInt): LongInt;assembler;
 asm
 asm
-	  movl	$134775813,%eax
-          mull	RandSeed
-          incl	%eax
-          movl	%eax,RandSeed
-          mull	4(%esp)
-          movl	%edx,%eax
+          movl  $134775813,%eax
+          mull  RandSeed
+          incl  %eax
+          movl  %eax,RandSeed
+          mull  4(%esp)
+          movl  %edx,%eax
 end;
 end;
-{
-begin
-  Randseed:=Randseed*134775813+1;
-  Random:=abs(Randseed mod l);
-end;
-}
 
 
 {$I386_DIRECT}
 {$I386_DIRECT}
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.5  1998-04-29 13:28:19  peter
+  Revision 1.6  1998-05-12 10:42:41  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
+
+  Revision 1.5  1998/04/29 13:28:19  peter
     * some cleanup and i386_att usage
     * some cleanup and i386_att usage
 
 
   Revision 1.4  1998/04/10 15:41:54  florian
   Revision 1.4  1998/04/10 15:41:54  florian
@@ -745,118 +741,4 @@ end;
 
 
   Revision 1.2  1998/04/08 07:53:31  michael
   Revision 1.2  1998/04/08 07:53:31  michael
   + Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)
   + Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)
-
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
-
-  Revision 1.30  1998/03/20 05:11:17  carl
-    * bugfix of register usage list for strcmp and strconcat
-
-  Revision 1.29  1998/03/15 19:38:41  peter
-    * fixed a bug in Move()
-
-  Revision 1.28  1998/03/10 23:50:39  florian
-    * strcopy saves now the used registers except ESI and EDI, solves
-      a problem with the optimizer
-
-  Revision 1.27  1998/03/10 16:25:52  jonas
-    * removed reloading of eax with 8(ebp), in int_help_constructor, as eax is nowhere modified
-
-  Revision 1.25  1998/03/02 11:44:43  florian
-    * writing of large cardinals fixed
-
-  Revision 1.24  1998/03/02 04:14:02  carl
-    * page fault bug fix with CHECK_OBJECT
-       warning: Will only work with GAS as VMT pointer field is an
-       .lcomm and will be ZEROED by linker (might not be true for TASM)
-
-  Revision 1.23  1998/02/24 17:50:46  peter
-    * upto 100% (255's char is different ;) faster STRCMP
-    * faster StrPas from i386.inc also strings.pp
-
-  Revision 1.22  1998/02/22 22:01:26  carl
-  + IOCHECK halts with the correct errorcode now
-
-  Revision 1.21  1998/02/11 16:55:14  michael
-  fixed cardinal printing. Large cardinals (>0fffffff) not yet working
-
-  Revision 1.20  1998/02/06 09:12:39  florian
-    * bug in CHECK_OBJECT fixed
-
-  Revision 1.19  1998/02/05 22:30:25  florian
-    + CHECK_OBJECT to check for an valid VMT (before calling a virtual method)
-
-  Revision 1.18  1998/02/04 14:46:36  daniel
-  * Some small tweaks
-
-  Revision 1.17  1998/01/27 22:05:07  florian
-    * again small fixes to DOM (Delphi Object Model)
-
-  Revision 1.16  1998/01/26 11:59:01  michael
-  + Added log at the end
-
-  revision 1.15
-  date: 1998/01/25 22:52:52;  author: peter;  state: Exp;  lines: +140 -122
-    * Faster string functions by using aligning
-  ----------------------------
-  revision 1.14
-  date: 1998/01/25 22:30:48;  author: florian;  state: Exp;  lines: +14 -2
-    * DOM: some fixes to tobject and the con-/destructor help routines
-  ----------------------------
-  revision 1.13
-  date: 1998/01/23 18:08:29;  author: florian;  state: Exp;  lines: +10 -4
-    * more bugs in FCL object model removed
-  ----------------------------
-  revision 1.12
-  date: 1998/01/23 15:54:47;  author: florian;  state: Exp;  lines: +5 -5
-    + small extensions to FCL object model
-  ----------------------------
-  revision 1.11
-  date: 1998/01/20 00:14:24;  author: peter;  state: Exp;  lines: +18 -5
-    * .type is linux only, go32v2 doesn't like it
-  ----------------------------
-  revision 1.10
-  date: 1998/01/19 16:19:53;  author: peter;  state: Exp;  lines: +7 -1
-  * Works now correct with shared libs, .globl always needs a .type
-  ----------------------------
-  revision 1.9
-  date: 1998/01/19 10:21:35;  author: michael;  state: Exp;  lines: +1 -6
-  * moved Fillchar t(..,char) to system.inc
-  ----------------------------
-  revision 1.8
-  date: 1998/01/19 09:15:05;  author: michael;  state: Exp;  lines: +40 -132
-  * Bugfixes in Move and FillChar
-  ----------------------------
-  revision 1.7
-  date: 1998/01/16 23:10:52;  author: florian;  state: Exp;  lines: +23 -1
-    + some tobject stuff
-  ----------------------------
-  revision 1.6
-  date: 1998/01/16 22:21:35;  author: michael;  state: Exp;  lines: +601 -493
-  + Installed pentium-optimized move (optional)
-  ----------------------------
-  revision 1.5
-  date: 1998/01/12 03:39:17;  author: carl;  state: Exp;  lines: +2 -2
-    * bugfix of RE_OVERFLOW, gives out now a Runerror(215)
-  ----------------------------
-  revision 1.4
-  date: 1998/01/01 16:57:36;  author: michael;  state: Exp;  lines: +1 -21
-  Moved DO_EXIT to system.inc. Now processor independent
-  ----------------------------
-  revision 1.3
-  date: 1997/12/10 12:12:31;  author: michael;  state: Exp;  lines: +2 -2
-  * changed dateifunc to FileFunc
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:34:36;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:48;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:48;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }
 }

+ 0 - 70
rtl/i386/makefile

@@ -1,70 +0,0 @@
-#****************************************************************************
-#
-#                   Copyright (c) 1993,96 by Florian Klaempfl
-#
-#****************************************************************************
-#
-# makefile for FPKPascal
-#
-#####################################################################
-# Start of configurable section
-#####################################################################
-
-# Set REFPATH if you want to generate diffs to a standard RTL
-ifndef REFPATH
-REFPATH=/usr/local/fpk/work/new/rtl
-endif
-ifndef DIFF
-DIFF=diff
-endif
-ifndef DIFFOPTS
-DIFFOPTS=-b -c
-endif
-
-#######################################################################
-# End of configurable section.
-# Do not edit after this line.
-#######################################################################
-
-# Check copy delete commands.
-# You need cp from GNU to handle / as directory separator
-ifeq ($(DOS),YES)
-COPY=cp -p -f
-DEL=del
-else
-COPY=cp -p -f
-DEL=rm
-endif
-
-
-PPFILES = getopts.pp \
-	strings.pp
-
-INCFILES = heap.inc \
-	i386.inc \
-	math.inc \
-	set.inc 
-
-all:
-
-.PHONY: clean diffclean diffs
-
-clean:
-	-$(DEL) *.dif
-
-diffclean:
-	-$(DEL) *.dif
-
-
-%.dif : %.inc 
-	-$(DIFF) $(DIFFOPTS) $*.inc $(REFPATH)/i386/$*.inc > $*.dif
-
-%.dif : %.pp 
-	-$(DIFF) $(DIFFOPTS) $*.pp $(REFPATH)/i386/$*.pp > $*.dif
-
-makefile.dif : makefile
-	-$(DIFF) $(DIFFOPTS) makefile $(REFPATH)/i386/makefile > makefile.dif
-	
-diffs : $(patsubst %.inc,%.dif,$(INCFILES)) \
-	$(patsubst %.pp,%.dif,$(PPFILES)) \
-	makefile.dif

+ 1 - 4
rtl/i386/readme

@@ -1,5 +1,4 @@
-This directory contains only RTL parts specific
-to the processor I386 family.
+This directory contains only RTL parts specific to the processor I386 family.
 
 
 (They are specific because they contain assembler instructions)
 (They are specific because they contain assembler instructions)
 
 
@@ -11,5 +10,3 @@ Include files for system are :
 
 
 Units are :
 Units are :
   strings.pp (written in assembler for speed)
   strings.pp (written in assembler for speed)
-  getopts.pp (depends on the way the command line 
-              is transmitted to the program)

+ 5 - 14
rtl/inc/astrings.pp

@@ -713,19 +713,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-05-12 10:42:44  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.2  1998/01/26 12:00:10  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/astrings.pp
-  description:
-  ----------------------------
-  revision 1.1
-  date: 1998/01/02 16:58:14;  author: michael;  state: Exp;
-  + Initial implementation of AnsiStrings
-  =============================================================================
 }
 }

+ 6 - 23
rtl/inc/complex.pp

@@ -551,27 +551,10 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
-
-  Revision 1.3  1998/01/26 11:59:25  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/complex.pp
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 15:33:30;  author: michael;  state: Exp;  lines: +14 -0
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
+  Revision 1.2  1998-05-12 10:42:44  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
+
 }
 }

+ 6 - 24
rtl/inc/file.inc

@@ -257,28 +257,10 @@ End;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
-
-  Revision 1.4  1998/03/05 02:42:29  peter
-    + blockread/blockwrite with integer result
-
-  Revision 1.3  1998/01/26 11:59:44  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/inc/file.inc
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1998/01/25 21:53:28;  author: peter;  state: Exp;  lines: +2 -2
-    + Universal Handles support for StdIn/StdOut/StdErr
-    * Updated layout of sysamiga.pas
-  ----------------------------
-  revision 1.1
-  date: 1998/01/11 02:43:11;  author: michael;  state: Exp;
-  + Initial implementation of these files (by Peter Vreman).
-    file operations are now in separate files per type of file.
-  =============================================================================
+  Revision 1.2  1998-05-12 10:42:44  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
+
 }
 }

+ 5 - 40
rtl/inc/filerec.inc

@@ -40,45 +40,10 @@ Type
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-05-12 10:42:44  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.7  1998/02/05 12:08:54  pierre
-    * added packrecords to about dword alignment
-      for structures used in dos calls
-
-  Revision 1.6  1998/01/26 12:00:21  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/filerec.inc
-  description:
-  ----------------------------
-  revision 1.5
-  date: 1998/01/06 00:29:32;  author: michael;  state: Exp;  lines: +20 -19
-  Implemented a system independent sequence of reset/rewrite/append fileopenfunc etc system \n (from Peter Vreman)
-  ----------------------------
-  revision 1.4
-  date: 1997/12/01 12:08:03;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference header.
-  ----------------------------
-  revision 1.3
-  date: 1997/11/28 18:56:18;  author: pierre;  state: Exp;  lines: +2 -1
-    bug fix     in ifdef win32
-  ----------------------------
-  revision 1.2
-  date: 1997/11/27 22:49:04;  author: florian;  state: Exp;  lines: +7 -0
-  - CPU.PP added
-  - some bugs in DOS fixed (espsecially for go32v1)
-  - the win32 system unit is now compilable
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }
 }

+ 444 - 0
rtl/inc/getopts.pp

@@ -0,0 +1,444 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993,97 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Getopt implementation for Free Pascal, modeled after GNU getopt.
+
+
+    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 getopts;
+
+{$I os.inc}
+
+{ --------------------------------------------------------------------
+  *NOTE*
+  The routines are a more or less straightforward conversion
+
+  of the GNU C implementation of getopt. One day they should be
+
+  replaced by some 'real pascal code'.
+  -------------------------------------------------------------------- }
+
+Interface
+
+Const No_Argument       = 0;
+      Required_Argument = 1;
+      Optional_Argument = 2;
+
+      EndOfOptions      = #255;
+
+
+Type TOption = Record
+       Name    : String;
+       Has_arg : Integer;
+       Flag    : PChar;
+       Value   : Char;
+      end;
+     POption  = ^TOption;
+     Orderings = (require_order,permute,return_in_order);
+
+Var OptArg : String;
+    OptInd : Longint;
+    OptErr : Boolean;
+    OptOpt : Char;
+
+
+Function GetOpt (ShortOpts : String) : char;
+Function GetLongOpts (ShortOpts : String;
+
+                      LongOpts : POption;
+
+                      var Longind : Integer) : char;
+
+Implementation
+
+Var
+  NextChar,
+  Nrargs,
+  first_nonopt,
+  last_nonopt   : Longint;
+  Ordering      : Orderings;
+
+
+
+Procedure Exchange;
+var
+  bottom,
+  middle,
+  top,i,len : longint;
+  temp      : pchar;
+begin
+  bottom:=first_nonopt;
+  middle:=last_nonopt;
+  top:=optind;
+  while (top>middle) and (middle>bottom) do
+    begin
+    if (top-middle>middle-bottom) then
+      begin
+      len:=middle-bottom;
+      for i:=1 to len-1 do
+        begin
+        temp:=argv[bottom+i];
+        argv[bottom+i]:=argv[top-(middle-bottom)+i];
+        argv[top-(middle-bottom)+i]:=temp;
+        end;
+      top:=top-len;
+      end
+    else
+      begin
+      len:=top-middle;
+      for i:=0 to len-1 do
+        begin
+        temp:=argv[bottom+i];
+        argv[bottom+i]:=argv[middle+i];
+        argv[middle+i]:=temp;
+        end;
+      bottom:=bottom+len;
+      end;
+    end;
+  first_nonopt:=first_nonopt + optind-last_nonopt;
+  last_nonopt:=optind;
+end; { exchange }
+
+
+procedure getopt_init (var opts : string);
+begin
+{ Initialize some defaults. }
+  Optarg:='';
+  Optind:=1;
+  First_nonopt:=1;
+  Last_nonopt:=1;
+  OptOpt:='?';
+  Nextchar:=0;
+  if opts[1]='-' then
+
+    begin
+    ordering:=return_in_order;
+    delete(opts,1,1);
+    end
+  else if opts[1]='+' then
+    begin
+    ordering:=require_order;
+    delete(opts,1,1);
+    end
+  else ordering:=permute;
+end;
+
+
+
+Function Internal_getopt (Var Optstring : string;
+                          LongOpts : POption;
+                          LongInd : pointer;
+                          Long_only : boolean ) : char;
+type
+  pinteger=^integer;
+
+var
+  temp,endopt,option_index : byte;
+  indfound: integer;
+  currentarg,optname : string;
+  p,pfound : POption;
+  exact,ambig : boolean;
+  c : char;
+
+begin
+  optarg:='';
+  if optind=0 then
+    getopt_init(optstring);
+{ Check if We need the next argument. }
+  if optind<nrargs then currentarg:=strpas(argv[optind]) else currentarg:='';
+  if (nextchar=0) then
+
+   begin
+     if ordering=permute then
+      begin
+      { If we processed options following non-options : exchange }
+        if (first_nonopt<>last_nonopt) and (last_nonopt<>optind) then
+         exchange
+        else
+         if last_nonopt<>optind then
+          first_nonopt:=optind;
+        while (optind<nrargs) and ((argv[optind][0]<>'-') or
+              (length(strpas(argv[optind]))=1)) do
+          inc(optind);
+        last_nonopt:=optind;
+      end;
+   { Check for '--' argument }
+     if optind<nrargs then
+      currentarg:=strpas(argv[optind])
+     else
+      currentarg:='';
+     if (optind<>nrargs) and (currentarg='--') then
+      begin
+        inc(optind);
+        if (first_nonopt<>last_nonopt) and (last_nonopt<>optind) then
+         exchange
+        else
+
+         if first_nonopt=last_nonopt then
+          first_nonopt:=optind;
+        last_nonopt:=nrargs;
+        optind:=nrargs;
+      end;
+
+   { Are we at the end of all arguments ? }
+     if optind>=nrargs then
+      begin
+        if first_nonopt<>last_nonopt then
+         optind:=first_nonopt;
+        Internal_getopt:=EndOfOptions;
+        exit;
+      end;
+     if optind<nrargs then
+      currentarg:=strpas(argv[optind])
+     else
+      currentarg:='';
+   { Are we at a non-option ? }
+     if (currentarg[1]<>'-') or (currentarg='-') then
+      begin
+        if ordering=require_order then
+         begin
+           Internal_getopt:=EndOfOptions;
+           exit;
+         end
+        else
+         begin
+           optarg:=strpas(argv[optind]);
+           inc(optind);
+           Internal_getopt:=#1;
+           exit;
+         end;
+      end;
+   { At this point we're at an option ...}
+     nextchar:=2;
+     if (longopts<>nil) and (currentarg[2]='-') then
+      inc(nextchar);
+   { So, now nextchar points at the first character of an option }
+   end;
+{ Check if we have a long option }
+  if longopts<>nil then
+
+   if length(currentarg)>1 then
+    if (currentarg[2]='-') or
+       ((not long_only) and (pos(currentarg[2],optstring)<>0)) then
+     begin
+     { Get option name }
+       endopt:=pos('=',currentarg);
+       if endopt=0 then
+        endopt:=length(currentarg)+1;
+       optname:=copy(currentarg,nextchar,endopt-nextchar);
+     { Match partial or full }
+       p:=longopts;
+       pfound:=nil;
+       exact:=false;
+       ambig:=false;
+       option_index:=0;
+       indfound:=0;
+       while (p^.name<>'') and (not exact) do
+        begin
+          if pos(optname,p^.name)<>0 then
+           begin
+             if length(optname)=length(p^.name) then
+              begin
+                exact:=true;
+                pfound:=p;
+                indfound:=option_index;
+              end
+             else
+              if pfound=nil then
+               begin
+                 indfound:=option_index;
+                 pfound:=p
+               end
+              else
+               ambig:=true;
+           end;
+          inc (longint(p),sizeof(toption));
+          inc (option_index);
+        end;
+       if ambig and not exact then
+
+        begin
+          if opterr then
+           writeln (paramstr(0),': option "',optname,'" is ambiguous');
+          nextchar:=0;
+          inc(optind);
+          Internal_getopt:='?';
+        end;
+       if pfound<>nil then
+        begin
+          inc(optind);
+          if endopt<=length(currentarg) then
+           begin
+             if pfound^.has_arg>0 then
+              optarg:=copy(currentarg,endopt+1,length(currentarg)-endopt)
+             else
+              begin
+                if opterr then
+                 if currentarg[2]='-' then
+                  writeln (paramstr(0),': option "--',pfound^.name,'" doesn''t allow an argument')
+                 else
+
+                  writeln (paramstr(0),': option "',currentarg[1],pfound^.name,'" doesn''t allow an argument');
+                nextchar:=0;
+                internal_getopt:='?';
+                exit;
+              end;
+           end
+
+          else { argument in next paramstr...  }
+
+           begin
+             if pfound^.has_arg=1 then
+              begin
+                if optind<nrargs then
+                 begin
+                   optarg:=strpas(argv[optind]);
+                   inc(optind);
+                 end { required argument }
+                else
+                 begin { no req argument}
+                   if opterr then
+                    writeln (paramstr(0),': option ',pfound^.name,' requires an argument');
+                   nextchar:=0;
+                   if optstring[1]=':' then
+                    Internal_getopt:=':'
+                   else
+                    Internal_getopt:='?';
+                   exit;
+                 end;
+              end;
+
+          end; { argument in next parameter end;}
+         nextchar:=0;
+         if longind<>nil then
+          pinteger(longind)^:=indfound+1;
+            if pfound^.flag<>nil then
+
+            begin
+              pfound^.flag^:=pfound^.value;
+              internal_getopt:=#0;
+              exit;
+            end;
+           internal_getopt:=pfound^.value;
+           exit;
+         end; { pfound<>nil }
+      { We didn't find it as an option }
+        if (not long_only) or
+           ((currentarg[2]='-') or (pos(CurrentArg[nextchar],optstring)=0)) then
+         begin
+           if opterr then
+            if currentarg[2]='-' then
+             writeln (paramstr(0),' unrecognized option "--',optname,'"')
+            else
+             writeln (paramstr(0),' unrecognized option "',currentarg[1],optname,'"');
+           nextchar:=0;
+           inc(optind);
+           Internal_getopt:='?';
+           exit;
+        end;
+
+     end; { Of long options.}
+{ We check for a short option. }
+  temp:=pos(currentarg[nextchar],optstring);
+  c:=currentarg[nextchar];
+  inc(nextchar);
+  if nextchar>length(currentarg) then
+
+   begin
+     inc(optind);
+     nextchar:=0;
+   end;
+  if (temp=0) or (c=':') then
+   begin
+     if opterr then
+      writeln (paramstr(0),': illegal option -- ',c);
+     optopt:=currentarg[nextchar-1];
+     internal_getopt:='?';
+     exit;
+   end;
+  Internal_getopt:=optstring[temp];
+  if optstring[temp+1]=':' then
+
+   if currentarg[temp+2]=':' then
+    begin { optional argument }
+      optarg:=copy (currentarg,nextchar,length(currentarg)-nextchar+1);
+      nextchar:=0;
+    end
+   else
+    begin { required argument }
+      if nextchar>0 then
+
+       begin
+         optarg:=copy (currentarg,nextchar,length(currentarg)-nextchar+1);
+         inc(optind)
+       end
+      else
+       if (optind=nrargs) then
+        begin
+          if opterr then
+           writeln (paramstr(0),': option requires an argument -- ',optstring[temp]);
+          optopt:=optstring[temp];
+          if optstring[1]=':' then
+
+           Internal_getopt:=':'
+          else
+           Internal_Getopt:='?'
+
+        end
+       else
+        begin
+          optarg:=strpas(argv[optind]);
+          inc(optind)
+        end;
+       nextchar:=0;
+    end; { End of required argument}
+end; { End of internal getopt...}
+
+
+Function GetOpt(ShortOpts : String) : char;
+begin
+  getopt:=internal_getopt (shortopts,nil,nil,false);
+end;
+
+
+Function GetLongOpts(ShortOpts : String;
+
+                     LongOpts : POption;
+
+                     var Longind : Integer) : char;
+begin
+  getlongopts:=internal_getopt ( shortopts,longopts,@longind,true);
+end;
+
+
+
+
+begin
+{ Needed to detect startup }
+
+  Opterr:=true;
+  Optind:=0;
+  nrargs:=paramcount+1;
+end.
+
+
+
+{
+  $Log$
+  Revision 1.1  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
+
+}

+ 24 - 46
rtl/inc/heaph.inc

@@ -12,58 +12,36 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
-  const
-    heapblocks : boolean=false;
 
 
-
-  var
-     heaporg,heapptr,heapend,heaperror,freelist : pointer;
-
-  procedure release(var p : pointer);
-  procedure mark(var p : pointer);
-  procedure markheap(var oldfreelist,oldheapptr : pointer);
-  procedure releaseheap(oldfreelist,oldheapptr : pointer);
-  function  cal_memavail : longint;
-  function  heapsize : longint;
+Procedure release(var p : pointer);
+Procedure mark(var p : pointer);
+Procedure markheap(var oldfreelist,oldheapptr : pointer);
+Procedure releaseheap(oldfreelist,oldheapptr : pointer);
+Function  cal_memavail : longint;
+Function  heapsize : longint;
 {$ifdef TEMPHEAP}
 {$ifdef TEMPHEAP}
-  procedure split_heap;
-  procedure switch_to_base_heap;
-  procedure switch_to_temp_heap;
-  procedure switch_heap;
-  procedure releasetempheap;
-  procedure gettempmem(var p : pointer;size : longint);
+  Procedure split_heap;
+  Procedure switch_to_base_heap;
+  Procedure switch_to_temp_heap;
+  Procedure switch_heap;
+  Procedure releasetempheap;
+  Procedure gettempmem(var p : pointer;size : longint);
 {$endif TEMPHEAP}
 {$endif TEMPHEAP}
 
 
-  const
-     allow_special : boolean =true;
+const
+  allow_special : boolean =true;
+  heapblocks    : boolean=false;
+var
+  heaporg,heapptr,heapend,heaperror,freelist : pointer;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-04-21 10:23:15  peter
-    + heapblocks
-
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
-
-  Revision 1.3  1998/01/26 11:59:33  michael
-  + Added log at the end
+  Revision 1.3  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-
-
-
-  Working file: rtl/inc/heaph.inc
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:08:03;  author: michael;  state: Exp;  lines: +11 -3
-  + added copyright reference header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
+  Revision 1.2  1998/04/21 10:23:15  peter
+    + heapblocks
 }
 }

+ 5 - 22
rtl/inc/innr.inc

@@ -54,28 +54,11 @@ const
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.4  1998/02/24 16:50:05  peter
-    * stackframe ommiting generated 'ret $-4'
-    + timer.pp bp7 version
-    * innr.inc are now the same files
-
-  Revision 1.3  1998/01/26 11:59:37  michael
-  + Added log at the end
-
-  revision 1.2
-  date: 1997/12/01 12:08:04;  author: michael;  state: Exp;  lines: +8 -17
-  + added copyright reference header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:46;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }
 }
 
 

+ 5 - 30
rtl/inc/lstrings.pp

@@ -535,35 +535,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.3  1998/01/26 12:00:05  michael
-  + Added log at the end
-
-  Revision 1.2  1997/12/22 15:36:19  michael
-  + All functions are implemented and tested.
-
-}
-{
-  $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
-
-  Revision 1.3  1998/01/26 12:00:05  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/lstrings.pp
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1997/12/22 15:36:19;  author: michael;  state: Exp;  lines: +498 -18
-  + All functions are implemented and tested.
-  ----------------------------
-  revision 1.1
-  date: 1997/12/19 16:11:49;  author: michael;  state: Exp;
-  + Initial implementation.
-  =============================================================================
 }
 }

+ 0 - 77
rtl/inc/makefile

@@ -1,77 +0,0 @@
-#****************************************************************************
-#
-#                   Copyright (c) 1993,96 by Florian Klaempfl
-#
-#****************************************************************************
-#
-# makefile for FPKPascal
-#
-#####################################################################
-# Start of configurable section
-#####################################################################
-
-# Set REFPATH if you want to generate diffs to a standard RTL
-ifndef REFPATH
-REFPATH=/usr/local/fpk/work/new/rtl
-endif
-ifndef DIFF
-DIFF=diff
-endif
-ifndef DIFFOPTS
-DIFFOPTS=-b -c
-endif
-
-#######################################################################
-# End of configurable section.
-# Do not edit after this line.
-#######################################################################
-
-# Check copy delete commands.
-# You need cp from GNU to handle / as directory separator
-ifeq ($(DOS),YES)
-COPY=cp -p -f
-DEL=del
-else
-COPY=cp -p -f
-DEL=rm
-endif
-
-
-PPFILES = complex.pp \
-	cpne.pp
-
-INCFILES = heaph.inc \
-	innr.inc \
-	mathh.inc \
-	real2str.inc \
-	system.inc  \
-	systemh.inc \
-        textrec.inc \
-	filerec.inc
-
-
-.PHONY: clean diffclean diffs
-
-all:
-
-clean:
-	-$(DEL) *.dif
-
-diffclean:
-	-$(DEL) *.dif
-
-
-%.dif : %.inc 
-	-$(DIFF) $(DIFFOPTS) $*.inc $(REFPATH)/inc/$*.inc > $*.dif
-
-%.dif : %.pp 
-	-$(DIFF) $(DIFFOPTS) $*.pp $(REFPATH)/inc/$*.pp > $*.dif
-
-makefile.dif : makefile
-	-$(DIFF) $(DIFFOPTS) makefile $(REFPATH)/inc/makefile > makefile.dif
-	
-diffs : $(patsubst %.inc,%.dif,$(INCFILES)) \
-	$(patsubst %.pp,%.dif,$(PPFILES)) \
-	makefile.dif
-
-

+ 7 - 1
rtl/inc/makefile.inc

@@ -5,9 +5,15 @@
 # System unit include files. These are composed from header and
 # System unit include files. These are composed from header and
 # implementation files.
 # implementation files.
 
 
-SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr file typefile version
+SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
+         file typefile version
 SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
 SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
 
 
+# Other unit names which can be used for all systems
+#
+#UNITNAMES=getops
+#UNITPPNAMES=$(addsuffix .pp,$(UNITNAMES))
+
 # Other files...
 # Other files...
 #astrings.pp
 #astrings.pp
 #complex.pp
 #complex.pp

+ 5 - 38
rtl/inc/mathh.inc

@@ -42,43 +42,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.7  1998/01/27 12:44:46  peter
-    * removed comment level 2 warning
-
-  Revision 1.6  1998/01/26 11:59:40  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/mathh.inc
-  description:
-  ----------------------------
-  revision 1.5
-  date: 1997/12/01 12:08:04;  author: michael;  state: Exp;  lines: +12 -4
-  + added copyright reference header.
-  ----------------------------
-  revision 1.4
-  date: 1997/11/28 23:26:45;  author: florian;  state: Exp;  lines: +3 -5
-  $ifdef fixed added
-  ----------------------------
-  revision 1.3
-  date: 1997/11/28 19:45:21;  author: pierre;  state: Exp;  lines: +35 -33
-    * one more bug fix with namelength
-    + fixed math in fixed_math define (does not compile yet)
-  ----------------------------
-  revision 1.2
-  date: 1997/11/28 16:49:08;  author: carl;  state: Exp;  lines: +33 -26
-  + added fixed point routines.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }
 }

+ 7 - 2
rtl/inc/readme

@@ -1,7 +1,7 @@
 This directory contains only RTL parts independent 
 This directory contains only RTL parts independent 
 of the processor and of the operating system.
 of the processor and of the operating system.
 
 
-The files contain the following:
+The include files contain the following:
 
 
 system.inc	OS and Processor independent implementation part of system unit.
 system.inc	OS and Processor independent implementation part of system unit.
 systemh.inc	Interface part of the system unit.
 systemh.inc	Interface part of the system unit.
@@ -11,4 +11,9 @@ astrings.pp	AnsiStrings implementation.
 lstrings.pp	LongStrings implementation.
 lstrings.pp	LongStrings implementation.
 sstrings.inc	ShortStrings implementation.
 sstrings.inc	ShortStrings implementation.
 heaph.inc	Declarations of Heap functions.
 heaph.inc	Declarations of Heap functions.
-mathh.inc	Declarations of mathematical functions.	
+mathh.inc	Declarations of mathematical functions.	
+
+The unit files are:
+
+complex.pp	Complex functions using operator overloading
+getops.pp	Pascal implementation of the GNU Getops

+ 14 - 50
rtl/inc/real2str.inc

@@ -19,21 +19,18 @@ type
   { corresponding to real    single     fixed   extended and comp for i386 }
   { corresponding to real    single     fixed   extended and comp for i386 }
 
 
 {$ifdef i386}
 {$ifdef i386}
-{$ifdef ver_above0_9_ still not ok }
-  bestreal  = extended; { still gives problems }
-{$else ver_above0_9_8}
+{  bestreal  = extended;  still gives problems }
   bestreal = double;
   bestreal = double;
-{$endif ver_above0_9_8}
-{$else not i386}
+{$else i386}
   bestreal = single;
   bestreal = single;
-{$endif not i386}
+{$endif i386}
 
 
 Procedure str_real (len,f : longint; d : bestreal; real_type :treal_type; var s : string);
 Procedure str_real (len,f : longint; d : bestreal; real_type :treal_type; var s : string);
-
-{ These numbers are for the double type...
+{
+  These numbers are for the double type...
   At the moment these are mapped onto a double but this may change
   At the moment these are mapped onto a double but this may change
-  in the future ! }
-
+  in the future !
+}
 var  maxlen : longint;   { Maximal length of string for float }
 var  maxlen : longint;   { Maximal length of string for float }
      minlen : longint;   { Minimal length of string for float }
      minlen : longint;   { Minimal length of string for float }
      explen : longint;   { Length of exponent, including E and sign.
      explen : longint;   { Length of exponent, including E and sign.
@@ -88,11 +85,7 @@ begin
     end;
     end;
   { check parameters }
   { check parameters }
   { default value for length is -32767 }
   { default value for length is -32767 }
-{$ifdef ver_above0_9_7}
   if len=-32767 then len:=maxlen;
   if len=-32767 then len:=maxlen;
-{$else }
-  if (len=-1) and (f=-1) then len:=maxlen;
-{$endif }
   { determine sign. before precision, needs 2 less calls to abs() }
   { determine sign. before precision, needs 2 less calls to abs() }
   sign:=d<0;
   sign:=d<0;
   { the creates a cannot determine which overloaded function to call
   { the creates a cannot determine which overloaded function to call
@@ -205,41 +198,12 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-04-07 22:40:46  florian
-    * final fix of comp writing
+  Revision 1.3  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
-
-  Revision 1.7  1998/03/16 23:38:17  peter
-    * fixed 0.997:0:2 bugs
-
-  Revision 1.6  1998/01/26 11:59:47  michael
-  + Added log at the end
-
-
-  revision 1.5
-  date: 1998/01/05 00:48:24;  author: carl;  state: Exp;  lines: +2 -2
-  + Now compatible with m68k floating point types
-  ----------------------------
-  revision 1.4
-  date: 1997/12/02 17:44:45;  author: pierre;  state: Exp;  lines: +2 -2
-    * use of extended type in function str_real still buggy
-  ----------------------------
-  revision 1.3
-  date: 1997/12/01 12:08:04;  author: michael;  state: Exp;  lines: +12 -6
-  + added copyright reference header.
-  ----------------------------
-  revision 1.2
-  date: 1997/11/28 19:45:21;  author: pierre;  state: Exp;  lines: +6 -3
-    * one more bug fix with namelength
-    + fixed math in fixed_math define (does not compile yet)
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
+  Revision 1.2  1998/04/07 22:40:46  florian
+    * final fix of comp writing
 }
 }

+ 239 - 326
rtl/inc/sstrings.inc

@@ -210,316 +210,63 @@ begin
 end;
 end;
 
 
 
 
+{*****************************************************************************
+                              Str() Helpers
+*****************************************************************************}
 
 
-{$ifndef str_intern }
-procedure str(i : integer;var s : string);
-
-begin
-   str(longint(i),s);
-end;
-   
-procedure str(si : shortint;var s : string);
-
-begin
-   str(longint(si),s);
-end;
-
-procedure str(b : byte;var s : string);
-
-begin
-   str(longint(b),s);
-end;
-
-procedure str(w : word;var s : string);
-
-begin
-   str(longint(w),s);
-end;
-
-{$ifdef ieee_support}
-procedure str(d : double;var s : string);
-
-begin
-   str_real(-1,-1,d,rt_s64real,s);
-end;
-{$endif ieee_support}
-
-
-{$ifndef ieee_support}
-{ REAL TYPE = single type in this case }
-procedure str(d : real;var s : string);
-
-begin
-   str_real(-1,-1,d,rt_s32real,s);
-end;
-{$endif ieee_support}
-
-{$else not str_intern }
 procedure int_str_real(d : real;len,fr : longint;var s : string);[public, alias : 'STR_REAL'];
 procedure int_str_real(d : real;len,fr : longint;var s : string);[public, alias : 'STR_REAL'];
-
 begin
 begin
- {$ifdef i386}
+{$ifdef i386}
    str_real(len,fr,d,rt_s64real,s);
    str_real(len,fr,d,rt_s64real,s);
- {$else}
+{$else}
    str_real(len,fr,d,rt_s32real,s);
    str_real(len,fr,d,rt_s32real,s);
- {$endif}
+{$endif}
 end;
 end;
 
 
-{$ifdef support_ieee}
-procedure int_str_single(d : single;len,fr : longint;var s : string);[public, alias : 'STR_SINGLE'];
 
 
+procedure int_str_single(d : single;len,fr : longint;var s : string);[public, alias : 'STR_SINGLE'];
 begin
 begin
    str_real(len,fr,d,rt_s32real,s);
    str_real(len,fr,d,rt_s32real,s);
 end;
 end;
 
 
-procedure int_str_extended(d : extended;len,fr : longint;var s : string);[public, alias : 'STR_EXTENDED'];
 
 
+procedure int_str_extended(d : extended;len,fr : longint;var s : string);[public, alias : 'STR_EXTENDED'];
 begin
 begin
    str_real(len,fr,d,rt_s80real,s);
    str_real(len,fr,d,rt_s80real,s);
 end;
 end;
-{$endif support_ieee}
 
 
-{$ifdef support_comp}
-procedure int_str_comp(d : comp;len,fr : longint;var s : string);[public, alias : 'STR_COMP'];
 
 
+procedure int_str_comp(d : comp;len,fr : longint;var s : string);[public, alias : 'STR_COMP'];
 begin
 begin
    str_real(len,fr,d,rt_s64bit,s);
    str_real(len,fr,d,rt_s64bit,s);
 end;
 end;
-{$endif support_comp}
 
 
-procedure int_str_fixed(d : fixed;len,fr : longint;var s : string);[public, alias : 'STR_FIXED'];
 
 
+procedure int_str_fixed(d : fixed;len,fr : longint;var s : string);[public, alias : 'STR_FIXED'];
 begin
 begin
    str_real(len,fr,d,rt_f32bit,s);
    str_real(len,fr,d,rt_f32bit,s);
 end;
 end;
 
 
-procedure int_str_longint(v : longint;len : longint;var s : string);[public, alias : 'STR_LONGINT'];
 
 
+procedure int_str_longint(v : longint;len : longint;var s : string);[public, alias : 'STR_LONGINT'];
 begin
 begin
    int_str(v,s);
    int_str(v,s);
    if length(s)<len then
    if length(s)<len then
      s:=space(len-length(s))+s;
      s:=space(len-length(s))+s;
 end;
 end;
 
 
-{$ifdef ver_above0_9_8}
-procedure int_str_cardinal(v : cardinal;len : longint;var s : string);[public, alias : 'STR_CARDINAL'];
-var
-   d : real;
 
 
+procedure int_str_cardinal(v : cardinal;len : longint;var s : string);[public, alias : 'STR_CARDINAL'];
 begin
 begin
   int_str(v,s);
   int_str(v,s);
   if length(s)<len then
   if length(s)<len then
     s:=space(len-length(s))+s;
     s:=space(len-length(s))+s;
 end;
 end;
-{$endif ver_above0_9_8}
-
-{$endif  str_intern }
-
-procedure val(const s : string;var d : real;var code : word);
-
-  var
-     { faster on a pentium }
-     esign,sign : real;
-
-     i : longint;
-     exponent : longint;
-     flags : byte;
-     hd : real;
-
-  begin
-     d:=0;
-     code:=1;
-     exponent:=0;
-     esign:=1;
-     flags:=0;
-     sign:=1;
-     while (code<=length(s)) and (s[code] in [' ',#9]) do
-       inc(code);
-     case s[code] of
-      '+' : inc(code);
-      '-' : begin
-              sign:=-1.0;
-              inc(code);
-            end;
-     end;
-     while (Code<=Length(s)) and (s[code] in ['0'..'9']) do
-       begin
-          { Read integer part }
-          flags:=flags or 1;
-          d:=d*10;
-          d:=d+(ord(s[code])-ord('0'));
-          inc(code);
-       end;
-     { Decimal ? }
-     if (s[code]='.') and (length(s)>=code) then
-       begin
-          hd:=0.1;
-          inc(code);
-          { After dot, a number is required. }
-          if not(s[code] in ['0'..'9']) or (length(s)<code) then
-            begin
-               d:=0.0;
-               exit;
-            end;
-          while (s[code] in ['0'..'9']) and (length(s)>=code) do
-            begin
-               { Read fractional part. }
-               flags:=flags or 2;
-               d:=d+hd*(ord(s[code])-ord('0'));
-               hd:=hd/10.0;
-               inc(code);
-            end;
-       end;
-     { Again, read integer and fractional part}
-     if flags=0 then
-       begin
-          d:=0.0;
-          exit;
-       end;
-     { Exponent ? }
-     if (upcase(s[code])='E') and (length(s)>=code) then
-       begin
-          inc(code);
-          if s[code]='+' then
-            inc(code)
-          else if s[code]='-' then
-            begin
-               esign:=-1;
-               inc(code);
-            end;
-          if not(s[code] in ['0'..'9']) or (length(s)<code) then
-            begin
-               d:=0.0;
-               exit;
-            end;
-          while (s[code] in ['0'..'9']) and (length(s)>=code) do
-            begin
-               exponent:=exponent*10;
-               exponent:=exponent+ord(s[code])-ord('0');
-               inc(code);
-            end;
-       end;
-     { Calculate Exponent }
-     if esign>0 then
-       for i:=1 to exponent do
-         d:=d*10
-     else
-       for i:=1 to exponent do
-         d:=d/10;
-     { Not all characters are read ? }
-     if length(s)>=code then
-       begin
-          d:=0.0;
-          exit;
-       end;
-     { evalute sign }
-     d:=d*sign;
-     { success ! }
-     code:=0;
-  end;
-
-procedure val(const s : string;var d : real;var code : integer);
-
-  begin
-     val(s,d,word(code));
-  end;
-
-procedure val(const s : string;var d : real);
-  var code : word;
-  begin
-     val(s,d,code);
-  end;
-
-{$ifdef ver_above0_9_2}
-{$IFDEF ieee_support}
-procedure val(const s : string;var d : single;var code : word);
-
-  var e : double;
-
-  begin
-     val(s,e,code);
-     d:=e;
-  end;
-
-procedure val(const s : string;var d : single;var code : integer);
-
-  var e : double;
-
-  begin
-     val(s,e,word(code));
-     d:=e;
-  end;
-
-procedure val(const s : string;var d : single);
-
-  var code : word;
-      e    : double;
-  begin
-     val(s,e,code);
-     d:=e;
-  end;
-{$ENDIF ieee_support}
-{$endif ver_above0_9_2}
-{$ifdef ver_above0_9_7}
-{$ifdef ieee_support}
-procedure val(const s : string;var d : extended;var code : word);
-
-var e : double;
-
-begin
-   val(s,e,code);
-   d:=e;
-end;
-
-procedure val(const s : string;var d : extended;var code : integer);
-
-var e : double;
-
-begin
-   val(s,e,word(code));
-   d:=e;
-end;
-
-procedure val(const s : string;var d : extended);
-
-var code : word;
-    e    : double;
-begin
-   val(s,e,code);
-   d:=e;
-end;
-{$endif ieee_support}
-{$ifdef comp_support}
-procedure val(const s : string;var d : comp;var code : word);
-
-var e : double;
-
-begin
-   val(s,e,code);
-   d:=e;
-end;
-
-procedure val(const s : string;var d : comp;var code : integer);
-
-var e : double;
-
-begin
-   val(s,e,word(code));
-   d:=e;
-end;
-
-procedure val(const s : string;var d : comp);
-
-var code : word;
-    e    : double;
-begin
-   val(s,e,code);
-   d:=e;
-end;
-{$endif comp_support}
 
 
-{$endif ver_above0_9_7}
 
 
+{*****************************************************************************
+                           Val() Functions 
+*****************************************************************************}
 
 
 Function InitVal(const s:string;var negativ:boolean;var base:byte):Word;
 Function InitVal(const s:string;var negativ:boolean;var base:byte):Word;
 var
 var
@@ -561,43 +308,43 @@ begin
 end;
 end;
 
 
 
 
-procedure val(const s : string;var v : longint;var code : word);
+procedure val(const s : string;var l : longint;var code : word);
 var
 var
   base,u  : byte;
   base,u  : byte;
   negativ : boolean;
   negativ : boolean;
 begin
 begin
-  v:=0;
+  l:=0;
   Code:=InitVal(s,negativ,base);
   Code:=InitVal(s,negativ,base);
   if Code>length(s) then
   if Code>length(s) then
    exit;
    exit;
   if negativ and (s='-2147483648') then
   if negativ and (s='-2147483648') then
    begin
    begin
      Code:=0;
      Code:=0;
-     v:=$80000000;
+     l:=$80000000;
      exit;
      exit;
    end;
    end;
   while Code<=Length(s) do
   while Code<=Length(s) do
    begin
    begin
      u:=ord(s[code]);
      u:=ord(s[code]);
      case u of
      case u of
-      48..57  : dec(u,48);
-      65..70  : dec(u,55);
+       48..57 : dec(u,48);
+       65..70 : dec(u,55);
       97..104 : dec(u,87);
       97..104 : dec(u,87);
      else
      else
       u:=16;
       u:=16;
      end;
      end;
-     v:=v*longint(base);
-     if (u>=base) or ((base=10) and (2147483647-v<longint(u))) then
+     l:=l*longint(base);
+     if (u>=base) or ((base=10) and (2147483647-l<longint(u))) then
       begin
       begin
-        v:=0;
+        l:=0;
         exit;
         exit;
       end;
       end;
-     inc(v,u);
+     inc(l,u);
      inc(code);
      inc(code);
    end;
    end;
   code := 0;
   code := 0;
   if negativ then
   if negativ then
-   v:=0-v;
+   l:=0-l;
 end;
 end;
 
 
 
 
@@ -609,7 +356,7 @@ end;
 
 
 procedure val(const s : string;var l : longint);
 procedure val(const s : string;var l : longint);
 var
 var
-   code : word;
+  code : word;
 begin
 begin
    val (s,l,code);
    val (s,l,code);
 end;
 end;
@@ -619,17 +366,17 @@ procedure val(const s : string;var b : byte);
 var
 var
   l : longint;
   l : longint;
 begin
 begin
-   val(s,l);
-   b:=l;
+  val(s,l);
+  b:=l;
 end;
 end;
 
 
 
 
 procedure val(const s : string;var b : byte;var code : word);
 procedure val(const s : string;var b : byte;var code : word);
 var
 var
-   l : longint;
+  l : longint;
 begin
 begin
-   val(s,l,code);
-   b:=l;
+  val(s,l,code);
+  b:=l;
 end;
 end;
 
 
 
 
@@ -641,10 +388,10 @@ end;
 
 
 procedure val(const s : string;var b : shortint);
 procedure val(const s : string;var b : shortint);
 var
 var
-   l : longint;
+  l : longint;
 begin
 begin
-   val(s,l);
-   b:=l;
+  val(s,l);
+  b:=l;
 end;
 end;
 
 
 
 
@@ -711,7 +458,203 @@ begin
 end;
 end;
 
 
 
 
-{$ifdef ver_above0_9_8}
+procedure val(const s : string;var d : real;var code : word);
+var
+  hd,
+  esign,sign : real;
+  exponent,i : longint;
+  flags      : byte;
+begin
+  d:=0;
+  code:=1;
+  exponent:=0;
+  esign:=1;
+  flags:=0;
+  sign:=1;
+  while (code<=length(s)) and (s[code] in [' ',#9]) do
+   inc(code);
+  case s[code] of
+   '+' : inc(code);
+   '-' : begin
+           sign:=-1.0;
+           inc(code);
+         end;
+  end;
+  while (Code<=Length(s)) and (s[code] in ['0'..'9']) do
+   begin
+   { Read integer part }
+      flags:=flags or 1;
+      d:=d*10;
+      d:=d+(ord(s[code])-ord('0'));
+      inc(code);
+   end;
+{ Decimal ? }
+  if (s[code]='.') and (length(s)>=code) then
+   begin
+      hd:=0.1;
+      inc(code);
+      { After dot, a number is required. }
+      if not(s[code] in ['0'..'9']) or (length(s)<code) then
+        begin
+           d:=0.0;
+           exit;
+        end;
+      while (s[code] in ['0'..'9']) and (length(s)>=code) do
+        begin
+           { Read fractional part. }
+           flags:=flags or 2;
+           d:=d+hd*(ord(s[code])-ord('0'));
+           hd:=hd/10.0;
+           inc(code);
+        end;
+   end;
+ { Again, read integer and fractional part}
+  if flags=0 then
+   begin
+      d:=0.0;
+      exit;
+   end;
+ { Exponent ? }
+  if (upcase(s[code])='E') and (length(s)>=code) then
+   begin
+      inc(code);
+      if s[code]='+' then
+        inc(code)
+      else
+        if s[code]='-' then
+         begin
+           esign:=-1;
+           inc(code);
+         end;
+      if not(s[code] in ['0'..'9']) or (length(s)<code) then
+        begin
+           d:=0.0;
+           exit;
+        end;
+      while (s[code] in ['0'..'9']) and (length(s)>=code) do
+        begin
+           exponent:=exponent*10;
+           exponent:=exponent+ord(s[code])-ord('0');
+           inc(code);
+        end;
+   end;
+{ Calculate Exponent }
+  if esign>0 then
+    for i:=1 to exponent do
+      d:=d*10
+    else
+      for i:=1 to exponent do
+        d:=d/10;
+{ Not all characters are read ? }
+  if length(s)>=code then
+   begin
+     d:=0.0;
+     exit;
+   end;
+{ evalute sign }
+  d:=d*sign;
+{ success ! }
+  code:=0;
+end;
+
+
+procedure val(const s : string;var d : real;var code : integer);
+begin
+  val(s,d,word(code));
+end;
+
+
+procedure val(const s : string;var d : real);
+var
+  code : word;
+begin
+  val(s,d,code);
+end;
+
+
+procedure val(const s : string;var d : single;var code : word);
+var
+  e : double;
+begin
+  val(s,e,code);
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : single;var code : integer);
+var
+  e : double;
+begin
+  val(s,e,word(code));
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : single);
+var
+  code : word;
+  e    : double;
+begin
+  val(s,e,code);
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : extended;var code : word);
+var
+  e : double;
+begin
+  val(s,e,code);
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : extended;var code : integer);
+var
+  e : double;
+begin
+  val(s,e,word(code));
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : extended);
+var
+  code : word;
+  e    : double;
+begin
+  val(s,e,code);
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : comp;var code : word);
+var
+  e : double;
+begin
+  val(s,e,code);
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : comp;var code : integer);
+var
+  e : double;
+begin
+  val(s,e,word(code));
+  d:=e;
+end;
+
+
+procedure val(const s : string;var d : comp);
+var
+  code : word;
+  e    : double;
+begin
+  val(s,e,code);
+  d:=e;
+end;
+
 
 
 procedure val(const s : string;var v : cardinal;var code : word);
 procedure val(const s : string;var v : cardinal;var code : word);
 var
 var
@@ -726,8 +669,8 @@ begin
    begin
    begin
      u:=ord(s[code]);
      u:=ord(s[code]);
      case u of
      case u of
-      48..57  : dec(u,48);
-      65..70  : dec(u,55);
+       48..57 : dec(u,48);
+       65..70 : dec(u,55);
       97..104 : dec(u,87);
       97..104 : dec(u,87);
      else
      else
       u:=16;
       u:=16;
@@ -758,42 +701,12 @@ begin
   val(s,v,word(code));
   val(s,v,word(code));
 end;
 end;
 
 
-{$endif ver_above0_9_8}
-
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-03-26 14:41:22  michael
-  + Added comp support for val and read(ln)
-
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
-
-  Revision 1.8  1998/03/18 15:04:36  pierre
-    * bug in val : a was accepted as 10 in base 10 !!
-
-  Revision 1.7  1998/02/11 16:55:18  michael
-  fixed cardinal printing. Large cardinals (>0fffffff) not yet working
-
-  Revision 1.6  1998/02/08 23:57:51  peter
-    * fixed val(longint) so it works again with $80000000+
-
-  Revision 1.5  1998/02/08 21:51:40  peter
-    * some optimizes and Val(cardinal) fixed
-
-  Revision 1.4  1998/01/26 12:00:13  michael
-  + Added log at the end
-
-  revision 1.3
-  date: 1998/01/23 12:06:05;  author: daniel;  state: Exp;  lines: +18 -22
-  * Did some small code tweaks.
-  ----------------------------
-  revision 1.2
-  date: 1998/01/12 02:31:44;  author: carl;  state: Exp;  lines: +30 -9
-    + added generic Floating point support/fixes for m68k port and other ports
-  ----------------------------
-  revision 1.1
-  date: 1997/12/22 18:54:25;  author: michael;  state: Exp;
-  + Initial implementation: moved all strings routines from system.inc to
-    sstrings.inc.
-  =============================================================================
+  Revision 1.3  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
+
 }
 }

+ 9 - 154
rtl/inc/system.inc

@@ -79,16 +79,11 @@ Procedure Dec(var i : byte);       [INTERNPROC: In_Dec_byte];
 Procedure Dec(var c : Char);       [INTERNPROC: In_Dec_byte];
 Procedure Dec(var c : Char);       [INTERNPROC: In_Dec_byte];
 Procedure Dec(var p : PChar);      [INTERNPROC: In_Dec_DWord];
 Procedure Dec(var p : PChar);      [INTERNPROC: In_Dec_DWord];
 
 
-{$IFNDEF ORDINTERN}
-  Function ord(c : Char) : byte;    [INTERNPROC: In_ord_Char];
-{$ENDIF ORDINTERN}
 Function chr(b : byte) : Char;      [INTERNPROC: In_chr_byte];
 Function chr(b : byte) : Char;      [INTERNPROC: In_chr_byte];
 Function Length(s : string) : byte; [INTERNPROC: In_Length_string];
 Function Length(s : string) : byte; [INTERNPROC: In_Length_string];
 
 
-{$IFDEF VER_ABOVE0_9_5}
-  Procedure Reset(var f : TypedFile);   [INTERNPROC: In_Reset_TypedFile];
-  Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
-{$ENDIF}
+Procedure Reset(var f : TypedFile);   [INTERNPROC: In_Reset_TypedFile];
+Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
 
 
 {****************************************************************************
 {****************************************************************************
                                Math Routines
                                Math Routines
@@ -413,155 +408,15 @@ End;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-04-16 12:30:47  peter
+  Revision 1.5  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
+
+  Revision 1.4  1998/04/16 12:30:47  peter
     + inc(pchar), dec(pchar), incc(pchar,a),dec(pchar,a)
     + inc(pchar), dec(pchar), incc(pchar,a),dec(pchar,a)
 
 
   Revision 1.3  1998/04/08 07:53:32  michael
   Revision 1.3  1998/04/08 07:53:32  michael
   + Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)
   + Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)
-
-  Revision 1.2  1998/03/25 23:39:17  florian
-    * complete Object Pascal support moved to objpas unit
-
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
-
-  Revision 1.29  1998/02/07 05:31:22  carl
-    * bugfix of Swap with cardinal (no return value was set)
-
-  Revision 1.28  1998/01/30 17:19:18  pierre
-    * output and stderr must not be closed at exit under dos
-
-  Revision 1.27  1998/01/26 11:59:53  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/system.inc
-  description:
-  ----------------------------
-  revision 1.26
-  date: 1998/01/23 22:21:49;  author: michael;  state: Exp;  lines: +18 -6
-  + Set up things for Delphi Object model under DELPHI_EXTENSIONS
-  ----------------------------
-  revision 1.25
-  date: 1998/01/20 09:14:35;  author: michael;  state: Exp;  lines: +13 -1
-  + implemented Hi and Lo for bytes. SHould be made an internalproc, though.
-  ----------------------------
-  revision 1.24
-  date: 1998/01/19 10:21:32;  author: michael;  state: Exp;  lines: +10 -1
-  * moved Fillchar t(..,char) to system.inc
-  ----------------------------
-  revision 1.23
-  date: 1998/01/16 17:58:51;  author: florian;  state: Exp;  lines: +8 -2
-    * basic tobject added (create, destroy and free)
-  ----------------------------
-  revision 1.22
-  date: 1998/01/11 02:45:43;  author: michael;  state: Exp;  lines: +322 -1380
-  + Moved file operations to
-    - file.inc : Untyped file handling
-    - text.inc text file handling
-    - typefile.inc typed file handling
-    - version stuff to version.inc
-     By Peter Vreman.
-  ----------------------------
-  revision 1.21
-  date: 1998/01/06 00:29:33;  author: michael;  state: Exp;  lines: +45 -81
-  Implemented a system independent sequence of reset/rewrite/append fileopenfunc etc system \n (from Peter Vreman)
-  ----------------------------
-  revision 1.20
-  date: 1998/01/05 12:32:14;  author: michael;  state: Exp;  lines: +143 -748
-  * Undid changes by Carl, it rendered the system unit unusable !
-  ----------------------------
-  revision 1.19
-  date: 1998/01/05 00:47:10;  author: carl;  state: Exp;  lines: +748 -143
-  + Compatible with m68k floating point types
-  + Test68000/Test68882 variables added when in m68k mode
-  ----------------------------
-  revision 1.18
-  date: 1998/01/03 00:44:19;  author: michael;  state: Exp;  lines: +6 -25
-  * Shorter WRITE_TEXT_BOOLEAN (From Peter Vreman)
-  - Removed unused vars in READ_TEXT_CHAR (From Peter Vreman)
-  - Removed 'far' from DoExitProc (From Peter Vreman)
-  ----------------------------
-  revision 1.17
-  date: 1998/01/01 16:56:08;  author: michael;  state: Exp;  lines: +60 -1
-  + Implemented Addr() function.
-  + Implemented Inc/Dec for cardinal
-  + Implemented Inc/Dec (C : Char; A : longint);
-  ----------------------------
-  revision 1.16
-  date: 1997/12/24 14:08:38;  author: michael;  state: Exp;  lines: +7 -2
-  + Added SSEG function, (From Peter Vreman)
-  * fixed bug in append, default filehandle should be 1, not 0 (From Peter
-    Vreman)
-  ----------------------------
-  revision 1.15
-  date: 1997/12/23 16:32:21;  author: michael;  state: Exp;  lines: +24 -26
-  * More efficient treating of append, reset and rewrite (From Peter Vreman)
-  ----------------------------
-  revision 1.14
-  date: 1997/12/22 18:53:18;  author: michael;  state: Exp;  lines: +6 -752
-  + All 255-length string handling routines have been moved to sstrings.inc.
-  ----------------------------
-  revision 1.13
-  date: 1997/12/22 15:35:30;  author: michael;  state: Exp;  lines: +10 -9
-  * Fixed bug introduced by previous commit.
-  ----------------------------
-  revision 1.12
-  date: 1997/12/22 11:11:54;  author: michael;  state: Exp;  lines: +138 -86
-  * Implemented better (faster) string handling routines from Peter Vreman.
-  ----------------------------
-  revision 1.11
-  date: 1997/12/22 10:44:26;  author: pierre;  state: Exp;  lines: +5 -5
-    * tipping error in READ_TEXT_INTEGER and so on
-  ----------------------------
-  revision 1.10
-  date: 1997/12/19 11:37:55;  author: pierre;  state: Exp;  lines: +53 -1
-    * added read_text for integer word byte and shortint
-  ----------------------------
-  revision 1.9
-  date: 1997/12/11 11:45:32;  author: michael;  state: Exp;  lines: +45 -45
-  + undid changes to pos/delete/copy/insert. Version 1.8 was UNUSABLE.
-  ----------------------------
-  revision 1.8
-  date: 1997/12/10 12:13:20;  author: michael;  state: Exp;  lines: +89 -89
-  * changed DateiFunc to FileFunc
-  ----------------------------
-  revision 1.7
-  date: 1997/12/02 16:08:53;  author: pierre;  state: Exp;  lines: +7 -1
-     * bug fix in val(string,longint,word) for '-2147483648'
-  ----------------------------
-  revision 1.6
-  date: 1997/12/01 12:08:05;  author: michael;  state: Exp;  lines: +10 -4
-  + added copyright reference header.
-  ----------------------------
-  revision 1.5
-  date: 1997/11/28 19:45:22;  author: pierre;  state: Exp;  lines: +14 -12
-    * one more bug fix with namelength
-    + fixed math in fixed_math define (does not compile yet)
-  ----------------------------
-  revision 1.4
-  date: 1997/11/28 12:21:51;  author: michael;  state: Exp;  lines: +2 -2
-  Removed the WRITE_TEXT_CARDINAL for version 0.9.1 and less.
-  ----------------------------
-  revision 1.3
-  date: 1997/11/27 22:49:05;  author: florian;  state: Exp;  lines: +5 -0
-  - CPU.PP added
-  - some bugs in DOS fixed (espsecially for go32v1)
-  - the win32 system unit is now compilable
-  ----------------------------
-  revision 1.2
-  date: 1997/11/27 16:29:37;  author: michael;  state: Exp;  lines: +3 -3
-  Change submitted by Pierre Muller:
-  Added check : version must be above 0.9.7 for extended type
-  handling functions.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }
 }

+ 43 - 225
rtl/inc/systemh.inc

@@ -22,70 +22,25 @@
 
 
 {$i version.inc}
 {$i version.inc}
 
 
-{TypedFile is standard from Version 0_9_3}
-{$IFDEF VER_ABOVE0_9_3}
-  {$DEFINE TypedFile}
-{$ENDIF VER_ABOVE0_9_3}
-
-{Ord() is Intern from Version 0_9_5}
-{$IFDEF VER_ABOVE0_9_5}
-  {$DEFINE OrdIntern}
-  {$DEFINE TypedReset}
-{$ENDIF VER_ABOVE0_9_5}
-
-{Str() is Intern from Version 0_9_7}
-{$IFDEF VER_ABOVE0_9_7}
-  {$DEFINE str_intern}
-{$ENDIF VER_ABOVE0_9_7}
-
-{ ------------------------- FLOATING POINT DEFINES ----------------------- }
-{ possible conditionals here:                                              }
-{   comp_support = comp type supported.                                    }
-{   ieee_support = ieee support otherwise only real support possible.      }
-{$ifdef i386}
-{$define comp_support}
-{$define ieee_support}
-{$endif}
-
-
 {****************************************************************************
 {****************************************************************************
                          Global Types and Constants
                          Global Types and Constants
 ****************************************************************************}
 ****************************************************************************}
 
 
 Type
 Type
-{
-  Longint is in TP declared as -2147483648..2147483647,
-  But it can't be translated to Free Pascal, since the compiler
-  first tries to convert 2147483648 to an integer constant
-  and later ignores the number.
-  But val can't use that...
-  So, In 2 complement notation:
-}
   Longint  = $80000000..$7fffffff;
   Longint  = $80000000..$7fffffff;
   Integer  = -32768..32767;
   Integer  = -32768..32767;
   shortint = -128..127;
   shortint = -128..127;
   byte     = 0..255;
   byte     = 0..255;
   Word     = 0..65535;
   Word     = 0..65535;
-{ at least declare Turbo Pascal real types:}
+  
+{ at least declare Turbo Pascal real types }
 {$IFDEF i386}
 {$IFDEF i386}
-  Double   = real;
-{$ENDIF}
-{$IFNDEF VER_ABOVE0_9_2}
-  Extended = real;
-  single   = real;
-  comp     = real;
-{$ELSE}
-  {$DEFINE VER_HAS_EXTENDED}
-{$ENDIF VER_ABOVE0_9_2}
-{$IFDEF VER0_6}
-  fixed = Longint;
+  Double = real;
 {$ENDIF}
 {$ENDIF}
 
 
 { some type aliases }
 { some type aliases }
-{$IFDEF VER_ABOVE0_9_2}
   dword    = cardinal;
   dword    = cardinal;
   longword = cardinal;
   longword = cardinal;
-{$ENDIF VER_ABOVE0_9_2}
 
 
 { Zero - terminated strings }
 { Zero - terminated strings }
   PChar  = ^Char;
   PChar  = ^Char;
@@ -98,21 +53,23 @@ const
 { max. values for longint and int}
 { max. values for longint and int}
   maxLongint = $7fffffff;
   maxLongint = $7fffffff;
   maxint = 32767;
   maxint = 32767;
+  
 { Compatibility With  TP }
 { Compatibility With  TP }
 {$ifdef i386}
 {$ifdef i386}
-  Test8086:byte = 2;       { Always i386 or newer }
-  Test8087:byte = 3;       { Always 387 or newer. Emulated if needed. }
+  Test8086 : byte = 2;       { Always i386 or newer }
+  Test8087 : byte = 3;       { Always 387 or newer. Emulated if needed. }
 {$endif i386}
 {$endif i386}
 {$ifdef m68k}
 {$ifdef m68k}
-  Test68000 : byte = 0; { Must be determined at startup for both }
+  Test68000 : byte = 0;      { Must be determined at startup for both }
   Test68881 : byte = 0;
   Test68881 : byte = 0;
 {$endif}
 {$endif}
 
 
 { max level in dumping on error }
 { max level in dumping on error }
-  Max_Frame_Dump:Word = 20;
+  Max_Frame_Dump : Word = 20;
 { Exit Procedure handling consts and types  }
 { Exit Procedure handling consts and types  }
-  Erroraddr:pointer = nil;
-  Errorcode:Word    = 0;
+  ExitProc : pointer=nil;
+  Erroraddr: pointer = nil;
+  Errorcode: Word    = 0;
 
 
 { file input modes }
 { file input modes }
   fmClosed = $D7B0;
   fmClosed = $D7B0;
@@ -120,20 +77,15 @@ const
   fmOutput = $D7B2;
   fmOutput = $D7B2;
   fmInOut  = $D7B3;
   fmInOut  = $D7B3;
   fmAppend = $D7B4;
   fmAppend = $D7B4;
-  Filemode:byte = 2;
+  Filemode : byte = 2;
 
 
 var
 var
 { Standard In- and Output }
 { Standard In- and Output }
   Output,
   Output,
   Input,
   Input,
   StdErr      : Text;
   StdErr      : Text;
-  ExitProc    : pointer;
-  ExitCode    : Word;
-{$IFDEF Win32}
+  ExitCode,
   InOutRes    : Longint;
   InOutRes    : Longint;
-{$ELSE Win32}
-  InOutRes    : Word;
-{$ENDIF Win32}
   StackBottom,
   StackBottom,
   LowestStack,
   LowestStack,
   RandSeed    : Longint;
   RandSeed    : Longint;
@@ -176,10 +128,6 @@ Procedure Dec(Var i:shortint);
 Procedure Dec(Var i:byte);
 Procedure Dec(Var i:byte);
 Procedure Dec(Var c:Char);
 Procedure Dec(Var c:Char);
 Procedure Dec(Var p:PChar);
 Procedure Dec(Var p:PChar);
-{$IFNDEF ORDINTERN}
-  Function Ord(c:Char):byte;
-  Function Ord(b:Boolean):byte;
-{$ENDIF ORDINTERN}
 Function Chr(b:byte):Char;
 Function Chr(b:byte):Char;
 Function Length(s:string):byte;
 Function Length(s:string):byte;
 
 
@@ -229,6 +177,13 @@ Function  Cseg:Word;
 Function  Dseg:Word;
 Function  Dseg:Word;
 Function  Sseg:Word;
 Function  Sseg:Word;
 
 
+{****************************************************************************
+                              PChar Handling
+****************************************************************************}
+
+function strpas(p:pchar):string;
+function strlen(p:pchar):longint;
+
 {****************************************************************************
 {****************************************************************************
                               String Handling
                               String Handling
 ****************************************************************************}
 ****************************************************************************}
@@ -245,20 +200,7 @@ Function  lowerCase(const s:string):string;
 Function  Space(b:byte):string;
 Function  Space(b:byte):string;
 Function  hexStr(Val:Longint;cnt:byte):string;
 Function  hexStr(Val:Longint;cnt:byte):string;
 Function  binStr(Val:Longint;cnt:byte):string;
 Function  binStr(Val:Longint;cnt:byte):string;
-{$IFNDEF STR_INTERN}
-  Procedure Str(l:Longint;Var s:string);
-{$ifdef support_ieee}
-   Procedure Str(d:Double;Var s : string);
-{$endif support_ieee}
-{$ifndef support_ieee}
-   Procedure Str(d : real;Var s : string);
-{$endif support_ieee}
-  Procedure Str(i:Integer;Var s:string);
-  Procedure Str(si:shortint;Var s:string);
-  Procedure Str(b:byte;Var s:string);
-  Procedure Str(w:Word;Var s:string);
-{$ENDIF STR_INTERN}
-Procedure Val(const s:string;Var v:Longint;Var code:Word);
+Procedure Val(const s:string;Var l:Longint;Var code:Word);
 Procedure Val(const s:string;Var l:Longint;Var code:Integer);
 Procedure Val(const s:string;Var l:Longint;Var code:Integer);
 Procedure Val(const s:string;Var l:Longint);
 Procedure Val(const s:string;Var l:Longint);
 Procedure Val(const s:string;Var b:byte;Var code:Word);
 Procedure Val(const s:string;Var b:byte;Var code:Word);
@@ -276,30 +218,18 @@ Procedure Val(const s:string;Var b:Integer);
 Procedure Val(const s:string;Var d:Real;Var code:Word);
 Procedure Val(const s:string;Var d:Real;Var code:Word);
 Procedure Val(const s:string;Var d:Real;Var code:Integer);
 Procedure Val(const s:string;Var d:Real;Var code:Integer);
 Procedure Val(const s:string;Var d:Real);
 Procedure Val(const s:string;Var d:Real);
-{$IFDEF VER_ABOVE0_9_2}
- {$IFDEF ieee_support}
-   Procedure Val(const s:string;Var d:single;Var code:Word);
-   Procedure Val(const s:string;Var d:single;Var code:Integer);
-   Procedure Val(const s:string;Var d:single);
- {$ENDIF ieee_support}
-{$ENDIF VER_ABOVE0_9_2}
-{$IFDEF VER_ABOVE0_9_7}
-  {$IFDEF ieee_support}
-   Procedure Val(const s:string;Var d:Extended;Var code:Word);
-   Procedure Val(const s:string;Var d:Extended;Var code:Integer);
-   Procedure Val(const s:string;Var d:Extended);
-  {$ENDIF ieee_support}
-  {$IFDEF comp_support}
-   Procedure Val(const s:string;Var d:comp;Var code:Word);
-   Procedure Val(const s:string;Var d:comp;Var code:Integer);
-   Procedure Val(const s:string;Var d:comp);
-  {$ENDIF comp_support}
-{$ENDIF VER_ABOVE0_9_7}
-{$IFDEF VER_ABOVE0_9_8}
-  Procedure Val(const s:string;Var v:cardinal;Var code:Word);
-  Procedure Val(const s:string;Var v:cardinal;Var code:Integer);
-  Procedure Val(const s:string;Var v:cardinal);
-{$ENDIF VER_ABOVE0_9_8}
+Procedure Val(const s:string;Var d:single;Var code:Word);
+Procedure Val(const s:string;Var d:single;Var code:Integer);
+Procedure Val(const s:string;Var d:single);
+Procedure Val(const s:string;Var d:Extended;Var code:Word);
+Procedure Val(const s:string;Var d:Extended;Var code:Integer);
+Procedure Val(const s:string;Var d:Extended);
+Procedure Val(const s:string;Var d:comp;Var code:Word);
+Procedure Val(const s:string;Var d:comp;Var code:Integer);
+Procedure Val(const s:string;Var d:comp);
+Procedure Val(const s:string;Var v:cardinal;Var code:Word);
+Procedure Val(const s:string;Var v:cardinal;Var code:Integer);
+Procedure Val(const s:string;Var v:cardinal);
 
 
 {****************************************************************************
 {****************************************************************************
                           Untyped File Management
                           Untyped File Management
@@ -331,11 +261,9 @@ Procedure Truncate (Var F:File);
                            Typed File Management
                            Typed File Management
 ****************************************************************************}
 ****************************************************************************}
 
 
-{$IFDEF TypedFile}
-  Procedure Assign(Var f:TypedFile;const Name:string);
-  Procedure Rewrite(Var f:TypedFile);
-  Procedure Reset(Var f:TypedFile);
-{$ENDIF TypedFile}
+Procedure Assign(Var f:TypedFile;const Name:string);
+Procedure Rewrite(Var f:TypedFile);
+Procedure Reset(Var f:TypedFile);
 
 
 {****************************************************************************
 {****************************************************************************
                             Text File Management
                             Text File Management
@@ -376,10 +304,6 @@ Procedure getdir(drivenr:byte;Var dir:string);
 Function IOResult:Word;
 Function IOResult:Word;
 Function Sptr:Longint;
 Function Sptr:Longint;
 
 
-{****************************************************************************
-                The whole Delphi stuff is in the unit objpas
-*****************************************************************************}
-
 {*****************************************************************************
 {*****************************************************************************
                           Init / Exit / ExitProc
                           Init / Exit / ExitProc
 *****************************************************************************}
 *****************************************************************************}
@@ -396,118 +320,12 @@ Procedure AddExitProc(Proc:TProcedure);
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-04-16 12:30:47  peter
-    + inc(pchar), dec(pchar), incc(pchar,a),dec(pchar,a)
+  Revision 1.5  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.3  1998/03/26 14:41:22  michael
-  + Added comp support for val and read(ln)
-
-  Revision 1.2  1998/03/25 23:39:17  florian
-    * complete Object Pascal support moved to objpas unit
-
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
-
-  Revision 1.22  1998/03/24 15:50:25  peter
-    + dword,longword=cardinal (for > 0.9.2 unlike Florian did with longword)
-
-  Revision 1.21  1998/03/05 02:42:30  peter
-    + blockread/blockwrite with integer result
-
-  Revision 1.20  1998/03/04 14:22:07  florian
-    + longword is synonyme for cardinal
-
-  Revision 1.19  1998/01/26 11:59:57  michael
-  + Added log at the end
-
-
-
-  Working file: rtl/inc/systemh.inc
-  description:
-  ----------------------------
-  revision 1.18
-  date: 1998/01/23 22:21:48;  author: michael;  state: Exp;  lines: +12 -1
-  + Set up things for Delphi Object model under DELPHI_EXTENSIONS
-  ----------------------------
-  revision 1.17
-  date: 1998/01/23 15:30:45;  author: michael;  state: Exp;  lines: +2 -2
-  * Daniel forgot to adapt systemh to changes he made in sstrings.inc.
-  ----------------------------
-  revision 1.16
-  date: 1998/01/20 09:14:36;  author: michael;  state: Exp;  lines: +3 -1
-  + implemented Hi and Lo for bytes. SHould be made an internalproc, though.
-  ----------------------------
-  revision 1.15
-  date: 1998/01/16 17:58:51;  author: florian;  state: Exp;  lines: +3 -2
-    * basic tobject added (create, destroy and free)
-  ----------------------------
-  revision 1.14
-  date: 1998/01/12 02:32:58;  author: carl;  state: Exp;  lines: +40 -12
-    + now works with sysatari
-  ----------------------------
-  revision 1.13
-  date: 1998/01/11 02:45:43;  author: michael;  state: Exp;  lines: +341 -459
-  + Moved file operations to
-    - file.inc : Untyped file handling
-    - text.inc text file handling
-    - typefile.inc typed file handling
-    - version stuff to version.inc
-     By Peter Vreman.
-  ----------------------------
-  revision 1.12
-  date: 1998/01/05 12:37:11;  author: michael;  state: Exp;  lines: +19 -30
-  + undid changes by Carl, they rendered the system unit useless.
-  ----------------------------
-  revision 1.11
-  date: 1998/01/05 00:47:55;  author: carl;  state: Exp;  lines: +30 -19
-  + Now compatible with m68k floating point types
-  ----------------------------
-  revision 1.10
-  date: 1998/01/01 16:56:09;  author: michael;  state: Exp;  lines: +8 -1
-  + Implemented Addr() function.
-  + Implemented Inc/Dec for cardinal
-  + Implemented Inc/Dec (C : Char; A : longint);
-  ----------------------------
-  revision 1.9
-  date: 1997/12/24 14:25:16;  author: michael;  state: Exp;  lines: +2 -1
-  + Added SSEG function (From Peter Vreman)
-  ----------------------------
-  revision 1.8
-  date: 1997/12/23 16:33:21;  author: michael;  state: Exp;  lines: +6 -3
-  + Added dec() and inc() for char (from Peter Vreman)
-  ----------------------------
-  revision 1.7
-  date: 1997/12/22 15:34:37;  author: michael;  state: Exp;  lines: +3 -2
-   + added faster pos (const char; ..) seeking.
-  ----------------------------
-  revision 1.6
-  date: 1997/12/13 19:02:14;  author: florian;  state: Exp;  lines: +26 -2
-  + defines for version 0.99.0
-  ----------------------------
-  revision 1.5
-  date: 1997/12/11 13:52:21;  author: florian;  state: Exp;  lines: +11 -1
-  *** empty log message ***
-  ----------------------------
-  revision 1.4
-  date: 1997/12/11 11:49:48;  author: michael;  state: Exp;  lines: +2 -1
-  + added comp type for versions below 0.9.1.
-  ----------------------------
-  revision 1.3
-  date: 1997/12/01 12:08:05;  author: michael;  state: Exp;  lines: +11 -4
-  + added copyright reference header.
-  ----------------------------
-  revision 1.2
-  date: 1997/11/27 16:29:38;  author: michael;  state: Exp;  lines: +3 -1
-  Change submitted by Pierre Muller:
-  Added check : version must be above 0.9.7 for extended type
-  handling functions.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
+  Revision 1.4  1998/04/16 12:30:47  peter
+    + inc(pchar), dec(pchar), incc(pchar,a),dec(pchar,a)
 }
 }

+ 15 - 80
rtl/inc/text.inc

@@ -407,27 +407,19 @@ Begin
   w(Len,t,s);
   w(Len,t,s);
 End;
 End;
 
 
-{$ifdef i386}
+
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
 var
 var
    s : String;
    s : String;
 Begin
 Begin
+{$ifdef i386}
    Str_real(Len,fixkomma,r,rt_s64real,s);
    Str_real(Len,fixkomma,r,rt_s64real,s);
-   w(Len,t,s);
-End;
 {$else}
 {$else}
-Procedure w(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
-var
-   s : String;
-Begin
    Str_real(Len,fixkomma,r,rt_s32real,s);
    Str_real(Len,fixkomma,r,rt_s32real,s);
+{$endif}
    w(Len,t,s);
    w(Len,t,s);
 End;
 End;
-{$endif}
-
 
 
-{$IFDEF VER_ABOVE0_9_7}
-{ Older versions of the compiler convert all floats to real }
 
 
 Procedure w(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: 'WRITE_TEXT_CARDINAL'];
 Procedure w(Len : Longint;var t : TextRec;l : cardinal);[Public,Alias: 'WRITE_TEXT_CARDINAL'];
 var
 var
@@ -438,7 +430,6 @@ Begin
 End;
 End;
 
 
 
 
-{$ifdef ieee_support}
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
 var
 var
   s : String;
   s : String;
@@ -455,19 +446,16 @@ Begin
   Str_real(Len,fixkomma,r,rt_s80real,s);
   Str_real(Len,fixkomma,r,rt_s80real,s);
   w(Len,t,s);
   w(Len,t,s);
 End;
 End;
-{$endif ieee_support}
 
 
-{$ifdef comp_support}
+
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
 var
 var
   s : String;
   s : String;
-  L : longint;
-
 Begin
 Begin
   Str_real(Len,fixkomma,r,rt_s64bit,s);
   Str_real(Len,fixkomma,r,rt_s64bit,s);
   w(Len,t,s);
   w(Len,t,s);
 End;
 End;
-{$endif comp_support}
+
 
 
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: 'WRITE_TEXT_FIXED'];
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: 'WRITE_TEXT_FIXED'];
 var
 var
@@ -476,7 +464,7 @@ Begin
   Str_real(Len,fixkomma,r,rt_f32bit,s);
   Str_real(Len,fixkomma,r,rt_f32bit,s);
   w(Len,t,s);
   w(Len,t,s);
 End;
 End;
-{$ENDIF VER_ABOVE0_9_7 }
+
 
 
 { Is called wc to avoid recursive calling. }
 { Is called wc to avoid recursive calling. }
 Procedure wc(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
 Procedure wc(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
@@ -770,7 +758,6 @@ Begin
 End;
 End;
 
 
 
 
-{$IFDEF VER_ABOVE0_9_8}
 Procedure r(var f : TextRec;var l : cardinal);[Public,Alias: 'READ_TEXT_CARDINAL'];
 Procedure r(var f : TextRec;var l : cardinal);[Public,Alias: 'READ_TEXT_CARDINAL'];
 var
 var
   hs   : String;
   hs   : String;
@@ -787,7 +774,6 @@ Begin
   If code<>0 Then
   If code<>0 Then
    RunError(106);
    RunError(106);
 End;
 End;
-{$ENDIF VER_ABOVE0_9_8}
 
 
 
 
 Procedure r(var f : TextRec;var d : Real);[Public,Alias: 'READ_TEXT_REAL'];
 Procedure r(var f : TextRec;var d : Real);[Public,Alias: 'READ_TEXT_REAL'];
@@ -826,7 +812,7 @@ Begin
    RunError(106);
    RunError(106);
 End;
 End;
 
 
-{$ifdef ieee_support}
+
 Procedure r(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
 Procedure r(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
 var
 var
   hs   : String;
   hs   : String;
@@ -862,9 +848,8 @@ Begin
   If code<>0 Then
   If code<>0 Then
    RunError(106);
    RunError(106);
 End;
 End;
-{$endif ieee_support}
 
 
-{$ifdef comp_support}
+
 Procedure r(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
 Procedure r(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
 var
 var
   hs   : String;
   hs   : String;
@@ -900,64 +885,14 @@ Begin
   If code<>0 Then
   If code<>0 Then
    RunError(106);
    RunError(106);
 End;
 End;
-{$endif}
-
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-04-07 22:40:46  florian
-    * final fix of comp writing
-
-  Revision 1.3  1998/04/04 17:06:17  michael
-  * fixed initialization bug in assign.
-
-  Revision 1.2  1998/03/26 14:41:22  michael
-  + Added comp support for val and read(ln)
-
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
-
-  Revision 1.13  1998/03/19 12:00:42  pierre
-    * missing write for comp fixed
-      was just a conditionnal mistyping !!
-
-  Revision 1.12  1998/03/16 23:36:37  peter
-    * fixed read(real) for a value with a . and a E
-
-  Revision 1.11  1998/02/23 14:43:23  carl
-    * bugfix of reading reals for non-i386 processors
-
-  Revision 1.10  1998/02/23 02:19:53  carl
-    * bugfix of writing real under non-i386 processors.
+  Revision 1.5  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.9  1998/02/12 11:05:27  michael
-  * fixed printing of cardinals
-
-  Revision 1.8  1998/02/04 09:54:22  michael
-  * fixed bug in reading of numeric input
-
-  Revision 1.7  1998/01/27 17:46:10  peter
-    * previous commit was the wrong file :(
-
-  Revision 1.6  1998/01/27 12:46:06  peter
-    * Fixed readln() from file which was broken after previous fix
-
-  Revision 1.5  1998/01/27 10:56:12  peter
-    * Readln; works again
-
-  Revision 1.4  1998/01/26 12:00:28  michael
-  + Added log at the end
-
-  revision 1.3
-  date: 1998/01/25 21:53:30;  author: peter;  state: Exp;  lines: +9 -7
-    + Universal Handles support for StdIn/StdOut/StdErr
-    * Updated layout of sysamiga.pas
-
-  revision 1.2
-  date: 1998/01/12 02:32:36;  author: carl;  state: Exp;  lines: +5 -3
-    + portability stuff (mainly FPU related)
-
-  revision 1.1
-  date: 1998/01/11 02:43:10;  author: michael;  state: Exp;
-  + Initial implementation of these files (by Peter Vreman).
-    file operations are now in separate files per type of file.
+  Revision 1.4  1998/04/07 22:40:46  florian
+    * final fix of comp writing
 }
 }

+ 5 - 49
rtl/inc/textrec.inc

@@ -57,54 +57,10 @@ type
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.9  1998/02/05 12:08:55  pierre
-    * added packrecords to about dword alignment
-      for structures used in dos calls
-
-  Revision 1.8  1998/01/26 12:00:01  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/textrec.inc
-  description:
-  ----------------------------
-  revision 1.7
-  date: 1998/01/06 00:29:33;  author: michael;  state: Exp;  lines: +21 -23
-  Implemented a system independent sequence of reset/rewrite/append fileopenfunc etc system \n (from Peter Vreman)
-  ----------------------------
-  revision 1.6
-  date: 1997/12/01 12:08:06;  author: michael;  state: Exp;  lines: +13 -0
-  + added copyright reference header.
-  ----------------------------
-  revision 1.5
-  date: 1997/11/28 19:45:22;  author: pierre;  state: Exp;  lines: +13 -9
-    * one more bug fix with namelength
-    + fixed math in fixed_math define (does not compile yet)
-  ----------------------------
-  revision 1.4
-  date: 1997/11/28 19:15:50;  author: pierre;  state: Exp;  lines: +0 -3
-     * forgot to remove the const statement
-  ----------------------------
-  revision 1.3
-  date: 1997/11/28 18:56:17;  author: pierre;  state: Exp;  lines: +9 -10
-    bug fix     in ifdef win32
-  ----------------------------
-  revision 1.2
-  date: 1997/11/27 22:49:05;  author: florian;  state: Exp;  lines: +4 -0
-  - CPU.PP added
-  - some bugs in DOS fixed (espsecially for go32v1)
-  - the win32 system unit is now compilable
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:47;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
 }
 }

+ 10 - 43
rtl/inc/typefile.inc

@@ -16,8 +16,6 @@
                     subroutines for typed file handling
                     subroutines for typed file handling
 ****************************************************************************}
 ****************************************************************************}
 
 
-{$IFDEF TypedFile}
-
 Procedure assign(var f:TypedFile;const Name:string);
 Procedure assign(var f:TypedFile;const Name:string);
 Begin
 Begin
   FillChar(f,SizeOF(FileRec),0);
   FillChar(f,SizeOF(FileRec),0);
@@ -26,40 +24,26 @@ Begin
   Move(Name[1],FileRec(f).Name,Length(Name));
   Move(Name[1],FileRec(f).Name,Length(Name));
 End;
 End;
 
 
-{$IFDEF VER_ABOVE0_9_5}
 
 
-Procedure Intern_Reset(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'RESET_TYPED'];
+Procedure Int_Typed_Reset(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'RESET_TYPED'];
 Begin
 Begin
   Reset(UnTypedFile(f),Size);
   Reset(UnTypedFile(f),Size);
 End;
 End;
 
 
-Procedure Intern_Rewrite(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'REWRITE_TYPED'];
-Begin
-  Rewrite(UnTypedFile(f),Size);
-End;
 
 
-{$ELSE not VER_ABOVE0_9_5}
-
-Procedure Rewrite(var f : TypedFile);[IOCheck];
+Procedure Int_Typed_Rewrite(var f : TypedFile;Size : Longint);[Public,IOCheck, Alias: 'REWRITE_TYPED'];
 Begin
 Begin
-  Rewrite(UnTypedFile(f),128);
-End;
-
-Procedure Reset(var f : TypedFile);[IOCheck];
-Begin
-  Reset(UnTypedFile(f),128);
+  Rewrite(UnTypedFile(f),Size);
 End;
 End;
 
 
-{$ENDIF VER_ABOVE0_9_5}
-
 
 
-Procedure TypedWrite(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_WRITE'];
+Procedure Int_Typed_Write(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_WRITE'];
 Begin
 Begin
   Do_Write(FileRec(f).Handle,Longint(@Buf),TypeSize);
   Do_Write(FileRec(f).Handle,Longint(@Buf),TypeSize);
 End;
 End;
 
 
 
 
-Procedure TypedRead(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_READ'];
+Procedure Int_Typed_Read(TypeSize : Longint;var f : TypedFile;var Buf);[IOCheck, Public, Alias : 'TYPED_READ'];
 var
 var
   Result : Longint;
   Result : Longint;
 Begin
 Begin
@@ -68,29 +52,12 @@ Begin
    InOutRes:=100;
    InOutRes:=100;
 End;
 End;
 
 
-{$ENDIF TypedFile }
-
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
-
-  Revision 1.3  1998/01/26 12:00:33  michael
-  + Added log at the end
-
+  Revision 1.2  1998-05-12 10:42:45  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  
-  Working file: rtl/inc/typefile.inc
-  description:
-  ----------------------------
-  revision 1.2
-  date: 1998/01/25 21:53:32;  author: peter;  state: Exp;  lines: +2 -2
-    + Universal Handles support for StdIn/StdOut/StdErr
-    * Updated layout of sysamiga.pas
-  ----------------------------
-  revision 1.1
-  date: 1998/01/11 02:43:11;  author: michael;  state: Exp;
-  + Initial implementation of these files (by Peter Vreman).
-    file operations are now in separate files per type of file.
-  =============================================================================
 }
 }

+ 5 - 14
rtl/inc/version.inc

@@ -149,19 +149,10 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:43  root
-  Initial revision
+  Revision 1.2  1998-05-12 10:42:46  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.2  1998/01/26 12:00:36  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/inc/version.inc
-  description:
-  ----------------------------
-  revision 1.1
-  date: 1998/01/11 02:44:07;  author: michael;  state: Exp;
-  + Initial implementation (By Peter Vreman)
-  =============================================================================
 }
 }

+ 149 - 117
rtl/linux/graph.pp

@@ -11,7 +11,8 @@ unit Graph;
   Info:
   Info:
 
 
   This unit provides the functions of Borland's Graph unit for linux,
   This unit provides the functions of Borland's Graph unit for linux,
-  it uses the SVGAlib to do the actual work, so you must have svgalib 
+  it uses the SVGAlib to do the actual work, so you must have svgalib
+
   on your system
   on your system
 
 
   This version requires Free Pascal 0.99.5 or higher.
   This version requires Free Pascal 0.99.5 or higher.
@@ -34,7 +35,8 @@ unit Graph;
                               declarations here so it can be used independently
                               declarations here so it can be used independently
                               of the svgalib unit. Removed things that are NOT
                               of the svgalib unit. Removed things that are NOT
                               part of Borland's Graph from the unit interface.
                               part of Borland's Graph from the unit interface.
-                               
+
+
   License Conditions:
   License Conditions:
 
 
   This library is free software; you can redistribute it and/or
   This library is free software; you can redistribute it and/or
@@ -50,7 +52,8 @@ unit Graph;
   You should have received a copy of the GNU Library General Public
   You should have received a copy of the GNU Library General Public
   License along with this library; if not, write to the Free
   License along with this library; if not, write to the Free
   Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-  
+
+
   *********************************************************************}
   *********************************************************************}
 
 
 {
 {
@@ -68,7 +71,8 @@ unit Graph;
   SetAspectRatio
   SetAspectRatio
   PieSlice
   PieSlice
   Sector
   Sector
-  
+
+
   (please remove what you implement fom this list)
   (please remove what you implement fom this list)
 }
 }
 
 
@@ -77,7 +81,8 @@ interface
 
 
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-   Constants 
+   Constants
+
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 const
 const
@@ -142,7 +147,8 @@ const
 
 
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-   Types 
+   Types
+
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 
 
@@ -158,12 +164,15 @@ Type
   RGBColor = record
   RGBColor = record
     r,g,b,i : byte;
     r,g,b,i : byte;
   end;
   end;
-  
+
+
   PaletteType = record
   PaletteType = record
-     Size   : integer; 
+     Size   : integer;
+
      Colors : array[0..767]of Byte;
      Colors : array[0..767]of Byte;
   end;
   end;
-  
+
+
   LineSettingsType = record
   LineSettingsType = record
      linestyle : word;
      linestyle : word;
      pattern : word;
      pattern : word;
@@ -192,7 +201,8 @@ Type
      Clip : boolean;
      Clip : boolean;
   end;
   end;
 
 
-  
+
+
  const
  const
   fillpattern : array[0..12] of FillPatternType = (
   fillpattern : array[0..12] of FillPatternType = (
       ($00,$00,$00,$00,$00,$00,$00,$00),     { Hintergrundfarbe }
       ($00,$00,$00,$00,$00,$00,$00,$00),     { Hintergrundfarbe }
@@ -210,18 +220,20 @@ Type
       (0,0,0,0,0,0,0,0)                      { benutzerdefiniert }
       (0,0,0,0,0,0,0,0)                      { benutzerdefiniert }
      );
      );
 
 
-   
+
+
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-   Function Declarations 
+   Function Declarations
+
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 { Retrieving coordinates }
 { Retrieving coordinates }
-function  GetX: Integer;					
-function  GetY: Integer;					
+function  GetX: Integer;                                        
+function  GetY: Integer;                                        
 
 
 { Pixel-oriented routines }
 { Pixel-oriented routines }
 procedure PutPixel(X, Y: Integer; Pixel: Word);
 procedure PutPixel(X, Y: Integer; Pixel: Word);
-function  GetPixel(X, Y: Integer): Word;	
+function  GetPixel(X, Y: Integer): Word;        
 
 
 { Line-oriented primitives }
 { Line-oriented primitives }
 procedure SetWriteMode(WriteMode: Integer);
 procedure SetWriteMode(WriteMode: Integer);
@@ -245,7 +257,7 @@ procedure FloodFill(X, Y: Integer; Border: Word);
 { Nonlinearly bounded primitives }
 { Nonlinearly bounded primitives }
 
 
 procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
 procedure Arc(X, Y: Integer; StAngle, EndAngle, Radius: Word);
-procedure GetArcCoords(var ArcCoords: ArcCoordsType);	
+procedure GetArcCoords(var ArcCoords: ArcCoordsType);   
 procedure Circle(X, Y: Integer; Radius: Word);
 procedure Circle(X, Y: Integer; Radius: Word);
 procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius : Word);
 procedure Ellipse(X, Y: Integer; StAngle, EndAngle: Word; XRadius, YRadius : Word);
 procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
 procedure FillEllipse(X, Y: Integer; XRadius, YRadius : Word);
@@ -292,7 +304,8 @@ uses Objects, Linux;
 
 
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-   SVGA bindings. 
+   SVGA bindings.
+
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 {  Link with VGA, gl and c libraries }
 {  Link with VGA, gl and c libraries }
@@ -303,7 +316,7 @@ uses Objects, Linux;
  { Constants }
  { Constants }
 const
 const
   { VGA modes }
   { VGA modes }
-  TEXT              = 0;		{ Compatible with VGAlib v1.2 }
+  TEXT              = 0;                { Compatible with VGAlib v1.2 }
   G320x200x16       = 1;
   G320x200x16       = 1;
   G640x200x16       = 2;
   G640x200x16       = 2;
   G640x350x16       = 3;
   G640x350x16       = 3;
@@ -340,9 +353,9 @@ const
   G1024x768x16      = 30;
   G1024x768x16      = 30;
   G1280x1024x16     = 31;
   G1280x1024x16     = 31;
 
 
-  G720x348x2        = 32;		{ Hercules emulation mode }
+  G720x348x2        = 32;               { Hercules emulation mode }
 
 
-  G320x200x16M32    = 33;	{ 32-bit per pixel modes. }
+  G320x200x16M32    = 33;       { 32-bit per pixel modes. }
   G640x480x16M32    = 34;
   G640x480x16M32    = 34;
   G800x600x16M32    = 35;
   G800x600x16M32    = 35;
   G1024x768x16M32   = 36;
   G1024x768x16M32   = 36;
@@ -366,7 +379,8 @@ const
   GLASTMODE         = 49;
   GLASTMODE         = 49;
 
 
   { Text }
   { Text }
-  
+
+
   WRITEMODE_OVERWRITE = 0;
   WRITEMODE_OVERWRITE = 0;
   WRITEMODE_MASKED    = 1;
   WRITEMODE_MASKED    = 1;
   FONT_EXPANDED       = 0;
   FONT_EXPANDED       = 0;
@@ -392,7 +406,8 @@ const
      linewidth_unit: Longint;    { Use only a multiple of this as parameter for
      linewidth_unit: Longint;    { Use only a multiple of this as parameter for
                                    set_displaystart }
                                    set_displaystart }
      linear_aperture: PChar;     { points to mmap secondary mem aperture of card }
      linear_aperture: PChar;     { points to mmap secondary mem aperture of card }
-     aperture_size: Longint;     { size of aperture in KB if size>=videomemory.} 
+     aperture_size: Longint;     { size of aperture in KB if size>=videomemory.}
+
      set_aperture_page: procedure (page: Longint);
      set_aperture_page: procedure (page: Longint);
             { if aperture_size<videomemory select a memory page }
             { if aperture_size<videomemory select a memory page }
      extensions: Pointer;        { points to copy of eeprom for mach32 }
      extensions: Pointer;        { points to copy of eeprom for mach32 }
@@ -401,31 +416,35 @@ const
 
 
   PGraphicsContext = ^TGraphicsContext;
   PGraphicsContext = ^TGraphicsContext;
   TGraphicsContext = record
   TGraphicsContext = record
-		       ModeType: Byte;
-		       ModeFlags: Byte;
-		       Dummy: Byte;
-		       FlipPage: Byte;
-		       Width: LongInt;
-		       Height: LongInt;
-		       BytesPerPixel: LongInt;
-		       Colors: LongInt;
-		       BitsPerPixel: LongInt;
-		       ByteWidth: LongInt;
-		       VBuf: pointer;
-		       Clip: LongInt;
-		       ClipX1: LongInt;
-		       ClipY1: LongInt;
-		       ClipX2: LongInt;
-		       ClipY2: LongInt;
-		       ff: pointer;
-		     end;
-                                                                                                                                                      
+                       ModeType: Byte;
+                       ModeFlags: Byte;
+                       Dummy: Byte;
+                       FlipPage: Byte;
+                       Width: LongInt;
+                       Height: LongInt;
+                       BytesPerPixel: LongInt;
+                       Colors: LongInt;
+                       BitsPerPixel: LongInt;
+                       ByteWidth: LongInt;
+                       VBuf: pointer;
+                       Clip: LongInt;
+                       ClipX1: LongInt;
+                       ClipY1: LongInt;
+                       ClipX2: LongInt;
+                       ClipY2: LongInt;
+                       ff: pointer;
+                     end;
+
+
  { vga functions }
  { vga functions }
  function vga_init: Longint; Cdecl; External;
  function vga_init: Longint; Cdecl; External;
- function vga_getdefaultmode: Longint; Cdecl; External;  
- function vga_hasmode(mode: Longint): Boolean; Cdecl; External; 
+ function vga_getdefaultmode: Longint; Cdecl; External;
+
+ function vga_hasmode(mode: Longint): Boolean; Cdecl; External;
+
  function vga_getmodeinfo(mode: Longint): pvga_modeinfo; Cdecl; External;
  function vga_getmodeinfo(mode: Longint): pvga_modeinfo; Cdecl; External;
- function vga_setmode(mode: Longint): Longint; Cdecl; External; 
+ function vga_setmode(mode: Longint): Longint; Cdecl; External;
+
 
 
  { gl functions }
  { gl functions }
  procedure gl_setpixel(x, y, c: LongInt); Cdecl; External;
  procedure gl_setpixel(x, y, c: LongInt); Cdecl; External;
@@ -448,14 +467,18 @@ const
  procedure gl_setwritemode(wm: LongInt); Cdecl; External;
  procedure gl_setwritemode(wm: LongInt); Cdecl; External;
  procedure gl_setfontcolors(bg, fg: LongInt); Cdecl; External;
  procedure gl_setfontcolors(bg, fg: LongInt); Cdecl; External;
  procedure gl_writen(x, y, n: LongInt; s: PChar); Cdecl; External;
  procedure gl_writen(x, y, n: LongInt; s: PChar); Cdecl; External;
- procedure gl_setfont(fw, fh: LongInt; fdp: pointer); Cdecl; External; 
+ procedure gl_setfont(fw, fh: LongInt; fdp: pointer); Cdecl; External;
+
  procedure gl_copyboxfromcontext(var gc: TGraphicsContext; x1, y1, w, h, x2, y2: LongInt); Cdecl; External;
  procedure gl_copyboxfromcontext(var gc: TGraphicsContext; x1, y1, w, h, x2, y2: LongInt); Cdecl; External;
- procedure gl_setcontext(gc: PGraphicsContext); Cdecl; External; 
+ procedure gl_setcontext(gc: PGraphicsContext); Cdecl; External;
+
  function  gl_setcontextvgavirtual(m: LongInt): LongInt; cdecl; external;
  function  gl_setcontextvgavirtual(m: LongInt): LongInt; cdecl; external;
- procedure gl_font8x8; Cdecl; External; 
+ procedure gl_font8x8; Cdecl; External;
+
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
-   Types, constants and variables 
+   Types, constants and variables
+
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 var
 var
@@ -496,7 +519,7 @@ const
   vmcCopy        = 2;
   vmcCopy        = 2;
   vmcSaveRestore = 4;
   vmcSaveRestore = 4;
   vmcBuffer      = 8;
   vmcBuffer      = 8;
-  vmcBackPut	 = 16;
+  vmcBackPut     = 16;
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
    Graphics Vision Layer
    Graphics Vision Layer
@@ -524,8 +547,9 @@ const
 var
 var
   sFont, sColor:Word;
   sFont, sColor:Word;
   sCharSpace: Integer;
   sCharSpace: Integer;
+{ Not used
   sMarker: Char;
   sMarker: Char;
-  sAttr: Word;
+  sAttr: Word; }
 
 
 { Windows-style text metric }
 { Windows-style text metric }
 type
 type
@@ -558,10 +582,11 @@ type
 type
 type
   PBitmap = ^TBitmap;
   PBitmap = ^TBitmap;
   TBitmap = record
   TBitmap = record
-	      Width, Height: Integer;
-	      Data: record end;
-	    end;
-	    
+              Width, Height: Integer;
+              Data: record end;
+            end;
+        
+
  { Storing screen regions }
  { Storing screen regions }
 type
 type
   TVgaBuf = record
   TVgaBuf = record
@@ -587,15 +612,16 @@ type
 
 
 
 
  { Procedures and functions }
  { Procedures and functions }
- 
+
+
 procedure SetColors;
 procedure SetColors;
 var
 var
   i: Integer;
   i: Integer;
 begin
 begin
   for i:=0 to 15 do
   for i:=0 to 15 do
     ColorTable[i] := gl_rgbcolor(BgiColors[i] shr 16,
     ColorTable[i] := gl_rgbcolor(BgiColors[i] shr 16,
-				 (BgiColors[i] shr 8) and 255,
-				 BgiColors[i] and 255)
+                                 (BgiColors[i] shr 8) and 255,
+                                 BgiColors[i] and 255)
 end;
 end;
 
 
 procedure InitVideo;
 procedure InitVideo;
@@ -613,8 +639,8 @@ begin
     if (VgaMode = -1) then VgaMode := G320X200X256;
     if (VgaMode = -1) then VgaMode := G320X200X256;
     if (not vga_hasmode(VgaMode))
     if (not vga_hasmode(VgaMode))
       then begin
       then begin
-	WriteLn('BGI: Mode not available.');
-	Halt(1)
+        WriteLn('BGI: Mode not available.');
+        Halt(1)
       end;
       end;
     ModeInfo := vga_getmodeinfo(VgaMode);
     ModeInfo := vga_getmodeinfo(VgaMode);
     {IsVirtual := (ModeInfo^.colors = 16) or (ModeInfo^.flags and IS_MODEX <> 0);}
     {IsVirtual := (ModeInfo^.colors = 16) or (ModeInfo^.flags and IS_MODEX <> 0);}
@@ -622,10 +648,10 @@ begin
     { We always want a back screen (for buffering). }
     { We always want a back screen (for buffering). }
     if IsVirtual
     if IsVirtual
       then begin
       then begin
-	{ Create virtual screen }
-	gl_setcontextvgavirtual(VgaMode);
-	BackScreen := gl_allocatecontext;
-	gl_getcontext(BackScreen)
+        { Create virtual screen }
+        gl_setcontextvgavirtual(VgaMode);
+        BackScreen := gl_allocatecontext;
+        gl_getcontext(BackScreen)
       end;
       end;
     vga_setmode(VgaMode);
     vga_setmode(VgaMode);
     gl_setcontextvga(VgaMode);  { Physical screen context. }
     gl_setcontextvga(VgaMode);  { Physical screen context. }
@@ -678,8 +704,8 @@ begin
   if not NoGraphics
   if not NoGraphics
     then begin
     then begin
       if ClipRect.Empty
       if ClipRect.Empty
-	then gl_setclippingwindow(0, 0, 0, 0)
-	else gl_setclippingwindow(x1, y1, x2 - 1, y2 - 1);
+        then gl_setclippingwindow(0, 0, 0, 0)
+        else gl_setclippingwindow(x1, y1, x2 - 1, y2 - 1);
       {gl_enableclipping(0);}
       {gl_enableclipping(0);}
     end;
     end;
   SetDelta
   SetDelta
@@ -784,14 +810,14 @@ begin
   begin
   begin
     If (Q[0] = TheMarker) and DoUseMarker
     If (Q[0] = TheMarker) and DoUseMarker
       then begin
       then begin
-	If col then gl_setfontcolors(BackColor, MarkColor)
-	else gl_setfontcolors(BackColor, TextColor);
-	If Q <> P then begin
-	  gl_writen(CurX, CurY, Q-P, P);
-	  MoveRel(FontWidth * (Q-P), 0)
-	end;
-	col := not col;
-	P := Q + 1
+        If col then gl_setfontcolors(BackColor, MarkColor)
+        else gl_setfontcolors(BackColor, TextColor);
+        If Q <> P then begin
+          gl_writen(CurX, CurY, Q-P, P);
+          MoveRel(FontWidth * (Q-P), 0)
+        end;
+        col := not col;
+        P := Q + 1
       end;
       end;
     {Inc(Q)} Q := Q + 1
     {Inc(Q)} Q := Q + 1
   end;
   end;
@@ -955,10 +981,10 @@ begin
       gl_setcontext(BackScreen);
       gl_setcontext(BackScreen);
       gl_disableclipping;
       gl_disableclipping;
       case Action of
       case Action of
-	pbCopy	: gl_copyboxfromcontext(PhysicalScreen^,
-					R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
-					R.A.X, R.A.Y);
-	pbClear	: gl_fillbox(R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y, 0);
+        pbCopy  : gl_copyboxfromcontext(PhysicalScreen^,
+                                        R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
+                                        R.A.X, R.A.Y);
+        pbClear : gl_fillbox(R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y, 0);
       end;
       end;
       PrepBuf := true;
       PrepBuf := true;
       SetDrawOrigin(0, 0);
       SetDrawOrigin(0, 0);
@@ -981,8 +1007,8 @@ procedure PasteRectAt(var R: Objects.TRect; P: Objects.TPoint; var Buf: TVgaBuf)
 begin
 begin
   if not NoGraphics and (BackScreen <> nil)
   if not NoGraphics and (BackScreen <> nil)
     then gl_copyboxfromcontext(BackScreen^,
     then gl_copyboxfromcontext(BackScreen^,
-			       R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
-			       P.X, P.Y);
+                               R.A.X, R.A.Y, R.B.X - R.A.X, R.B.Y - R.A.Y,
+                               P.X, P.Y);
 end;
 end;
 
 
 
 
@@ -995,7 +1021,6 @@ end; { PasteRect }
 function StoreScreen(x1, y1, x2, y2: Integer): PScreenBuf;
 function StoreScreen(x1, y1, x2, y2: Integer): PScreenBuf;
 var
 var
   s: LongInt;
   s: LongInt;
-  Handle: Word;
   p: pointer;
   p: pointer;
   SaveOrigin: TPoint;
   SaveOrigin: TPoint;
 
 
@@ -1027,7 +1052,7 @@ procedure FreeScreenBuf(Buf: PScreenBuf);
 Begin
 Begin
   If Buf <> nil then Begin
   If Buf <> nil then Begin
     case Buf^.Mode of
     case Buf^.Mode of
-      2	: FreeImage(pointer(Buf^.Info));
+      2 : FreeImage(pointer(Buf^.Info));
     end;
     end;
     Dispose(Buf)
     Dispose(Buf)
   End
   End
@@ -1039,13 +1064,13 @@ var
 Begin
 Begin
   If Buf <> nil then
   If Buf <> nil then
     case Buf^.Mode of
     case Buf^.Mode of
-      2	:
-	  begin
-	    SaveOrigin := DrawOrigin;
-	    SetDrawOrigin(0, 0);
-	    PasteImage(x3, y3, pointer(Buf^.Info), NormalPut);
-	    SetDrawOriginP(SaveOrigin);
-	  end
+      2 :
+          begin
+            SaveOrigin := DrawOrigin;
+            SetDrawOrigin(0, 0);
+            PasteImage(x3, y3, pointer(Buf^.Info), NormalPut);
+            SetDrawOriginP(SaveOrigin);
+          end
     end
     end
 End;
 End;
 
 
@@ -1092,12 +1117,12 @@ end;
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
 
 
-function GetX: Integer;					
+function GetX: Integer;                                 
 begin
 begin
   GetX := CurX - DrawDelta.X
   GetX := CurX - DrawDelta.X
 end;
 end;
 
 
-function GetY: Integer;					
+function GetY: Integer;                                 
 begin
 begin
   GetY := CurY - DrawDelta.Y
   GetY := CurY - DrawDelta.Y
 end;
 end;
@@ -1109,7 +1134,7 @@ begin
     then gl_setpixel(X + DrawDelta.X, Y + DrawDelta.Y, Pixel)
     then gl_setpixel(X + DrawDelta.X, Y + DrawDelta.Y, Pixel)
 end;
 end;
 
 
-function GetPixel(X, Y: Integer): Word;			
+function GetPixel(X, Y: Integer): Word;                 
 begin
 begin
   if NoGraphics
   if NoGraphics
     then GetPixel := 0
     then GetPixel := 0
@@ -1154,7 +1179,7 @@ procedure Line(x1, y1, x2, y2: Integer);
 begin
 begin
   if not NoGraphics
   if not NoGraphics
     then gl_line(x1 + DrawDelta.X, y1 + DrawDelta.Y,
     then gl_line(x1 + DrawDelta.X, y1 + DrawDelta.Y,
-		 x2 + DrawDelta.X, y2 + DrawDelta.Y, TheColor)
+                 x2 + DrawDelta.X, y2 + DrawDelta.Y, TheColor)
 end;
 end;
 
 
 procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
 procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
@@ -1185,11 +1210,11 @@ begin
   if not NoGraphics
   if not NoGraphics
     then begin
     then begin
       R.Assign(x1 + DrawDelta.X, y1 + DrawDelta.Y,
       R.Assign(x1 + DrawDelta.X, y1 + DrawDelta.Y,
-	       x2 + DrawDelta.X + 1, y2 + DrawDelta.Y + 1);
+               x2 + DrawDelta.X + 1, y2 + DrawDelta.Y + 1);
       R.Intersect(ClipRect);
       R.Intersect(ClipRect);
       if not R.Empty
       if not R.Empty
-	then gl_fillbox(R.A.X, R.A.Y,
-			R.B.X - R.A.X, R.B.Y - R.A.Y, TheFillColor)
+        then gl_fillbox(R.A.X, R.A.Y,
+                        R.B.X - R.A.X, R.B.Y - R.A.Y, TheFillColor)
     end;
     end;
 end;
 end;
 
 
@@ -1205,7 +1230,8 @@ begin
   end;
   end;
   Moveto(x2+depth,y1-depth);
   Moveto(x2+depth,y1-depth);
   Lineto(x2+depth,y2-depth);
   Lineto(x2+depth,y2-depth);
-  Lineto(x2,y2);  
+  Lineto(x2,y2);
+
 end;
 end;
 
 
 procedure DrawPoly(NumPoints: Word; var PolyPoints);
 procedure DrawPoly(NumPoints: Word; var PolyPoints);
@@ -1243,7 +1269,7 @@ end;
 
 
 { Nonlinearly bounded primitives
 { Nonlinearly bounded primitives
 }
 }
-procedure GetArcCoords(var ArcCoords: ArcCoordsType);	
+procedure GetArcCoords(var ArcCoords: ArcCoordsType);   
 
 
 begin
 begin
 end;
 end;
@@ -1295,7 +1321,7 @@ begin
 end;
 end;
 
 
 
 
-procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);	
+procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);        
 var
 var
   SaveClipRect: TRect;
   SaveClipRect: TRect;
 begin
 begin
@@ -1305,12 +1331,12 @@ begin
     Height := y2 - y1 + 1;
     Height := y2 - y1 + 1;
     if not NoGraphics
     if not NoGraphics
       then begin
       then begin
-	{gl_disableclipping(0);}
-	SaveClipRect := ClipRect;
-	SetClipRect(0, 0, SizeX, SizeY);
-	gl_getbox(x1 + DrawDelta.X, y1 + DrawDelta.Y,
-		  x2 - x1 + 1, y2 - y1 + 1, @Data);
-	SetClipRectR(SaveClipRect)
+        {gl_disableclipping(0);}
+        SaveClipRect := ClipRect;
+        SetClipRect(0, 0, SizeX, SizeY);
+        gl_getbox(x1 + DrawDelta.X, y1 + DrawDelta.Y,
+                  x2 - x1 + 1, y2 - y1 + 1, @Data);
+        SetClipRectR(SaveClipRect)
       end;
       end;
   end;
   end;
 end;
 end;
@@ -1325,20 +1351,20 @@ begin
     begin
     begin
       {gl_putbox(x + DrawDelta.X, y + DrawDelta.Y, Width, Height, @Data)}
       {gl_putbox(x + DrawDelta.X, y + DrawDelta.Y, Width, Height, @Data)}
       R.Assign(X + DrawDelta.X, Y + DrawDelta.Y,
       R.Assign(X + DrawDelta.X, Y + DrawDelta.Y,
-	       X + DrawDelta.X + Width, Y + DrawDelta.Y + Height);
+               X + DrawDelta.X + Width, Y + DrawDelta.Y + Height);
       R.Intersect(ClipRect);
       R.Intersect(ClipRect);
       if not R.Empty
       if not R.Empty
-	then begin
-	  {gl_disableclipping(0);}
-	  SaveClipRect := ClipRect;
-	  SetClipRect(0, 0, SizeX, SizeY);
-	  gl_putboxpart(R.A.X, R.A.Y,
-			R.B.X - R.A.X, R.B.Y - R.A.Y,
-			Width, Height,
-			@Data,
-			R.A.X - X, R.A.Y - Y);
-	  SetClipRectR(SaveClipRect);
-	end;
+        then begin
+          {gl_disableclipping(0);}
+          SaveClipRect := ClipRect;
+          SetClipRect(0, 0, SizeX, SizeY);
+          gl_putboxpart(R.A.X, R.A.Y,
+                        R.B.X - R.A.X, R.B.Y - R.A.Y,
+                        Width, Height,
+                        @Data,
+                        R.A.X - X, R.A.Y - Y);
+          SetClipRectR(SaveClipRect);
+        end;
     end;
     end;
 end; { PutImage }
 end; { PutImage }
 
 
@@ -1358,7 +1384,13 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-04-15 13:40:11  michael
+  Revision 1.2  1998-05-12 10:42:47  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
+
+  Revision 1.1  1998/04/15 13:40:11  michael
   + Initial implementation of graph unit
   + Initial implementation of graph unit
 
 
 }
 }

+ 2 - 2
rtl/linux/makefile

@@ -245,8 +245,8 @@ graph$(PPUEXT) : graph.pp linux$(PPUEXT) objects$(PPUEXT)
 # Other RTL Units
 # Other RTL Units
 #
 #
 
 
-getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/getopts.pp .
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+	$(COPY) $(INC)/getopts.pp .
 	$(PP) $(OPT) getopts $(REDIR)
 	$(PP) $(OPT) getopts $(REDIR)
 	$(DEL) getopts.pp
 	$(DEL) getopts.pp
 
 

+ 91 - 101
rtl/linux/syslinux.pp

@@ -33,14 +33,15 @@ Interface
 {$I heaph.inc}
 {$I heaph.inc}
 
 
 const
 const
-  UnusedHandle=$ffff; 
-  StdInputHandle=0;
-  StdOutputHandle=1;
-  StdErrorHandle=2; 
+  UnusedHandle    = $ffff;
+  StdInputHandle  = 0;
+  StdOutputHandle = 1;
+  StdErrorHandle  = 2;
 
 
-var argc : longint;
-    argv : ppchar;
-    envp : ppchar;
+var
+  argc : longint;
+  argv : ppchar;
+  envp : ppchar;
 
 
 Implementation
 Implementation
 
 
@@ -50,35 +51,34 @@ Type
   PLongint = ^Longint;
   PLongint = ^Longint;
 
 
 {$ifdef crtlib}
 {$ifdef crtlib}
-Procedure _rtl_exit(l: longint); [ C ];
-Function  _rtl_paramcount: longint; [ C ];
-Procedure _rtl_paramstr(st: pchar; l: longint); [ C ];
-Function  _rtl_open(f: pchar; flags: longint): longint; [ C ];
-Procedure _rtl_close(h: longint); [ C ];
-Procedure _rtl_write(h: longint; addr: longInt; len : longint); [ C ];
-Procedure _rtl_erase(p: pchar); [ C ];
-Procedure _rtl_rename(p1: pchar; p2 : pchar); [ C ];
-Function  _rtl_read(h: longInt; addr: longInt; len : longint) : longint; [ C ];
-Function  _rtl_filepos(Handle: longint): longint; [ C ];
-Procedure _rtl_seek(Handle: longint; pos:longint); [ C ];
-Function  _rtl_filesize(Handle:longint): longInt; [ C ];
-Procedure _rtl_rmdir(buffer: pchar); [ C ];
-Procedure _rtl_mkdir(buffer: pchar); [ C ];
-Procedure _rtl_chdir(buffer: pchar); [ C ];
+  Procedure _rtl_exit(l: longint); cdecl;
+  Function  _rtl_paramcount: longint; cdecl;
+  Procedure _rtl_paramstr(st: pchar; l: longint); cdecl;
+  Function  _rtl_open(f: pchar; flags: longint): longint; cdecl;
+  Procedure _rtl_close(h: longint); cdecl;
+  Procedure _rtl_write(h: longint; addr: longInt; len : longint); cdecl;
+  Procedure _rtl_erase(p: pchar); cdecl;
+  Procedure _rtl_rename(p1: pchar; p2 : pchar); cdecl;
+  Function  _rtl_read(h: longInt; addr: longInt; len : longint) : longint; cdecl;
+  Function  _rtl_filepos(Handle: longint): longint; cdecl;
+  Procedure _rtl_seek(Handle: longint; pos:longint); cdecl;
+  Function  _rtl_filesize(Handle:longint): longInt; cdecl;
+  Procedure _rtl_rmdir(buffer: pchar); cdecl;
+  Procedure _rtl_mkdir(buffer: pchar); cdecl;
+  Procedure _rtl_chdir(buffer: pchar); cdecl;
 {$else}
 {$else}
-
-{ used in syscall to report errors.}
-var Errno : longint;
-
-{ Include constant and type definitions }
-{$i errno.inc    }  { Error numbers                 }
-{$i sysnr.inc    }  { System call numbers           }
-{$i sysconst.inc }  { Miscellaneous constants       }
-{$i systypes.inc }  { Types needed for system calls }
-
-{ Read actual system call definitions. }
-{$i syscalls.inc }  
-
+  { used in syscall to report errors.}
+  var
+    Errno : longint;
+
+  { Include constant and type definitions }
+  {$i errno.inc    }  { Error numbers                 }
+  {$i sysnr.inc    }  { System call numbers           }
+  {$i sysconst.inc }  { Miscellaneous constants       }
+  {$i systypes.inc }  { Types needed for system calls }
+
+  { Read actual system call definitions. }
+  {$i syscalls.inc }
 {$endif}
 {$endif}
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -92,9 +92,8 @@ Begin
   Do_Exit;
   Do_Exit;
 {$ifdef i386}
 {$ifdef i386}
   asm
   asm
-    jmp _haltproc
+        jmp     _haltproc
   end;
   end;
-{$else}
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -102,9 +101,9 @@ End;
 Function ParamCount: Longint;
 Function ParamCount: Longint;
 Begin
 Begin
 {$ifdef crtlib}
 {$ifdef crtlib}
-  ParamCount := _rtl_paramcount;
-{$else}  
-  Paramcount := argc-1
+  ParamCount:=_rtl_paramcount;
+{$else}
+  Paramcount:=argc-1
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -119,7 +118,7 @@ Var
 Begin
 Begin
 {$ifdef crtlib}
 {$ifdef crtlib}
   _rtl_paramstr(@b, l);
   _rtl_paramstr(@b, l);
-{$else}  
+{$else}
   if l>argc then
   if l>argc then
    begin
    begin
      paramstr:='';
      paramstr:='';
@@ -127,20 +126,20 @@ Begin
    end;
    end;
   pp:=argv;
   pp:=argv;
   i:=0;
   i:=0;
-  while (i<l) and (pp^<>nil) do 
+  while (i<l) and (pp^<>nil) do
    begin
    begin
      pp:=pp+4;
      pp:=pp+4;
      inc(i);
      inc(i);
    end;
    end;
   if pp^<>nil then
   if pp^<>nil then
    move (pp^^,b[0],255)
    move (pp^^,b[0],255)
-  else 
+  else
    b[0]:=#0;
    b[0]:=#0;
 {$endif}
 {$endif}
   ParamStr:=StrPas(b);
   ParamStr:=StrPas(b);
 End;
 End;
 
 
-  
+
 Procedure Randomize;
 Procedure Randomize;
 Begin
 Begin
 {$ifdef crtlib}
 {$ifdef crtlib}
@@ -155,45 +154,33 @@ End;
                               Heap Management
                               Heap Management
 *****************************************************************************}
 *****************************************************************************}
 
 
-{ ___brk_addr is defined and allocated in prt1.S. }
+{ ___brk_addr is defined and allocated in prt1.as }
 
 
-Function Get_Brk_addr : longint;
-begin
+Function Get_Brk_addr : longint;assembler;
 {$ifdef i386}
 {$ifdef i386}
-  asm
-    movl ___brk_addr,%eax
-    leave
-    ret
-  end ['EAX'];
-{$else}
+asm
+        movl    ___brk_addr,%eax
+end ['EAX'];
 {$endif}
 {$endif}
-end;
 
 
 
 
-Procedure Set_brk_addr (NewAddr : longint);
-begin
+Procedure Set_brk_addr (NewAddr : longint);assembler;
 {$ifdef i386}
 {$ifdef i386}
-  asm
-    movl 8(%ebp),%eax
-    movl %eax,___brk_addr
-  end ['EAX'];
-{$else}
+asm
+        movl    NewAddr,%eax
+        movl    %eax,___brk_addr
+end ['EAX'];
 {$endif}
 {$endif}
-end;
 
 
 
 
 Function brk(Location : longint) : Longint;
 Function brk(Location : longint) : Longint;
 { set end of data segment to location }
 { set end of data segment to location }
-var t     : syscallregs;
-    dummy : longint;
-
+var
+  t     : syscallregs;
+  dummy : longint;
 begin
 begin
   t.reg2:=Location;
   t.reg2:=Location;
-  dummy:=syscall (syscall_nr_brk,t);
-{$ifdef debug}
-  writeln ('Brk syscall returned : ',dummy);
-  writeln ('Errno = ',errno);
-{$endif}
+  dummy:=syscall(syscall_nr_brk,t);
   set_brk_addr(dummy);
   set_brk_addr(dummy);
   brk:=dummy;
   brk:=dummy;
 end;
 end;
@@ -206,8 +193,8 @@ begin
      Set_brk_addr(brk(0));
      Set_brk_addr(brk(0));
      if Get_brk_addr=0 then
      if Get_brk_addr=0 then
       exit(-1);
       exit(-1);
-   end; 
-  init_brk:=0; 
+   end;
+  init_brk:=0;
 end;
 end;
 
 
 
 
@@ -242,7 +229,8 @@ end;
 Procedure Errno2Inoutres;
 Procedure Errno2Inoutres;
 {
 {
   Convert ErrNo error to the correct Inoutres value
   Convert ErrNo error to the correct Inoutres value
-}  
+}
+
 begin
 begin
   if ErrNo=0 then { Else it will go through all the cases }
   if ErrNo=0 then { Else it will go through all the cases }
    exit;
    exit;
@@ -261,12 +249,12 @@ begin
    Sys_ENOSPC : Inoutres:=101;
    Sys_ENOSPC : Inoutres:=101;
  Sys_ENAMETOOLONG,
  Sys_ENAMETOOLONG,
     Sys_ELOOP,
     Sys_ELOOP,
-  Sys_ENOTDIR : Inoutres:=3;        
+  Sys_ENOTDIR : Inoutres:=3;
     Sys_EROFS : Inoutres:=150;
     Sys_EROFS : Inoutres:=150;
    Sys_EEXIST,
    Sys_EEXIST,
    Sys_EACCES : Inoutres:=5;
    Sys_EACCES : Inoutres:=5;
   Sys_ETXTBSY : Inoutres:=162;
   Sys_ETXTBSY : Inoutres:=162;
-  end; 
+  end;
 end;
 end;
 
 
 
 
@@ -286,7 +274,7 @@ Begin
   _rtl_erase(p);
   _rtl_erase(p);
 {$else}
 {$else}
   sys_unlink(p);
   sys_unlink(p);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -297,7 +285,7 @@ Begin
   _rtl_rename(p1,p2);
   _rtl_rename(p1,p2);
 {$else }
 {$else }
   sys_rename(p1,p2);
   sys_rename(p1,p2);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -309,7 +297,7 @@ Begin
   Do_Write:=Len;
   Do_Write:=Len;
 {$else}
 {$else}
   Do_Write:=sys_write(Handle,pchar(addr),len);
   Do_Write:=sys_write(Handle,pchar(addr),len);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 {$endif}
   if Do_Write<0 then
   if Do_Write<0 then
    Do_Write:=0;
    Do_Write:=0;
@@ -322,7 +310,7 @@ Begin
   Do_Read:=_rtl_read(Handle,addr,len);
   Do_Read:=_rtl_read(Handle,addr,len);
 {$else}
 {$else}
   Do_Read:=sys_read(Handle,pchar(addr),len);
   Do_Read:=sys_read(Handle,pchar(addr),len);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 {$endif}
   if Do_Read<0 then
   if Do_Read<0 then
    Do_Read:=0;
    Do_Read:=0;
@@ -335,7 +323,7 @@ Begin
   Do_FilePos:=_rtl_filepos(Handle);
   Do_FilePos:=_rtl_filepos(Handle);
 {$else}
 {$else}
   Do_FilePos:=sys_lseek(Handle, 0, Seek_Cur);
   Do_FilePos:=sys_lseek(Handle, 0, Seek_Cur);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -375,8 +363,8 @@ Begin
   if SysCall(SysCall_nr_fstat,regs)=0 then
   if SysCall(SysCall_nr_fstat,regs)=0 then
    Do_FileSize:=Info.Size
    Do_FileSize:=Info.Size
   else
   else
-   Do_FileSize:=-1; 
-  Errno2Inoutres; 
+   Do_FileSize:=-1;
+  Errno2Inoutres;
 {$endif}
 {$endif}
 End;
 End;
 
 
@@ -385,14 +373,14 @@ Procedure Do_Truncate(Handle,Pos:longint);
 {$ifndef crtlib}
 {$ifndef crtlib}
 var
 var
   sr : syscallregs;
   sr : syscallregs;
-{$endif}  
+{$endif}
 begin
 begin
 {$ifndef crtlib}
 {$ifndef crtlib}
   sr.reg2:=Handle;
   sr.reg2:=Handle;
   sr.reg3:=Pos;
   sr.reg3:=Pos;
   syscall(syscall_nr_ftruncate,sr);
   syscall(syscall_nr_ftruncate,sr);
-  Errno2Inoutres; 
-{$endif}  
+  Errno2Inoutres;
+{$endif}
 end;
 end;
 
 
 
 
@@ -429,17 +417,18 @@ Begin
    0 : begin
    0 : begin
          oflags :=Open_RDONLY;
          oflags :=Open_RDONLY;
          FileRec(f).mode:=fminput;
          FileRec(f).mode:=fminput;
-       end;      
+       end;
    1 : begin
    1 : begin
          oflags :=Open_WRONLY;
          oflags :=Open_WRONLY;
          FileRec(f).mode:=fmoutput;
          FileRec(f).mode:=fmoutput;
-       end;      
+       end;
+
    2 : begin
    2 : begin
          oflags :=Open_RDWR;
          oflags :=Open_RDWR;
          FileRec(f).mode:=fminout;
          FileRec(f).mode:=fminout;
-       end;      
+       end;
   end;
   end;
-  if (flags and $100)=$100 then 
+  if (flags and $100)=$100 then
    oflags:=oflags or (Open_CREAT or Open_TRUNC)
    oflags:=oflags or (Open_CREAT or Open_TRUNC)
   else
   else
    if (flags and $10)=$10 then
    if (flags and $10)=$10 then
@@ -453,17 +442,17 @@ Begin
       fmappend : begin
       fmappend : begin
                    FileRec(f).Handle:=StdOutputHandle;
                    FileRec(f).Handle:=StdOutputHandle;
                    FileRec(f).mode:=fmoutput; {fool fmappend}
                    FileRec(f).mode:=fmoutput; {fool fmappend}
-                 end;  
+                 end;
      end;
      end;
      exit;
      exit;
    end;
    end;
-{ real open call }  
+{ real open call }
 {$ifdef crtlib}
 {$ifdef crtlib}
   FileRec(f).Handle:=_rtl_open(p, oflags);
   FileRec(f).Handle:=_rtl_open(p, oflags);
   if FileRec(f).Handle<0 then
   if FileRec(f).Handle<0 then
    InOutRes:=2
    InOutRes:=2
   else
   else
-   InOutRes:=0; 
+   InOutRes:=0;
 {$else}
 {$else}
   FileRec(f).Handle:=sys_open(p,oflags,438);
   FileRec(f).Handle:=sys_open(p,oflags,438);
   Errno2Inoutres;
   Errno2Inoutres;
@@ -565,7 +554,7 @@ var
 begin
 begin
   drivenr:=0;
   drivenr:=0;
   dir:='';
   dir:='';
-{$ifndef crtlib}  
+{$ifndef crtlib}
   thedir:='/'#0;
   thedir:='/'#0;
   if sys_stat(@thedir[1],thisdir)<0 then
   if sys_stat(@thedir[1],thisdir)<0 then
    exit;
    exit;
@@ -594,7 +583,7 @@ begin
       exit;
       exit;
      repeat
      repeat
        d:=sys_readdir (dirstream);
        d:=sys_readdir (dirstream);
-       if (d<>nil) and 
+       if (d<>nil) and
           (not ((d^.name[0]='.') and ((d^.name[1]=#0) or ((d^.name[1]='.') and (d^.name[2]=#0))))) and
           (not ((d^.name[0]='.') and ((d^.name[1]=#0) or ((d^.name[1]='.') and (d^.name[2]=#0))))) and
           (mountpoint or (d^.ino=thisino)) then
           (mountpoint or (d^.ino=thisino)) then
         begin
         begin
@@ -655,8 +644,6 @@ end;
 
 
 
 
 Begin
 Begin
-{ Initialize ExitProc }
-  ExitProc:=Nil;
 { Set up segfault Handler }
 { Set up segfault Handler }
   InstallSegFaultHandler;
   InstallSegFaultHandler;
 { Setup heap }
 { Setup heap }
@@ -665,15 +652,18 @@ Begin
   OpenStdIO(Input,fmInput,'stdin',StdInputHandle);
   OpenStdIO(Input,fmInput,'stdin',StdInputHandle);
   OpenStdIO(Output,fmOutput,'stdout',StdOutputHandle);
   OpenStdIO(Output,fmOutput,'stdout',StdOutputHandle);
   OpenStdIO(StdErr,fmOutput,'stderr',StdErrorHandle);
   OpenStdIO(StdErr,fmOutput,'stderr',StdErrorHandle);
-{ Reset IO Error }  
+{ Reset IO Error }
   InOutRes:=0;
   InOutRes:=0;
 End.
 End.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-05-06 12:35:26  michael
-  + Removed log from before restored version.
+  Revision 1.3  1998-05-12 10:42:48  peter
+    * moved getopts to inc/, all supported OS's need argc,argv exported
+    + strpas, strlen are now exported in the systemunit
+    * removed logs
+    * removed $ifdef ver_above
 
 
-  Revision 1.1.1.1  1998/03/25 11:18:43  root
-  * Restored version
+  Revision 1.2  1998/05/06 12:35:26  michael
+  + Removed log from before restored version.
 }
 }