Explorar el Código

* 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 hace 27 años
padre
commit
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.
-        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
          pushf
@@ -70,41 +70,10 @@ end.
 
 {
   $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
     intel i386+
-    
+
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -87,7 +88,7 @@ begin
 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
         asm
         cld
@@ -159,47 +160,47 @@ asm
      0 %ebp
 }
       { eax isn't touched anywhere, so it doesn't have to reloaded }
-	movl	8(%ebp),%eax
+        movl    8(%ebp),%eax
       { initialise self ? }
-	orl	%esi,%esi
-	jne	.LHC_4
+        orl     %esi,%esi
+        jne     .LHC_4
       { get memory, but save register first temporary variable }
-        subl	$4,%esp
-        movl	%esp,%esi
+        subl    $4,%esp
+        movl    %esp,%esi
       { Save Register}
         pushal
       { Memory size }
-        pushl	(%eax)
-        pushl	%esi
-        call	GETMEM
+        pushl   (%eax)
+        pushl   %esi
+        call    GETMEM
         popal
       { Memory size to %esi }
-        movl	(%esi),%esi
-        addl	$4,%esp
+        movl    (%esi),%esi
+        addl    $4,%esp
       { If no memory available : fail() }
-        orl	%esi,%esi
-        jz	.LHC_5
+        orl     %esi,%esi
+        jz      .LHC_5
       { init self for the constructor }
-        movl	%esi,12(%ebp)
+        movl    %esi,12(%ebp)
 .LHC_4:
       { 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 }
       { can't be put, because this calls Fail() }
-        incl	%eax
+        incl    %eax
         ret
 .LHC_7:
       { set zero inside the object }
         pushal
-        pushw	$0
-        pushl	(%eax)
-        pushl	%esi
-        call	.L_FILL_OBJECT
+        pushw   $0
+        pushl   (%eax)
+        pushl   %esi
+        call    FILL_OBJECT
         popal
       { set the VMT address for the new created object }
-        movl	%eax,(%esi)
-        orl	%eax,%eax
+        movl    %eax,(%esi)
+        orl     %eax,%eax
 .LHC_5:
 end;
 
@@ -284,44 +285,45 @@ asm
      0 %ebp
 }
       { temporary Variable }
-	subl 	$4,%esp
-        movl 	%esp,%edi
+        subl    $4,%esp
+        movl    %esp,%edi
         pushal
       { 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! }
-        movl 	12(%ebp),%eax
+        movl    12(%ebp),%eax
       { get VMT-pointer (from Self) to %ebx }
-        movl 	(%eax),%ebx
+        movl    (%eax),%ebx
       { And put size on the Stack }
-        pushl 	(%ebx)
+        pushl   (%ebx)
       { SELF }
       { I think for precaution }
       { 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:
         popal
-        addl	$4,%esp
+        addl    $4,%esp
 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 !!!
 }
 begin
   asm
-        pushl %eax
-        pushl %ecx
+        pushl   %eax
+        pushl   %ecx
         cld
         movl    16(%ebp),%edi
         movl    12(%ebp),%esi
@@ -350,13 +352,13 @@ begin
         movl    %eax,%ecx
         rep
         movsb
-        popl %ecx
-        popl %eax
+        popl    %ecx
+        popl    %eax
   end ['ECX','EAX','ESI','EDI'];
 end;
 
 
-procedure strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
+procedure int_strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
 begin
   asm
         xorl    %ecx,%ecx
@@ -395,7 +397,7 @@ begin
 end;
 
 
-procedure strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
+procedure int_strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
 begin
   asm
         cld
@@ -443,6 +445,9 @@ begin
   end ['EDX','ECX','EBX','EAX','ESI','EDI'];
 end;
 
+{****************************************************************************
+                                  PChar
+****************************************************************************}
 
 function strpas(p:pchar):string;
 begin
@@ -480,6 +485,7 @@ begin
   end ['ECX','EAX','ESI','EDI'];
 end;
 
+
 function strlen(p:pchar):longint;assembler;
 asm
         movl    p,%edi
@@ -492,26 +498,35 @@ asm
         subl    %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;
 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:
 end ['EAX'];
 
 
 function get_next_frame(framebp:longint):longint;assembler;
 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:
 end ['EAX'];
 
@@ -546,14 +561,16 @@ procedure runerror(w : word);[alias: 'runerror'];
      halt(errorcode);
   end;
 
-procedure io1(addr : longint);[public,alias: 'IOCHECK'];
+
+
+procedure int_iocheck(addr : longint);[public,alias: 'IOCHECK'];
 var
   l : longint;
 begin
 { Since IOCHECK is called directly and only later the optimiser }
 { Maybe also save global registers  }
   asm
