* fixes for H+

rtl/inc/objects.pp

@@ -88,7 +88,9 @@ UNIT Objects;
 
 
 {==== Compiler directives ===========================================}
-{$IFNDEF FPC}
+{$IFDEF FPC}
+  {$H-} { No ansistrings }
+{$ELSE}
 { FPC doesn't support these switches in 0.99.5 }
   {$F+} { Force far calls }
   {$A+} { Word Align Data }
@@ -2726,7 +2728,10 @@ END;
 END.
 {
   $Log$
-  Revision 1.12  1998-11-12 11:54:50  peter
+  Revision 1.13  1998-11-16 10:21:24  peter
+    * fixes for H+
+
+  Revision 1.12  1998/11/12 11:54:50  peter
     * fixed for 0.99.8
 
   Revision 1.11  1998/11/12 11:45:09  peter

rtl/inc/system.inc

@@ -256,6 +256,21 @@ End;
 {$endif RTLLITE}
 
 
+{*****************************************************************************
+                             Directory support.
+*****************************************************************************}
+
+Procedure getdir(drivenr:byte;Var dir:ansistring);
+{ this is needed to also allow ansistrings, the shortstring version is
+  OS dependent }
+var
+  s : shortstring;
+begin
+  getdir(drivenr,s);
+  dir:=s;
+end;
+
+
 {*****************************************************************************
                              Miscellaneous
 *****************************************************************************}
@@ -462,7 +477,10 @@ end;
 
 {
   $Log$
-  Revision 1.41  1998-11-05 10:29:36  pierre
+  Revision 1.42  1998-11-16 10:21:25  peter
+    * fixes for H+
+
+  Revision 1.41  1998/11/05 10:29:36  pierre
    * fix for length(char) in const expressions
 
   Revision 1.40  1998/11/04 20:34:02  michael

rtl/inc/systemh.inc

@@ -26,15 +26,23 @@
 
 {$i version.inc}
 
+{****************************************************************************
+                             Needed switches
+****************************************************************************}
+
+{$I-,Q-,H-,R-}
+
+{ Stack check gives a note under linux }
+{$ifndef linux}
+  {$S-}
+{$endif}
 
 {****************************************************************************
                          Global Types and Constants
 ****************************************************************************}
 
 Type
-{$Q-}
+  Longint  = $80000000..$7fffffff; { $8000000 creates a longint overfow !! }
-{ $8000000 creates a longint overfow !! }
-  Longint  = $80000000..$7fffffff;
   Integer  = -32768..32767;
   shortint = -128..127;
   byte     = 0..255;
@@ -379,7 +387,8 @@ Procedure SetTextBuf(Var f:Text; Var Buf; Size:Word);
 Procedure chdir(const s:string);
 Procedure mkdir(const s:string);
 Procedure rmdir(const s:string);
-Procedure getdir(drivenr:byte;Var dir:string);
+Procedure getdir(drivenr:byte;Var dir:shortstring);
+Procedure getdir(drivenr:byte;Var dir:ansistring);
 
 {*****************************************************************************
                              Miscelleaous
@@ -430,7 +439,10 @@ const
 
 {
   $Log$
-  Revision 1.40  1998-11-05 10:29:37  pierre
+  Revision 1.41  1998-11-16 10:21:26  peter
+    * fixes for H+
+
+  Revision 1.40  1998/11/05 10:29:37  pierre
    * fix for length(char) in const expressions
 
   Revision 1.39  1998/11/04 20:34:01  michael

rtl/linux/crt.pp

@@ -1082,7 +1082,7 @@ end;
 
 var
   Lastansi  : boolean;
-  AnsiCode  : string[32];
+  AnsiCode  : string;
 Procedure DoWrite(const s:String);
 {
   Write string to screen, parse most common AnsiCodes
@@ -1231,7 +1231,7 @@ Var
   Temp : String;
 Begin
   Move(F.BufPTR^[0],Temp[1],F.BufPos);
-  temp[0]:=chr(F.BufPos);
+  setlength(temp,F.BufPos);
   DoWrite(Temp);
   F.BufPos:=0;
   CrtWrite:=0;
@@ -1492,7 +1492,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.12  1998-11-10 15:01:01  peter
+  Revision 1.13  1998-11-16 10:21:27  peter
+    * fixes for H+
+
+  Revision 1.12  1998/11/10 15:01:01  peter
     * fixed GetXY at startup
 
   Revision 1.11  1998/10/30 12:11:51  peter

rtl/linux/linux.pp

@@ -2946,7 +2946,9 @@ Function Dirname(Const path:pathstr):pathstr;
   a slash.
 }
 var
-  Dir,Name,Ext : string;
+  Dir  : PathStr;
+  Name : NameStr;
+  Ext  : ExtStr;
 begin
   FSplit(Path,Dir,Name,Ext);
   if length(Dir)>1 then
@@ -2962,7 +2964,9 @@ Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
   supplied, it is cut off the filename.
 }
 var
-  Dir,Name,Ext : string;
+  Dir  : PathStr;
+  Name : NameStr;
+  Ext  : ExtStr;
 begin
   FSplit(Path,Dir,Name,Ext);
   if Suf<>Ext then
@@ -3515,7 +3519,10 @@ End.
 
 {
   $Log$
-  Revision 1.24  1998-11-10 14:57:53  peter
+  Revision 1.25  1998-11-16 10:21:28  peter
+    * fixes for H+
+
+  Revision 1.24  1998/11/10 14:57:53  peter
     * renamed rename -> FRename
 
   Revision 1.23  1998/10/30 15:47:11  peter

rtl/linux/printer.pp

@@ -15,19 +15,19 @@
 
 {   Change Log
    ----------
-  
+
    Started by Michael Van Canneyt, 1996
    (michael@tfdec1.fys.kuleuven.ac.be)
-  
+
    Current version is 0.9
-  
+
    Date          Version          Who         Comments
    1996          0.8              Michael     Initial implementation
    11/97         0.9              Peter Vreman <pfv@worldonline.nl>
-                                              Unit now depends on the 
+                                              Unit now depends on the
                                               linux unit only.
                                               Cleaned up code.
-                                                     
+
   ---------------------------------------------------------------------}
 
 Unit printer;
@@ -42,7 +42,7 @@ Const
 Var
   Lst : Text;
 
-Procedure AssignLst ( Var F : text; ToFile : string[255]);
+Procedure AssignLst ( Var F : text; ToFile : string);
 {
  Assigns to F a printing device. ToFile is a string with the following form:
  '|filename options'  : This sets up a pipe with the program filename,
@@ -51,12 +51,12 @@ Procedure AssignLst ( Var F : text; ToFile : string[255]);
               (No Quotes), which will be replaced by the PID of your program.
               When closing lst, the file will be sent to lpr and deleted.
               (lpr should be in PATH)
-                
+
  'filename|' Idem as previous, only the file is NOT sent to lpr, nor is it
              deleted.
              (useful for opening /dev/printer or for later printing)
- 
+
- Lst is set up using '/tmp/PID.lst'. You can change this behaviour at 
+ Lst is set up using '/tmp/PID.lst'. You can change this behaviour at
  compile time, setting the DefFile constant.
 }
 
@@ -65,11 +65,11 @@ Uses Linux,Strings;
 
 {
   include definition of textrec
-}    
+}
 {$i textrec.inc}
-                                                                                 
 
-Const 
+
+Const
   P_TOF   = 1; { Print to file }
   P_TOFNP = 2; { Print to File, don't spool }
   P_TOP   = 3; { Print to Pipe }
@@ -77,8 +77,8 @@ Const
 Var
   Lpr      : String[255]; { Contains path to lpr binary, including null char }
   SaveExit : pointer;
-  
+
-  
+
 Procedure PrintAndDelete (f:string);
 var
   i,j  : longint;
@@ -88,20 +88,20 @@ begin
   if lpr='' then
    exit;
   i:=Fork;
-  if i<0 then 
+  if i<0 then
    exit; { No printing was done. We leave the file where it is.}
   if i=0 then
    begin
    { We're in the child }
      getmem(p,12);
-     if p=nil then 
+     if p=nil then
       halt(127);
      pp:=p;
      pp^:=@lpr[1];
      pp:=pp+4;
      pp^:=@f[1];
      pp:=pp+4;
-     pp^:=nil;  
+     pp^:=nil;
      Execve(lpr,p,envp);
      { In trouble here ! }
      halt(128)
@@ -110,7 +110,7 @@ begin
    begin
    { We're in the parent. }
      waitpid (i,@j,0);
-     if j<>0 then 
+     if j<>0 then
       exit;
    { Erase the file }
      Unlink(f);
@@ -140,7 +140,7 @@ begin
  if i<0 then
   textrec(f).mode:=fmclosed
  else
-  textrec(f).handle:=i; 
+  textrec(f).handle:=i;
 end;
 
 
@@ -157,8 +157,8 @@ begin
      Unlink(StrPas(textrec(f).name));
      exit
    end;
-{ Non empty : needs printing ? } 
+{ Non empty : needs printing ? }
-  if (textrec(f).userdata[16]=P_TOF) then 
+  if (textrec(f).userdata[16]=P_TOF) then
    PrintAndDelete (strpas(textrec(f).name));
   textrec(f).mode:=fmclosed
 end;
@@ -203,7 +203,7 @@ begin
 {$IFDEF PRINTERDEBUG}
   writeln ('Printer : In AssignLst');
 {$ENDIF}
-  If ToFile='' then 
+  If ToFile='' then
    exit;
   textrec(f).bufptr:=@textrec(f).buffer;
   textrec(f).bufsize:=128;
@@ -250,11 +250,14 @@ begin
   rewrite(Lst);
   lpr:='/usr/bin/lpr';
 end.
-                        
+
 
 {
   $Log$
-  Revision 1.2  1998-05-06 12:35:26  michael
+  Revision 1.3  1998-11-16 10:21:29  peter
+    * fixes for H+
+
+  Revision 1.2  1998/05/06 12:35:26  michael
   + Removed log from before restored version.
 
   Revision 1.1.1.1  1998/03/25 11:18:43  root

rtl/linux/sockets.pp

@@ -36,9 +36,9 @@ Const
   AF_X25          = 9;       { Reserved for X.25 project    }
   AF_INET6        = 10;      { IP version 6                 }
   AF_MAX          = 12;
- 
+
  {  Protocol Families }
-  
+
   PF_UNSPEC       = AF_UNSPEC;
   PF_UNIX         = AF_UNIX;
   PF_INET         = AF_INET;
@@ -51,13 +51,13 @@ Const
   PF_X25          = AF_X25;
   PF_INET6        = AF_INET6;
 
-  PF_MAX          = AF_MAX;   
+  PF_MAX          = AF_MAX;
 
 const
   { Two constants to determine whether part of soket is for in or output }
   S_IN = 0;
   S_OUT = 1;
-  
+
 Type
   TSockAddr = packed Record
     family:word;  { was byte, fixed }
@@ -68,7 +68,7 @@ Type
     family:word; { was byte, fixed }
     path:array[0..108] of char;
     end;
-  
+
   TInetSockAddr = packed Record
     family:Word;
     port  :Word;
@@ -77,7 +77,7 @@ Type
     end;
 
   TSockArray = Array[1..2] of Longint;
-  
+
 Var
   SocketError:Longint;
 
@@ -149,7 +149,7 @@ Const
   Socket_Sys_GETSOCKOPT  = 15;
   Socket_Sys_SENDMSG     = 16;
   Socket_Sys_RECVMSG     = 17;
-  
+
 
 Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:longint):longint;
 var
@@ -167,7 +167,7 @@ begin
   SocketCall:=Syscall(syscall_nr_socketcall,regs);
   If SocketCall<0 then
    SocketError:=Errno
-  else 
+  else
    SocketError:=0;
 end;
 
@@ -178,11 +178,11 @@ begin
   SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
 end;
 
-  
+
 {******************************************************************************
                           Basic Socket Functions
 ******************************************************************************}
-    
+
 Function socket(Domain,SocketType,Protocol:Longint):Longint;
 begin
   Socket:=SocketCall(Socket_Sys_Socket,Domain,SocketType,ProtoCol);
@@ -282,23 +282,23 @@ Procedure OpenSock(var F:Text);
 begin
   if textrec(f).handle=UnusedHandle then
    textrec(f).mode:=fmclosed
-  else   
+  else
    case textrec(f).userdata[1] of
     S_OUT : textrec(f).mode:=fmoutput;
      S_IN : textrec(f).mode:=fminput;
    else
     textrec(f).mode:=fmclosed;
-   end;	       
+   end;
 end;
 
 
 
 Procedure IOSock(var F:text);
 begin
-  case textrec(f).mode of 
+  case textrec(f).mode of
    fmoutput : fdWrite(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufpos);
     fminput : textrec(f).BufEnd:=fdRead(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufsize);
-  end;    
+  end;
   textrec(f).bufpos:=0;
 end;
 
@@ -310,9 +310,9 @@ begin
    IOSock(f);
   textrec(f).bufpos:=0;
 end;
-      
 
-      
+
+
 Procedure CloseSock(var F:text);
 begin
   Close(f);
@@ -355,7 +355,7 @@ begin
   FileRec(SockIn).Handle:=Sock;
   FileRec(SockIn).RecSize:=1;
   FileRec(Sockin).userdata[1]:=S_IN;
-{Output}  
+{Output}
   Assign(SockOut,'.');
   FileRec(SockOut).Handle:=Sock;
   FileRec(SockOut).RecSize:=1;
@@ -396,7 +396,7 @@ begin
   AddrLen:=length(addr)+3;
   DoAccept:=Accept(Sock,UnixAddr,AddrLen);
   Move(UnixAddr.Path,Addr[1],AddrLen);
-  Addr[0]:=Chr(AddrLen);
+  SetLength(Addr,AddrLen);
 end;
 
 
@@ -420,7 +420,7 @@ begin
      Sock2Text(S,SockIn,SockOut);
      Accept:=true;
    end
-  else     
+  else
    Accept:=false;
 end;
 
@@ -436,7 +436,7 @@ begin
      Sock2File(S,SockIn,SockOut);
      Accept:=true;
    end
-  else     
+  else
    Accept:=false;
 end;
 
@@ -516,7 +516,7 @@ begin
 end;
 
 
-          
+
 Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
 var
   s : longint;
@@ -527,7 +527,7 @@ begin
      Sock2Text(S,SockIn,SockOut);
      Accept:=true;
    end
-  else     
+  else
    Accept:=false;
 end;
 
@@ -543,7 +543,7 @@ begin
      Sock2File(S,SockIn,SockOut);
      Accept:=true;
    end
-  else     
+  else
    Accept:=false;
 end;
 
@@ -554,7 +554,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  1998-07-16 10:36:45  michael
+  Revision 1.3  1998-11-16 10:21:30  peter
+    * fixes for H+
+
+  Revision 1.2  1998/07/16 10:36:45  michael
   + added connect call for inet sockets
 
   Revision 1.1.1.1  1998/03/25 11:18:43  root

rtl/linux/syslinux.pp

@@ -615,7 +615,7 @@ Begin
 End;
 
 
-procedure getdir(drivenr : byte;var dir : string);
+procedure getdir(drivenr : byte;var dir : shortstring);
 {$ifndef crtlib}
 var
   thisdir      : stat;
@@ -739,7 +739,10 @@ End.
 
 {
   $Log$
-  Revision 1.17  1998-10-15 08:30:00  peter
+  Revision 1.18  1998-11-16 10:21:32  peter
+    * fixes for H+
+
+  Revision 1.17  1998/10/15 08:30:00  peter
     + sigfpe -> runerror 200
 
   Revision 1.16  1998/09/14 10:48:27  peter