paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 10:42:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronised with trunk till r41976

Browse Source 
git-svn-id: branches/debug_eh@41977 -
This commit is contained in:
Jonas Maebe 2019-05-02 19:44:41 +00:00
commit 3a1fb45315
58 changed files with 1487 additions and 411 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11838,6 +11838,7 @@ tests/tbs/tb0653.pp svneol=native#text/plain
tests/tbs/tb0654.pp svneol=native#text/plain
tests/tbs/tb0655.pp svneol=native#text/pascal
tests/tbs/tb0656.pp svneol=native#text/pascal
tests/tbs/tb0657.pp svneol=native#text/pascal
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/tb610.pp svneol=native#text/pascal
tests/tbs/tb613.pp svneol=native#text/plain

108
compiler/aasmbase.pas
View File

@ -232,11 +232,6 @@ interface
function create_smartlink_library:boolean;inline;
function create_smartlink:boolean;inline;
function LengthUleb128(a: qword) : byte;
function LengthSleb128(a: int64) : byte;
function EncodeUleb128(a: qword;out buf) : byte;
function EncodeSleb128(a: int64;out buf) : byte;
function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
{ dummy default noop callback }
@ -285,109 +280,6 @@ implementation
end;
function LengthUleb128(a: qword) : byte;
begin
result:=0;
repeat
a := a shr 7;
inc(result);
if a=0 then
break;
until false;
end;
function LengthSleb128(a: int64) : byte;
var
b, size: byte;
asign : int64;
neg, more: boolean;
begin
more := true;
neg := a < 0;
size := sizeof(a)*8;
result:=0;
repeat
b := a and $7f;
a := a shr 7;
if neg then
begin
{ Use a variable to be sure that the correct or mask is generated }
asign:=1;
asign:=asign shl (size - 7);
a := a or -asign;
end;
if (((a = 0) and
(b and $40 = 0)) or
((a = -1) and
(b and $40 <> 0))) then
more := false;
inc(result);
if not(more) then
break;
until false;
end;
function EncodeUleb128(a: qword;out buf) : byte;
var
b: byte;
pbuf : pbyte;
begin
result:=0;
pbuf:=@buf;
repeat
b := a and $7f;
a := a shr 7;
if a<>0 then
b := b or $80;
pbuf^:=b;
inc(pbuf);
inc(result);
if a=0 then
break;
until false;
end;
function EncodeSleb128(a: int64;out buf) : byte;
var
b, size: byte;
asign : int64;
neg, more: boolean;
pbuf : pbyte;
begin
more := true;
neg := a < 0;
size := sizeof(a)*8;
result:=0;
pbuf:=@buf;
repeat
b := a and $7f;
a := a shr 7;
if neg then
begin
{ Use a variable to be sure that the correct or mask is generated }
asign:=1;
asign:=asign shl (size - 7);
a := a or -asign;
end;
if (((a = 0) and
(b and $40 = 0)) or
((a = -1) and
(b and $40 <> 0))) then
more := false
else
b := b or $80;
pbuf^:=b;
inc(pbuf);
inc(result);
if not(more) then
break;
until false;
end;
function ReplaceForbiddenAsmSymbolChars(const s: ansistring): ansistring;
var
i : longint;

22
compiler/aasmcnst.pas
View File

@ -57,7 +57,7 @@ type
protected
fval: tai;
public
constructor create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
constructor create(_def: tdef; _val: tai);
destructor destroy; override;
property val: tai read fval write setval;
end;
@ -70,7 +70,7 @@ type
{ iterator to walk over all individual items in the aggregate }
tadeenumerator = class(tobject)
private
fvalues: tfplist;
fvalues: tfpobjectlist;
fvaluespos: longint;
function getcurrent: tai_abstracttypedconst;
public
@ -81,7 +81,7 @@ type
end;
protected
fvalues: tfplist;
fvalues: tfpobjectlist;
fisstring: boolean;
{ converts the existing data to a single tai_string }
@ -93,7 +93,7 @@ type
procedure addvalue(val: tai_abstracttypedconst);
function valuecount: longint;
procedure insertvaluebeforepos(val: tai_abstracttypedconst; pos: longint);
function replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
procedure replacevalueatpos(val: tai_abstracttypedconst; pos: longint);
{ change the type to a record, regardless of how the aggregate was created;
the size of the original type and the record must match }
procedure changetorecord(_def: trecorddef);
@ -640,9 +640,9 @@ implementation
end;
constructor tai_simpletypedconst.create(_adetyp: ttypedconstkind; _def: tdef; _val: tai);
constructor tai_simpletypedconst.create(_def: tdef; _val: tai);
begin
inherited create(_adetyp,_def);
inherited create(tck_simple,_def);
fval:=_val;
end;
@ -710,7 +710,7 @@ implementation
{ the "nil" def will be replaced with an array def of the appropriate
size once we're finished adding data, so we don't create intermediate
arraydefs all the time }
fvalues.add(tai_simpletypedconst.create(tck_simple,nil,newstr));
fvalues.add(tai_simpletypedconst.create(nil,newstr));
end;
procedure tai_aggregatetypedconst.add_to_string(strtai: tai_string; othertai: tai);
@ -744,7 +744,7 @@ implementation
begin
inherited;
fisstring:=false;
fvalues:=tfplist.create;
fvalues:=tfpobjectlist.create(true);
end;
@ -794,9 +794,9 @@ implementation
end;
function tai_aggregatetypedconst.replacevalueatpos(val: tai_abstracttypedconst; pos: longint): tai_abstracttypedconst;
procedure tai_aggregatetypedconst.replacevalueatpos(val: tai_abstracttypedconst; pos: longint);
begin
result:=tai_abstracttypedconst(fvalues[pos]);
{ since fvalues owns its elements, it will automatically free the old value }
fvalues[pos]:=val;
end;
@ -831,8 +831,6 @@ implementation
var
ai: tai_abstracttypedconst;
begin
for ai in self do
ai.free;
fvalues.free;
inherited destroy;
end;

37
compiler/avr/aoptcpu.pas
View File

@ -484,6 +484,43 @@ Implementation
result:=true;
end;
end;
A_SBRS,
A_SBRC:
begin
{
Turn
in rx, y
sbr* rx, z
Into
sbi* y, z
}
if (taicpu(p).ops=2) and
(taicpu(p).oper[0]^.typ=top_reg) and
assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(p.next))) and
GetLastInstruction(p,hp1) and
(hp1.typ=ait_instruction) and
(taicpu(hp1).opcode=A_IN) and
(taicpu(hp1).ops=2) and
(taicpu(hp1).oper[1]^.typ=top_const) and
(taicpu(hp1).oper[1]^.val in [0..31]) and
MatchOperand(taicpu(hp1).oper[0]^,taicpu(p).oper[0]^.reg) and
(not RegModifiedBetween(taicpu(p).oper[0]^.reg, hp1, p)) then
begin
if taicpu(p).opcode=A_SBRS then
taicpu(p).opcode:=A_SBIS
else
taicpu(p).opcode:=A_SBIC;
taicpu(p).loadconst(0, taicpu(hp1).oper[1]^.val);
DebugMsg('Peephole InSbrx2Sbix performed', p);
asml.Remove(hp1);
hp1.free;
result:=true;
end;
end;
A_ANDI:
begin
{

90
compiler/cutils.pas
View File

@ -180,6 +180,11 @@ interface
Function nextafter(x,y:double):double;
function LengthUleb128(a: qword) : byte;
function LengthSleb128(a: int64) : byte;
function EncodeUleb128(a: qword;out buf) : byte;
function EncodeSleb128(a: int64;out buf) : byte;
{ hide Sysutils.ExecuteProcess in units using this one after SysUtils}
const
ExecuteProcess = 'Do not use' deprecated 'Use cfileutil.RequotedExecuteProcess instead, ExecuteProcess cannot deal with single quotes as used by Unix command lines';
@ -1631,6 +1636,91 @@ implementation
end;
function LengthUleb128(a: qword) : byte;
begin
result:=0;
repeat
a := a shr 7;
inc(result);
if a=0 then
break;
until false;
end;
function LengthSleb128(a: int64) : byte;
var
b, size: byte;
more: boolean;
begin
more := true;
size := sizeof(a)*8;
result:=0;
repeat
b := a and $7f;
a := SarInt64(a, 7);
if (
((a = 0) and (b and $40 = 0)) or
((a = -1) and (b and $40 <> 0))
) then
more := false;
inc(result);
if not(more) then
break;
until false;
end;
function EncodeUleb128(a: qword;out buf) : byte;
var
b: byte;
pbuf : pbyte;
begin
result:=0;
pbuf:=@buf;
repeat
b := a and $7f;
a := a shr 7;
if a<>0 then
b := b or $80;
pbuf^:=b;
inc(pbuf);
inc(result);
if a=0 then
break;
until false;
end;
function EncodeSleb128(a: int64;out buf) : byte;
var
b, size: byte;
more: boolean;
pbuf : pbyte;
begin
more := true;
size := sizeof(a)*8;
result:=0;
pbuf:=@buf;
repeat
b := a and $7f;
a := SarInt64(a, 7);
if (
((a = 0) and (b and $40 = 0)) or
((a = -1) and (b and $40 <> 0))
) then
more := false
else
b := b or $80;
pbuf^:=b;
inc(pbuf);
inc(result);
until not more;
end;
initialization
internalerrorproc:=@defaulterror;
initupperlower;

4
compiler/entfile.pas
View File

@ -609,13 +609,13 @@ end;
function tentryfile.getbyte:byte;
begin
if entryidx+1>entry.size then
if entryidx>=entry.size then
begin
error:=true;
result:=0;
exit;
end;
if bufsize-bufidx>=1 then
if bufidx<bufsize then
begin
result:=pbyte(@buf[bufidx])^;
inc(bufidx);

2
compiler/llvm/llvmtype.pas
View File

@ -410,7 +410,7 @@ implementation
symdef:=cpointerdef.getreusable(symdef);
if not equal_llvm_defs(symdef,p.def) then
begin
cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(tck_simple,symdef,tai_simpletypedconst(p).val),p.def);
cnv:=taillvm.op_reg_tai_size(la_bitcast,NR_NO,tai_simpletypedconst.create(symdef,tai_simpletypedconst(p).val),p.def);
tai_simpletypedconst(p).val:=cnv;
end;
end;

15
compiler/llvm/nllvmtcon.pas
View File