-	pushal
+        pushal
   end;
   l:=ioresult;
   if l<>0 then
@@ -562,179 +579,158 @@ begin
      halt(l);
    end;
   asm
-	popal
-   end;
+        popal
+  end;
 end;
 
 
-procedure re_overflow;[public,alias: 'RE_OVERFLOW'];
+procedure int_re_overflow;[public,alias: 'RE_OVERFLOW'];
 var
   addr : longint;
 begin
 { Overflow was shortly before the return address }
    asm
-	movl	4(%ebp),%edi
-        movl	%edi,addr
+        movl    4(%ebp),%edi
+        movl    %edi,addr
    end;
    writeln('Overflow at ',addr);
    RunError(215);
 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;
 asm
-	movl	l,%eax
-        orl	%eax,%eax
-        jns	.LMABS1
-        negl	%eax
+        movl    l,%eax
+        orl     %eax,%eax
+        jns     .LMABS1
+        negl    %eax
 .LMABS1:
 end ['EAX'];
 
 
 function odd(l:longint):boolean;assembler;
 asm
-       movl	l,%eax
-       andl	$1,%eax
-       setnz	%al
+       movl     l,%eax
+       andl     $1,%eax
+       setnz    %al
 end ['EAX'];
 
 
 function sqr(l:longint):longint;assembler;
 asm
-        mov	l,%eax
-        imull	%eax,%eax
+        mov     l,%eax
+        imull   %eax,%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
+{ Workaround: }
+  if l=$80000000 then
+   begin
+     s:='-2147483648';
+     exit;
+   end;
   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;
 
 
+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}
 
 Function Random(L: LongInt): LongInt;assembler;
 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;
-{
-begin
-  Randseed:=Randseed*134775813+1;
-  Random:=abs(Randseed mod l);
-end;
-}
 
 {$I386_DIRECT}
 
 {
   $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
 
   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
   + 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)
 
@@ -11,5 +10,3 @@ Include files for system are :
 
 Units are :
   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$
-  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.
 {
   $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$
-  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$
-  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}
-  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}
 
-  const
-     allow_special : boolean =true;
+const
+  allow_special : boolean =true;
+  heapblocks    : boolean=false;
+var
+  heaporg,heapptr,heapend,heaperror,freelist : pointer;
 
 {
   $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$
-  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$
-  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
 # 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))
 
+# Other unit names which can be used for all systems
+#
+#UNITNAMES=getops
+#UNITPPNAMES=$(addsuffix .pp,$(UNITNAMES))
+
 # Other files...
 #astrings.pp
 #complex.pp

+ 5 - 38
rtl/inc/mathh.inc

@@ -42,43 +42,10 @@
 
 {
   $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 
 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.
 systemh.inc	Interface part of the system unit.
@@ -11,4 +11,9 @@ astrings.pp	AnsiStrings implementation.
 lstrings.pp	LongStrings implementation.
 sstrings.inc	ShortStrings implementation.
 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 }
 
 {$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;
-{$endif ver_above0_9_8}
-{$else not i386}
+{$else i386}
   bestreal = single;
-{$endif not i386}
+{$endif i386}
 
 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
-  in the future ! }
-
+  in the future !
+}
 var  maxlen : longint;   { Maximal length of string for float }
      minlen : longint;   { Minimal length of string for float }
      explen : longint;   { Length of exponent, including E and sign.
@@ -88,11 +85,7 @@ begin
     end;
   { check parameters }
   { default value for length is -32767 }
-{$ifdef ver_above0_9_7}
   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() }
   sign:=d<0;
   { the creates a cannot determine which overloaded function to call
@@ -205,41 +198,12 @@ end;
 
 {
   $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;
 
 
+{*****************************************************************************
+                              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'];
-
 begin
- {$ifdef i386}
+{$ifdef i386}
    str_real(len,fr,d,rt_s64real,s);
- {$else}
+{$else}
    str_real(len,fr,d,rt_s32real,s);
- {$endif}
+{$endif}
 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
    str_real(len,fr,d,rt_s32real,s);
 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
    str_real(len,fr,d,rt_s80real,s);
 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
    str_real(len,fr,d,rt_s64bit,s);
 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
    str_real(len,fr,d,rt_f32bit,s);
 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
    int_str(v,s);
    if length(s)<len then
      s:=space(len-length(s))+s;
 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
   int_str(v,s);
   if length(s)<len then
     s:=space(len-length(s))+s;
 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;
 var
@@ -561,43 +308,43 @@ begin
 end;
 
 
-procedure val(const s : string;var v : longint;var code : word);
+procedure val(const s : string;var l : longint;var code : word);
 var
   base,u  : byte;
   negativ : boolean;
 begin
-  v:=0;
+  l:=0;
   Code:=InitVal(s,negativ,base);
   if Code>length(s) then
    exit;
   if negativ and (s='-2147483648') then
    begin
      Code:=0;
-     v:=$80000000;
+     l:=$80000000;
      exit;
    end;
   while Code<=Length(s) do
    begin
      u:=ord(s[code]);
      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);
      else
       u:=16;
      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
-        v:=0;
+        l:=0;
         exit;
       end;
-     inc(v,u);
+     inc(l,u);
      inc(code);
    end;
   code := 0;
   if negativ then
-   v:=0-v;
+   l:=0-l;
 end;
 
 
@@ -609,7 +356,7 @@ end;
 
 procedure val(const s : string;var l : longint);
 var
-   code : word;
+  code : word;
 begin
    val (s,l,code);
 end;
@@ -619,17 +366,17 @@ procedure val(const s : string;var b : byte);
 var
   l : longint;
 begin
-   val(s,l);
-   b:=l;
+  val(s,l);
+  b:=l;
 end;
 
 
 procedure val(const s : string;var b : byte;var code : word);
 var
-   l : longint;
+  l : longint;
 begin
-   val(s,l,code);
-   b:=l;
+  val(s,l,code);
+  b:=l;
 end;
 
 
@@ -641,10 +388,10 @@ end;
 
 procedure val(const s : string;var b : shortint);
 var
-   l : longint;
+  l : longint;
 begin
-   val(s,l);
-   b:=l;
+  val(s,l);
+  b:=l;
 end;
 
 
@@ -711,7 +458,203 @@ begin
 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);
 var
@@ -726,8 +669,8 @@ begin
    begin
      u:=ord(s[code]);
      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);
      else
       u:=16;
