mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 12:49:33 +02:00
* fixes for H+
This commit is contained in:
peter
parent
59c75c7410
commit
dbbdb79dfe
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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-}
|
||||
{ $8000000 creates a longint overfow !! }
|
||||
Longint = $80000000..$7fffffff;
|
||||
Longint = $80000000..$7fffffff; { $8000000 creates a longint overfow !! }
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ? }
|
||||
if (textrec(f).userdata[16]=P_TOF) then
|
||||
{ Non empty : needs printing ? }
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user