@ -164,15 +164,12 @@ implementation
procedure tllvmtypedconstplaceholder.replace(ai: tai; d: tdef);
var
oldconst: tai_abstracttypedconst;
begin
if d<>def then
internalerror(2015091002);
oldconst:=agginfo.aggai.replacevalueatpos(
tai_simpletypedconst.create(tck_simple,d,ai),pos
agginfo.aggai.replacevalueatpos(
tai_simpletypedconst.create(d,ai),pos
);
oldconst.free;
end;
@ -257,7 +254,7 @@ implementation
function tllvmtai_typedconstbuilder.wrap_with_type(p: tai; def: tdef): tai;
begin
result:=tai_simpletypedconst.create(tck_simple,def,p);
result:=tai_simpletypedconst.create(def,p);
end;
@ -294,7 +291,7 @@ implementation
begin
kind:=tck_simple;
{ finalise the queued expression }
ai:=tai_simpletypedconst.create(kind,def,p);
ai:=tai_simpletypedconst.create(def,p);
{ set the new index to -1, so we internalerror should we try to
add anything further }
update_queued_tai(def,ai,ai,-1);
@ -305,7 +302,7 @@ implementation
fqueued_tai:=nil;
end
else
stc:=tai_simpletypedconst.create(tck_simple,def,p);
stc:=tai_simpletypedconst.create(def,p);
info:=tllvmaggregateinformation(curagginfo);
{ these elements can be aggregates themselves, e.g. a shortstring can
be emitted as a series of bytes and string data arrays }
@ -359,7 +356,7 @@ implementation
fillbytes:=info.prepare_next_field(def);
while fillbytes>0 do
begin
info.aggai.insertvaluebeforepos(tai_simpletypedconst.create(tck_simple,u8inttype,tai_const.create_8bit(0)),info.anonrecalignpos);
info.aggai.insertvaluebeforepos(tai_simpletypedconst.create(u8inttype,tai_const.create_8bit(0)),info.anonrecalignpos);
dec(fillbytes);
end;
end;

17
packages/amunits/src/coreunits/agraphics.pas
View File

@ -134,7 +134,6 @@ type
_p1,
_p2 : Pointer; { system reserved }
reserved : Longint; { system use }
Flags : Longint; { only exists in layer allocation }
end;
pLayer = ^tLayer;
@ -158,7 +157,7 @@ type
cr2,
crnew : pClipRect; { used by dedice }
SuperSaveClipRects : pClipRect; { preallocated cr's }
cliprects : pClipRect; { system use during refresh }
_cliprects : pClipRect; { system use during refresh }
LayerInfo : Pointer; { points to head of the list }
Lock : tSignalSemaphore;
BackFill : pHook;
@ -391,8 +390,8 @@ type
pCopList = ^tCopList;
tCopList = record
Next : pCopList; { next block for this copper list }
CopList : pCopList; { system use }
ViewPort : Pointer; { system use }
_CopList : pCopList; { system use }
_ViewPort : Pointer; { system use }
CopIns : pCopIns; { start of this block }
CopPtr : pCopIns; { intermediate ptr }
CopLStart : psmallint; { mrgcop fills this in for Long Frame}
@ -418,8 +417,8 @@ type
fm0 : array [0..1] of word;
diwstart : array [0..9] of word;
bplcon2 : array [0..1] of word;
sprfix : array [0..(2*8)] of word;
sprstrtup : Array [0..(2*8*2)] of Word;
sprfix : array [0..(2*8-1)] of word;
sprstrtup : Array [0..(2*8*2-1)] of Word;
wait14 : array [0..1] of word;
norm_hblank : array [0..1] of word;
jump : array [0..1] of word;
@ -1147,7 +1146,7 @@ Type
pColorMap = ^tColorMap;
tColorMap = record
Flags : Byte;
CType : Byte; { This is "Type" in C includes }
Type_ : Byte; { This is "Type" in C includes }
Count : Word;
ColorTable : Pointer;
cm_vpe : pViewPortExtra;
@ -1739,7 +1738,7 @@ Type
pQueryHeader = ^tQueryHeader;
tQueryHeader = record
tructID, { datachunk type identifier }
StructID, { datachunk type identifier }
DisplayID, { copy of display record key }
SkipID, { TAG_SKIP -- see tagitems.h }
Length : ULONG; { length of local data in double-longwords }
@ -1878,7 +1877,7 @@ Type
Header : tQueryHeader;
Vec : Pointer;
Data : Pointer;
vi_Type : WORD; { Type in C Includes }
Type_ : WORD; { Type in C Includes }
pad : Array[0..2] of WORD;
reserved : Array[0..1] of ULONG;
end;

2
packages/amunits/src/coreunits/clipboard.pas
View File

@ -13,7 +13,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$PACKRECORDS 2}
unit clipboard;
INTERFACE

8
packages/amunits/src/coreunits/intuition.pas
View File

@ -2433,7 +2433,7 @@ Type
ViewInitX,
ViewInitY : smallint; { View initial offset values }
EnableCLI : Boolean; { CLI availability switch }
EnableCLI : WordBool; { CLI availability switch }
{ printer configurations }
PrinterType : Word; { printer type }
@ -3905,8 +3905,8 @@ Type
pSGWork = ^tSGWork;
tSGWork = record
{ set up when gadget is first activated }
Gad : pGadget; { the contestant itself } { Gadget in C-Includes }
StrInfo : pStringInfo; { easy access to sinfo } { StrInfo in C-Includes }
Gadget : pGadget; { the contestant itself } { Gadget in C-Includes }
StringInfo : pStringInfo; { easy access to sinfo } { StrInfo in C-Includes }
WorkBuffer : STRPTR; { intuition's planned result }
PrevBuffer : STRPTR; { what was there before }
Modes : ULONG; { current mode }
@ -3919,7 +3919,7 @@ Type
Actions : ULONG; { what Intuition will do }
LongInt_ : Longint; { temp storage for longint }
GInfo : pGadgetInfo; { see cghooks.h } { GadgetInfo in C-Includes }
GadgetInfo : pGadgetInfo; { see cghooks.h } { GadgetInfo in C-Includes }
EditOp : Word; { from constants below }
END;

26
packages/arosunits/src/agraphics.pas
View File

@ -341,7 +341,7 @@ type
// SYSTEM VARIABLES
NextVSprite: PVSprite; // GEL linked list forward/backward pointers sorted by y,x value
PrevVSprite: PVSprite;
DrawPath: PVSprite; // pointer of overlay drawing
IntVSprite: PVSprite; // pointer of overlay drawing
ClearPath: PVSprite; // pointer for overlay clearing
OldY, OldX: SmallInt; // previous position
// COMMON VARIABLES
@ -564,10 +564,10 @@ type
PShapeHookMsg = ^TShapeHookMsg;
TShapeHookMsg = record
Action: LongInt;
Layer: PLayer;
ActualShape: PRegion;
NewBounds: TRectangle;
OldBounds: TRectangle;
NewShape: PRegion;
OldShape: PRegion;
NewBounds: PRectangle;
OldBounds: PRectangle;
end;
// Hook for getting LA_ShapeHook and getting this Msg
TShapeHookProc = function(Hook: PHook; Layer: PLayer; Msg: PShapeHookMsg): PRegion; cdecl;
@ -990,19 +990,19 @@ type
// Copper structures
PCopIns = ^TCopIns;
TCopIns = record
OpCode : smallint; // 0 = move, 1 = wait
OpCode: smallint; // 0 = move, 1 = wait
case SmallInt of
0:(
NxtList: PCopList;
);
1:(
VWaitPos: SmallInt; // vertical wait position
DestAddr: SmallInt; // destination Pointer
DestData: SmallInt; // data to send
);
2:(
HWaitPos: SmallInt; // horizontal wait position
DestData: SmallInt; // data to send
);
VWaitPos: SmallInt; // vertical wait position
HWaitPos: SmallInt; // horizontal wait position
);
end;
TCopList = record
@ -1994,9 +1994,9 @@ type
VBCounter: ULONG;
HashTableSemaphore: PSignalSemaphore; // Semaphore for hash_table access, private in fact
ChunkyToPlanarPtr: PLongWord; // HWEmul[0];
HWEmul: array[1..8] of PLongWord;
case boolean of
true: ( ChunkyToPlanarPtr: PLongWord;); // HWEmul[0];
false: (HWEmul: array[0..8] of PLongWord;);
end;
type

45
packages/arosunits/src/amigados.pas
View File

@ -848,12 +848,6 @@ type
dl_DiskType: LongInt; // 'DOS', etc
dl_unused: BPTR;
dl_Name: BSTR; // bptr to bcpl name
{$ifdef aros}
{$ifndef AROS_DOS_PACKETS}
dl_Reserved: array[0..5] of IPTR;
dl_AROS: TDosListAROSExt;
{$endif}
{$endif}
end;
{ device structure (same as the DeviceNode structure in filehandler.h) }
@ -874,12 +868,6 @@ type
dvi_GlobVec: BSTR;
{$endif}
dvi_Name: BSTR;
{$ifdef aros}
{$ifndef AROS_DOS_PACKETS}
dvi_Reserved: array[0..5] of IPTR;
dvi_AROS: TDosListAROSExt;
{$endif}
{$endif}
end;
const
@ -1165,12 +1153,6 @@ type
* vector for you.
}
dn_Name: BSTR; { the node name, e.g. '\3','D','F','3' }
{$ifdef aros}
{$ifndef AROS_DOS_PACKETS}
dn_Reserved: array[0..5] of IPTR; // Private extensions Should not be used in user land code.
dn_AROS: TDosListAROSExt;
{$endif}
{$endif}
end;
type
@ -1518,39 +1500,16 @@ type
TDosLibrary = record
dl_lib: TLibrary;
dl_Root: PRootNode; // Pointer to RootNode, described below }
{$ifdef AROS_BINCOMPAT}
dl_GV: APTR; // Pointer to BCPL global vector }
dl_A2: LongInt; // Private register dump of DOS }
dl_A5: LongInt;
dl_A6: LongInt;
{$endif}
dl_Errors: PErrorString; // pointer to array of error msgs
dl_TimeReq: PTimeRequest; // private pointer to timer request
dl_UtilityBase : PLibrary; // private ptr to utility library
dl_IntuitionBase : PLibrary;
{ These were AROS-specific private fields. At the moment they are mostly not used
and are present only for binary compatibility with programs that used dl_Flags
(Directory Opus for example). Do not try to use them in any way!}
{$ifdef aros}
dl_TimerBase: PDevice;
dl_TimerIO: TTimeRequest;
dl_DevInfo: PDosList;
dl_SysBase: PExecBase;
dl_SegList: BPTR;
dl_NulHandler: PDevice;
dl_NulLock: PUnit;
// LDDemon (library loader) private data
dl_LDObjectsListSigSem: TSignalSemaphore;
dl_LDObjectsList: TList;
dl_LDHandler: TInterrupt;
dl_LDDemonPort: PMsgPort;
dl_LDDemonTask: PProcess;
dl_LDReturn: ULONG;
//* AROS-specific and private. Can go away in future.
dl_SYSLock: BPTR;
// The flags are ORed with RootNode^.rn_Flags. See below for definitions.
dl_Flags: ULONG;
{$endif}
end;
const

2
packages/arosunits/src/datatypes.pas
View File

@ -781,8 +781,8 @@ type
TAnimHeader = record
ah_Operation: Byte;
ah_Mask: Byte;
ah_Height: Word;
ah_Width: Word;
ah_Height: Word;
ah_Left: SmallInt;
ah_Top: SmallInt;
ah_AbsTime: LongWord;

8
packages/arosunits/src/intuition.pas
View File

@ -1471,7 +1471,7 @@ type
ViewInitX,
ViewInitY: SmallInt; // View initial offset values
EnableCLI: LongBool; // CLI availability switch
EnableCLI: WordBool; // CLI availability switch
// printer configurations
PrinterType: Word; // printer type
@ -1663,11 +1663,11 @@ type
Screens are then maintained in a front to back order using Screen.NextScreen }
Flags: LongWord; // see definitions below
{$ifdef AROS_BINCOMPAT}
MouseX,
MouseY: SmallInt; // mouse position relative to View
{$else}
MouseY,
MouseX: SmallInt; // mouse position relative to View
{$else}
MouseX,
MouseY: SmallInt; // mouse position relative to View
{$endif}
Seconds: LongWord; // timestamp of most current input event

1
packages/arosunits/src/locale.pas
View File

@ -12,7 +12,6 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$PACKRECORDS 2}
unit locale;

1
packages/arosunits/src/serial.pas
View File

@ -17,7 +17,6 @@
unit serial;
interface
{$PACKRECORDS 2}
uses
exec;

10
packages/arosunits/src/workbench.pas
View File

@ -237,7 +237,7 @@ type
ism_Drawer: BPTR; // Lock on the drawer this object resides in, NULL for Workbench backdrop (devices).
ism_Name: STRPTR; // Name of the object in question.
ism_type: Word; // One of WBDISK, WBDRAWER, WBTOOL, WBPROJECT, WBGARBAGE, WBDEVICE, WBKICK or WBAPPICON.
ism_Selected: LongBool; // TRUE if currently selected, FALSE otherwise.
ism_Selected: WordBool; // TRUE if currently selected, FALSE otherwise.
ism_Tags: PTagItem; // Pointer to the list of tag items passed to ChangeWorkbenchSelectionA().
ism_DrawerWindow: PWindow; // Pointer to the window attached to this icon, if the icon is a drawer-like object.
ism_ParentWindow: PWindow; // Pointer to the window the icon resides in.
@ -536,20 +536,22 @@ type
TWBHandlerMessage = record
wbhm_Message: TMessage; // Standard message structure.
wbhm_type: TWBHM_type; // type of message.
wbhm_Data: record
case integer of
0 :
(
Open: record
OpenName: STRPTR; // Name of the drawer.
Name: STRPTR; // Name of the drawer.
end;
);
1 :
(
Update: record
UpdateName: STRPTR; // Mame of the object.
Updatetype: LongInt; // type of object (WBDRAWER, WBPROJECT, ...).
Name: STRPTR; // Mame of the object.
Type_: LongInt; // type of object (WBDRAWER, WBPROJECT, ...).
end;
);
end;
end;

15
packages/fcl-db/src/sqldb/odbc/odbcconn.pas
View File

@ -939,7 +939,7 @@ begin
ColNameDefaultLength+1, // and its length; we include the #0 terminating any ansistring of Length > 0 in the buffer
ColNameLength, // actual column name length
DataType, // the SQL datatype for the column
ColumnSize, // column size
ColumnSize, // column size (in characters)
DecimalDigits, // number of decimal digits
Nullable), // SQL_NO_NULLS, SQL_NULLABLE or SQL_NULLABLE_UNKNOWN
SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get column properties for column %d.',[i]
@ -969,8 +969,8 @@ begin
SQL_CHAR: begin FieldType:=ftFixedChar; FieldSize:=ColumnSize; end;
SQL_VARCHAR: begin FieldType:=ftString; FieldSize:=ColumnSize; end;
SQL_LONGVARCHAR: begin FieldType:=ftMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
SQL_WCHAR: begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
SQL_WVARCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
SQL_WCHAR: begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize; end;
SQL_WVARCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize; end;
SQL_SS_XML,
SQL_WLONGVARCHAR: begin FieldType:=ftWideMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
SQL_DECIMAL: begin FieldType:=ftFloat; FieldSize:=0; end;
@ -1120,10 +1120,7 @@ begin
end;
// add FieldDef
with FieldDefs.Add(FieldDefs.MakeNameUnique(ColName), FieldType, FieldSize, (Nullable=SQL_NO_NULLS) and (AutoIncAttr=SQL_FALSE), i) do
begin
if Updatable = SQL_ATTR_READONLY then Attributes := Attributes + [faReadonly];
end;
AddFieldDef(FieldDefs, i, ColName, FieldType, FieldSize, -1, False, (Nullable=SQL_NO_NULLS) and (AutoIncAttr=SQL_FALSE), Updatable=SQL_ATTR_READONLY);
end;
end;
@ -1166,9 +1163,9 @@ begin
// TODO: finish this
case FieldDef.DataType of
ftWideString,ftFixedWideChar: // mapped to TWideStringField
Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size+sizeof(WideChar), @StrLenOrInd); //buffer must contain space for the null-termination character
Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_WCHAR, buffer, FieldDef.Size*FieldDef.CharSize+sizeof(WideChar), @StrLenOrInd); //buffer must contain space for the null-termination character
ftGuid, ftFixedChar,ftString: // are mapped to a TStringField (including TGuidField)
Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size+1, @StrLenOrInd);
Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_CHAR, buffer, FieldDef.Size*FieldDef.CharSize+1, @StrLenOrInd);
ftSmallint: // mapped to TSmallintField
Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_SSHORT, buffer, SizeOf(Smallint), @StrLenOrInd);
ftInteger,ftAutoInc: // mapped to TLongintField

24
packages/fcl-registry/src/winreg.inc
View File