@@ -758,42 +701,12 @@ begin
   val(s,v,word(code));
 end;
 
-{$endif ver_above0_9_8}
-
 {
   $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 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 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
@@ -413,155 +408,15 @@ End;
 
 {
   $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)
 
   Revision 1.3  1998/04/08 07:53:32  michael
   + 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}
 
-{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
 ****************************************************************************}
 
 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;
   Integer  = -32768..32767;
   shortint = -128..127;
   byte     = 0..255;
   Word     = 0..65535;
-{ at least declare Turbo Pascal real types:}
+  
+{ at least declare Turbo Pascal real types }
 {$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}
 
 { some type aliases }
-{$IFDEF VER_ABOVE0_9_2}
   dword    = cardinal;
   longword = cardinal;
-{$ENDIF VER_ABOVE0_9_2}
 
 { Zero - terminated strings }
   PChar  = ^Char;
@@ -98,21 +53,23 @@ const
 { max. values for longint and int}
   maxLongint = $7fffffff;
   maxint = 32767;
+  
 { Compatibility With  TP }
 {$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}
 {$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;
 {$endif}
 
 { max level in dumping on error }
-  Max_Frame_Dump:Word = 20;
+  Max_Frame_Dump : Word = 20;
 { Exit Procedure handling consts and types  }
-  Erroraddr:pointer = nil;
-  Errorcode:Word    = 0;
+  ExitProc : pointer=nil;
+  Erroraddr: pointer = nil;
+  Errorcode: Word    = 0;
 
 { file input modes }
   fmClosed = $D7B0;
@@ -120,20 +77,15 @@ const
   fmOutput = $D7B2;
   fmInOut  = $D7B3;
   fmAppend = $D7B4;
-  Filemode:byte = 2;
+  Filemode : byte = 2;
 
 var
 { Standard In- and Output }
   Output,
   Input,
   StdErr      : Text;
-  ExitProc    : pointer;
-  ExitCode    : Word;
-{$IFDEF Win32}
+  ExitCode,
   InOutRes    : Longint;
-{$ELSE Win32}
-  InOutRes    : Word;
-{$ENDIF Win32}
   StackBottom,
   LowestStack,
   RandSeed    : Longint;
@@ -176,10 +128,6 @@ Procedure Dec(Var i:shortint);
 Procedure Dec(Var i:byte);
 Procedure Dec(Var c:Char);
 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 Length(s:string):byte;
 
@@ -229,6 +177,13 @@ Function  Cseg:Word;
 Function  Dseg:Word;
 Function  Sseg:Word;
 
+{****************************************************************************
+                              PChar Handling
+****************************************************************************}
+
+function strpas(p:pchar):string;
+function strlen(p:pchar):longint;
+
 {****************************************************************************
                               String Handling
 ****************************************************************************}
@@ -245,20 +200,7 @@ Function  lowerCase(const s:string):string;
 Function  Space(b:byte):string;
 Function  hexStr(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);
 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:Integer);
 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
@@ -331,11 +261,9 @@ Procedure Truncate (Var F:File);
                            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
@@ -376,10 +304,6 @@ Procedure getdir(drivenr:byte;Var dir:string);
 Function IOResult:Word;
 Function Sptr:Longint;
 
-{****************************************************************************
-                The whole Delphi stuff is in the unit objpas
-*****************************************************************************}
-
 {*****************************************************************************
                           Init / Exit / ExitProc
 *****************************************************************************}
@@ -396,118 +320,12 @@ Procedure AddExitProc(Proc:TProcedure);
 
 {
   $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);
 End;
 
-{$ifdef i386}
+
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : real);[Public,Alias: 'WRITE_TEXT_REAL'];
 var
    s : String;
 Begin
+{$ifdef i386}
    Str_real(Len,fixkomma,r,rt_s64real,s);
-   w(Len,t,s);
-End;
 {$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);
+{$endif}
    w(Len,t,s);
 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'];
 var
@@ -438,7 +430,6 @@ Begin
 End;
 
 
-{$ifdef ieee_support}
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : single);[Public,Alias: 'WRITE_TEXT_SINGLE'];
 var
   s : String;
@@ -455,19 +446,16 @@ Begin
   Str_real(Len,fixkomma,r,rt_s80real,s);
   w(Len,t,s);
 End;
-{$endif ieee_support}
 
-{$ifdef comp_support}
+
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : comp);[Public,Alias: 'WRITE_TEXT_COMP'];
 var
   s : String;
-  L : longint;
-
 Begin
   Str_real(Len,fixkomma,r,rt_s64bit,s);
   w(Len,t,s);
 End;
-{$endif comp_support}
+
 
 Procedure w(fixkomma,Len : Longint;var t : TextRec;r : fixed);[Public,Alias: 'WRITE_TEXT_FIXED'];
 var
@@ -476,7 +464,7 @@ Begin
   Str_real(Len,fixkomma,r,rt_f32bit,s);
   w(Len,t,s);
 End;
-{$ENDIF VER_ABOVE0_9_7 }
+
 
 { Is called wc to avoid recursive calling. }
 Procedure wc(Len : Longint;var t : TextRec;b : Boolean);[Public,Alias: 'WRITE_TEXT_BOOLEAN'];
@@ -770,7 +758,6 @@ Begin
 End;
 
 
-{$IFDEF VER_ABOVE0_9_8}
 Procedure r(var f : TextRec;var l : cardinal);[Public,Alias: 'READ_TEXT_CARDINAL'];
 var
   hs   : String;
@@ -787,7 +774,6 @@ Begin
   If code<>0 Then
    RunError(106);
 End;
-{$ENDIF VER_ABOVE0_9_8}
 
 
 Procedure r(var f : TextRec;var d : Real);[Public,Alias: 'READ_TEXT_REAL'];
@@ -826,7 +812,7 @@ Begin
    RunError(106);
 End;
 
-{$ifdef ieee_support}
+
 Procedure r(var f : TextRec;var d : extended);[Public,Alias: 'READ_TEXT_EXTENDED'];
 var
   hs   : String;
@@ -862,9 +848,8 @@ Begin
   If code<>0 Then
    RunError(106);
 End;
-{$endif ieee_support}
 
-{$ifdef comp_support}
+
 Procedure r(var f : TextRec;var d : comp);[Public,Alias: 'READ_TEXT_COMP'];
 var
   hs   : String;
@@ -900,64 +885,14 @@ Begin
   If code<>0 Then
    RunError(106);
 End;
-{$endif}
-
 {
   $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$
-  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
 ****************************************************************************}
 
-{$IFDEF TypedFile}
-
 Procedure assign(var f:TypedFile;const Name:string);
 Begin
   FillChar(f,SizeOF(FileRec),0);
@@ -26,40 +24,26 @@ Begin
   Move(Name[1],FileRec(f).Name,Length(Name));
 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
   Reset(UnTypedFile(f),Size);
 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
-  Rewrite(UnTypedFile(f),128);
-End;
-
-Procedure Reset(var f : TypedFile);[IOCheck];
-Begin
-  Reset(UnTypedFile(f),128);
+  Rewrite(UnTypedFile(f),Size);
 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
   Do_Write(FileRec(f).Handle,Longint(@Buf),TypeSize);
 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
   Result : Longint;
 Begin
@@ -68,29 +52,12 @@ Begin
    InOutRes:=100;
 End;
 