@ -42,6 +42,17 @@ begin
Result:=(S='') or (S[1]<>'\')
end;
function RegDataWordToRegDataType(RD: DWORD): TRegDataType;
begin
// Test in ascending because rdString is most commonly used
Result := Succ(Low(RegDataWords));
repeat
if RegDataWords[Result] = RD then
Exit;
Inc(Result);
until Result > High(Result);
Result := Low(RegDataWords);
end;
function TRegistry.sysCreateKey(Key: UnicodeString): Boolean;
Var
@ -95,9 +106,7 @@ begin
Result:=-1
else
begin
RegData:=High(TRegDataType);
While (RegData>rdUnknown) and (RD<>RegDataWords[RegData]) do
RegData:=Pred(RegData);
RegData:=RegDataWordToRegDataType(RD);
Result:=BufSize;
end;
end;
@ -110,15 +119,10 @@ Var
begin
With Value do
begin
FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(ValueName),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(ValueName),Nil,@RD,Nil,lpdword(@DataSize));
Result:=FLastError=ERROR_SUCCESS;
if Result then
begin
RD:=DWord(RegData);
RegData:=High(TRegDataType);
While (RegData>rdUnknown) and (RD<>RegDataWords[RegData]) do
RegData:=Pred(RegData);
end;
RegData:=RegDataWordToRegDataType(RD);
end;
If Not Result Then
begin

4
packages/fcl-web/src/base/restbase.pp
View File