-{$ENDIF TypedFile }
-
 {
   $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$
-  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:
 
   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
 
   This version requires Free Pascal 0.99.5 or higher.
@@ -34,7 +35,8 @@ unit Graph;
                               declarations here so it can be used independently
                               of the svgalib unit. Removed things that are NOT
                               part of Borland's Graph from the unit interface.
-                               
+
+
   License Conditions:
 
   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
   License along with this library; if not, write to the Free
   Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-  
+
+
   *********************************************************************}
 
 {
@@ -68,7 +71,8 @@ unit Graph;
   SetAspectRatio
   PieSlice
   Sector
-  
+
+
   (please remove what you implement fom this list)
 }
 
@@ -77,7 +81,8 @@ interface
 
 
 { ---------------------------------------------------------------------
-   Constants 
+   Constants
+
   ---------------------------------------------------------------------}
 
 const
@@ -142,7 +147,8 @@ const
 
 
 { ---------------------------------------------------------------------
-   Types 
+   Types
+
   ---------------------------------------------------------------------}
 
 
@@ -158,12 +164,15 @@ Type
   RGBColor = record
     r,g,b,i : byte;
   end;
-  
+
+
   PaletteType = record
-     Size   : integer; 
+     Size   : integer;
+
      Colors : array[0..767]of Byte;
   end;
-  
+
+
   LineSettingsType = record
      linestyle : word;
      pattern : word;
@@ -192,7 +201,8 @@ Type
      Clip : boolean;
   end;
 
-  
+
+
  const
   fillpattern : array[0..12] of FillPatternType = (
       ($00,$00,$00,$00,$00,$00,$00,$00),     { Hintergrundfarbe }
@@ -210,18 +220,20 @@ Type
       (0,0,0,0,0,0,0,0)                      { benutzerdefiniert }
      );
 
-   
+
+
 { ---------------------------------------------------------------------
-   Function Declarations 
+   Function Declarations
+
   ---------------------------------------------------------------------}
 
 { Retrieving coordinates }
-function  GetX: Integer;					
-function  GetY: Integer;					
+function  GetX: Integer;                                        
+function  GetY: Integer;                                        
 
 { Pixel-oriented routines }
 procedure PutPixel(X, Y: Integer; Pixel: Word);
-function  GetPixel(X, Y: Integer): Word;	
+function  GetPixel(X, Y: Integer): Word;        
 
 { Line-oriented primitives }
 procedure SetWriteMode(WriteMode: Integer);
@@ -245,7 +257,7 @@ procedure FloodFill(X, Y: Integer; Border: Word);
 { Nonlinearly bounded primitives }
 
 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 Ellipse(X, Y: Integer; StAngle, EndAngle: Word; 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 }
@@ -303,7 +316,7 @@ uses Objects, Linux;
  { Constants }
 const
   { VGA modes }
-  TEXT              = 0;		{ Compatible with VGAlib v1.2 }
+  TEXT              = 0;                { Compatible with VGAlib v1.2 }
   G320x200x16       = 1;
   G640x200x16       = 2;
   G640x350x16       = 3;
@@ -340,9 +353,9 @@ const
   G1024x768x16      = 30;
   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;
   G800x600x16M32    = 35;
   G1024x768x16M32   = 36;
@@ -366,7 +379,8 @@ const
   GLASTMODE         = 49;
 
   { Text }
-  
+
+
   WRITEMODE_OVERWRITE = 0;
   WRITEMODE_MASKED    = 1;
   FONT_EXPANDED       = 0;
@@ -392,7 +406,8 @@ const
      linewidth_unit: Longint;    { Use only a multiple of this as parameter for
                                    set_displaystart }
      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);
             { if aperture_size<videomemory select a memory page }
      extensions: Pointer;        { points to copy of eeprom for mach32 }
@@ -401,31 +416,35 @@ const
 
   PGraphicsContext = ^TGraphicsContext;
   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 }
  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_setmode(mode: Longint): Longint; Cdecl; External; 
+ function vga_setmode(mode: Longint): Longint; Cdecl; External;
+
 
  { gl functions }
  procedure gl_setpixel(x, y, c: LongInt); Cdecl; External;
@@ -448,14 +467,18 @@ const
  procedure gl_setwritemode(wm: LongInt); Cdecl; External;
  procedure gl_setfontcolors(bg, fg: LongInt); 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_setcontext(gc: PGraphicsContext); Cdecl; External; 
+ procedure gl_setcontext(gc: PGraphicsContext); 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
@@ -496,7 +519,7 @@ const
   vmcCopy        = 2;
   vmcSaveRestore = 4;
   vmcBuffer      = 8;