@ -717,7 +717,7 @@ begin
TStringArray(AP)[I]:=AValue.Strings[i];
end;
else
Raise ERESTAPI.CreateFmt('%s: unsupported array element type : ',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
Raise ERESTAPI.CreateFmt('%s: unsupported array element type : %s',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
end;
end;
end;
@ -1041,7 +1041,7 @@ begin
For I:=0 to Length(TStringArray(AP))-1 do
A.Add(TJSONString.Create(TStringArray(AP)[I]));
else
Raise ERESTAPI.CreateFmt('%s: unsupported array element type : ',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
Raise ERESTAPI.CreateFmt('%s: unsupported array element type : %s',[ClassName,GetEnumName(TypeInfo(TTypeKind),Ord(ET^.Kind))]);
end;
end;

30
packages/fpmkunit/src/fpmkunit.pp
View File

@ -518,6 +518,8 @@ Type
Property RequireChecksum : Cardinal Read FRequireChecksum Write FRequireChecksum;
end;
TResourceFile = Class(TConditionalString);
{ TPackageVariant }
TPackage = Class;
@ -588,6 +590,13 @@ Type
Property Dependencies[Index : Integer] : TDependency Read GetDependency Write SetDependency; default;
end;
{ TResourceFiles }
TResourceFiles = Class(TConditionalStrings)
public
Procedure GetInstallFiles(AList : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
end;
{ TTarget }
TTarget = Class(TNamedItem)
@ -606,6 +615,7 @@ Type
FUnitPath,
FIncludePath : TConditionalStrings;
FDependencies : TDependencies;
FResourceFiles : TResourceFiles;
FCommands : TCommands;
FDirectory: String;
FExtension: String;
@ -646,6 +656,7 @@ Type
Procedure GetInstallFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
Procedure GetArchiveFiles(List : TStrings; ACPU:TCPU; AOS : TOS); virtual;
Property Dependencies : TDependencies Read FDependencies;
Property ResourceFiles: TResourceFiles read FResourceFiles;
Property Commands : TCommands Read FCommands;
Property State : TTargetState Read FTargetState;
Property TargetType : TTargetType Read FTargetType Write FTargetType;
@ -2820,6 +2831,21 @@ begin
Result := GPluginManager;
end;
{ TResourceFiles }
procedure TResourceFiles.GetInstallFiles(AList: TStrings; const APrefixU, APrefixB: String; ACPU: TCPU; AOS: TOS);
Var
I : Integer;
R : TResourceFile;
begin
For I:=0 to Count-1 do
begin
R:=Tobject(Items[I]) as TResourceFile;
if (ACPU in R.CPUs) and (AOS in R.OSes) then
AList.Add(ConcatPaths([APrefixU, R.Value]));
end;
end;
{ TfpmResolvePackagePathsPlugin }
procedure TfpmResolvePackagePathsPlugin.ResolveUnitConfigFilenameForBasePath(
@ -8561,6 +8587,7 @@ begin
FIncludePath:=TConditionalStrings.Create(TConditionalString);
FObjectPath:=TConditionalStrings.Create(TConditionalString);
FDependencies:=TDependencies.Create(TDependency);
FResourceFiles:=TResourceFiles.Create(TResourceFile);
FCommands:=TCommands.Create(TCommand);
end;
@ -8571,6 +8598,7 @@ begin
FreeAndNil(FObjectPath);
FreeAndNil(FIncludePath);
FreeAndNil(FDependencies);
FreeAndNil(FResourceFiles);
FreeAndNil(FCommands);
FreeAndNil(Foptions);
inherited Destroy;
@ -8597,6 +8625,7 @@ begin
DestTarget.FileType := FileType;
DestTarget.Directory := Directory;
DestTarget.ResourceStrings := ResourceStrings;
DestTarget.ResourceFiles.Assign(ResourceFiles);
DestTarget.Install := Install;
DestTarget.FTargetSourceFileName := fTargetSourceFileName;
DestTarget.ObjectPath.Assign(ObjectPath);
@ -8859,6 +8888,7 @@ begin
List.Add(APrefixU + RSTFileName);
end;
end;
FResourceFiles.GetInstallFiles(List, APrefixU, APrefixB, ACPU, AOS);
end;

36
packages/morphunits/src/agraphics.pas
View File

@ -129,7 +129,29 @@ type
_p1,
_p2 : APTR; // system reserved
reserved: LongInt; // system use
Flags : LongInt; // only exists in layer allocation
end;
PLayer_Info = ^TLayer_Info;
TLayer_Info = record
Top_Layer: Player;
check_lp: PLayer;
Obs: PClipRect;
FreeClipRects: PClipRect;
PrivateReserve1: LongInt;
PrivateReserve2: LongInt;
Lock: TSignalSemaphore;
gs_Head: TMinList;
PrivateReserve3: SmallInt;
PrivateReserve4: APTR;
Flags: Word; // LIFLG_SUPPORTS_OFFSCREEN_LAYERS
fatten_count: ShortInt;
LockLayersCount: ShortInt;
PrivateReserve5: SmallInt;
BlankHook: APTR;
LayerInfo_extra: APTR;
end;
@ -275,12 +297,12 @@ type
NxtList: PCopList;
);
1:(
VWaitPos: SmallInt; // vertical wait position
DestAddr: SmallInt; // destination Pointer
DestData: SmallInt; // data to send
);
2:(
VWaitPos: SmallInt; // vertical wait position
HWaitPos: SmallInt; // horizontal wait position
DestData: SmallInt; // data to send
);
end;
@ -288,7 +310,7 @@ type
PCprList = ^TCprList;
TCprList = record
Next: PCprList;
Start: Word; // start of copper list
Start: PWord; // start of copper list
MaxCount: SmallInt; // number of long instructions
end;
@ -1903,9 +1925,9 @@ type
VBCounter: LongWord;
HashTableSemaphore: PSignalSemaphore; // Semaphore for hash_table access, private in fact
ChunkyToPlanarPtr: PLongWord; // HWEmul[0];
HWEmul: array[1..8] of PLongWord;
case boolean of
true: ( ChunkyToPlanarPtr: PLongWord;); // HWEmul[0];
false: (HWEmul: array[0..8] of PLongWord;);
end;
const

4
packages/morphunits/src/amigados.pas
View File

@ -546,7 +546,7 @@ type
PErrorString = ^TErrorString;
TErrorString = packed record
estr_Nums: PLongInt;
estr_Byte: PByte;
estr_Strings: PByte;
end;
type
@ -852,7 +852,7 @@ type
ap_Reserved : ShortInt;
ap_Strlen : SmallInt;
ap_Info : TFileInfoBlock;
ap_Buf : Array[0..0] of Char;
ap_Buf : Array[0..1] of Char;
{ * an_Buf continues * }
);
end;

7
packages/morphunits/src/datatypes.pas
View File

@ -629,6 +629,13 @@ Type
dtd_AttrList : pTagItem; { Additional attributes }
end;
// DTM_RELEASERAWINFO
PdtReleaseDrawInfo = ^TdtReleaseDrawInfo;
TdtReleaseDrawInfo = record
MethodID: PtrUInt;
dtr_Handle: APTR; // Handle as returned by DTM_OBTAINDRAWINFO
end;
{ DTM_WRITE }
pdtWrite = ^tdtWrite;
tdtWrite = record

4
packages/morphunits/src/exec.pas
View File

@ -1071,7 +1071,7 @@ type
lib_Node : TNode;
lib_Flags : Byte;
lib_pad : Byte;
lib_MegSize : Word;
lib_NegSize : Word;
lib_PosSize : Word;
lib_Version : Word;
lib_Revision: Word;
@ -1418,7 +1418,7 @@ type
PortList : TList;
TaskReady : TList;
TaskWait : TList;
SoftInts : Array[0..5] Of TSoftIntList;
SoftInts : Array[0..4] Of TSoftIntList;
LastAlert : Array[0..3] Of LongInt;
VBlankFrequency : Byte;

4
packages/morphunits/src/intuition.pas
View File

@ -1707,7 +1707,7 @@ type
ViewInitX,
ViewInitY: SmallInt; // View initial offset values
EnableCLI: LongBool; // CLI availability switch
EnableCLI: WordBool; // CLI availability switch
// printer configurations
PrinterType: Word; // printer type
@ -2075,8 +2075,6 @@ type
cl_SubclassCount: LongWord; // number of direct subclasses
cl_ObjectCount: LongWord; // number of instances
cl_Flags: LongWord; // Flags (CLF_INLIST)
cl_ObjectSize: LongWord; // cl_InstOffset + cl_InstSize + SizeOf(_Object)
cl_MemoryPool: APTR;
end;
const

4
packages/morphunits/src/utility.pas
View File

@ -140,8 +140,8 @@ const
type
PUtilityBase = ^TUtilityName;
TUtilityName = packed record
PUtilityBase = ^TUtilityBase;
TUtilityBase = packed record
ub_LibNode : TLibrary;
ub_Language: Byte;
ub_Reserved: Byte;

258
packages/rtl-objpas/src/inc/dateutil.inc
View File

@ -440,6 +440,24 @@ Function LocalTimeToUniversal(LT: TDateTime; TZOffset: Integer): TDateTime;
function ScanDateTime(const Pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; overload;
function ScanDateTime(const Pattern:string;const s:string;startpos:integer=1) : tdatetime; overload;
// ISO date/time
// YYYYMMDD or YYYY-MM-DD
function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
// HH HH:NN HH:NN:SS HH:NN:SS.ZZZ or HHNN HHNNSS HHNNSS.ZZZ
function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
// Combination of previous
function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
// Z +hh:nn -hh:nn
Function TryISOTZStrToTZOffset(TZ : String; Out TZOffset : Integer) : boolean;
// ISO 8601 Date/Time formatting
function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean): TDateTime;
Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime): TDateTime;
Function TryISO8601ToDate(const DateString: string; ReturnUTC : Boolean;out ADateTime: TDateTime) : Boolean;
implementation
uses sysconst;
@ -2678,6 +2696,246 @@ begin
Result := LT;
end;
Const
FmtUTC = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz';
FmtUTCTZ = 'hh":"mm';
function DateToISO8601(const ADate: TDateTime; AInputIsUTC: Boolean = True): string;
const
FmtOffset: string = '%.02d:%.02d';
Sign: array[Boolean] of Char = ('+', '-');
var
Offset: Integer;
begin
Result := FormatDateTime(FmtUTC, ADate);
Offset := GetLocalTimeOffset;
if AInputIsUTC or (Offset=0) then
Result:=Result+'Z'
else
begin
Result:=Result+Sign[Offset>0];
Offset := Abs(Offset);
Result:= Result+Format(FmtOffset, [Offset div MinsPerHour, Offset mod MinsPerHour]);
end;
end;
function TryISOStrToDate(const aString: string; out outDate: TDateTime): Boolean;
var
xYear, xMonth, xDay: LongInt;
begin
case Length(aString) of
8: Result :=
TryStrToInt(Copy(aString, 1, 4), xYear) and
TryStrToInt(Copy(aString, 5, 2), xMonth) and
TryStrToInt(Copy(aString, 7, 2), xDay) and
TryEncodeDate(xYear, xMonth, xDay, outDate);
10: Result :=
TryStrToInt(Copy(aString, 1, 4), xYear) and
TryStrToInt(Copy(aString, 6, 2), xMonth) and
TryStrToInt(Copy(aString, 9, 2), xDay) and
TryEncodeDate(xYear, xMonth, xDay, outDate);
else
Result := False;
end;
if not Result then
outDate := 0;
end;
function TryISOStrToTime(const aString: string; Out outTime: TDateTime): Boolean;
var
xHour, xMinute, xSecond, xMillisecond, xLength: LongInt;
begin
Result := True;
xLength := Length(aString);
if (xLength>0) and (aString[xLength] = 'Z') then
begin
Dec(xLength);
end else
if (xLength>6) and CharInSet(aString[xLength-5], ['+', '-']) then
begin
Result :=
TryStrToInt(Copy(aString, xLength-4, 2), xHour) and
(aString[xLength-2] = ':') and
TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
Dec(xLength, 6);
end else
if (xLength>5) and CharInSet(aString[xLength-4], ['+', '-']) then
begin
Result :=
TryStrToInt(Copy(aString, xLength-3, 2), xHour) and
TryStrToInt(Copy(aString, xLength-1, 2), xMinute);
Dec(xLength, 5);
end else
if (xLength>3) and CharInSet(aString[xLength-2], ['+', '-']) then
begin
Result :=
TryStrToInt(Copy(aString, xLength-1, 2), xHour);
Dec(xLength, 3);
end;
if not Result then
begin
outTime := 0;
Exit;
end;
case xLength of
2: Result :=
TryStrToInt(aString, xHour) and
TryEncodeTime(xHour, 0, 0, 0, outTime);
4: Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryEncodeTime(xHour, xMinute, 0, 0, outTime);
5: Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and
TryStrToInt(Copy(aString, 4, 2), xMinute) and
TryEncodeTime(xHour, xMinute, 0, 0, outTime);
6: Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryStrToInt(Copy(aString, 5, 2), xSecond) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
8: Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and
TryStrToInt(Copy(aString, 4, 2), xMinute) and
(aString[6] = ':') and
TryStrToInt(Copy(aString, 7, 2), xSecond) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
10: Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryStrToInt(Copy(aString, 5, 2), xSecond) and
(aString[7] = '.') and
TryStrToInt(Copy(aString, 8, 3), xMillisecond) and
TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
12: Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and
TryStrToInt(Copy(aString, 4, 2), xMinute) and
(aString[6] = ':') and
TryStrToInt(Copy(aString, 7, 2), xSecond) and
(aString[9] = '.') and
TryStrToInt(Copy(aString, 10, 3), xMillisecond) and
TryEncodeTime(xHour, xMinute, xSecond, xMillisecond, outTime);
else
Result := False;
end;
if not Result then
outTime := 0;
end;
function TryISOStrToDateTime(const aString: string; out outDateTime: TDateTime): Boolean;
var
xLength: Integer;
sDate,sTime : String;
xDate, xTime: TDateTime;
begin
xLength := Length(aString);
if (xLength>11) and CharInSet(aString[11], [' ', 'T']) then
begin
sDate:=Copy(aString, 1, 10);
sTime:=Copy(aString, 12, Length(aString))
end
else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then
begin
sDate:=Copy(aString, 1, 8);
sTime:=Copy(aString, 10, Length(aString));
end
else
exit(False);
Result:=TryISOStrToDate(sDate, xDate) and TryISOStrToTime(sTime, xTime);
if Result then
outDateTime := xDate+xTime
else
outDateTime := 0;
end;
Function TryISOTZStrToTZOffset(TZ : String; Out TZOffset : Integer) : boolean;
Var
H,M : LongInt;
begin
Result:=(TZ='Z') or (TZ='');
if Result then
TZOffset:=0
else
begin
Result:=TZ[1] in ['+','-'];
if Not Result then
Exit;
Result:=TryStrToInt(Copy(TZ,2,2),H) and TryStrToInt(Copy(TZ,5,2),M);
if not Result then
exit;
TZOffset:=H*60+M;
if (TZ[1]='+') then
TZOffset:=-TZOffset;
end;
end;
Function ISOTZStrToTZOffset(TZ : String) : Integer;
begin
if not TryISOTZStrToTZOffSet(TZ,Result) then
Raise EConvertError.CreateFmt('Invalid ISO timezone string',[TZ]);
end;
Function TryISO8601ToDate(const DateString: string; ReturnUTC : Boolean;out ADateTime: TDateTime) : Boolean;
Var
S,TZ : String;
L,Offset,TZOffset : Integer;
begin
S:=DateString;
L:=Length(S);
if L=0 then
exit(False);
if S[L]='Z' then
begin
TZ:='Z';
S:=Copy(S,1,L-1);
end
else If (L>5) and (S[L-5] in ['+','-']) then
begin
TZ:=Copy(S,L-5,6);
S:=Copy(S,1,L-6);
end;
Result:=TryIsoStrToDateTime(S,aDateTime) and TryISOTZStrToTZOffset(TZ,TZOffset);
if not Result then
exit;
aDateTime:=IncMinute(aDateTime,TZOffSet);
// offset for UTC or not
if ReturnUTC then
Offset:=0
else
OffSet:=-GetLocalTimeOffset;
aDateTime:=IncMinute(aDateTime,Offset);
Result:=True;
end;
Function ISO8601ToDate(const DateString: string; ReturnUTC : Boolean): TDateTime;
begin
if not TryISO8601ToDate(DateString,ReturnUTC,Result) then
Raise EConvertError.CreateFmt(SErrInvalidTimeStamp,[DateString]);
end;
Function ISO8601ToDateDef(const DateString: string; ReturnUTC : Boolean; aDefault : TDateTime): TDateTime;
begin
if not TryISO8601ToDate(DateString,ReturnUTC,Result) then
Result:=aDefault;
end;
{$else}
implementation
{$endif FPUNONE}

53
rtl/bsd/ostypes.inc
View File

@ -107,6 +107,45 @@ TYPE
st_gen : cuint32; // file generation number
st_birthtime : time_t; // File creation time
st_birthtimensec : clong; // nsec of file creation time
{$elseif defined(freebsd)}
{$ifdef i386}
{$define __STAT_TIME_T_EXT}
{$endif}
st_dev : dev_t; // inode's device
st_ino : ino_t; // inode's number
st_nlink : nlink_t; // number of hard links
st_mode : mode_t; // inode protection mode
st_padding0 : cint16;
st_uid : uid_t; // user ID of the file's owner
st_gid : gid_t; // group ID of the file's group
st_padding1 : cint32;
st_rdev : dev_t; // device type
{$ifdef __STAT_TIME_T_EXT}
st_atim_ext : cint32;
{$endif}
st_atime : time_t; // time of last access
st_atimensec : clong; // nsec of last access
{$ifdef __STAT_TIME_T_EXT}
st_mtim_ext : cint32;
{$endif}
st_mtime : time_t; // time of last data modification
st_mtimensec : clong; // nsec of last data modification
{$ifdef __STAT_TIME_T_EXT}
st_ctim_ext : cint32;
{$endif}
st_ctime : time_t; // time of last file status change
st_ctimensec : clong; // nsec of last file status change
{$ifdef __STAT_TIME_T_EXT}
st_birthtim_ext : cint32;
{$endif}
st_birthtime : time_t; // File creation time
st_birthtimensec : clong; // nsec of file creation time
st_size : off_t; // file size, in bytes
st_blocks : cint64; // blocks allocated for file
st_blksize : cint32; // optimal blocksize for I/O
st_flags : cuint32; // user defined flags for file
st_gen : cuint64; // file generation number
st_spare : array [0..10-1] of cuint64;
{$else}
st_dev : dev_t; // inode's device
{$ifdef darwin_new_iostructs}
@ -189,6 +228,17 @@ TYPE
d_padding : array[0..3] of cuint8;
d_name : array[0..(255 + 1)-1] of char; // name must be no longer than this
end;
{$elseif defined(freebsd)}
dirent = record
d_fileno : ino_t;
d_off : off_t;
d_reclen : cuint16; // length of this record
d_type : cuint8; // file type, see below
d_pad0 : cuint8;
d_namlen : cuint16; // length of string in d_name
d_pad1 : cuint16;
d_name : array[0..(255 + 1)-1] of char; // name must be no longer than this
end;
{$else}
dirent = record
d_fileno : cuint32; // file number of entry
@ -242,6 +292,9 @@ TYPE
l_pid : pid_t; { lock owner }
l_type : cshort; { lock type: read/write, etc. }
l_whence: cshort; { type of l_start }
{$ifdef freebsd}
l_sysid : cint;
{$endif}
end;
TFlock = flock;
pFlock = ^flock;

10
rtl/embedded/Makefile
View File

@ -2806,20 +2806,14 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
$(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
$(COMPILER) $<
$(COMPILER) $<
consoleio$(PPUEXT) : consoleio.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
heapmgr$(PPUEXT) : heapmgr.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
$(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
dos$(PPUEXT) : dos.pp $(INC)/fexpand.inc $(INC)/filerec.inc $(INC)/textrec.inc $(INC)/dosh.inc $(INC)/dos.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
$(COMPILER) $<
$(COMPILER) $<
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
objpas$(PPUEXT) sysconst$(PPUEXT) heapmgr$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
@ -2837,7 +2831,7 @@ fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) varia
$(COMPILER) $(OBJPASDIR)/fmtbcd.pp
types$(PPUEXT) : $(OBJPASDIR)/types.pp math$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/types.pp
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(SYSTEMUNIT)$(PPUEXT)
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(OBJPASDIR)/rtlconst.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/sysconst.pp

15
rtl/embedded/Makefile.fpc
View File

@ -227,10 +227,10 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
#
#ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
# $(COMPILER) $<
#doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
# $(COMPILER) $<
consoleio$(PPUEXT) : consoleio.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
@ -243,21 +243,20 @@ heapmgr$(PPUEXT) : heapmgr.pp $(SYSTEMUNIT)$(PPUEXT)
# TP7 Compatible RTL Units
#
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
$(SYSTEMUNIT)$(PPUEXT)
dos$(PPUEXT) : dos.pp $(INC)/fexpand.inc $(INC)/filerec.inc $(INC)/textrec.inc $(INC)/dosh.inc $(INC)/dos.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
#crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
# $(COMPILER) $<
objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
#printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $<
# $(COMPILER) $<
#graph$(PPUEXT) : graph.pp
$(COMPILER) $<
# $(COMPILER) $<
#
# Delphi Compatible Units
@ -287,7 +286,7 @@ fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) varia
types$(PPUEXT) : $(OBJPASDIR)/types.pp math$(PPUEXT) objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/types.pp
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(SYSTEMUNIT)$(PPUEXT)
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp $(OBJPASDIR)/rtlconst.inc objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

10
rtl/freebsd/ptypes.inc
View File

@ -26,7 +26,7 @@ const
SEM_SAFE=255;
type
dev_t = cuint32; { used for device numbers }
dev_t = cuint64; { used for device numbers }
TDev = dev_t;
pDev = ^dev_t;
@ -35,11 +35,7 @@ type
pGid = ^gid_t;
TIOCtlRequest = cuLong;
{$ifdef CPU64}
ino_t = cuint32; { used for file serial numbers }
{$else}
ino_t = clong; { used for file serial numbers }
{$endif}
ino_t = cuint64; { used for file serial numbers }
TIno = ino_t;
pIno = ^ino_t;
@ -47,7 +43,7 @@ type
TMode = mode_t;
pMode = ^mode_t;
nlink_t = cuint16; { used for link counts }
nlink_t = cuint64; { used for link counts }
TnLink = nlink_t;
pnLink = ^nlink_t;

3
rtl/inc/dos.inc
View File

@ -232,6 +232,7 @@ end;
****************************************************************************}
{$IFNDEF HAS_FSPLIT}
{$push}
{$warnings off}
Procedure FSplit (Path: PathStr; var Dir: DirStr; var Name: NameStr; var Ext: ExtStr);
var
@ -275,7 +276,7 @@ begin
Name := Copy (Path, DirEnd + 1, ExtStart - DirEnd - 1);
Ext := Copy (Path, ExtStart, Length (Path) - ExtStart + 1);
end;
{$warnings on}
{$pop}
{$ENDIF HAS_FSPLIT}

3
rtl/inc/fexpand.inc
View File

@ -160,11 +160,12 @@ begin
{$IFNDEF FPC_FEXPAND_SYSUTILS}
(* Allow both '/' and '\' as directory separators *)
(* by converting all to the native one. *)
{$push}
{$warnings off}
for I := 1 to Length (Pa) do
if CharInSet(Pa [I], AllowDirectorySeparators) then
Pa [I] := DirectorySeparator;
{$warnings on}
{$pop}
{$ENDIF not FPC_FEXPAND_SYSUTILS}
(* PathStart is amount of characters to strip to get beginning *)

3
rtl/inc/ustrings.inc
View File

@ -2313,6 +2313,7 @@ function StringCodePage(const S: UnicodeString): TSystemCodePage; overload;
end;
{$push}
{$warnings off}
function StubUnicodeCase(const s : UnicodeString) : UnicodeString;
begin
@ -2333,7 +2334,7 @@ function StubCompareWideString(const s1, s2 : WideString; Options : TCompareOpti
begin
unimplementedunicodestring;
end;
{$warnings on}
{$pop}
procedure initunicodestringmanager;
begin

79
rtl/linux/i386/sysnr.inc
View File

@ -20,6 +20,7 @@
}
Const
syscall_nr_restart_syscall = 0;
syscall_nr_exit = 1;
syscall_nr_fork = 2;
syscall_nr_read = 3;
@ -239,10 +240,10 @@ Const
syscall_nr_pivot_root = 217;
syscall_nr_mincore = 218;
syscall_nr_madvise = 219;
syscall_nr_madvise1 = 219; { delete when C lib stub is removed }
{ syscall_nr_madvise1 = 219; not found in C headers }
syscall_nr_getdents64 = 220;
syscall_nr_fcntl64 = 221;
syscall_nr_security = 223; { syscall for security modules }
{ syscall_nr_security = 223; not found in C headers }
syscall_nr_gettid = 224;
syscall_nr_readahead = 225;
syscall_nr_setxattr = 226;
@ -270,7 +271,7 @@ Const
syscall_nr_io_submit = 248;
syscall_nr_io_cancel = 249;
syscall_nr_fadvise64 = 250;
syscall_nr_set_zone_reclaim = 251;
{ syscall_nr_set_zone_reclaim = 251; not found in C headers }
syscall_nr_exit_group = 252;
syscall_nr_lookup_dcookie = 253;
syscall_nr_epoll_create = 254;
@ -279,14 +280,14 @@ Const
syscall_nr_remap_file_pages = 257;
syscall_nr_set_tid_address = 258;
syscall_nr_timer_create = 259;
syscall_nr_timer_settime = syscall_nr_timer_create+1;
syscall_nr_timer_gettime = syscall_nr_timer_create+2;
syscall_nr_timer_getoverrun = syscall_nr_timer_create+3;
syscall_nr_timer_delete = syscall_nr_timer_create+4;
syscall_nr_clock_settime = syscall_nr_timer_create+5;
syscall_nr_clock_gettime = syscall_nr_timer_create+6;
syscall_nr_clock_getres = syscall_nr_timer_create+7;
syscall_nr_clock_nanosleep = syscall_nr_timer_create+8;
syscall_nr_timer_settime = 260;
syscall_nr_timer_gettime = 261;
syscall_nr_timer_getoverrun = 262;
syscall_nr_timer_delete = 263;
syscall_nr_clock_settime = 264;
syscall_nr_clock_gettime = 265;
syscall_nr_clock_getres = 266;
syscall_nr_clock_nanosleep = 267;
syscall_nr_statfs64 = 268;
syscall_nr_fstatfs64 = 269;
syscall_nr_tgkill = 270;
@ -297,12 +298,12 @@ Const
syscall_nr_get_mempolicy = 275;
syscall_nr_set_mempolicy = 276;
syscall_nr_mq_open = 277;
syscall_nr_mq_unlink = syscall_nr_mq_open+1;
syscall_nr_mq_timedsend = syscall_nr_mq_open+2;
syscall_nr_mq_timedreceive = syscall_nr_mq_open+3;
syscall_nr_mq_notify = syscall_nr_mq_open+4;
syscall_nr_mq_getsetattr = syscall_nr_mq_open+5;
syscall_nr_sys_kexec_load = 283;
syscall_nr_mq_unlink = 278;
syscall_nr_mq_timedsend = 279;
syscall_nr_mq_timedreceive = 280;
syscall_nr_mq_notify = 281;
syscall_nr_mq_getsetattr = 282;
syscall_nr_kexec_load = 283;
syscall_nr_waitid = 284;
{ syscall_sys_nr_setaltroot 285 }
syscall_nr_add_key = 286;
@ -339,3 +340,47 @@ Const
syscall_nr_move_pages = 317;
syscall_nr_getcpu = 318;
syscall_nr_epoll_pwait = 319;
syscall_nr_utimensat = 320;
syscall_nr_signalfd = 321;
syscall_nr_timerfd_create = 322;
syscall_nr_eventfd = 323;
syscall_nr_fallocate = 324;
syscall_nr_timerfd_settime = 325;
syscall_nr_timerfd_gettime = 326;
syscall_nr_signalfd4 = 327;
syscall_nr_eventfd2 = 328;
syscall_nr_epoll_create1 = 329;
syscall_nr_dup3 = 330;
syscall_nr_pipe2 = 331;
syscall_nr_inotify_init1 = 332;
syscall_nr_preadv = 333;
syscall_nr_pwritev = 334;
syscall_nr_rt_tgsigqueueinfo = 335;
syscall_nr_perf_event_open = 336;
syscall_nr_recvmmsg = 337;
syscall_nr_fanotify_init = 338;
syscall_nr_fanotify_mark = 339;
syscall_nr_prlimit64 = 340;
syscall_nr_name_to_handle_at = 341;
syscall_nr_open_by_handle_at = 342;
syscall_nr_clock_adjtime = 343;
syscall_nr_syncfs = 344;
syscall_nr_sendmmsg = 345;
syscall_nr_setns = 346;
syscall_nr_process_vm_readv = 347;
syscall_nr_process_vm_writev = 348;
syscall_nr_kcmp = 349;
syscall_nr_finit_module = 350;
syscall_nr_sched_setattr = 351;
syscall_nr_sched_getattr = 352;
syscall_nr_seccomp = 354;
syscall_nr_getrandom = 355;
syscall_nr_memfd_create = 356;
syscall_nr_bpf = 357;
syscall_nr_userfaultfd = 374;
syscall_nr_membarrier = 375;
syscall_nr_mlock2 = 376;
syscall_nr_copy_file_range = 377;
syscall_nr_pkey_mprotect = 380;
syscall_nr_pkey_alloc = 381;
syscall_nr_pkey_free = 382;

1
rtl/linux/powerpc/stat.inc
View File

@ -43,6 +43,7 @@
st_mtime : clong;
st_mtime_nsec : culong;
st_ctime : clong;
st_ctime_nsec : culong;
__unused3_ : culong;
__unused4_ : culong;
__unused5_ : culong;

85
rtl/linux/powerpc/sysnr.inc
View File

@ -16,6 +16,7 @@
**********************************************************************}
const
syscall_nr_restart_syscall = 0;
syscall_nr_exit = 1;
syscall_nr_fork = 2;
syscall_nr_read = 3;
@ -283,6 +284,11 @@ const
syscall_nr_fadvise64_64 = 254;
{$endif}
syscall_nr_rtas = 255;
syscall_nr_sys_debug_setcontext = 256;
syscall_nr_migrate_pages = 258;
syscall_nr_mbind = 259;
syscall_nr_get_mempolicy = 260;
syscall_nr_set_mempolicy = 261;
syscall_nr_mq_open = 262;
syscall_nr_mq_unlink = 263;
syscall_nr_mq_timedsend = 264;
@ -300,8 +306,8 @@ const
syscall_nr_inotify_add_watch = 276;
syscall_nr_inotify_rm_watch = 277;
syscall_nr_spu_run = 278;
syscall_nr_spu_create = 278;
syscall_nr_pselect6 = 289;
syscall_nr_spu_create = 279;
syscall_nr_pselect6 = 280;
syscall_nr_ppoll = 281;
syscall_nr_unshare = 282;
syscall_nr_splice = 283;
@ -312,7 +318,11 @@ const
syscall_nr_mknodat = 288;
syscall_nr_fchownat = 289;
syscall_nr_futimesat = 290;
syscall_nr_sys_fstatat64 = 291;
{$ifdef cpu32}
syscall_nr_fstatat64 = 291;
{$else}
syscall_nr_newfstatat = 291;
{$endif}
syscall_nr_unlinkat = 292;
syscall_nr_renameat = 293;
syscall_nr_linkat = 294;
@ -326,8 +336,67 @@ const
syscall_nr_getcpu = 302;
syscall_nr_epoll_pwait = 303;
syscall_nr_utimensat = 304;
syscall_nr_fallocate = 305;
syscall_nr_signalfd = 306;
syscall_nr_timerfd = 307;
syscall_nr_eventfd = 308;
syscall_nr_sync_file_range2 = 309;
syscall_nr_signalfd = 305;
syscall_nr_timerfd_create = 306;
syscall_nr_eventfd = 307;
syscall_nr_sync_file_range2 = 308;
syscall_nr_fallocate = 309;
syscall_nr_subpage_prot = 310;
syscall_nr_timerfd_settime = 311;
syscall_nr_timerfd_gettime = 312;
syscall_nr_signalfd4 = 313;
syscall_nr_eventfd2 = 314;
syscall_nr_epoll_create1 = 315;
syscall_nr_dup3 = 316;
syscall_nr_pipe2 = 317;
syscall_nr_inotify_init1 = 318;
syscall_nr_perf_event_open = 319;
syscall_nr_preadv = 320;
syscall_nr_pwritev = 321;
syscall_nr_rt_tgsigqueueinfo = 322;
syscall_nr_fanotify_init = 323;
syscall_nr_fanotify_mark = 324;
syscall_nr_prlimit64 = 325;
syscall_nr_socket = 326;
syscall_nr_bind = 327;
syscall_nr_connect = 328;
syscall_nr_listen = 329;
syscall_nr_accept = 330;
syscall_nr_getsockname = 331;
syscall_nr_getpeername = 332;
syscall_nr_socketpair = 333;
syscall_nr_send = 334;
syscall_nr_sendto = 335;
syscall_nr_recv = 336;
syscall_nr_recvfrom = 337;
syscall_nr_shutdown = 338;
syscall_nr_setsockopt = 339;
syscall_nr_getsockopt = 340;
syscall_nr_sendmsg = 341;
syscall_nr_recvmsg = 342;
syscall_nr_recvmmsg = 343;
syscall_nr_accept4 = 344;
syscall_nr_name_to_handle_at = 345;
syscall_nr_open_by_handle_at = 346;
syscall_nr_clock_adjtime = 347;
syscall_nr_syncfs = 348;
syscall_nr_sendmmsg = 349;
syscall_nr_setns = 350;
syscall_nr_process_vm_readv = 351;
syscall_nr_process_vm_writev = 352;
syscall_nr_finit_module = 353;
syscall_nr_kcmp = 354;
syscall_nr_sched_setattr = 355;
syscall_nr_sched_getattr = 356;
syscall_nr_renameat2 = 357;
syscall_nr_seccomp = 358;
syscall_nr_getrandom = 359;
syscall_nr_memfd_create = 360;
syscall_nr_bpf = 361;
syscall_nr_execveat = 362;
syscall_nr_switch_endian = 363;
syscall_nr_userfaultfd = 364;
syscall_nr_membarrier = 365;
syscall_nr_mlock2 = 378;
syscall_nr_copy_file_range = 379;

6
rtl/linux/ptypes.inc
View File

@ -195,7 +195,8 @@ Type
fsid : array[0..1] of cint; { File system ID }
namelen : clong; { Maximum name length in system }
frsize : clong;
spare : array [0..4] of clong; { For later use }
flags : clong;
spare : array [0..3] of clong; { For later use }
end;
{$else}
TStatfs = record
@ -209,7 +210,8 @@ Type
fsid : array[0..1] of cint; { File system ID }
namelen, { Maximum name length in system }
frsize : cint;
spare : array [0..4] of cint; { For later use }
flags : cint;
spare : array [0..3] of cint; { For later use }
end;
{$endif}
PStatFS=^TStatFS;

50
rtl/linux/x86_64/sysnr.inc
View File

@ -340,4 +340,52 @@ const
syscall_nr_sync_file_range = 277;
syscall_nr_vmsplice = 278;
syscall_nr_move_pages = 279;
syscall_nr_utimensat = 280;
syscall_nr_epoll_pwait = 281;
syscall_nr_signalfd = 282;
syscall_nr_timerfd_create = 283;
syscall_nr_eventfd = 284;
syscall_nr_fallocate = 285;
syscall_nr_timerfd_settime = 286;
syscall_nr_timerfd_gettime = 287;
syscall_nr_accept4 = 288;
syscall_nr_signalfd4 = 289;
syscall_nr_eventfd2 = 290;
syscall_nr_epoll_create1 = 291;
syscall_nr_dup3 = 292;
syscall_nr_pipe2 = 293;
syscall_nr_inotify_init1 = 294;
syscall_nr_preadv = 295;
syscall_nr_pwritev = 296;
syscall_nr_rt_tgsigqueueinfo = 297;
syscall_nr_perf_event_open = 298;
syscall_nr_recvmmsg = 299;
syscall_nr_fanotify_init = 300;
syscall_nr_fanotify_mark = 301;
syscall_nr_prlimit64 = 302;
syscall_nr_name_to_handle_at = 303;
syscall_nr_open_by_handle_at = 304;
syscall_nr_clock_adjtime = 305;
syscall_nr_syncfs = 306;
syscall_nr_sendmmsg = 307;
syscall_nr_setns = 308;
syscall_nr_getcpu = 309;
syscall_nr_process_vm_readv = 310;
syscall_nr_process_vm_writev = 311;
syscall_nr_kcmp = 312;
syscall_nr_finit_module = 313;
syscall_nr_sched_setattr = 314;
syscall_nr_sched_getattr = 315;
syscall_nr_renameat2 = 316;
syscall_nr_seccomp = 317;
syscall_nr_getrandom = 318;
syscall_nr_memfd_create = 319;
syscall_nr_kexec_file_load = 320;
syscall_nr_bpf = 321;
syscall_nr_userfaultfd = 323;
syscall_nr_membarrier = 324;
syscall_nr_mlock2 = 325;
syscall_nr_copy_file_range = 326;
syscall_nr_pkey_mprotect = 329;
syscall_nr_pkey_alloc = 330;
syscall_nr_pkey_free = 331;

3
rtl/objpas/classes/streams.inc
View File

@ -1047,6 +1047,7 @@ begin
inherited Destroy;
end;
{$push}
{$warnings off}
function TStreamAdapter.Read(pv: Pointer; cb: DWORD; pcbRead: PDWORD): HResult; stdcall;
var
@ -1267,4 +1268,4 @@ begin
raise e;
end;
{$warnings on}
{$pop}

6
rtl/objpas/fgl.pp
View File

@ -900,7 +900,7 @@ end;
function TFPGList.GetList: PTypeList;
begin
Result := PTypeList(FList);
Result := PTypeList(@FList);
end;
function TFPGList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
@ -1035,7 +1035,7 @@ end;
function TFPGObjectList.GetList: PTypeList;
begin
Result := PTypeList(FList);
Result := PTypeList(@FList);
end;
function TFPGObjectList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
@ -1165,7 +1165,7 @@ end;
function TFPGInterfacedObjectList.GetList: PTypeList;
begin
Result := PTypeList(FList);
Result := PTypeList(@FList);
end;
function TFPGInterfacedObjectList.ItemPtrCompare(Item1, Item2: Pointer): Integer;

46
rtl/objpas/sysutils/sysencoding.inc
View File

@ -22,7 +22,13 @@ begin
try
{$endif}
if not Assigned(FStandardEncodings[seAnsi]) then
FStandardEncodings[seAnsi] := TMBCSEncoding.Create(DefaultSystemCodePage);
begin
// DefaultSystemCodePage can be set to non-ANSI
if Assigned(widestringmanager.GetStandardCodePageProc) then
FStandardEncodings[seAnsi] := TMBCSEncoding.Create(widestringmanager.GetStandardCodePageProc(scpAnsi))
else
FStandardEncodings[seAnsi] := TMBCSEncoding.Create(DefaultSystemCodePage);
end;
{$ifdef FPC_HAS_FEATURE_THREADING}
finally
LeaveCriticalSection(FLock);
@ -91,6 +97,40 @@ begin
Result := GetANSI;
end;
class function TEncoding.GetSystemEncoding: TEncoding;
var
I: Integer;
begin
{$ifdef FPC_HAS_FEATURE_THREADING}
EnterCriticalSection(FLock);
try
{$endif}
for I := Low(FSystemEncodings) to High(FSystemEncodings) do
begin
if FSystemEncodings[I].CodePage=DefaultSystemCodePage then
begin
Result := FSystemEncodings[I];
if I<>Low(FSystemEncodings) then // exchange with first position to find it faster the next time
begin
FSystemEncodings[I] := FSystemEncodings[Low(FSystemEncodings)];
FSystemEncodings[Low(FSystemEncodings)] := Result;
end;
Exit;
end;
end;
// not found - create new encoding at first position
Result := TMBCSEncoding.Create(DefaultSystemCodePage);
SetLength(FSystemEncodings, Length(FSystemEncodings)+1);
if High(FSystemEncodings)<>Low(FSystemEncodings) then
FSystemEncodings[High(FSystemEncodings)] := FSystemEncodings[Low(FSystemEncodings)];
FSystemEncodings[Low(FSystemEncodings)] := Result;
{$ifdef FPC_HAS_FEATURE_THREADING}
finally
LeaveCriticalSection(FLock);
end;
{$endif}
end;
class function TEncoding.GetUnicode: TEncoding;
begin
{$ifdef FPC_HAS_FEATURE_THREADING}
@ -142,6 +182,7 @@ end;
class procedure TEncoding.FreeEncodings;
var
E: TStandardEncoding;
I: Integer;
begin
{$ifdef FPC_HAS_FEATURE_THREADING}
EnterCriticalSection(FLock);
@ -149,6 +190,9 @@ begin
{$endif}
for E := Low(FStandardEncodings) to High(FStandardEncodings) do
FreeAndNil(FStandardEncodings[E]);
for I := Low(FSystemEncodings) to High(FSystemEncodings) do
FSystemEncodings[I].Free;
SetLength(FSystemEncodings, 0);
{$ifdef FPC_HAS_FEATURE_THREADING}
finally
LeaveCriticalSection(FLock);

3
rtl/objpas/sysutils/sysencodingh.inc
View File

@ -30,12 +30,14 @@ type
seUTF8);
var
FStandardEncodings: array[TStandardEncoding] of TEncoding; static;
FSystemEncodings: array of TEncoding; static;
Class Var
FLock : TRTLCriticalSection;
class function GetANSI: TEncoding; static;
class function GetASCII: TEncoding; static;
class function GetBigEndianUnicode: TEncoding; static;
class function GetDefault: TEncoding; static;
class function GetSystemEncoding: TEncoding; static;
class function GetUnicode: TEncoding; static;
class function GetUTF7: TEncoding; static;
class function GetUTF8: TEncoding; static;
@ -99,6 +101,7 @@ type
class property ASCII: TEncoding read GetASCII;
class property BigEndianUnicode: TEncoding read GetBigEndianUnicode;
class property Default: TEncoding read GetDefault;
class property SystemEncoding: TEncoding read GetSystemEncoding;
class property Unicode: TEncoding read GetUnicode;
class property UTF7: TEncoding read GetUTF7;
class property UTF8: TEncoding read GetUTF8;