-  vmcBackPut	 = 16;
+  vmcBackPut     = 16;
 
 { ---------------------------------------------------------------------
    Graphics Vision Layer
@@ -524,8 +547,9 @@ const
 var
   sFont, sColor:Word;
   sCharSpace: Integer;
+{ Not used
   sMarker: Char;
-  sAttr: Word;
+  sAttr: Word; }
 
 { Windows-style text metric }
 type
@@ -558,10 +582,11 @@ type
 type
   PBitmap = ^TBitmap;
   TBitmap = record
-	      Width, Height: Integer;
-	      Data: record end;
-	    end;
-	    
+              Width, Height: Integer;
+              Data: record end;
+            end;
+        
+
  { Storing screen regions }
 type
   TVgaBuf = record
@@ -587,15 +612,16 @@ type
 
 
  { Procedures and functions }
- 
+
+
 procedure SetColors;
 var
   i: Integer;
 begin
   for i:=0 to 15 do
     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;
 
 procedure InitVideo;
@@ -613,8 +639,8 @@ begin
     if (VgaMode = -1) then VgaMode := G320X200X256;
     if (not vga_hasmode(VgaMode))
       then begin
-	WriteLn('BGI: Mode not available.');
-	Halt(1)
+        WriteLn('BGI: Mode not available.');
+        Halt(1)
       end;
     ModeInfo := vga_getmodeinfo(VgaMode);
     {IsVirtual := (ModeInfo^.colors = 16) or (ModeInfo^.flags and IS_MODEX <> 0);}
@@ -622,10 +648,10 @@ begin
     { We always want a back screen (for buffering). }
     if IsVirtual
       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;
     vga_setmode(VgaMode);
     gl_setcontextvga(VgaMode);  { Physical screen context. }
@@ -678,8 +704,8 @@ begin
   if not NoGraphics
     then begin
       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);}
     end;
   SetDelta
@@ -784,14 +810,14 @@ begin
   begin
     If (Q[0] = TheMarker) and DoUseMarker
       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;
     {Inc(Q)} Q := Q + 1
   end;
@@ -955,10 +981,10 @@ begin
       gl_setcontext(BackScreen);
       gl_disableclipping;
       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;
       PrepBuf := true;
       SetDrawOrigin(0, 0);
@@ -981,8 +1007,8 @@ procedure PasteRectAt(var R: Objects.TRect; P: Objects.TPoint; var Buf: TVgaBuf)
 begin
   if not NoGraphics and (BackScreen <> nil)
     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;
 
 
@@ -995,7 +1021,6 @@ end; { PasteRect }
 function StoreScreen(x1, y1, x2, y2: Integer): PScreenBuf;
 var
   s: LongInt;
-  Handle: Word;
   p: pointer;
   SaveOrigin: TPoint;
 
@@ -1027,7 +1052,7 @@ procedure FreeScreenBuf(Buf: PScreenBuf);
 Begin
   If Buf <> nil then Begin
     case Buf^.Mode of
-      2	: FreeImage(pointer(Buf^.Info));
+      2 : FreeImage(pointer(Buf^.Info));
     end;
     Dispose(Buf)
   End
@@ -1039,13 +1064,13 @@ var
 Begin
   If Buf <> nil then
     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;
 
@@ -1092,12 +1117,12 @@ end;
   ---------------------------------------------------------------------}
 
 
-function GetX: Integer;					
+function GetX: Integer;                                 
 begin
   GetX := CurX - DrawDelta.X
 end;
 
-function GetY: Integer;					
+function GetY: Integer;                                 
 begin
   GetY := CurY - DrawDelta.Y
 end;
@@ -1109,7 +1134,7 @@ begin
     then gl_setpixel(X + DrawDelta.X, Y + DrawDelta.Y, Pixel)
 end;
 
-function GetPixel(X, Y: Integer): Word;			
+function GetPixel(X, Y: Integer): Word;                 
 begin
   if NoGraphics
     then GetPixel := 0
@@ -1154,7 +1179,7 @@ procedure Line(x1, y1, x2, y2: Integer);
 begin
   if not NoGraphics
     then gl_line(x1 + DrawDelta.X, y1 + DrawDelta.Y,
-		 x2 + DrawDelta.X, y2 + DrawDelta.Y, TheColor)
+                 x2 + DrawDelta.X, y2 + DrawDelta.Y, TheColor)
 end;
 
 procedure SetLineStyle(LineStyle: Word; Pattern: Word; Thickness: Word);
@@ -1185,11 +1210,11 @@ begin
   if not NoGraphics
     then begin
       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);
       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;
 
@@ -1205,7 +1230,8 @@ begin
   end;
   Moveto(x2+depth,y1-depth);
   Lineto(x2+depth,y2-depth);
-  Lineto(x2,y2);  
+  Lineto(x2,y2);
+
 end;
 
 procedure DrawPoly(NumPoints: Word; var PolyPoints);
@@ -1243,7 +1269,7 @@ end;
 
 { Nonlinearly bounded primitives
 }
-procedure GetArcCoords(var ArcCoords: ArcCoordsType);	
+procedure GetArcCoords(var ArcCoords: ArcCoordsType);   
 
 begin
 end;
@@ -1295,7 +1321,7 @@ begin
 end;
 
 
-procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);	
+procedure GetImage(x1, y1, x2, y2: Integer; var BitMap);        
 var
   SaveClipRect: TRect;
 begin
@@ -1305,12 +1331,12 @@ begin
     Height := y2 - y1 + 1;
     if not NoGraphics
       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;
@@ -1325,20 +1351,20 @@ begin
     begin
       {gl_putbox(x + DrawDelta.X, y + DrawDelta.Y, Width, Height, @Data)}
       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);
       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; { PutImage }
 
@@ -1358,7 +1384,13 @@ end.
 
 {
   $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
 
 }

+ 2 - 2
rtl/linux/makefile

@@ -245,8 +245,8 @@ graph$(PPUEXT) : graph.pp linux$(PPUEXT) objects$(PPUEXT)
 # 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)
 	$(DEL) getopts.pp
 

+ 91 - 101
rtl/linux/syslinux.pp

@@ -33,14 +33,15 @@ Interface
 {$I heaph.inc}
 
 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
 
@@ -50,35 +51,34 @@ Type
   PLongint = ^Longint;
 
 {$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}
-
-{ 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}
 
 {*****************************************************************************
@@ -92,9 +92,8 @@ Begin
   Do_Exit;
 {$ifdef i386}
   asm
-    jmp _haltproc
+        jmp     _haltproc
   end;
-{$else}
 {$endif}
 End;
 
@@ -102,9 +101,9 @@ End;
 Function ParamCount: Longint;
 Begin
 {$ifdef crtlib}
-  ParamCount := _rtl_paramcount;
-{$else}  
-  Paramcount := argc-1
+  ParamCount:=_rtl_paramcount;
+{$else}
+  Paramcount:=argc-1
 {$endif}
 End;
 
@@ -119,7 +118,7 @@ Var
 Begin
 {$ifdef crtlib}
   _rtl_paramstr(@b, l);
-{$else}  
+{$else}
   if l>argc then
    begin
      paramstr:='';
@@ -127,20 +126,20 @@ Begin
    end;
   pp:=argv;
   i:=0;
-  while (i<l) and (pp^<>nil) do 
+  while (i<l) and (pp^<>nil) do
    begin
      pp:=pp+4;
      inc(i);
    end;
   if pp^<>nil then
    move (pp^^,b[0],255)
-  else 
+  else
    b[0]:=#0;
 {$endif}
   ParamStr:=StrPas(b);
 End;
 
-  
+
 Procedure Randomize;
 Begin
 {$ifdef crtlib}
@@ -155,45 +154,33 @@ End;
                               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}
-  asm
-    movl ___brk_addr,%eax
-    leave
-    ret
-  end ['EAX'];
-{$else}
+asm
+        movl    ___brk_addr,%eax
+end ['EAX'];
 {$endif}
-end;
 
 
-Procedure Set_brk_addr (NewAddr : longint);
-begin
+Procedure Set_brk_addr (NewAddr : longint);assembler;
 {$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}
-end;
 
 
 Function brk(Location : longint) : Longint;
 { set end of data segment to location }
-var t     : syscallregs;
-    dummy : longint;
-
+var
+  t     : syscallregs;
+  dummy : longint;
 begin
   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);
   brk:=dummy;
 end;
@@ -206,8 +193,8 @@ begin
      Set_brk_addr(brk(0));
      if Get_brk_addr=0 then
       exit(-1);
-   end; 
-  init_brk:=0; 
+   end;
+  init_brk:=0;
 end;
 
 
@@ -242,7 +229,8 @@ end;
 Procedure Errno2Inoutres;
 {
   Convert ErrNo error to the correct Inoutres value
-}  
+}
+
 begin
   if ErrNo=0 then { Else it will go through all the cases }
    exit;
@@ -261,12 +249,12 @@ begin
    Sys_ENOSPC : Inoutres:=101;
  Sys_ENAMETOOLONG,
     Sys_ELOOP,