9
rtl/openbsd/ptypes.inc
View File

@ -61,7 +61,7 @@ type
pSize = ^size_t;
pSize_t = ^size_t;
ssize_t = cint32; { used by function for returning number of bytes }
ssize_t = clong; { used by function for returning number of bytes }
TsSize = ssize_t;
psSize = ^ssize_t;
@ -107,7 +107,6 @@ type
pthread_mutexattr_t_rec = record end;
pthread_cond_t_rec = record end;
pthread_condattr_t_rec = record end;
pthread_once_t_rec = record end;
pthread_rwlock_t_rec = record end;
pthread_rwlockattr_t_rec = record end;
@ -118,7 +117,11 @@ type
pthread_cond_t = ^pthread_cond_t_rec;
pthread_condattr_t = ^pthread_condattr_t_rec;
pthread_key_t = cint;
pthread_once_t = ^pthread_once_t_rec;
pthread_once_t_rec = record
state : cint;
mutex : pthread_mutex_t;
end;
pthread_once_t = pthread_once_t_rec;
pthread_rwlock_t = ^pthread_rwlock_t_rec;
pthread_rwlockattr_t = ^pthread_rwlockattr_t_rec;

60
rtl/openbsd/t_openbsd.h2paschk
View File

@ -8,8 +8,11 @@
# supported architecture.
@Pascal uses baseunix;
@Pascal {$i ptypes.inc}
@Pascal {$i ostypes.inc}
@Pascal begin
# Adds support for M_PIl constant inside math.h header
@C #include <sys/types.h>
@C #include <sys/stat.h>
@C #include <sys/time.h>
@ -23,9 +26,66 @@
@C #include <unistd.h>
@C #include <stdio.h>
@C #include <stddef.h>
@C #include <fcntl.h>
@C #include <pthread.h>
@C #include <netdb.h>
@C #include <semaphore.h>
@C #include <wchar.h>
@C #include <math.h>
@C int main()
@C {
@type dev_t
@type gid_t
@type ino_t
@type mode_t
@type nlink_t
@type off_t
@type pid_t
@type size_t
@type ssize_t
@type uid_t
@type wint_t
@type clock_t
@type time_t
@type socklen_t
@record timeval,struct timeval
.tv_sec
.tv_usec
@record timespec,struct timespec
.tv_sec
.tv_nsec
@type pthread_t
@type pthread_attr_t
@type pthread_mutex_t
@type pthread_mutexattr_t
@type pthread_cond_t
@type pthread_condattr_t
@type pthread_key_t
@type pthread_rwlock_t
@type pthread_rwlockattr_t
@type sem_t
@type rlim_t
@record pthread_once_t,struct pthread_once
.state
.mutex
@constant O_RDONLY
@constant O_WRONLY
@constant O_RDWR
@constant O_CREAT
@constant O_EXCL
@constant O_TRUNC
@constant O_NOCTTY
@constant O_APPEND
@constant O_NONBLOCK
@floatconstant PI,M_PI
@record stat,struct stat
.st_mode
.st_dev

361
rtl/unix/scripts/check_sys.sh
View File

@ -7,20 +7,79 @@
syscall_header=/usr/include/syscall.h
fpc_sysnr=./sysnr.inc
os=`uname -s`
i=0
for arg in $* ; do
let i++
echo "Handling arg $i, \"$arg\""
if [ "${arg//=}" != "$arg" ] ; then
echo "Evaluating $arg"
eval $arg
elif [ "$arg" == "-v" ] ; then
verbose=1
else
echo "arg not handled!"
fi
done
if [ "$os" == "OpenBSD" ] ; then
c_syscall_header=sys/syscall.h
else
c_syscall_header=syscall.h
start_pwd=`pwd`
start_dir=`basename $start_pwd`
if [ -d "rtl" ] ; then
echo "Entering rtl directory"
cd rtl
fi
if ! [ -f $fpc_sysnr ] ; then
cpu=`fpc -iTP`
os=`uname -s | tr [:upper:] [:lower:] `
now_pwd=`pwd`
now_dir=`basename $now_pwd`
if [ -d "$os" ] ; then
echo "Entering $os directory"
cd $os
fi
case "$os" in
freebsd|openbsd|netbsd) c_syscall_header=sys/syscall.h;;
*) c_syscall_header=syscall.h;;
esac
if [ -z "$FPC" ] ; then
FPC=fpc
fi
if [ ! -f $fpc_sysnr ] ; then
cpu=`$FPC -iTP`
if [ "${cpu//sparc/}" != "$cpu" ] ; then
cpu=sparcgen
fi
fpc_sysnr=./$cpu/sysnr.inc
if [ ! -f "$fpc_sysnr" ] ; then
fpc_sysnr=`ls -1 ./${cpu}*/sysnr.inc| head -1`
fi
if [ ! -f "$fpc_sysnr" ] ; then
if [ "${cpu//sparc/}" != "$cpu" ] ; then
cpu=sparcgen
fi
fpc_sysnr=./$cpu/sysnr.inc
if [ ! -f "$fpc_sysnr" ] ; then
echo "sysnr.inc file not found, try again in rtl/$os directory"
exit
fi
fi
fi
verbose=0
if [ -f "$fpc_sysnr" ] ; then
echo "Checking $fpc_sysnr content for Free Pascal syscall numbers"
fpc_sysnr_dir=`dirname $fpc_sysnr `
sysnr_includes=`grep -o '{\$i *[a-z_A-Z0-9/.]*' $fpc_sysnr | sed 's:.*{\$i *:'$fpc_sysnr_dir/: `
if [ -n "$sysnr_includes" ] ; then
echo "Found $sysnr_includes include files"
fpc_sysnr="$fpc_sysnr $sysnr_includes"
fi
fi
if [ -z "$verbose" ] ; then
verbose=0
fi
os=`uname -s`
@ -39,22 +98,64 @@ EOF
# Can be overwritten by setting CC variable
# But I don't know if other compilers also generate
# .i files with --save-temps option
if [ "$CC" == "" ] ; then
if [ -z "$CC" ] ; then
CC=gcc
fi
cpu=`$FPC -iTP`
is_16=0
is_32=0
is_64=0
case $cpu in
aarch64) is_64=1;;
alpha) is_32=1;;
arm) is_32=1;;
avr) is_16=1;;
i386) is_32=1;;
i8086) is_16=1;;
ia64) is_64=1;;
jvm) is_32=1;;
m68k) is_32=1;;
mips) is_32=1;;
mipsel) is_32=1;;
powerpc) is_32=1;;
powerpc64) is_64=1;;
riscv32) is_32=1;;
riscv64) is_64=1;;
sparc) is_32=1;;
sparc64) is_64=1;;
vis) is_32=1;;
x86_64) is_64=1;;
esac
if [ $is_64 -eq 1 ] ; then
CC_OPT="$CC_OPT -m64"
CPUBITS=64
elif [ $is_32 -eq 1 ] ;then
CC_OPT="$CC_OPT -m32"
CPUBITS=32
elif [ $is_16 -eq 1 ] ; then
CPUBITS=16
else
CPUBITS=unknown
fi
# Use gcc with --save-temps option to create .i file
$CC --save-temps -o test-syscall ./test-syscall.c
echo "Calling $CC $CC_OPT --save-temps -o test-syscall ./test-syscall.c"
$CC $CC_OPT --save-temps -o ./test-syscall ./test-syscall.c
res=$?
if [ $res -ne 0 ] ; then
echo "Call to $CC failed"
exit
else
rm -f ./test-syscall.c ./test-syscall
fi
# list of errno.h headers listed
syscall_headers=` sed -n "s:.*\"\(.*/.*\.h\)\".*:\1:p" test-syscall.i |sort | uniq`
echo "Headers found are \"$syscall_headers\""
rm -f test-syscall.*
echo "C syscall headers files found are \"$syscall_headers\""
if [ "$syscall_headers" != "" ] ; then
if [ -n "$syscall_headers" ] ; then
syscall_header="$syscall_headers"
fi
@ -70,15 +171,109 @@ fi
# You should only need to change the variables above
sed -n "s:^[ \t]*${fpc_syscall_prefix}\\([_a-zA-Z0-9]*\\)[ \t]*=[ \t]*\\([0-9]*\\).*:check_syscall_number ${syscall_prefix}\1 \2:p" ${fpc_sysnr} > check_sys_list.sh
sed -n "s:^.*define[[:space:]]*${syscall_prefix}\\([_a-zA-Z0-9]*\\)[[:space:]]*\\([0-9]*\\).*:check_syscall_number_reverse ${fpc_syscall_prefix}\1 \2:p" ${syscall_header} > check_sys_list_reverse.sh
awkfile=preproc.awk
tmp_fpc_sysnr=tmp-sysnr-${cpu}.inc
function check_syscall_number ()
c_syscall_source=test-syscall-${cpu}.c
# Test C file to grab all loaded headers
# must be called with -DSYS_MACRO=$sys
cat > $c_syscall_source <<EOF
#include <${c_syscall_header}>
#include <stdio.h>
int
main ()
{
sys=$1
printf ("%d\n", (int) SYS_MACRO);
return 0;
}
EOF
cat > $awkfile <<EOF
BEGIN {IGNORECASE = 1;
enable=1;
macro="";
incfile="";
cpu= "cpu" proc;
cpubits= "cpu" cpubits;
}
/\{\\\$i / { incfile=\$2;
print "Include file " incfile " found"; }
/\{\\\$ifdef / { macro=gensub("[^A-Za-z_0-9].*","","",\$2);
if ( (macro == cpu) || (macro == cpubits)) { enable=1;
print "// ifdef " macro " found and accepted at line " FNR;
} else {enable=0;
print "// ifdef " macro " found and rejected at line " FNR;
};
}
/\{\\\$ifndef / { macro=gensub("[^A-Za-z_0-9].*","","",\$2);
if ( (macro == cpu) || (macro == cpubits) ) { enable=0;
print "// ifndef " macro " found and rejected at line " FNR;
} else {enable=1;
print "// ifndef " macro " found and accepted at line " FNR;
};
}
/\{\\\$else/ { if (enable == 1) {enable=0;} else {enable = 1;}}
/.*/ { if (enable == 1) {
wholeline=\$0;
code=gensub("{.*}","","g",\$0);
code=gensub("[(][*].*[*][)]","","g",code);
comments=gensub(code,"","",\$0);
comments1=gensub(".*({.*}).*","\1","g",comments);
if (comments == comments1)
comments1="";
comments2=gensub(".*[(][*].*[*][)]).*","\1","g",comments);
if (comments == comments2)
comments2="";
comments3=gensub(".*//","","",comments);
if (comments == comments3)
comments3="";
all_comments= comments1 comments2 comments3;
if (all_comments != "")
print code "// " comments1 comments2 comments3 ;
else
print code;
}
}
/\{\\\$endif/ {enable=1;}
EOF
if [ -z "$AWK" ] ; then
AWK=`which gawk 2> /dev/null`
fi
if [ -z "$AWK" ] ; then
AWK=`which awk 2> /dev/null`
fi
if [ -n "$AWK" ] ; then
echo "Preprocessing ${fpc_sysnr} to $tmp_fpc_sysnr"
echo "$AWK -v proc=$cpu -v cpubits=$CPUBITS -f $awkfile ${fpc_sysnr} > $tmp_fpc_sysnr"
$AWK -v proc=$cpu -v cpubits=$CPUBITS -f $awkfile ${fpc_sysnr} > $tmp_fpc_sysnr
fpc_sysnr=$tmp_fpc_sysnr
fi
sed -n "s:^\(.*\)*[ \t]*${fpc_syscall_prefix}\\([_a-zA-Z0-9]*\\)[ \t]*=[ \t]*\\([0-9]*\\)\\(.*\\)$:check_c_syscall_number_from_fpc_rtl \2 \3 \"\1 \4\":p" $fpc_sysnr > check_sys_list.sh
sed -n "s:^.*#[[:space:]]*define[[:space:]]*${syscall_prefix}\\([_a-zA-Z0-9]*\\)[[:space:]]*\\([0-9]*\\)\\(.*\\)$:check_c_syscall_number_in_fpc_rtl \1 \2 \"\3\":p" ${syscall_header} > check_sys_list_reverse.sh
forward_count=0
forward_ok_count=0
forward_failure_count=0
function check_c_syscall_number_from_fpc_rtl ()
{
bare_sys=$1
sys=${syscall_prefix}$bare_sys
value=$2
comment="$3"
if [[ ! ( ( -n "$value" ) && ( $value -ge 0 ) ) ]] ; then
echo "Computing $2 value"
let value=$2
fi
obsolete=0
let forward_count++
if [[ "$value" =~ ^[0-9]+$ ]] ; then
eval $sys=\$$value
if [ $verbose -ne 0 ] ; then
@ -92,11 +287,28 @@ function check_syscall_number ()
fi
# Remember this value for later
eval $sys=$value
if [ $verbose -ne 0 ] ; then
echo Testing $sys value $value
echo -en "Testing $sys value $value \r"
found=`sed -n "/#[[:space:]]*define[[:space:]]*${sys}[^A-Za-z0-9_]/p" ${syscall_header}`
val=`sed -n "s:#[[:space:]]*define[[:space:]]*${sys}[^A-Za-z0-9_][^A-Za-z0-9_]*\([0-9]*\).*:\1:p" ${syscall_header}`
$CC $CC_OPT -DSYS_MACRO=${syscall_prefix}${bare_sys} -o ./test_c_${bare_sys} $c_syscall_source > ./test_${bare_sys}.comp-log 2>&1
C_COMP_RES=$?
if [ $C_COMP_RES -eq 0 ] ; then
CC_value=`./test_c_${bare_sys} `
if [ "$value" != "$CC_value" ] ; then
echo "$CC returns $CC_value, while $value is expected"
let forward_failure_count++
return
else
rm -f ./test_c_${bare_sys}
fi
rm -f ./test-${bare_sys}.comp-log
else
echo "$CC failed to compile code containing $sys syscall number $value"
echo "$CC $CC_OPT -DSYS_MACRO=${syscall_prefix}${bare_sys} -o ./test_c_${bare_sys} $c_syscall_source > ./test_${bare_sys}.comp-log 2>&1"
let forward_failure_count++
return
fi
found=`sed -n "/#define[[:space:]]*${sys}[^A-Za-z0-9_]/p" ${syscall_header}`
val=`sed -n "s:#define[[:space:]]*${sys}[^A-Za-z0-9_][^A-Za-z0-9_]*\([0-9]*\).*:\1:p" ${syscall_header}`
if [ $verbose -ne 0 ] ; then
echo Test for $sys found \"${found}\" \"${value}\" \"${val}\"
fi
@ -104,34 +316,87 @@ function check_syscall_number ()
if [ $verbose -ne 0 ] ; then
echo ${sys} value ${val} is correct
fi
let forward_ok_count++
else
if [ "${val}" == "" ] ; then
found=`sed -n "/#define.*[^A-Za-z0-9_]${value}$/p" ${syscall_header}`
if [ "${found}" == "" ] ; then
if [ -z "${val}" ] ; then
found=`sed -n ".*define[[:space:]].*[^A-Za-z0-9_][[:space:]]${value}$/p" ${syscall_header}`
if [ -z "${found}" ] ; then
found=`sed -n "s:\/\* ${value} is compa:/* ${value} is compa:p" ${syscall_header}`
if [ "$found" != "" ] ; then
if [ -n "$found" ] ; then
obsolete=1
fi
fi
fi
if [ "$found" == "" ] ; then
if [ -z "$found" ] ; then
found=`grep -n -w $value ${syscall_header}`
fi
if [ $obsolete -eq 1 ] ; then
echo Warning: ${sys} expected ${value}, is obsolete line is \"${found}\"
echo Warning: ${bare_sys} expected ${value}, is obsolete line is \"${found}\"
else
echo Problem: ${sys} expected ${value}, line is \"${found}\", val found is \"${val}\"
echo Problem: ${bare_sys} expected ${value}, line is \"${found}\", val found is \"${val}\"
fi
let forward_failure_count++
fi
}
function check_syscall_number_reverse ()
reverse_count=0
reverse_ok_count=0
reverse_failure_count=0
add_file=./add_missing_syscalls.inc
suggested_addition_count=0
echo "{ Generated by check_rtl_sys.sh script }" > $add_file
function check_c_syscall_number_in_fpc_rtl ()
{
sys=$1
bare_sys=$1
sys=${fpc_syscall_prefix}${bare_sys}
c_sys=${syscall_prefix}${bare_sys}
value=$2
comment="$3"
echo -en "Testing $sys value $value \r"
$CC $CC_OPT -DSYS_MACRO=${c_sys} -o ./test_c_${bare_sys} $c_syscall_source > ./test_${bare_sys}.comp-log 2>&1
C_COMP_RES=$?
if [ $C_COMP_RES -eq 0 ] ; then
rm ./test_${bare_sys}.comp-log
CC_value=`./test_c_${bare_sys} `
if [ "$value" != "$CC_value" ] ; then
echo "For sys=$sys, $CC returns $CC_value, while $value is expected"
let reverse_failure_count++
return
else
rm -f ./test_c_$bare_sys
fi
else
# if C syscall is not accepted do nothing
#echo "For sys=$sys, $CC compilation failed"
#cat ./test_${bare_sys}.comp-log
# let reverse_failure_count++
rm -f ./test_c_${bare_sys}
rm ./test_${bare_sys}.comp-log
return
fi
if [ $verbose -ne 0 ] ; then
echo "Full comment is \"$comment \""
fi
if [ "${comment/*\/\*/}" != "$comment" ] ; then
comment="${comment/*\/\*/}"
if [ $verbose -ne 0 ] ; then
echo "comment is \"$comment \""
fi
comment="${comment/\*\/*/}"
if [ $verbose -ne 0 ] ; then
echo "comment is \"$comment \""
fi
comment=`echo $comment | sed 's:^[[:space:]]*\(.*\)[[:space:]]*$:\1' `
if [ $verbose -ne 0 ] ; then
echo "comment is \"$comment \""
fi
fi
if [ $verbose -ne 0 ] ; then
echo Testing syscall header entry $sys value $value
fi
let reverse_count++
found=`sed -n "/.*${sys}/p" ${fpc_sysnr}`
val=`sed -n "s:.*${sys}[ \t]*=[ \t]*\([0-9]*\).*:\1:p" ${fpc_sysnr}`
if [ $verbose -ne 0 ] ; then
@ -141,14 +406,24 @@ function check_syscall_number_reverse ()
if [ $verbose -ne 0 ] ; then
echo ${sys} value ${val} is correct
fi
let reverse_ok_count++
else
if [ "${val}" == "" ] ; then
found=`sed -n "/#define.*[^A-Za-z0-9_]${value}$/p" ${syscall_header}`
if [ "${found}" == "" ] ; then
found=`sed -n "s:\/\* ${value} is compa: ${value} is compa:p" ${syscall_header}`
if [ -z "${val}" ] ; then
found=`sed -n "/#[[:space:]]*define.*[^A-Za-z0-9_][[:space:]]*${value}([[:space:]]|$)/p" ${syscall_header}`
if [ -z "${found}" ] ; then
found=`sed -n "s:\/\*.*i[[:space:]]${value} is compa: ${value} is compa:p" ${syscall_header}`
fi
fi
echo Problem: ${sys} expected ${value}, line is \"${found}\", val found is \"${val}\"
echo "Problem: ${bare_sys} expected ${value}, line is \"${found}\", val found is \"${val}\""
if [ -n "$comment" ] ; then
echo " ${fpc_syscall_prefix}${bare_sys} = ${value}; { $comment }" >> $add_file
echo "Suggest adding: ${fpc_syscall_prefix}${bare_sys} = ${value}; { $comment }"
else
echo " ${fpc_syscall_prefix}${bare_sys} = ${value};" >> $add_file
echo "Suggest adding: ${fpc_syscall_prefix}${bare_sys} = ${value};"
fi
let suggested_addition_count++
let reverse_failure_count++
fi
}
@ -157,8 +432,18 @@ function check_syscall_number_reverse ()
# to system define
set -f
echo "Checking values from \"${fpc_sysnr}\" in \"${syscall_header}\""
echo "Checking values from \"${fpc_sysnr}\" in C syscall headers"
source ./check_sys_list.sh
echo "Checking if values in \"${syscall_header}\" are missing in \"${fpc_sysnr}\""
echo "Checking if values in C syscall headers are in \"${fpc_sysnr}\""
source ./check_sys_list_reverse.sh
echo "Forward counts: OK=$forward_ok_count, failures=$forward_failure_count, total=$forward_count"
echo "Reverse counts: OK=$reverse_ok_count, failures=$reverse_failure_count, total=$reverse_count"
if [ $suggested_addition_count -gt 0 ] ; then
echo "Missing $suggested_addition_count syscall numbers in $add_file"
else
rm $add_file
fi
rm ./check_sys_list.sh ./check_sys_list_reverse.sh ./$awkfile
if [ -f "$tmp_fpc_sysnr" ] ; then
echo rm $tmp_fpc_sysnr
fi

1
rtl/win/wininc/ascdef.inc
View File

@ -480,6 +480,7 @@ function FindFirstFileEx(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lp
function FindFirstFileTransacted(lpfilename : LPCStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall;
external 'kernel32' name 'FindFirstFileTransactedA';
function GetComputerNameEx(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExA';
function QueryFullProcessImageName(hProcess:THandle;dwFlags:DWord; lpexename :lpstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameA';
{$endif read_interface}

1
rtl/win/wininc/ascfun.inc
View File

@ -493,6 +493,7 @@ function GetConsoleAliasExesLengthA:DWORD;stdcall;external 'kernel32' name 'GetC
function GetConsoleAliasesA(AliasBuffer:LPSTR; AliasBufferLength:DWORD; ExeName:LPSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesA';
function GetConsoleAliasExesA(ExeNameBuffer:LPSTR; ExeNameBufferLength:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesA';
function GetComputerNameExA(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExA';
function QueryFullProcessImageNameA(hProcess:THandle;dwFlags:DWord; lpexename :lpstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameA';
{$endif read_interface}

6
rtl/win/wininc/defines.inc
View File

@ -1167,6 +1167,7 @@
PROCESS_CREATE_THREAD = 2;
PROCESS_DUP_HANDLE = 64;
PROCESS_QUERY_INFORMATION = 1024;
PROCESS_QUERY_LIMITED_INFORMATION = $1000;
PROCESS_SET_INFORMATION = 512;
PROCESS_TERMINATE = 1;
PROCESS_VM_OPERATION = 8;
@ -6377,9 +6378,8 @@ const
CONSOLE_FULLSCREEN_MODE = 1;
CONSOLE_WINDOWED_MODE = 2;
CONSOLE_WINDOWED_MODE = 2;
PROCESS_NAME_NATIVE = 1;
{$endif read_interface}

7
rtl/win/wininc/func.inc
View File

@ -1320,7 +1320,12 @@ function CONSOLE_REAL_OUTPUT_HANDLE : HANDLE;
function GetConsoleWindow:HWND;stdcall;external 'kernel32' name 'GetConsoleWindow';
function GetConsoleProcessList(lpdwProcessList:LPDWORD; dwProcessCount:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleProcessList';
function ReadDirectoryChangesW(hDirectory: HANDLE; lpBuffer: LPVOID;nBufferLength: DWORD; bWatchSubtree: BOOL; dwNotifyFilter: DWORD;lpBytesReturned: LPDWORD;lpOverlapped: LPOVERLAPPED;lpCompletionRoutine: LPOVERLAPPED_COMPLETION_ROUTINE): BOOL; stdcall; external 'kernel32' name 'ReadDirectoryChangesW';
function IsDebuggerPresent : BOOL; stdcall; external 'kernel32.dll' name 'IsDebuggerPresent';
function Wow64DisableWow64FsRedirection(RedirectionState : ppointer) : BOOL; stdcall; external 'kernel32.dll' name 'Wow64DisableWow64FsRedirection';
function Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection:BYTE) : BOOL; stdcall; external 'kernel32.dll' name 'Wow64EnableWow64FsRedirection';
function Wow64RevertWow64FsRedirection(RedirectionState : pointer) : BOOL; stdcall; external 'kernel32.dll' name 'Wow64RevertWow64FsRedirection';
function IsWow64Process(hProcess:THandle; Wow64Process:PBOOL):BOOL;stdcall; external 'kernel32.dll' name 'IsWow64Process';
function GetPhysicallyInstalledSystemMemory(TotalMemoryInKilobytes: PULONGLONG ):BOOL; stdcall; external 'kernel32.dll' name 'GetPhysicallyInstalledSystemMemory';
{$endif read_interface}

32
rtl/win/wininc/messages.inc
View File

@ -270,22 +270,22 @@
HDM_HITTEST = 4614;
HDM_LAYOUT = 4613;
{ Header control notifications }
HDN_BEGINTRACKW = -(326);
HDN_DIVIDERDBLCLICKW = -(325);
HDN_ENDTRACKW = -(327);
HDN_ITEMCHANGEDW = -(321);
HDN_ITEMCHANGINGW = -(320);
HDN_ITEMCLICKW = -(322);
HDN_ITEMDBLCLICKW = -(323);
HDN_TRACKW = -(328);
HDN_BEGINTRACKA = -(306);
HDN_DIVIDERDBLCLICKA = -(305);
HDN_ENDTRACKA = -(307);
HDN_ITEMCHANGEDA = -(301);
HDN_ITEMCHANGINGA = -(300);
HDN_ITEMCLICKA = -(302);
HDN_ITEMDBLCLICKA = -(303);
HDN_TRACKA = -(308);
HDN_BEGINTRACKW = UINT(-326);
HDN_DIVIDERDBLCLICKW = UINT(-325);
HDN_ENDTRACKW = UINT(-327);
HDN_ITEMCHANGEDW = UINT(-321);
HDN_ITEMCHANGINGW = UINT(-320);
HDN_ITEMCLICKW = UINT(-322);
HDN_ITEMDBLCLICKW = UINT(-323);
HDN_TRACKW = UINT(-328);
HDN_BEGINTRACKA = UINT(-306);
HDN_DIVIDERDBLCLICKA = UINT(-305);
HDN_ENDTRACKA = UINT(-307);
HDN_ITEMCHANGEDA = UINT(-301);
HDN_ITEMCHANGINGA = UINT(-300);
HDN_ITEMCLICKA = UINT(-302);
HDN_ITEMDBLCLICKA = UINT(-303);
HDN_TRACKA = UINT(-308);
{$ifdef UNICODE}
const

1
rtl/win/wininc/unidef.inc
View File

@ -473,6 +473,7 @@ function FindFirstFileEx(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;l
// winver>$0600
function FindFirstFileTransacted(lpfilename : LPCWStr;fInfoLevelId:FINDEX_INFO_LEVELS ;lpFindFileData:pointer;fSearchOp : FINDEX_SEARCH_OPS;lpSearchFilter:pointer;dwAdditionalFlags:dword;htransaction : HANDLE):Handle; stdcall; external 'kernel32' name 'FindFirstFileTransactedW';
function GetComputerNameEx(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPWSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExW';
function QueryFullProcessImageName(hProcess:THandle;dwFlags:DWord; lpexename :lpwstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameW';
{$endif read_interface}

1
rtl/win/wininc/unifun.inc
View File

@ -496,6 +496,7 @@ function GetConsoleAliasExesLengthW:DWORD;stdcall;external 'kernel32' name 'GetC
function GetConsoleAliasesW(AliasBuffer:LPWSTR; AliasBufferLength:DWORD; ExeName:LPWSTR):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasesW';
function GetConsoleAliasExesW(ExeNameBuffer:LPWSTR; ExeNameBufferLength:DWORD):DWORD;stdcall;external 'kernel32' name 'GetConsoleAliasExesW';
function GetComputerNameExW(NameType:COMPUTER_NAME_FORMAT;lpbuffer:LPWSTR;nSize:LPDWORD):BOOL;stdcall;external 'kernel32' name 'GetComputerNameExW';
function QueryFullProcessImageNameW(hProcess:THandle;dwFlags:DWord; lpexename :lpwstr;lpdwsize:pdword):BOOL; stdcall; external 'kernel32.dll' name 'QueryFullProcessImageNameW';
{$endif read_interface}

29
tests/tbs/tb0657.pp Normal file
View File

@ -0,0 +1,29 @@
program tb0657;
{$mode objfpc}
uses
fgl;
type
TIntList = specialize TFPGList<LongInt>;
const
c = 3;
var
l: TIntList;
i: LongInt;
begin
l := TIntList.Create;
try
for i := 0 to c do
l.Add(i);
for i := 0 to l.Count - 1 do
if l.List^[i] <> i then
Halt(i + 1);
finally
l.Free;
end;
end.

5
tests/utils/testsuite/utests.pp
View File

@ -211,7 +211,10 @@ type
ver_3_0_3,
ver_3_0_4,
ver_3_0_5,
ver_3_1_1);
ver_3_1_1,
ver_3_2_0,
ver_3_2_1,
ver_3_3_1);
const
ver_trunk = high (known_versions);

220
utils/h2pas/h2paschk.pas
View File

@ -48,6 +48,9 @@ program h2paschk;
.blue
.alpha
@TYPE size_t
@CONSTANT O_RW
@C return 0;
@C }
@ -91,6 +94,20 @@ type
procedure DoneLangOutputs;
procedure StartRecord(RecordID: TIdentifier);
procedure HandleType(TypeID: TIdentifier);
procedure HandleConstant(ConstantID: TIdentifier;PascalType,PascalHexStrSize,CType,CFormat : string);
procedure HandleConstant(ConstantID: TIdentifier);
procedure HandleConstantU8(ConstantID: TIdentifier);
procedure HandleConstantU16(ConstantID: TIdentifier);
procedure HandleConstantU32(ConstantID: TIdentifier);
procedure HandleConstantU64(ConstantID: TIdentifier);
procedure HandleSignedConstant(ConstantID: TIdentifier;PascalType,CType,CFormat : string);
procedure HandleSignedConstant(ConstantID: TIdentifier);
procedure HandleConstantS8(ConstantID: TIdentifier);
procedure HandleConstantS16(ConstantID: TIdentifier);
procedure HandleConstantS32(ConstantID: TIdentifier);
procedure HandleConstantS64(ConstantID: TIdentifier);
procedure HandleFloatConstant(ConstantID: TIdentifier);
procedure ProcessField(FieldID: TIdentifier);
public
destructor Destroy; override;
@ -127,11 +144,86 @@ begin
DoneLangOutput(Lang);
end;
procedure TH2PasCheckerCodeGen.HandleType(TypeID: TIdentifier);
begin
Writeln(FLangOutput[lPascal], ' Writeln(''SizeOf(', TypeID[CommLangID], ')='',SizeOf(', TypeID[lPascal], '));');
Writeln(FLangOutput[lC], ' printf("SizeOf(', TypeID[CommLangID], ')=%lu\n",sizeof(', TypeID[lC], '));');
end;
procedure TH2PasCheckerCodeGen.HandleConstant(ConstantID: TIdentifier;PascalType,PascalHexStrSize,CType,CFormat : string);
begin
Writeln(FLangOutput[lPascal], ' Writeln(''Unsigned value Of(', ConstantID[CommLangID], ')=0x'',hexstr(',PascalType,'(', ConstantID[lPascal], '),',PascalHexStrSize,'));');
Writeln(FLangOutput[lC], ' printf("Unsigned value Of(', ConstantID[CommLangID], ')=0x',CFormat,'\n",(',CType,') ', ConstantID[lC], ');');
end;
procedure TH2PasCheckerCodeGen.HandleSignedConstant(ConstantID: TIdentifier;PascalType,CType,CFormat : string);
begin
Writeln(FLangOutput[lPascal], ' Writeln(''Signed value Of(', ConstantID[CommLangID], ')='',',PascalType,'(', ConstantID[lPascal],'));');
Writeln(FLangOutput[lC], ' printf("Signed value Of(', ConstantID[CommLangID], ')=',CFormat,'\n",(',CType,') ', ConstantID[lC],');');
end;
procedure TH2PasCheckerCodeGen.HandleFloatConstant(ConstantID: TIdentifier);
begin
Writeln(FLangOutput[lPascal], ' Writeln(''Value Of(', ConstantID[CommLangID], ')='',',ConstantID[lPascal],':25:25);');
Writeln(FLangOutput[lC], ' printf("Value Of(', ConstantID[CommLangID], ')=%0.25f\n",',ConstantID[lC],');');
end;
procedure TH2PasCheckerCodeGen.HandleConstant(ConstantID: TIdentifier);
begin
HandleConstant(ConstantID,'qword','16','unsigned long long','%016llx');
end;
procedure TH2PasCheckerCodeGen.HandleConstantU8(ConstantID: TIdentifier);
begin
HandleConstant(ConstantID,'byte','2','unsigned char','%02x');
end;
procedure TH2PasCheckerCodeGen.HandleConstantU16(ConstantID: TIdentifier);
begin
HandleConstant(ConstantID,'word','4','unsigned short','%04x');
end;
procedure TH2PasCheckerCodeGen.HandleConstantU32(ConstantID: TIdentifier);
begin
HandleConstant(ConstantID,'dword','8','unsigned int','%08x');
end;
procedure TH2PasCheckerCodeGen.HandleConstantU64(ConstantID: TIdentifier);
begin
HandleConstant(ConstantID,'qword','16','unsigned int','%016llx');
end;
procedure TH2PasCheckerCodeGen.HandleSignedConstant(ConstantID: TIdentifier);
begin
HandleSignedConstant(ConstantID,'int64','signed long long','%lld');
end;
procedure TH2PasCheckerCodeGen.HandleConstantS8(ConstantID: TIdentifier);
begin
HandleSignedConstant(ConstantID,'int8','signed char','%d');
end;
procedure TH2PasCheckerCodeGen.HandleConstantS16(ConstantID: TIdentifier);
begin
HandleSignedConstant(ConstantID,'int16','signed short','%d');
end;
procedure TH2PasCheckerCodeGen.HandleConstantS32(ConstantID: TIdentifier);
begin
HandleSignedConstant(ConstantID,'int32','signed int','%d');
end;
procedure TH2PasCheckerCodeGen.HandleConstantS64(ConstantID: TIdentifier);
begin
HandleSignedConstant(ConstantID,'int64','unsigned int','%lld');
end;
procedure TH2PasCheckerCodeGen.StartRecord(RecordID: TIdentifier);
begin
FCurrentRecord := RecordID;
Writeln(FLangOutput[lPascal], ' Writeln(''SizeOf(', RecordID[CommLangID], ')='',SizeOf(', RecordID[lPascal], '));');
Writeln(FLangOutput[lC], ' printf("SizeOf(', RecordID[CommLangID], ')=%lu\n",sizeof(', RecordID[lC], '));');
HandleType(RecordID);
end;
procedure TH2PasCheckerCodeGen.ProcessField(FieldID: TIdentifier);
@ -156,6 +248,30 @@ var
I: Integer;
ID: TIdentifier;
Lang: TLanguage;
procedure ReadID;
begin
if Pos(',', InS) >= 1 then
begin
for Lang in TLanguage do
begin
if Pos(',', InS) >= 1 then
begin
ID[Lang] := Copy(InS, 1, Pos(',', InS) - 1);
Delete(InS, 1, Pos(',', InS));
end
else
begin
ID[Lang] := InS;
InS := '';
end;
end;
end
else
for Lang in TLanguage do
ID[Lang] := InS;
end;
begin
FInFileName := InFileName;
AssignFile(InF, InFileName);
@ -192,27 +308,69 @@ begin
Writeln(FLangOutput[lPascal], InS);
'@C':
Writeln(FLangOutput[lC], InS);
'@FLOATCONSTANT':
begin
ReadID;
HandleFloatConstant(ID);
end;
'@CONSTANT':
begin
ReadID;
HandleConstant(ID);
end;
'@CONSTANT_U8':
begin
ReadID;
HandleConstantU8(ID);
end;
'@CONSTANT_U16':
begin
ReadID;
HandleConstantU16(ID);
end;
'@CONSTANT_U32':
begin
ReadID;
HandleConstantU32(ID);
end;
'@CONSTANT_U64':
begin
ReadID;
HandleConstantU64(ID);
end;
'@CONSTANT_S':
begin
ReadID;
HandleSignedConstant(ID);
end;
'@CONSTANT_S8':
begin
ReadID;
HandleConstantS8(ID);
end;
'@CONSTANT_S16':
begin
ReadID;
HandleConstantS16(ID);
end;
'@CONSTANT_S32':
begin
ReadID;
HandleConstantU32(ID);
end;
'@CONSTANT_S64':
begin
ReadID;
HandleConstantS64(ID);
end;
'@TYPE':
begin
ReadID;
HandleType(ID);
end;
'@RECORD':
begin
if Pos(',', InS) >= 1 then
begin
for Lang in TLanguage do
begin
if Pos(',', InS) >= 1 then
begin
ID[Lang] := Copy(InS, 1, Pos(',', InS) - 1);
Delete(InS, 1, Pos(',', InS));
end
else
begin
ID[Lang] := InS;
InS := '';
end;
end;
end
else
for Lang in TLanguage do
ID[Lang] := InS;
ReadID;
StartRecord(ID);
end;
else
@ -222,25 +380,7 @@ begin
'.':
begin
Delete(InS, 1, 1);
if Pos(',', InS) >= 1 then
begin
for Lang in TLanguage do
begin
if Pos(',', InS) >= 1 then
begin
ID[Lang] := Copy(InS, 1, Pos(',', InS) - 1);
Delete(InS, 1, Pos(',', InS));
end
else
begin
ID[Lang] := InS;
InS := '';
end;
end;
end
else
for Lang in TLanguage do
ID[Lang] := InS;
ReadID;
ProcessField(ID);
end;
end;