-  Sys_ENOTDIR : Inoutres:=3;        
+  Sys_ENOTDIR : Inoutres:=3;
     Sys_EROFS : Inoutres:=150;
    Sys_EEXIST,
    Sys_EACCES : Inoutres:=5;
   Sys_ETXTBSY : Inoutres:=162;
-  end; 
+  end;
 end;
 
 
@@ -286,7 +274,7 @@ Begin
   _rtl_erase(p);
 {$else}
   sys_unlink(p);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 End;
 
@@ -297,7 +285,7 @@ Begin
   _rtl_rename(p1,p2);
 {$else }
   sys_rename(p1,p2);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 End;
 
@@ -309,7 +297,7 @@ Begin
   Do_Write:=Len;
 {$else}
   Do_Write:=sys_write(Handle,pchar(addr),len);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
   if Do_Write<0 then
    Do_Write:=0;
@@ -322,7 +310,7 @@ Begin
   Do_Read:=_rtl_read(Handle,addr,len);
 {$else}
   Do_Read:=sys_read(Handle,pchar(addr),len);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
   if Do_Read<0 then
    Do_Read:=0;
@@ -335,7 +323,7 @@ Begin
   Do_FilePos:=_rtl_filepos(Handle);
 {$else}
   Do_FilePos:=sys_lseek(Handle, 0, Seek_Cur);
-  Errno2Inoutres; 
+  Errno2Inoutres;
 {$endif}
 End;
 
@@ -375,8 +363,8 @@ Begin
   if SysCall(SysCall_nr_fstat,regs)=0 then
    Do_FileSize:=Info.Size
   else
-   Do_FileSize:=-1; 
-  Errno2Inoutres; 
+   Do_FileSize:=-1;
+  Errno2Inoutres;
 {$endif}
 End;
 
@@ -385,14 +373,14 @@ Procedure Do_Truncate(Handle,Pos:longint);
 {$ifndef crtlib}
 var
   sr : syscallregs;
-{$endif}  
+{$endif}
 begin
 {$ifndef crtlib}
   sr.reg2:=Handle;
   sr.reg3:=Pos;
   syscall(syscall_nr_ftruncate,sr);
-  Errno2Inoutres; 
-{$endif}  
+  Errno2Inoutres;
+{$endif}
 end;
 
 
@@ -429,17 +417,18 @@ Begin
    0 : begin
          oflags :=Open_RDONLY;
          FileRec(f).mode:=fminput;
-       end;      
+       end;
    1 : begin
          oflags :=Open_WRONLY;
          FileRec(f).mode:=fmoutput;
-       end;      
+       end;
+
    2 : begin
          oflags :=Open_RDWR;
          FileRec(f).mode:=fminout;
-       end;      
+       end;
   end;
-  if (flags and $100)=$100 then 
+  if (flags and $100)=$100 then
    oflags:=oflags or (Open_CREAT or Open_TRUNC)
   else
    if (flags and $10)=$10 then
@@ -453,17 +442,17 @@ Begin
       fmappend : begin
                    FileRec(f).Handle:=StdOutputHandle;
                    FileRec(f).mode:=fmoutput; {fool fmappend}
-                 end;  
+                 end;
      end;
      exit;
    end;
-{ real open call }  
+{ real open call }
 {$ifdef crtlib}
   FileRec(f).Handle:=_rtl_open(p, oflags);
   if FileRec(f).Handle<0 then
    InOutRes:=2
   else
-   InOutRes:=0; 
+   InOutRes:=0;
 {$else}
   FileRec(f).Handle:=sys_open(p,oflags,438);
   Errno2Inoutres;
@@ -565,7 +554,7 @@ var
 begin
   drivenr:=0;
   dir:='';
-{$ifndef crtlib}  
+{$ifndef crtlib}
   thedir:='/'#0;
   if sys_stat(@thedir[1],thisdir)<0 then
    exit;
@@ -594,7 +583,7 @@ begin
       exit;
      repeat
        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
           (mountpoint or (d^.ino=thisino)) then
         begin
@@ -655,8 +644,6 @@ end;
 
 
 Begin
-{ Initialize ExitProc }
-  ExitProc:=Nil;
 { Set up segfault Handler }
   InstallSegFaultHandler;
 { Setup heap }
@@ -665,15 +652,18 @@ Begin
   OpenStdIO(Input,fmInput,'stdin',StdInputHandle);
   OpenStdIO(Output,fmOutput,'stdout',StdOutputHandle);
   OpenStdIO(StdErr,fmOutput,'stderr',StdErrorHandle);
-{ Reset IO Error }  
+{ Reset IO Error }
   InOutRes:=0;
 End.
 
 {
   $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.
 }