diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc index c8124fc6b1..8627ab9dd9 100644 --- a/rtl/i386/i386.inc +++ b/rtl/i386/i386.inc @@ -91,7 +91,9 @@ end ['EAX','EBX','ECX','ESI','EDI']; {$define FPC_SYSTEM_HAS_FILLCHAR} Procedure FillChar(var x;count:longint;value:byte); - [public,alias: 'FPC_FILLCHAR'];assembler; +{ alias seems to be nowhere used? (JM) + [public,alias: 'FPC_FILLCHAR']; } +assembler; asm cld movl x,%edi @@ -403,7 +405,7 @@ end['EAX','EBX','ECX','EDX','ESI']; ****************************************************************************} {$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR} -procedure int_help_constructor;assembler; [public,alias:'FPC_HELP_CONSTRUCTOR']; +procedure fpc_help_constructor; assembler; [public,alias:'FPC_HELP_CONSTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif} asm { Entry without preamble, since we need the ESP of the constructor Stack (relative to %ebp): @@ -481,7 +483,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_HELP_FAIL} -procedure int_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; +procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; {$ifdef hascompilerproc} compilerproc; {$endif} { should be called with a object that needs to be freed if VMT field is at -1 %edi contains VMT offset in object again } @@ -515,7 +517,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR} -procedure int_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR']; +procedure fpc_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif} asm { Stack (relative to %ebp): 12 Self @@ -553,7 +555,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_NEW_CLASS} -procedure int_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; +procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif} asm { to be sure in the future, we save also edit } pushl %edi @@ -587,7 +589,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS} -procedure int_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; +procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif} asm { to be sure in the future, we save also edit } pushl %edi @@ -615,13 +617,13 @@ asm end; {$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS} -procedure int_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; +procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif} { a non zero class must allways be disposed VMT is allways at pos 0 } asm testl %esi,%esi je .LHFC_1 - call INT_DISPOSE_CLASS + call FPC_DISPOSE_CLASS { set both object places to zero } xorl %esi,%esi movl %esi,8(%ebp) @@ -632,20 +634,12 @@ end; {$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT} -{$ifdef SYSTEMDEBUG} { we want the stack for debugging !! PM } -procedure int_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; +procedure fpc_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif} begin -{$else not SYSTEMDEBUG} -procedure int_check_object;assembler;[public,alias:'FPC_CHECK_OBJECT']; -{$endif not SYSTEMDEBUG} asm pushl %edi -{$ifdef SYSTEMDEBUG} movl obj,%edi -{$else not SYSTEMDEBUG} - movl 8(%esp),%edi -{$endif not SYSTEMDEBUG} pushl %eax { Here we must check if the VMT pointer is nil before } { accessing it... } @@ -661,17 +655,12 @@ asm popl %eax popl %edi { the adress is pushed : it needs to be removed from stack !! PM } -{$ifdef SYSTEMDEBUG} end;{ of asm } end; -{$else SYSTEMDEBUG} - ret $4 -end; -{$endif not SYSTEMDEBUG} {$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT} -procedure int_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT']; +procedure fpc_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif} { checks for a correct vmt pointer } { deeper check to see if the current object is } { really related to the true } @@ -717,7 +706,7 @@ end; ****************************************************************************} {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY} -procedure int_strcopy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY']; +procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY']; {$ifdef hascompilerproc} compilerproc; {$endif} { this procedure must save all modified registers except EDI and ESI !!! } @@ -760,8 +749,8 @@ end; {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} -procedure int_strconcat(s1,s2:pointer); - [public,alias:'FPC_SHORTSTR_CONCAT']; +procedure fpc_shortstr_concat(s1,s2:pointer); + [public,alias:'FPC_SHORTSTR_CONCAT']; {$ifdef hascompilerproc} compilerproc; {$endif} begin asm movl s2,%edi @@ -800,7 +789,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE} -procedure int_strcmp(dstr,sstr:pointer);[public,alias:'FPC_SHORTSTR_COMPARE']; +function fpc_shortstr_compare(dstr,sstr:pointer): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif} begin asm cld @@ -850,7 +839,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} -function strpas(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; +function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif} {$include strpas.inc} {$define FPC_SYSTEM_HAS_STRLEN} @@ -858,7 +847,7 @@ function strlen(p:pchar):longint;assembler; {$include strlen.inc} {$define FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR} -function strchararray(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; +function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif} begin asm cld @@ -1115,7 +1104,18 @@ procedure inclocked(var l : longint);assembler; { $Log$ - Revision 1.13 2001-07-08 21:00:18 peter + Revision 1.14 2001-08-01 15:00:09 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.13 2001/07/08 21:00:18 peter * various widestring updates, it works now mostly without charset mapping supported diff --git a/rtl/i386/rttip.inc b/rtl/i386/rttip.inc index e83ae0ae2c..a7ecd394f6 100644 --- a/rtl/i386/rttip.inc +++ b/rtl/i386/rttip.inc @@ -18,7 +18,9 @@ { much faster } {$define FPC_SYSTEM_HAS_FPC_INITIALIZE} -Procedure Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE'];assembler; + +Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias:'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif} +assembler; asm // Save registers push %eax @@ -90,7 +92,7 @@ asm addl $4,%ebx // push data pushl %eax - call Initialize + call INT_INITIALIZE jmp .LMyRecordInitLoop // Array handling .LDoArrayInit: @@ -118,7 +120,7 @@ asm addl Data,%eax // push data pushl %eax - call Initialize + call INT_INITIALIZE jmp .LMyArrayInitLoop // AnsiString handling : .LDoAnsiStringInit: @@ -133,7 +135,9 @@ end; {$define FPC_SYSTEM_HAS_FPC_FINALIZE} -Procedure int_finalize (Data,TypeInfo: Pointer);[Public,Alias:'FPC_FINALIZE'];assembler; + +Procedure fpc_finalize (Data,TypeInfo: Pointer);[Public,Alias:'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif} +assembler; asm push %eax push %ebx @@ -167,7 +171,7 @@ asm // Interfaces .LDoInterfaceFinal: pushl Data - call Int_Intf_Decr_Ref + call Intf_Decr_Ref jmp .LExitFinalize // Variants .LDoVariantFinal: @@ -176,7 +180,7 @@ asm .LDoDynArrayFinal: pushl TypeInfo pushl Data - call DYNARRAY_DECR_REF + call FPC_DYNARRAY_DECR_REF jmp .LExitFinalize .LDoClassFinal: .LDoObjectFinal: @@ -237,7 +241,7 @@ asm // AnsiString handling : .LDoAnsiStringFinal: pushl Data - call ANSISTR_DECR_REF + call FPC_ANSISTR_DECR_REF .LExitFinalize: pop %edx pop %ecx @@ -247,7 +251,9 @@ end; {$define FPC_SYSTEM_HAS_FPC_ADDREF} -Procedure Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF'];Assembler; + +Procedure fpc_Addref (Data,TypeInfo : Pointer); [Public,alias : 'FPC_ADDREF']; {$ifdef hascompilerproc} compilerproc; {$endif} +Assembler; asm // Save registers push %eax @@ -282,7 +288,7 @@ asm // Interfaces .LDoInterfaceAddRef: pushl Data - call INT_INTF_INCR_REF + call INTF_INCR_REF jmp .LExitAddRef // Variants .LDoVariantAddRef: @@ -316,7 +322,7 @@ asm addl $4,%ebx // push data pushl %eax - call ADDREF + call INT_ADDREF jmp .LMyRecordAddRefLoop // Array handling .LDoArrayAddRef: @@ -344,12 +350,12 @@ asm addl Data,%eax // push data pushl %eax - call ADDREF + call INT_ADDREF jmp .LMyArrayAddRefLoop // AnsiString handling : .LDoAnsiStringAddRef: pushl Data - call ANSISTR_INCR_REF + call FPC_ANSISTR_INCR_REF .LExitAddRef: pop %edx pop %ecx @@ -359,7 +365,8 @@ end; {$define FPC_SYSTEM_HAS_FPC_DECREF} -Procedure DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF'];Assembler; +Procedure fpc_DecRef (Data,TypeInfo : Pointer); [Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif} +Assembler; asm // Save registers push %eax @@ -394,7 +401,7 @@ asm // Interfaces .LDoInterfaceDecRef: pushl Data - call INT_INTF_DECR_REF + call INTF_DECR_REF jmp .LExitDecRef // Variants .LDoVariantDecRef: @@ -429,7 +436,7 @@ asm addl $4,%ebx // push data pushl %eax - call DECREF + call INT_DECREF jmp .LMyRecordDecRefLoop // Array handling .LDoArrayDecRef: @@ -457,13 +464,13 @@ asm addl Data,%eax // push data pushl %eax - call DECREF + call INT_DECREF jmp .LMyArrayDecRefLoop // AnsiString handling : .LDoAnsiStringDecRef: movl Data,%eax pushl %eax - call ANSISTR_DECR_REF + call FPC_ANSISTR_DECR_REF .LExitDecRef: pop %edx pop %ecx @@ -473,7 +480,18 @@ end; { $Log$ - Revision 1.9 2001-05-31 22:42:56 florian + Revision 1.10 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.9 2001/05/31 22:42:56 florian * some fixes for widestrings and variants Revision 1.8 2001/04/23 18:25:44 peter diff --git a/rtl/i386/set.inc b/rtl/i386/set.inc index c199831884..b5f5b934e4 100644 --- a/rtl/i386/set.inc +++ b/rtl/i386/set.inc @@ -15,7 +15,7 @@ **********************************************************************} {$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL} -procedure do_load_small(p : pointer;l:longint);assembler;[public,alias:'FPC_SET_LOAD_SMALL']; +procedure fpc_set_load_small(p : pointer;l:longint);assembler;[public,alias:'FPC_SET_LOAD_SMALL']; {$ifdef hascompilerproc} compilerproc; {$endif} { load a normal set p from a smallset l } @@ -31,7 +31,7 @@ asm end; {$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT} -procedure do_create_element(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; +procedure fpc_set_create_element(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; {$ifdef hascompilerproc} compilerproc; {$endif} { create a new set in p from an element b } @@ -56,7 +56,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE} -procedure do_set_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_SET_BYTE']; +procedure fpc_set_set_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_SET_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif} { add the element b to the set pointed by p } @@ -75,7 +75,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE} -procedure do_unset_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_UNSET_BYTE']; +procedure fpc_set_unset_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_UNSET_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif} { suppresses the element b to the set pointed by p used for exclude(set,element) @@ -95,7 +95,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE} -procedure do_set_range(p : pointer;l,h : byte);assembler;[public,alias:'FPC_SET_SET_RANGE']; +procedure fpc_set_set_range(p : pointer;l,h : byte);assembler;[public,alias:'FPC_SET_SET_RANGE']; {$ifdef hascompilerproc} compilerproc; {$endif} { adds the range [l..h] to the set pointed to by p } @@ -142,7 +142,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE} -procedure do_in_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_IN_BYTE']; +procedure fpc_set_in_byte(p : pointer;b : byte);assembler;[public,alias:'FPC_SET_IN_BYTE']; {$ifdef hascompilerproc} compilerproc; {$endif} { tests if the element b is in the set p the carryflag is set if it present } @@ -161,7 +161,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS} -procedure do_add_sets(set1,set2,dest : pointer);assembler;[public,alias:'FPC_SET_ADD_SETS']; +procedure fpc_set_add_sets(set1,set2,dest : pointer);assembler;[public,alias:'FPC_SET_ADD_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { adds set1 and set2 into set dest } @@ -181,7 +181,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS} -procedure do_mul_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_MUL_SETS']; +procedure fpc_set_mul_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_MUL_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { multiplies (takes common elements of) set1 and set2 result put in dest } @@ -201,7 +201,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS} -procedure do_sub_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SUB_SETS']; +procedure fpc_set_sub_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SUB_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { computes the diff from set1 to set2 result in dest } @@ -223,7 +223,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS} -procedure do_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; +procedure fpc_set_symdif_sets(set1,set2,dest:pointer);assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { computes the symetric diff from set1 to set2 result in dest } @@ -244,7 +244,7 @@ end; {$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS} -procedure do_comp_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_COMP_SETS']; +procedure fpc_set_comp_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_COMP_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { compares set1 and set2 zeroflag is set if they are equal } @@ -268,9 +268,8 @@ end; -{$IfNDef NoSetInclusion} {$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET} -procedure do_contains_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; +procedure fpc_set_contains_sets(set1,set2 : pointer);assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { on exit, zero flag is set if set1 <= set2 (set2 contains set1) } @@ -292,11 +291,10 @@ asm we have zero flag set, and that what is expected } .LMCONTAINSSETEND: end; -{$EndIf SetInclusion} {$ifdef LARGESETS} -procedure do_set(p : pointer;b : word);assembler;[public,alias:'FPC_SET_SET_WORD']; +procedure fpc_largeset_set_wor(p : pointer;b : word);assembler;[public,alias:'FPC_LARGESET_SET_WORD']; {$ifdef hascompilerproc} compilerproc; {$endif} { sets the element b in set p works for sets larger than 256 elements not yet use by the compiler so @@ -315,7 +313,7 @@ asm end; -procedure do_in(p : pointer;b : word);assembler;[public,alias:'FPC_SET_IN_WORD']; +procedure fpc_largeset_in_word(p : pointer;b : word);assembler;[public,alias:'FPC_LARGESET_IN_WORD']; {$ifdef hascompilerproc} compilerproc; {$endif} { tests if the element b is in the set p the carryflag is set if it present works for sets larger than 256 elements @@ -334,7 +332,7 @@ asm end; -procedure add_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_ADD_SETS_SIZE']; +procedure fpc_largeset_add_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_ADD_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { adds set1 and set2 into set dest size is the number of bytes in the set } @@ -353,7 +351,7 @@ asm end; -procedure mul_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_MUL_SETS_SIZE']; +procedure fpc_largeset_mul_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_MUL_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { multiplies (i.E. takes common elements of) set1 and set2 result put in dest size is the number of bytes in the set @@ -373,7 +371,7 @@ asm end; -procedure sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SUB_SETS_SIZE']; +procedure fpc_largeset_sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_SUB_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} asm movl set1,%esi movl set2,%ebx @@ -391,7 +389,7 @@ asm end; -procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SYMDIF_SETS_SIZE']; +procedure fpc_largeset_symdif_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_SYMDIF_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { computes the symetric diff from set1 to set2 result in dest } @@ -411,7 +409,7 @@ asm end; -procedure comp_sets(set1,set2 : pointer;size : longint);assembler;[public,alias:'FPC_SET_COMP_SETS_SIZE']; +procedure fpc_largeset_comp_sets(set1,set2 : pointer;size : longint);assembler;[public,alias:'FPC_LARGESET_COMP_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} asm movl set1,%esi movl set2,%edi @@ -429,8 +427,7 @@ asm .LMCOMPSETSIZEEND: end; -{$IfNDef NoSetInclusion} -procedure contains_sets(set1,set2 : pointer; size: longint);assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; +procedure fpc_largeset_contains_sets(set1,set2 : pointer; size: longint);assembler;[public,alias:'FPC_LARGESET_CONTAINS_SETS']; {$ifdef hascompilerproc} compilerproc; {$endif} { on exit, zero flag is set if set1 <= set2 (set2 contains set1) } @@ -452,14 +449,24 @@ asm we have zero flag set, and that what is expected } .LMCONTAINSSETEND2: end; -{$EndIf NoSetInclusion} {$endif LARGESET} { $Log$ - Revision 1.4 2001-05-09 19:57:07 peter + Revision 1.5 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.4 2001/05/09 19:57:07 peter *** empty log message *** Revision 1.3 2000/09/21 16:09:19 jonas diff --git a/rtl/inc/aliases.inc b/rtl/inc/aliases.inc new file mode 100644 index 0000000000..6d79ea008b --- /dev/null +++ b/rtl/inc/aliases.inc @@ -0,0 +1,47 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2000 by Florian Klaempfl + member of the Free Pascal development team. + + This file contains external definitions (which map to aliases + of functions which are later implemented) so that they can + be called before their implementation is known. We can't use + forward definitions, because there's a bug which causes all + sorts of trouble if you you first declare a procedure as + forward, then call it and then implement it using an + "external name 'bla'" where 'bla' is a public alias of a + procedure defined after the call to the forward defined + procedure. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + ********************************************************************** +} + +{ export for internal usage } +Procedure int_Finalize (Data,TypeInfo: Pointer); [external name 'FPC_FINALIZE']; +Procedure int_Addref (Data,TypeInfo : Pointer);saveregisters; [external name 'FPC_ADDREF']; +Procedure int_DecRef (Data, TypeInfo : Pointer);saveregisters;[external name 'FPC_DECREF']; +Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE']; +procedure int_FinalizeArray(data,typeinfo : pointer;count,size : longint); [external name 'FPC_FINALIZEARRAY']; + +{ + $Log$ + Revision 1.1 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + +} diff --git a/rtl/inc/astrings.inc b/rtl/inc/astrings.inc index e00b0bccb4..e1d8f35989 100644 --- a/rtl/inc/astrings.inc +++ b/rtl/inc/astrings.inc @@ -106,7 +106,7 @@ begin end; -Procedure AnsiStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_DECR_REF']; +Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} { Decreases the ReferenceCount of a non constant ansistring; If the reference count is zero, deallocate the string; @@ -130,8 +130,12 @@ Begin S:=nil; end; +{$ifdef hascompilerproc} +{ also define alias for internal use in the system unit } +Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); [external name 'FPC_ANSISTR_DECR_REF']; +{$endif hascompilerproc} -Procedure AnsiStr_Incr_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_INCR_REF']; +Procedure fpc_AnsiStr_Incr_Ref (Var S : Pointer);[Public,Alias:'FPC_ANSISTR_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} Begin If S=Nil then exit; @@ -140,8 +144,12 @@ Begin inclocked(PAnsiRec(S-FirstOff)^.Ref); end; +{$ifdef hascompilerproc} +{ also define alias which can be used inside the system unit } +Procedure fpc_AnsiStr_Incr_Ref (Var S : Pointer); [external name 'FPC_ANSISTR_INCR_REF']; +{$endif hascompilerproc} -Procedure AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_ANSISTR_ASSIGN']; +Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_ANSISTR_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif} { Assigns S2 to S1 (S1:=S2), taking in account reference counts. } @@ -150,13 +158,17 @@ begin If PAnsiRec(S2-FirstOff)^.Ref>0 then inclocked(PAnsiRec(S2-FirstOff)^.ref); { Decrease the reference count on the old S1 } - ansistr_decr_ref (S1); + fpc_ansistr_decr_ref (S1); { And finally, have S1 pointing to S2 (or its copy) } S1:=S2; end; +{$ifdef hascompilerproc} +{ alias for internal use } +Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_ANSISTR_ASSIGN']; +{$endif hascompilerproc} -Procedure AnsiStr_Concat (S1,S2 : Pointer;var S3 : Pointer);[Public, alias: 'FPC_ANSISTR_CONCAT']; +Procedure fpc_AnsiStr_Concat (S1,S2 : Pointer;var S3 : Pointer);[Public, alias: 'FPC_ANSISTR_CONCAT']; {$ifdef hascompilerproc} compilerproc; {$endif} { Concatenates 2 AnsiStrings : S1+S2. Result Goes to S3; @@ -166,15 +178,14 @@ Var begin { only assign if s1 or s2 is empty } if (S1=Nil) then - AnsiStr_Assign(S3,S2) + fpc_AnsiStr_Assign(S3,S2) else if (S2=Nil) then - AnsiStr_Assign(S3,S1) + fpc_AnsiStr_Assign(S3,S1) else begin { create new result } - if S3<>nil then - AnsiStr_Decr_Ref(S3); + fpc_AnsiStr_Decr_Ref(S3); Size:=PAnsiRec(S2-FirstOff)^.Len; Location:=Length(AnsiString(S1)); SetLength (AnsiString(S3),Size+Location); @@ -206,7 +217,7 @@ end; {$endif EXTRAANSISHORT} -Procedure AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; +Procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts a AnsiString to a ShortString; } @@ -226,7 +237,7 @@ begin end; -Procedure ShortStr_To_AnsiStr (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_ANSISTR']; +Procedure fpc_ShortStr_To_AnsiStr (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts a ShortString to a AnsiString; } @@ -244,7 +255,7 @@ begin end; -Procedure Char_To_AnsiStr(var S1 : Pointer; c : Char);[Public, alias: 'FPC_CHAR_TO_ANSISTR']; +Procedure fpc_Char_To_AnsiStr(var S1 : Pointer; c : Char);[Public, alias: 'FPC_CHAR_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts a ShortString to a AnsiString; } @@ -256,13 +267,13 @@ begin end; -Procedure PChar_To_AnsiStr(var a : ansistring;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_ANSISTR']; +Procedure fpc_PChar_To_AnsiStr(var a : ansistring;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} Var L : Longint; begin if pointer(a)<>nil then begin - AnsiStr_Decr_Ref(Pointer(a)); + fpc_AnsiStr_Decr_Ref(Pointer(a)); pointer(a):=nil; end; if (not assigned(p)) or (p[0]=#0) Then @@ -277,7 +288,7 @@ begin end; -Procedure CharArray_To_AnsiStr(var a : ansistring;p : pchar;l:longint);[Public,Alias : 'FPC_CHARARRAY_TO_ANSISTR']; +Procedure fpc_CharArray_To_AnsiStr(var a : ansistring;p : pchar;l:longint);[Public,Alias : 'FPC_CHARARRAY_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} var i : longint; begin @@ -293,7 +304,7 @@ begin end; -Function AnsiStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_ANSISTR_COMPARE']; +Function fpc_AnsiStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_ANSISTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif} { Compares 2 AnsiStrings; The result is @@ -306,7 +317,7 @@ Var begin if S1=S2 then begin - AnsiStr_Compare:=0; + fpc_AnsiStr_Compare:=0; exit; end; Maxi:=Length(AnsiString(S1)); @@ -316,18 +327,18 @@ begin Temp:=CompareByte(S1^,S2^,MaxI); if temp=0 then temp:=Length(AnsiString(S1))-Length(AnsiString(S2)); - AnsiStr_Compare:=Temp; + fpc_AnsiStr_Compare:=Temp; end; -Procedure AnsiStr_CheckZero(p : pointer);[Public,Alias : 'FPC_ANSISTR_CHECKZERO']; +Procedure fpc_AnsiStr_CheckZero(p : pointer);[Public,Alias : 'FPC_ANSISTR_CHECKZERO']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if p=nil then HandleErrorFrame(201,get_frame); end; -Procedure AnsiStr_CheckRange(len,index : longint);[Public,Alias : 'FPC_ANSISTR_RANGECHECK']; +Procedure fpc_AnsiStr_CheckRange(len,index : longint);[Public,Alias : 'FPC_ANSISTR_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if (index>len) or (Index<1) then HandleErrorFrame(201,get_frame); @@ -336,7 +347,7 @@ end; {$ifndef INTERNSETLENGTH} Procedure SetLength (Var S : AnsiString; l : Longint); {$else INTERNSETLENGTH} -Procedure AnsiStr_SetLength (Var S : AnsiString; l : Longint);[Public,Alias : 'FPC_ANSISTR_SETLENGTH']; +Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : Longint);[Public,Alias : 'FPC_ANSISTR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} {$endif INTERNSETLENGTH} { Sets The length of string S to L. @@ -367,7 +378,7 @@ begin else movelen := succ(length(s)); Move(Pointer(S)^,Temp^,movelen); end; - ansistr_decr_ref(Pointer(S)); + fpc_ansistr_decr_ref(Pointer(S)); Pointer(S):=Temp; end; { Force nil termination in case it gets shorter } @@ -378,13 +389,13 @@ begin begin { Length=0 } if Pointer(S)<>nil then - ansistr_decr_ref (Pointer(S)); + fpc_ansistr_decr_ref (Pointer(S)); Pointer(S):=Nil; end; end; {$ifdef EXTRAANSISHORT} -Function AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint; +Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint; {$ifdef hascompilerproc} compilerproc; {$endif} { Compares a AnsiString with a ShortString; The result is @@ -429,7 +440,10 @@ end; {$endif INTERNLENGTH} -Procedure UniqueString(Var S : AnsiString); [Public,Alias : 'FPC_ANSISTR_UNIQUE']; +{ overloaded version of UniqueString for interface } +Procedure UniqueString(Var S : AnsiString); [external name 'FPC_ANSISTR_UNIQUE']; + +Procedure fpc_ansistr_Unique(Var S : AnsiString); [Public,Alias : 'FPC_ANSISTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif} { Make sure reference count of S is 1, using copy-on-write semantics. @@ -446,7 +460,7 @@ begin SNew:=NewAnsiString (L); Move (Pointer(S)^,SNew^,L+1); PAnsiRec(SNew-FirstOff)^.len:=L; - ansistr_decr_ref (Pointer(S)); { Thread safe } + fpc_ansistr_decr_ref (Pointer(S)); { Thread safe } Pointer(S):=SNew; end; end; @@ -530,92 +544,103 @@ begin end; -Function ValAnsiFloat(Const S : AnsiString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR']; +Function fpc_Val_Real_AnsiStr(Const S : AnsiString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} Var SS : String; begin - AnsiStr_To_ShortStr(SS,Pointer(S)); - ValAnsiFloat := ValFloat(SS,Code); -end; - - -Function ValAnsiUnsignedInt (Const S : AnsiString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_ANSISTR']; -Var - SS : ShortString; -begin - AnsiStr_To_ShortStr(SS,Pointer(S)); - ValAnsiUnsignedInt := ValUnsignedInt(SS,Code); -end; - - -Function ValAnsiSignedInt (DestSize: longint; Const S : AnsiString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_ANSISTR']; -Var - SS : ShortString; -begin - ValAnsiSignedInt:=0; - if length(S)>255 then - code:=256 + fpc_Val_Real_AnsiStr := 0; + if length(S) > 255 then + code := 256 else begin - AnsiStr_To_ShortStr (SS,Pointer(S)); - ValAnsiSignedInt := ValSignedInt(DestSize,SS,Code); - end; -end; - -Function ValAnsiUnsignedint64 (Const S : AnsiString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_ANSISTR']; -Var - SS : ShortString; -begin - ValAnsiUnsignedInt64:=0; - if length(S)>255 then - code:=256 - else - begin - AnsiStr_To_ShortStr(SS,Pointer(S)); - ValAnsiUnsignedInt64 := ValQWord(SS,Code); + SS := S; + Val(SS,fpc_Val_Real_AnsiStr,code); end; end; -Function ValAnsiSignedInt64 (Const S : AnsiString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_ANSISTR']; +Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} Var SS : ShortString; begin - ValAnsiSignedInt64:=0; - if length(S)>255 then - code:=256 + fpc_Val_UInt_AnsiStr := 0; + if length(S) > 255 then + code := 256 else begin - AnsiStr_To_ShortStr (SS,Pointer(S)); - ValAnsiSignedInt64 := valInt64(SS,Code); + SS := S; + Val(SS,fpc_Val_UInt_AnsiStr,code); end; end; -procedure AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; +Function fpc_Val_SInt_AnsiStr (DestSize: longint; Const S : AnsiString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} +Var + SS : ShortString; +begin + fpc_Val_SInt_AnsiStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS := S; + fpc_Val_SInt_AnsiStr := fpc_Val_SInt_ShortStr(DestSize,SS,Code); + end; +end; + +Function fpc_Val_UInt64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} +Var + SS : ShortString; +begin + fpc_Val_UInt64_AnsiStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS := S; + Val(SS,fpc_Val_UInt64_AnsiStr,Code); + end; +end; + + +Function fpc_Val_SInt64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} +Var + SS : ShortString; +begin + fpc_Val_SInt64_AnsiStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS := s; + Val(SS,fpc_Val_SInt64_AnsiStr,Code); + end; +end; + +procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; {$ifdef hascompilerproc} compilerproc; {$endif} var - ss : shortstring; + ss: ShortString; begin str_real(len,fr,d,treal_type(rt),ss); s:=ss; end; -Procedure AnsiStr_Cardinal(C : Cardinal;Len : Longint; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_CARDINAL']; +Procedure fpc_AnsiStr_UInt(C : Cardinal;Len : Longint; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_CARDINAL']; {$ifdef hascompilerproc} compilerproc; {$endif} Var SS : ShortString; begin - int_str_cardinal(C,Len,SS); + str(C:Len,SS); S:=SS; end; -Procedure AnsiStr_Longint(L : Longint; Len : Longint; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_LONGINT']; +Procedure fpc_AnsiStr_SInt(L : Longint; Len : Longint; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_LONGINT']; {$ifdef hascompilerproc} compilerproc; {$endif} Var SS : ShortString; begin - int_Str_Longint (L,Len,SS); + str (L:Len,SS); S:=SS; end; @@ -707,7 +732,18 @@ end; { $Log$ - Revision 1.16 2001-07-10 18:04:37 peter + Revision 1.17 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.16 2001/07/10 18:04:37 peter * merged textfile, readlink and concat ansistring fixes Revision 1.15 2001/07/09 21:15:41 peter diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc new file mode 100644 index 0000000000..d6fd30ec53 --- /dev/null +++ b/rtl/inc/compproc.inc @@ -0,0 +1,195 @@ +{ + $Id$ + This file is part of the Free Pascal Run time library. + Copyright (c) 1999-2000 by the Free Pascal development team + + This file contains the declarations of internal compiler helper + routines. That means you can *NOT* call these directly, as they may + be changed or even removed at any time. The only reason they are + included in the interface of the system unit, is so that the + compiler doesn't need special code to access their parameter + list information etc. + + Note that due to the "compilerproc" directive, it isn't even possible + to use these routines in your programs. + + See the File COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{$ifdef hascompilerproc} + +procedure fpc_Shortstr_SetLength(var s:shortstring;len:StrLenInt); compilerproc; +procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer); compilerproc; +procedure fpc_shortstr_concat(s1,s2:pointer); compilerproc; +function fpc_shortstr_compare(dstr,sstr:pointer) : longint; compilerproc; + +function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring; compilerproc; +procedure fpc_str_to_chararray(strtyp, arraysize: longint; src,dest: pchar);compilerproc; + +function fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc; +function fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc; +procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer); compilerproc; +procedure fpc_dynarray_incr_ref(var p : pointer); compilerproc; +procedure fpc_dynarray_setlength(var p : pointer;pti : pointer; + dimcount : dword;dims : pdynarrayindex); compilerproc; +function fpc_dynarray_copy(var p : pointer;ti : pointer; + dimcount : dword;dims : pdynarrayindex) : pointer; compilerproc; + +procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring); compilerproc; +procedure fpc_ShortStr_Longint(v : longint;len : longint;var s : shortstring); compilerproc; +procedure fpc_shortstr_cardinal(v : cardinal;len : longint;var s : shortstring); compilerproc; +Function fpc_Val_SInt_ShortStr(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; compilerproc; +Function fpc_Val_UInt_Shortstr(Const S: ShortString; var Code: ValSInt): ValUInt; compilerproc; +Function fpc_Val_Real_ShortStr(const s : shortstring; var code : ValSInt): ValReal; compilerproc; + +Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); compilerproc; +Procedure fpc_AnsiStr_Incr_Ref (Var S : Pointer); compilerproc; +Procedure fpc_AnsiStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc; +Procedure fpc_AnsiStr_Concat (S1,S2 : Pointer;var S3 : Pointer); compilerproc; +{$ifdef EXTRAANSISHORT} +Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc; +{$endif EXTRAANSISHORT} +Procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer); compilerproc; +Procedure fpc_ShortStr_To_AnsiStr (Var S1 : Pointer; Const S2 : ShortString); compilerproc; +Procedure fpc_Char_To_AnsiStr(var S1 : Pointer; c : Char); compilerproc; +Procedure fpc_PChar_To_AnsiStr(var a : ansistring;p : pchar); compilerproc; +Procedure fpc_CharArray_To_AnsiStr(var a : ansistring;p : pchar;l:longint); compilerproc; +Function fpc_AnsiStr_Compare(S1,S2 : Pointer): Longint; compilerproc; +Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc; +Procedure fpc_AnsiStr_CheckRange(len,index : longint); compilerproc; +{$ifdef EXTRAANSISHORT} +Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): Longint; compilerproc; +{$endif EXTRAANSISHORT} +Procedure fpc_ansistr_Unique(Var S : AnsiString); compilerproc; + +Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc; +Procedure fpc_WideStr_Incr_Ref (Var S : Pointer); compilerproc; +Procedure fpc_WideStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer); compilerproc; +Procedure fpc_ShortStr_To_WideStr (Var S1 : Pointer; Const S2 : ShortString); compilerproc; +Procedure fpc_WideStr_To_AnsiStr (Var S1 : Pointer;S2 : Pointer); compilerproc; +Procedure fpc_AnsiStr_To_WideStr (Var S1 : Pointer; Const S2 : Pointer); compilerproc; +Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc; +Procedure fpc_WideStr_Concat (S1,S2 : Pointer;var S3 : Pointer); compilerproc; +Procedure fpc_Char_To_WideStr(var S1 : Pointer; c : Char); compilerproc; +Procedure fpc_PChar_To_WideStr(var a : widestring;p : pchar); compilerproc; +Procedure fpc_CharArray_To_WideStr(var a : widestring;p : pchar;l:longint); compilerproc; +Function fpc_WideStr_Compare(S1,S2 : Pointer): Longint; compilerproc; +Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc; +Procedure fpc_WideStr_CheckRange(len,index : longint); compilerproc; +Procedure fpc_WideStr_SetLength (Var S : WideString; l : Longint); compilerproc; +Procedure fpc_widestr_Unique(Var S : WideString); compilerproc; + +Function fpc_Val_Real_AnsiStr(Const S : AnsiString; Var Code : ValSInt): ValReal; compilerproc; +Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; Var Code : ValSInt): ValUInt; compilerproc; +Function fpc_Val_SInt_AnsiStr (DestSize: longint; Const S : AnsiString; Var Code : ValSInt): ValSInt; compilerproc; +Function fpc_Val_UInt64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): qword;compilerproc; +Function fpc_Val_SInt64_AnsiStr (Const S : AnsiString; Var Code : ValSInt): Int64; compilerproc; +procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring); compilerproc; +Procedure fpc_AnsiStr_UInt(C : Cardinal;Len : Longint; Var S : AnsiString); compilerproc; +Procedure fpc_AnsiStr_SInt(L : Longint; Len : Longint; Var S : AnsiString); compilerproc; + +Function fpc_Val_Real_WideStr(Const S : WideString; Var Code : ValSInt): ValReal; compilerproc; +Function fpc_Val_UInt_WideStr (Const S : WideString; Var Code : ValSInt): ValUInt; compilerproc; +Function fpc_Val_SInt_WideStr (DestSize: longint; Const S : WideString; Var Code : ValSInt): ValSInt; compilerproc; +Function fpc_Val_UInt64_WideStr (Const S : WideString; Var Code : ValSInt): qword; compilerproc; +Function fpc_Val_SInt64_WideStr (Const S : WideString; Var Code : ValSInt): Int64; compilerproc; +procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : longint;var s : WideString); compilerproc; +Procedure fpc_WideStr_Cardinal(C : Cardinal;Len : Longint; Var S : WideString); compilerproc; +Procedure fpc_WideStr_Longint(L : Longint; Len : Longint; Var S : WideString); compilerproc; + +function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc; +procedure fpc_do_as(aclass : tclass;aobject : tobject); compilerproc; +procedure fpc_intf_decr_ref(var i: pointer); compilerproc; +procedure fpc_intf_incr_ref(const i: pointer); compilerproc; +procedure fpc_intf_assign(var D: pointer; const S: pointer); compilerproc; +procedure fpc_intf_as(var D: pointer; const S: pointer; const iid: TGUID); compilerproc; + +Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; compilerproc; +Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); compilerproc; +Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject; compilerproc; +Procedure fpc_PopAddrStack; compilerproc; +function fpc_PopObjectStack : TObject; compilerproc; +function fpc_PopSecondObjectStack : TObject; compilerproc; +Procedure fpc_ReRaise; compilerproc; +Function fpc_Catches(Objtype : TClass) : TObject; compilerproc; +Procedure fpc_DestroyException(o : TObject); compilerproc; + +procedure fpc_help_constructor; compilerproc; +procedure fpc_help_fail; compilerproc; +procedure fpc_help_destructor; compilerproc; +procedure fpc_new_class; compilerproc; +procedure fpc_dispose_class; compilerproc; +procedure fpc_help_fail_class; compilerproc; +procedure fpc_check_object(obj : pointer); compilerproc; +procedure fpc_check_object_ext; compilerproc; + +Procedure fpc_Initialize (Data,TypeInfo : pointer); compilerproc; +Procedure fpc_Finalize (Data,TypeInfo: Pointer); compilerproc; +Procedure fpc_Addref (Data,TypeInfo : Pointer); compilerproc; +Procedure fpc_DecRef (Data,TypeInfo : Pointer); compilerproc; +procedure fpc_FinalizeArray(data,typeinfo : pointer;count,size : longint); compilerproc; + +procedure fpc_set_load_small(p : pointer;l:longint); compilerproc; +procedure fpc_set_create_element(p : pointer;b : byte); compilerproc; +procedure fpc_set_set_byte(p : pointer;b : byte); compilerproc; +procedure fpc_set_unset_byte(p : pointer;b : byte); compilerproc; +procedure fpc_set_set_range(p : pointer;l,h : byte); compilerproc; +procedure fpc_set_in_byte(p : pointer;b : byte); compilerproc; +procedure fpc_set_add_sets(set1,set2,dest : pointer); compilerproc; +procedure fpc_set_mul_sets(set1,set2,dest:pointer); compilerproc; +procedure fpc_set_sub_sets(set1,set2,dest:pointer); compilerproc; +procedure fpc_set_symdif_sets(set1,set2,dest:pointer); compilerproc; +procedure fpc_set_comp_sets(set1,set2 : pointer); compilerproc; +procedure fpc_set_contains_sets(set1,set2 : pointer); compilerproc; + +{$ifdef LARGESETS} +procedure fpc_largeset_set_word(p : pointer;b : word); compilerproc; +procedure fpc_largeset_in_word(p : pointer;b : word); compilerproc; +procedure fpc_largeset_add_sets(set1,set2,dest : pointer;size : longint); compilerproc; +procedure fpc_largeset_sets(set1,set2,dest : pointer;size : longint); compilerproc; +procedure fpc_largeset_sub_sets(set1,set2,dest : pointer;size : longint); compilerproc; +procedure fpc_largeset_symdif_sets(set1,set2,dest : pointer;size : longint); compilerproc; +procedure fpc_largeset_comp_sets(set1,set2 : pointer;size : longint); compilerproc; +procedure fpc_largeset_contains_sets(set1,set2 : pointer; size: longint); compilerproc; +{$endif LARGESETS} + +procedure fpc_rangeerror; compilerproc; +procedure fpc_overflow; compilerproc; +procedure fpc_iocheck(addr : longint); compilerproc; + +procedure fpc_InitializeUnits; compilerproc; +// not generated by compiler, called directly in system unit +// procedure fpc_FinalizeUnits; compilerproc; + +{ +Procedure fpc_do_exit; compilerproc; +Procedure fpc_lib_exit; compilerproc; +Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : longint); compilerproc; +Procedure fpc_HandleError (Errno : longint); compilerproc; +} + +procedure fpc_AbstractErrorIntern;compilerproc; +procedure fpc_assert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); compilerproc; + +{$endif hascompilerproc} + +{ + $Log$ + Revision 1.1 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + +} diff --git a/rtl/inc/dynarr.inc b/rtl/inc/dynarr.inc index 7165ef1a02..a6ec228511 100644 --- a/rtl/inc/dynarr.inc +++ b/rtl/inc/dynarr.inc @@ -16,15 +16,7 @@ ********************************************************************** } -procedure FinalizeArray(data,typeinfo : pointer;count,size : longint);forward; -Procedure Addref (Data,TypeInfo : Pointer);forward; -Procedure int_finalize (Data,TypeInfo: Pointer);forward; - type - tdynarrayindex = longint; - pdynarrayindex = ^tdynarrayindex; - t_size = dword; - { don't add new fields, the size is used } { to calculate memory requirements } pdynarray = ^tdynarray; @@ -43,18 +35,21 @@ type end; -function dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH']; +function fpc_dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} begin - dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high+1; + fpc_dynarray_length := 0; + if assigned(p) then + fpc_dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high+1; end; -function dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_HIGH']; +function fpc_dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_HIGH']; {$ifdef hascompilerproc} compilerproc; {$endif} begin - dynarray_high:=pdynarray(p-sizeof(tdynarray))^.high; + fpc_dynarray_high := -1; + if assigned(p) then + fpc_dynarray_high:=pdynarray(p-sizeof(tdynarray))^.high; end; - { releases and finalizes the data of a dyn. array and sets p to nil } procedure dynarray_clear(var p : pdynarray;ti : pdynarraytypeinfo); begin @@ -62,7 +57,7 @@ procedure dynarray_clear(var p : pdynarray;ti : pdynarraytypeinfo); inc(pointer(ti),ord(ti^.namelen)); { finalize all data } - finalizearray(p,ti^.eletype,p^.high+1,ti^.elesize); + int_finalizearray(p,ti^.eletype,p^.high+1,ti^.elesize); { release the data } freemem(p,sizeof(tdynarray)+(p^.high+1)*ti^.elesize); @@ -70,7 +65,7 @@ procedure dynarray_clear(var p : pdynarray;ti : pdynarraytypeinfo); end; -procedure dynarray_decr_ref(var p : pointer;ti : pdynarraytypeinfo);[Public,Alias:'FPC_DYNARRAY_DECR_REF']; +procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer);[Public,Alias:'FPC_DYNARRAY_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} var realp : pdynarray; begin @@ -84,12 +79,16 @@ procedure dynarray_decr_ref(var p : pointer;ti : pdynarraytypeinfo);[Public,Alia { decr. ref. count } { should we remove the array? } if declocked(realp^.refcount) then - dynarray_clear(realp,ti); + dynarray_clear(realp,pdynarraytypeinfo(ti)); p:=nil; end; +{$ifdef hascompilerproc} +{ provide local access to dynarr_decr_ref for dynarr_setlength } +procedure fpc_dynarray_decr_ref(var p : pointer;ti : pointer); [external name 'FPC_DYNARRAY_DECR_REF']; +{$endif} -procedure dynarray_incr_ref(var p : pointer);[Public,Alias:'FPC_DYNARRAY_INCR_REF']; +procedure fpc_dynarray_incr_ref(var p : pointer);[Public,Alias:'FPC_DYNARRAY_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} var realp : pdynarray; begin @@ -103,9 +102,17 @@ procedure dynarray_incr_ref(var p : pointer);[Public,Alias:'FPC_DYNARRAY_INCR_RE inclocked(realp^.refcount); end; +{$ifdef hascompilerproc} +{ provide local access to dynarr_decr_ref for dynarr_setlength } +procedure fpc_dynarray_incr_ref(var p : pointer;ti : pointer); [external name 'FPC_DYNARRAY_INCR_REF']; +{$endif} -procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo; - dimcount : dword;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARR_SETLENGTH']; +{ provide local access to dynarr_setlength } +procedure int_dynarray_setlength(var p : pointer;pti : pointer; + dimcount : dword;dims : pdynarrayindex);[external name 'FPC_DYNARR_SETLENGTH']; + +procedure fpc_dynarray_setlength(var p : pointer;pti : pointer; + dimcount : dword;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} var i : tdynarrayindex; @@ -116,7 +123,7 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo; ti : pdynarraytypeinfo; begin - ti:=pti; + ti:=pdynarraytypeinfo(pti); { skip kind and name } inc(pointer(ti),ord(ti^.namelen)); @@ -139,7 +146,7 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo; { if the new dimension is 0, we've to release all data } if dims[0]=0 then begin - dynarray_clear(realp,pti); + dynarray_clear(realp,pdynarraytypeinfo(pti)); p:=nil; exit; end; @@ -152,7 +159,7 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo; { increment ref. count of members } for i:=0 to dims[0]-1 do - addref(pointer(newp)+sizeof(tdynarray)+ti^.elesize*i,ti^.eletype); + int_addref(pointer(newp)+sizeof(tdynarray)+ti^.elesize*i,ti^.eletype); { a declock(ref. count) isn't enough here } { it could be that the in MT enviroments } @@ -161,7 +168,7 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo; { it is, because it doesn't really matter } { if the array is now removed } - dynarray_decr_ref(p,ti); + fpc_dynarray_decr_ref(p,ti); end else if dims[0]<>realp^.high+1 then begin @@ -179,7 +186,7 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo; { shrink the array? } if dims[0]1 then begin for i:=0 to dims[0]-1 do - dynarray_setlength(pointer(plongint(pointer(newp)+sizeof(tdynarray))[i*ti^.elesize]), + int_dynarray_setlength(pointer(plongint(pointer(newp)+sizeof(tdynarray))[i*ti^.elesize]), ti^.eletype,dimcount-1,@dims[1]); end; end; @@ -207,17 +214,32 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo; newp^.high:=dims[0]-1; end; -function dynarray_copy(var p : pointer;ti : pdynarraytypeinfo; - dimcount : dword;dims : pdynarrayindex) : pointer;[Public,Alias:'FPC_DYNARRAY_COPY']; + +function fpc_dynarray_copy(var p : pointer;ti : pointer; + dimcount : dword;dims : pdynarrayindex) : pointer;[Public,Alias:'FPC_DYNARRAY_COPY']; {$ifdef hascompilerproc} compilerproc; {$endif} begin + { note: ti is of type pdynarrayinfo, but it can't be declared } + { that way because this procedure is also declared in the interface } + { (as compilerproc) and the pdynarraytypeinfo isn't available there } {!!!!!!!!!!} end; { $Log$ - Revision 1.7 2001-05-27 14:28:44 florian + Revision 1.8 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.7 2001/05/27 14:28:44 florian + made the ref. couting MT safe Revision 1.6 2001/04/13 23:49:48 peter diff --git a/rtl/inc/dynarrh.inc b/rtl/inc/dynarrh.inc new file mode 100644 index 0000000000..d228fd80ba --- /dev/null +++ b/rtl/inc/dynarrh.inc @@ -0,0 +1,37 @@ +{ + $Id$ + This file is part of the Free Pascal Run time library. + Copyright (c) 1999-2000 by the Free Pascal development team + + This file contains type declarations necessary for the dynamic + array routine helpers in syshelp.inc + + See the File COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + +**********************************************************************} + +type + tdynarrayindex = longint; + pdynarrayindex = ^tdynarrayindex; + t_size = dword; + +{ + $Log$ + Revision 1.1 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + +} diff --git a/rtl/inc/except.inc b/rtl/inc/except.inc index 4b1a8ed99c..bd439a71f0 100644 --- a/rtl/inc/except.inc +++ b/rtl/inc/except.inc @@ -35,7 +35,7 @@ Type end; - TExceptObjectClass = Class of TObject; + TExceptObjectClass = Class of TObject; Const CatchAllExceptions = -1; @@ -54,11 +54,11 @@ begin end; {$ifndef HAS_ADDR_STACK_ON_STACK} -Function PushExceptAddr (Ft: Longint): PJmp_buf ; +Function fpc_PushExceptAddr (Ft: Longint): PJmp_buf ; [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters; {$else HAS_ADDR_STACK_ON_HEAP} -Function PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; - [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters; +Function fpc_PushExceptAddr (Ft: Longint;_buf,_newaddr : pointer): PJmp_buf ; + [Public, Alias : 'FPC_PUSHEXCEPTADDR'];saveregisters; {$ifdef hascompilerproc} compilerproc; {$endif} {$endif HAS_ADDR_STACK_ON_STACK} var @@ -94,12 +94,12 @@ begin {$endif HAS_ADDR_STACK_ON_STACK} ExceptAddrStack^.Buf:=Buf; ExceptAddrStack^.FrameType:=ft; - PushExceptAddr:=Buf; + fpc_PushExceptAddr:=Buf; end; -Procedure PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); - [Public, Alias : 'FPC_PUSHEXCEPTOBJECT'];saveregisters; +Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); + [Public, Alias : 'FPC_PUSHEXCEPTOBJECT'];saveregisters; {$ifdef hascompilerproc} compilerproc; {$endif} var Newobj : PExceptObject; begin @@ -122,6 +122,11 @@ begin ExceptObjectStack^.Frame:=AFrame; end; +{$ifdef hascompilerproc} +{ make it avalable for local use } +Procedure fpc_PushExceptObj (Obj : TObject; AnAddr,AFrame : Pointer); [external name 'FPC_PUSHEXCEPTOBJECT']; +{$endif} + Procedure DoUnHandledException; begin @@ -132,13 +137,13 @@ begin end; -Function Raiseexcept (Obj : TObject; AnAddr,AFrame : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION']; +Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION']; {$ifdef hascompilerproc} compilerproc; {$endif} begin {$ifdef excdebug} writeln ('In RaiseException'); {$endif} - Raiseexcept:=nil; - PushExceptObj(Obj,AnAddr,AFrame); + fpc_Raiseexception:=nil; + fpc_PushExceptObj(Obj,AnAddr,AFrame); If ExceptAddrStack=Nil then DoUnhandledException; if (RaiseProc <> nil) and (ExceptObjectStack <> nil) then @@ -147,7 +152,7 @@ begin end; -Procedure PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; +Procedure fpc_PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK']; {$ifdef hascompilerproc} compilerproc; {$endif} {$ifndef HAS_ADDR_STACK_ON_STACK} var hp : PExceptAddr; @@ -175,7 +180,7 @@ begin end; -function PopObjectStack : TObject;[Public, Alias : 'FPC_POPOBJECTSTACK']; +function fpc_PopObjectStack : TObject;[Public, Alias : 'FPC_POPOBJECTSTACK']; {$ifdef hascompilerproc} compilerproc; {$endif} var hp : PExceptObject; begin @@ -190,7 +195,7 @@ begin else begin { we need to return the exception object to dispose it } - PopObjectStack:=ExceptObjectStack^.FObject; + fpc_PopObjectStack:=ExceptObjectStack^.FObject; hp:=ExceptObjectStack; ExceptObjectStack:=ExceptObjectStack^.next; dispose(hp); @@ -199,7 +204,7 @@ end; { this is for popping exception objects when a second exception is risen } { in an except/on } -function PopSecondObjectStack : TObject;[Public, Alias : 'FPC_POPSECONDOBJECTSTACK']; +function fpc_PopSecondObjectStack : TObject;[Public, Alias : 'FPC_POPSECONDOBJECTSTACK']; {$ifdef hascompilerproc} compilerproc; {$endif} var hp : PExceptObject; begin @@ -215,14 +220,14 @@ begin else begin { we need to return the exception object to dispose it } - PopSecondObjectStack:=ExceptObjectStack^.next^.FObject; + fpc_PopSecondObjectStack:=ExceptObjectStack^.next^.FObject; hp:=ExceptObjectStack^.next; ExceptObjectStack^.next:=hp^.next; dispose(hp); end; end; -Procedure ReRaise;[Public, Alias : 'FPC_RERAISE']; +Procedure fpc_ReRaise;[Public, Alias : 'FPC_RERAISE']; {$ifdef hascompilerproc} compilerproc; {$endif} begin {$ifdef excdebug} writeln ('In reraise'); @@ -233,20 +238,23 @@ begin end; -Function Catches(Objtype : TExceptObjectClass) : TObject;[Public, Alias : 'FPC_CATCHES']; +Function fpc_Catches(Objtype : TClass) : TObject;[Public, Alias : 'FPC_CATCHES']; {$ifdef hascompilerproc} compilerproc; {$endif} +var + _Objtype : TExceptObjectClass; begin If ExceptObjectStack=Nil then begin Writeln ('Internal error.'); halt (255); end; - if Not ((Objtype = TExceptObjectClass(CatchAllExceptions)) or - (ExceptObjectStack^.FObject is ObjType)) then - Catches:=Nil + _Objtype := TExceptObjectClass(Objtype); + if Not ((_Objtype = TExceptObjectClass(CatchAllExceptions)) or + (ExceptObjectStack^.FObject is _ObjType)) then + fpc_Catches:=Nil else begin // catch ! - Catches:=ExceptObjectStack^.FObject; + fpc_Catches:=ExceptObjectStack^.FObject; { this can't be done, because there could be a reraise (PFV) PopObjectStack; @@ -256,7 +264,7 @@ begin end; end; -Procedure DestroyException(o : TObject);[Public, Alias : 'FPC_DESTROYEXCEPTION']; +Procedure fpc_DestroyException(o : TObject);[Public, Alias : 'FPC_DESTROYEXCEPTION']; {$ifdef hascompilerproc} compilerproc; {$endif} begin { with free we're on the really save side } o.Free; @@ -273,7 +281,18 @@ begin end; { $Log$ - Revision 1.6 2001-04-13 22:30:04 peter + Revision 1.7 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.6 2001/04/13 22:30:04 peter * remove warnings Revision 1.5 2001/01/24 21:47:18 florian diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 1443eac585..e9d202d06e 100644 --- a/rtl/inc/generic.inc +++ b/rtl/inc/generic.inc @@ -330,7 +330,7 @@ end; FPC_HELP_CONSTRUCTOR : generic allways means aa little less efficient (PM) } { I don't think we really need to save any registers here } { since this is called at the start of the constructor (CEC) } -function int_help_constructor(var _self : pointer; var vmt : pointer; vmt_pos : cardinal) : pointer; [public,alias:'FPC_HELP_CONSTRUCTOR']; +function fpc_help_constructor(var _self : pointer; var vmt : pointer; vmt_pos : cardinal) : pointer; [public,alias:'FPC_HELP_CONSTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif} type ppointer = ^pointer; pvmt = ^tvmt; @@ -363,7 +363,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR} -procedure int_help_destructor(var _self : pointer; vmt : pointer; vmt_pos : cardinal);saveregisters;[public,alias:'FPC_HELP_DESTRUCTOR']; +procedure fpc_help_destructor(var _self : pointer; vmt : pointer; vmt_pos : cardinal);saveregisters;[public,alias:'FPC_HELP_DESTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif} type ppointer = ^pointer; pvmt = ^tvmt; @@ -431,7 +431,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT} -procedure int_check_object(vmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT']; +procedure fpc_check_object(vmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif} type pvmt = ^tvmt; tvmt = packed record @@ -453,7 +453,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT} -procedure int_check_object_ext(vmt, expvmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT_EXT']; +procedure fpc_check_object_ext(vmt, expvmt : pointer);saveregisters;[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif} type pvmt = ^tvmt; tvmt = packed record @@ -482,7 +482,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COPY} -procedure int_strcopy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY']; +procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY']; {$ifdef hascompilerproc} compilerproc; {$endif} var slen : byte; type @@ -509,7 +509,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} -procedure int_strconcat(s1,s2:pointer);[public,alias:'FPC_SHORTSTR_CONCAT']; +procedure fpc_shortstr_concat(s1,s2:pointer);[public,alias:'FPC_SHORTSTR_CONCAT']; {$ifdef hascompilerproc} compilerproc; {$endif} var s1l, s2l : byte; type @@ -529,7 +529,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE} -function int_strcmp(rightstr,leftstr:pointer) : longint;[public,alias:'FPC_SHORTSTR_COMPARE']; +function fpc_shortstr_compare(rightstr,leftstr:pointer) : longint;[public,alias:'FPC_SHORTSTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif} var s1,s2,max,i : byte; d : longint; @@ -562,7 +562,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} -function strpas(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; +function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif} var l : longint; s: shortstring; @@ -581,9 +581,12 @@ end; {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} +{ also add a strpas alias for internal use in the system unit (JM) } +function strpas(p:pchar):shortstring; [external name 'FPC_PCHAR_TO_SHORTSTR']; + {$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR} -function strchararray(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; +function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif} var s: shortstring; begin @@ -604,7 +607,7 @@ end; {$endif} {$ifndef FPC_SYSTEM_HAS_FPC_STR_TO_CHARARRAY} -procedure str_to_chararray(strtyp, arraysize: longint; src,dest: pchar);[public,alias:'FPC_STR_TO_CHARARRAY']; +procedure fpc_str_to_chararray(strtyp, arraysize: longint; src,dest: pchar);[public,alias:'FPC_STR_TO_CHARARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif} type plongint = ^longint; var @@ -826,7 +829,18 @@ end; { $Log$ - Revision 1.16 2001-07-31 19:36:51 peter + Revision 1.17 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.16 2001/07/31 19:36:51 peter * small cleanup of commented code (merged) Revision 1.15 2001/07/29 13:49:15 peter diff --git a/rtl/inc/genrtti.inc b/rtl/inc/genrtti.inc index e3372459b7..e9aa459357 100644 --- a/rtl/inc/genrtti.inc +++ b/rtl/inc/genrtti.inc @@ -17,7 +17,7 @@ {$ifndef FPC_SYSTEM_HAS_FPC_INITIALIZE} -Procedure Initialize (Data,TypeInfo : pointer);saveregisters;[Public,Alias : 'FPC_INITIALIZE']; +Procedure fpc_Initialize (Data,TypeInfo : pointer);saveregisters;[Public,Alias : 'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif} { this definition is sometimes (depending on switches) already defined or not so define it locally to avoid problems PM } @@ -41,7 +41,7 @@ begin Count:=PArrayRec(Temp)^.Count; // get element Count TInfo:=PArrayRec(Temp)^.Info; // Get element info For I:=0 to Count-1 do - Initialize (Data+(I*size),TInfo); + int_Initialize (Data+(I*size),TInfo); end; tkrecord : begin @@ -52,14 +52,15 @@ begin Count:=PRecRec(Temp)^.Count; // get element Count For I:=1 to count Do With PRecRec(Temp)^.elements[I] do - Initialize (Data+Offset,Info); + int_Initialize (Data+Offset,Info); end; end; end; {$endif} {$ifndef FPC_SYSTEM_HAS_FPC_FINALIZE} -Procedure Finalize (Data,TypeInfo: Pointer);saveregisters;[Public,Alias : 'FPC_FINALIZE']; + +Procedure fpc_Finalize (Data,TypeInfo: Pointer);saveregisters;[Public,Alias : 'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif} { this definition is sometimes (depending on switches) already defined or not so define it locally to avoid problems PM } @@ -83,7 +84,7 @@ begin Count:=PArrayRec(Temp)^.Count; // get element Count TInfo:=PArrayRec(Temp)^.Info; // Get element info For I:=0 to Count-1 do - Finalize (Data+(I*size),TInfo); + int_Finalize (Data+(I*size),TInfo); end; tkrecord : begin @@ -94,14 +95,15 @@ begin Count:=PRecRec(Temp)^.Count; // get element Count For I:=1 to count do With PRecRec(Temp)^.elements[I] do - Finalize (Data+Offset,Info); + int_Finalize (Data+Offset,Info); end; end; end; {$endif} {$ifndef FPC_SYSTEM_HAS_FPC_ADDREF} -Procedure Addref (Data,TypeInfo : Pointer);saveregisters; [Public,alias : 'FPC_ADDREF']; + +Procedure fpc_Addref (Data,TypeInfo : Pointer);saveregisters; [Public,alias : 'FPC_ADDREF']; {$ifdef hascompilerproc} compilerproc; {$endif} { this definition is sometimes (depending on switches) already defined or not so define it locally to avoid problems PM } @@ -112,7 +114,6 @@ Var Temp : PByte; I : longint; Size,Count : longint; TInfo : Pointer; - begin Temp:=PByte(TypeInfo); case temp^ of @@ -122,7 +123,7 @@ begin { expects a var parameter, so to pass the address of the } { ansistring and not that of the data parameter on the stack, } { you have to dereference data (JM) } - tkAstring,tkWstring : AnsiStr_Incr_Ref(PPointer(Data)^); + tkAstring,tkWstring : fpc_AnsiStr_Incr_Ref(PPointer(Data)^); tkArray : begin Temp:=Temp+1; @@ -132,7 +133,7 @@ begin Count:=PArrayRec(Temp)^.Count; // get element Count TInfo:=PArrayRec(Temp)^.Info; // Get element info For I:=0 to Count-1 do - AddRef (Data+(I*size),TInfo); + int_AddRef (Data+(I*size),TInfo); end; tkrecord : begin @@ -143,14 +144,16 @@ begin Count:=PRecRec(Temp)^.Count; // get element Count For I:=1 to count do With PRecRec(Temp)^.elements[I] do - AddRef (Data+Offset,Info); + int_AddRef (Data+Offset,Info); end; end; end; {$endif} + {$ifndef FPC_SYSTEM_HAS_FPC_DECREF} -Procedure DecRef (Data, TypeInfo : Pointer);saveregisters;[Public,alias : 'FPC_DECREF']; + +Procedure fpc_DecRef (Data, TypeInfo : Pointer);saveregisters;[Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif} { this definition is sometimes (depending on switches) already defined or not so define it locally to avoid problems PM } Type @@ -165,7 +168,7 @@ begin Temp:=PByte(TypeInfo); case temp^ of { see AddRef for comment about below construct (JM) } - tkAstring,tkWstring : AnsiStr_Decr_Ref(PPointer(Data)^); + tkAstring,tkWstring : fpc_AnsiStr_Decr_Ref(PPointer(Data)^); tkArray : begin Temp:=Temp+1; @@ -175,7 +178,7 @@ begin Count:=PArrayRec(Temp)^.Count; // get element Count TInfo:=PArrayRec(Temp)^.Info; // Get element info For I:=0 to Count-1 do - DecRef (Data+(I*size),TInfo); + fpc_DecRef (Data+(I*size),TInfo); end; tkrecord : begin @@ -186,14 +189,14 @@ begin Count:=PRecRec(Temp)^.Count; // get element Count For I:=1 to count do With PRecRec(Temp)^.elements[I] do - DecRef (Data+Offset,Info); + fpc_DecRef (Data+Offset,Info); end; end; end; {$endif} {$ifndef FPC_SYSTEM_HAS_FPC_FINALIZEARRAY} -procedure FinalizeArray(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY']; +procedure fpc_FinalizeArray(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY']; {$ifdef hascompilerproc} compilerproc; {$endif} var i : longint; begin @@ -204,7 +207,18 @@ procedure FinalizeArray(data,typeinfo : pointer;count,size : longint); [Public,A { $Log$ - Revision 1.4 2001-06-28 19:18:57 peter + Revision 1.5 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.4 2001/06/28 19:18:57 peter * ansistr fix merged Revision 1.3 2001/05/28 20:43:17 peter diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index 5c9a312aaa..fe2f2aaa40 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -19,15 +19,15 @@ ****************************************************************************} { the reverse order of the parameters make code generation easier } - function int_do_is(aclass : tclass;aobject : tobject) : boolean;[public,alias: 'FPC_DO_IS']; + function fpc_do_is(aclass : tclass;aobject : tobject) : boolean;[public,alias: 'FPC_DO_IS']; {$ifdef hascompilerproc} compilerproc; {$endif} begin - int_do_is:=assigned(aobject) and assigned(aclass) and + fpc_do_is:=assigned(aobject) and assigned(aclass) and aobject.inheritsfrom(aclass); end; { the reverse order of the parameters make code generation easier } - procedure int_do_as(aclass : tclass;aobject : tobject);[public,alias: 'FPC_DO_AS']; + procedure fpc_do_as(aclass : tclass;aobject : tobject);[public,alias: 'FPC_DO_AS']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if assigned(aobject) and not(aobject.inheritsfrom(aclass)) then handleerror(219); @@ -35,38 +35,49 @@ {$ifndef HASINTF} { dummies for make cycle with 1.0.x } - procedure int_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF']; + procedure intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF']; begin end; - procedure int_intf_incr_ref(const i: pointer);[public,alias: 'FPC_INTF_INCR_REF']; + procedure intf_incr_ref(const i: pointer);[public,alias: 'FPC_INTF_INCR_REF']; begin end; - procedure int_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; + procedure intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; begin end; - procedure int_intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS']; + procedure intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS']; begin end; {$else HASINTF} { interface helpers } - procedure int_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF']; + procedure fpc_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if assigned(i) then IUnknown(i)._Release; i:=nil; end; - procedure int_intf_incr_ref(const i: pointer);[public,alias: 'FPC_INTF_INCR_REF']; + {$ifdef hascompilerproc} + { local declaration for intf_decr_ref for local access } + procedure intf_decr_ref(var i: pointer); [external name 'FPC_INTF_DECR_REF']; + {$endif hascompilerproc} + + + procedure fpc_intf_incr_ref(const i: pointer);[public,alias: 'FPC_INTF_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if assigned(i) then IUnknown(i)._AddRef; end; - procedure int_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; + {$ifdef hascompilerproc} + { local declaration of intf_incr_ref for local access } + procedure intf_incr_ref(const i: pointer); [external name 'FPC_INTF_INCR_REF']; + {$endif hascompilerproc} + + procedure fpc_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if assigned(S) then IUnknown(S)._AddRef; @@ -75,7 +86,7 @@ D:=S; end; - procedure int_intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS']; + procedure fpc_intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS']; {$ifdef hascompilerproc} compilerproc; {$endif} const S_OK = 0; var @@ -89,7 +100,7 @@ D:=tmpi; end else - int_intf_decr_ref(D); + intf_decr_ref(D); end; {$endif HASINTF} @@ -540,7 +551,7 @@ IEntry:=getinterfaceentry(iid); if Assigned(IEntry) then begin PDWORD(@obj)^:=DWORD(PDWORD(Self))+IEntry^.IOffset; - int_intf_incr_ref(pointer(obj)); { it must be an com interface } + intf_incr_ref(pointer(obj)); { it must be an com interface } getinterface:=True; end else begin @@ -557,7 +568,7 @@ if Assigned(IEntry) then begin PDWORD(@obj)^:=DWORD(PDWORD(Self))+IEntry^.IOffset; if Assigned(IEntry^.iid) then { for Com interfaces } - int_intf_incr_ref(pointer(obj)); + intf_incr_ref(pointer(obj)); getinterfacebystr:=True; end else begin @@ -681,7 +692,18 @@ { $Log$ - Revision 1.15 2001-05-27 14:28:44 florian + Revision 1.16 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.15 2001/05/27 14:28:44 florian + made the ref. couting MT safe Revision 1.14 2001/04/13 22:30:04 peter diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc index 46cf5b0af1..52dc0aaa85 100644 --- a/rtl/inc/sstrings.inc +++ b/rtl/inc/sstrings.inc @@ -21,7 +21,7 @@ {$ifndef INTERNSETLENGTH} procedure SetLength(var s:shortstring;len:StrLenInt); {$else INTERNSETLENGTH} -procedure Shortstr_SetLength(var s:shortstring;len:StrLenInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH']; +procedure fpc_Shortstr_SetLength(var s:shortstring;len:StrLenInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} {$endif INTERNSETLENGTH} begin if Len>255 then @@ -311,13 +311,13 @@ end; Str() Helpers *****************************************************************************} -procedure ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_FLOAT']; +procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_FLOAT']; {$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc} begin str_real(len,fr,d,treal_type(rt),s); end; -procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_LONGINT']; +procedure fpc_shortstr_longint(v : longint;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_LONGINT']; {$ifdef hascompilerproc} compilerproc; {$endif} begin int_str(v,s); if length(s)length(s) then @@ -405,34 +404,40 @@ begin (ValUInt(MaxUIntValue-Temp) < u)) or (prev > maxValue) Then Begin - ValSignedInt := 0; + fpc_Val_SInt_ShortStr := 0; Exit End; Temp:=Temp+u; inc(code); end; code := 0; - ValSignedInt := ValSInt(Temp); + fpc_Val_SInt_ShortStr := ValSInt(Temp); If Negative Then - ValSignedInt := -ValSignedInt; + fpc_Val_SInt_ShortStr := -fpc_Val_SInt_ShortStr; If Not(Negative) and (base <> 10) Then {sign extend the result to allow proper range checking} Case DestSize of - 1: ValSignedInt := shortint(ValSignedInt); - 2: ValSignedInt := smallint(ValSignedInt); + 1: fpc_Val_SInt_ShortStr := shortint(fpc_Val_SInt_ShortStr); + 2: fpc_Val_SInt_ShortStr := smallint(fpc_Val_SInt_ShortStr); { Uncomment the folling once full 64bit support is in place - 4: ValSignedInt := longint(ValSignedInt);} + 4: fpc_Val_SInt_ShortStr := longint(fpc_Val_SInt_ShortStr);} End; end; +{$ifdef hascompilerproc} +{ we need this for fpc_Val_SInt_Ansistr and fpc_Val_SInt_WideStr because } +{ we have to pass the DestSize parameter on (JM) } +Function fpc_Val_SInt_ShortStr(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; [external name 'FPC_VAL_SINT_SHORTSTR']; +{$endif hascompilerproc} -Function ValUnsignedInt(Const S: ShortString; var Code: ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_SHORTSTR']; + +Function fpc_Val_UInt_Shortstr(Const S: ShortString; var Code: ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif} var u, prev : ValUInt; base : byte; negative : boolean; begin - ValUnSignedInt:=0; + fpc_Val_UInt_Shortstr:=0; Code:=InitVal(s,negative,base); If Negative or (Code>length(s)) Then Exit; @@ -445,28 +450,28 @@ begin else u:=16; end; - prev := ValUnsignedInt; + prev := fpc_Val_UInt_Shortstr; If (u>=base) or (ValUInt(MaxUIntValue-u) div ValUInt(Base)=code) do @@ -537,25 +543,25 @@ begin { if esign>0 then for i:=1 to exponent do - valfloat:=valfloat*10 + fpc_Val_Real_ShortStr:=Val_Real_ShortStr*10 else for i:=1 to exponent do - valfloat:=valfloat/10; } + fpc_Val_Real_ShortStr:=Val_Real_ShortStr/10; } hd:=1.0; for i:=1 to exponent do hd:=hd*10.0; if esign>0 then - valfloat:=valfloat*hd + fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*hd else - valfloat:=valfloat/hd; + fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr/hd; { Not all characters are read ? } if length(s)>=code then begin - valfloat:=0.0; + fpc_Val_Real_ShortStr:=0.0; exit; end; { evaluate sign } - valfloat:=valfloat*sign; + fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*sign; { success ! } code:=0; end; @@ -569,7 +575,18 @@ end; { $Log$ - Revision 1.14 2001-07-08 21:00:18 peter + Revision 1.15 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.14 2001/07/08 21:00:18 peter * various widestring updates, it works now mostly without charset mapping supported diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 1d12d78a02..43f76b95c3 100644 --- a/rtl/inc/system.inc +++ b/rtl/inc/system.inc @@ -186,6 +186,8 @@ End; {$i wstrings.inc} {$endif HASWIDESTRING} +{$i aliases.inc} + {***************************************************************************** Dynamic Array support *****************************************************************************} @@ -343,19 +345,19 @@ end; Miscellaneous *****************************************************************************} -procedure int_rangeerror;[public,alias:'FPC_RANGEERROR']; +procedure fpc_rangeerror;[public,alias:'FPC_RANGEERROR']; {$ifdef hascompilerproc} compilerproc; {$endif} begin HandleErrorFrame(201,get_frame); end; -procedure int_overflow;[public,alias:'FPC_OVERFLOW']; +procedure fpc_overflow;[public,alias:'FPC_OVERFLOW']; {$ifdef hascompilerproc} compilerproc; {$endif} begin HandleErrorFrame(215,get_frame); end; -procedure int_iocheck(addr : longint);[saveregisters,public,alias:'FPC_IOCHECK']; +procedure fpc_iocheck(addr : longint);[saveregisters,public,alias:'FPC_IOCHECK']; {$ifdef hascompilerproc} compilerproc; {$endif} var l : longint; begin @@ -406,7 +408,7 @@ type var InitFinalTable : TInitFinalTable;external name 'INITFINAL'; -procedure InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; +procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS']; {$ifdef hascompilerproc} compilerproc; {$endif} var i : longint; begin @@ -437,7 +439,6 @@ begin end; end; - {***************************************************************************** Error / Exit / ExitProc *****************************************************************************} @@ -619,8 +620,12 @@ begin HandleErrorFrame(211,get_frame); end; +{$ifdef hascompilerproc} +{ alias for internal usage in the compiler } +procedure fpc_AbstractErrorIntern; compilerproc; external name 'FPC_ABSTRACTERROR'; +{$endif hascompilerproc} -Procedure int_assert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); [SaveRegisters,Public,Alias : 'FPC_ASSERT']; +Procedure fpc_assert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); [SaveRegisters,Public,Alias : 'FPC_ASSERT']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if pointer(AssertErrorProc)<>nil then AssertErrorProc(Msg,FName,LineNo,ErrorAddr) @@ -661,7 +666,18 @@ end; { $Log$ - Revision 1.20 2001-07-30 21:38:55 peter + Revision 1.21 2001-08-01 15:00:10 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.20 2001/07/30 21:38:55 peter * m68k updates merged Revision 1.19 2001/07/29 14:05:55 peter diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 6393c65582..ca6aa5d790 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -527,9 +527,29 @@ const {$i objpash.inc} + +{***************************************************************************** + Internal helper routines support +*****************************************************************************} + +{$i dynarrh.inc} + +{$i compproc.inc} + { $Log$ - Revision 1.32 2001-07-31 08:57:22 marco + Revision 1.33 2001-08-01 15:00:11 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.32 2001/07/31 08:57:22 marco * Either I did something wrong, or Peter's merge killed wchar decl. Fixed. Revision 1.31 2001/07/30 21:38:55 peter diff --git a/rtl/inc/wstrings.inc b/rtl/inc/wstrings.inc index a7acbd0abc..a4e6c452f4 100644 --- a/rtl/inc/wstrings.inc +++ b/rtl/inc/wstrings.inc @@ -161,7 +161,7 @@ begin end; -Procedure WideStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_DECR_REF']; +Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_DECR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} { Decreases the ReferenceCount of a non constant widestring; If the reference count is zero, deallocate the string; @@ -185,8 +185,12 @@ Begin S:=nil; end; +{$ifdef hascompilerproc} +{ alias for internal use } +Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_DECR_REF']; +{$endif compilerproc} -Procedure WideStr_Incr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_REF']; +Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_REF']; {$ifdef hascompilerproc} compilerproc; {$endif} Begin If S=Nil then exit; @@ -196,7 +200,7 @@ Begin end; -Procedure WideStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR']; +Procedure fpc_WideStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer);[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts a WideString to a ShortString; } @@ -216,7 +220,7 @@ begin end; -Procedure ShortStr_To_WideStr (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_WIDESTR']; +Procedure fpc_ShortStr_To_WideStr (Var S1 : Pointer; Const S2 : ShortString);[Public, alias: 'FPC_SHORTSTR_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts a ShortString to a WideString; } @@ -230,7 +234,7 @@ begin end; -Procedure WideStr_To_AnsiStr (Var S1 : Pointer;S2 : Pointer);[Public, alias: 'FPC_WIDESTR_TO_ANSISTR']; +Procedure fpc_WideStr_To_AnsiStr (Var S1 : Pointer;S2 : Pointer);[Public, alias: 'FPC_WIDESTR_TO_ANSISTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts a WideString to an AnsiString } @@ -253,7 +257,7 @@ begin end; -Procedure AnsiStr_To_WideStr (Var S1 : Pointer; Const S2 : Pointer);[Public, alias: 'FPC_ANSISTR_TO_WIDESTR']; +Procedure fpc_AnsiStr_To_WideStr (Var S1 : Pointer; Const S2 : Pointer);[Public, alias: 'FPC_ANSISTR_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts an AnsiString to a WideString; } @@ -277,7 +281,7 @@ end; { checked against the ansistring routine, 2001-05-27 (FK) } -Procedure WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_WIDESTR_ASSIGN']; +Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[Public,Alias:'FPC_WIDESTR_ASSIGN']; {$ifdef hascompilerproc} compilerproc; {$endif} { Assigns S2 to S1 (S1:=S2), taking in account reference counts. } @@ -286,13 +290,18 @@ begin If PWideRec(S2-WideFirstOff)^.Ref>0 then Inc(PWideRec(S2-WideFirstOff)^.ref); { Decrease the reference count on the old S1 } - widestr_decr_ref (S1); + fpc_widestr_decr_ref (S1); { And finally, have S1 pointing to S2 (or its copy) } S1:=S2; end; +{$ifdef hascompilerproc} +{ alias for internal use } +Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer);[external name 'FPC_WIDESTR_ASSIGN']; +{$endif hascompilerproc} + { checked against the ansistring routine, 2001-05-27 (FK) } -Procedure WideStr_Concat (S1,S2 : Pointer;var S3 : Pointer);[Public, alias: 'FPC_WIDESTR_CONCAT']; +Procedure fpc_WideStr_Concat (S1,S2 : Pointer;var S3 : Pointer);[Public, alias: 'FPC_WIDESTR_CONCAT']; {$ifdef hascompilerproc} compilerproc; {$endif} { Concatenates 2 WideStrings : S1+S2. Result Goes to S3; @@ -302,15 +311,14 @@ Var begin { only assign if s1 or s2 is empty } if (S1=Nil) then - WideStr_Assign(S3,S2) + fpc_WideStr_Assign(S3,S2) else if (S2=Nil) then - WideStr_Assign(S3,S1) + fpc_WideStr_Assign(S3,S1) else begin - { create new result } - if S3<>nil then - WideStr_Decr_Ref(S3); + { create new result } + fpc_WideStr_Decr_Ref(S3); Size:=PWideRec(S2-WideFirstOff)^.Len; Location:=Length(WideString(S1)); SetLength (WideString(S3),Size+Location); @@ -320,7 +328,7 @@ begin end; -Procedure Char_To_WideStr(var S1 : Pointer; c : Char);[Public, alias: 'FPC_CHAR_TO_WIDESTR']; +Procedure fpc_Char_To_WideStr(var S1 : Pointer; c : Char);[Public, alias: 'FPC_CHAR_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} { Converts a Char to a WideString; } @@ -332,13 +340,13 @@ begin end; -Procedure PChar_To_WideStr(var a : widestring;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_WIDESTR']; +Procedure fpc_PChar_To_WideStr(var a : widestring;p : pchar);[Public,Alias : 'FPC_PCHAR_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} Var L : Longint; begin if pointer(a)<>nil then begin - WideStr_Decr_Ref(Pointer(a)); + fpc_WideStr_Decr_Ref(Pointer(a)); pointer(a):=nil; end; if (not assigned(p)) or (p[0]=#0) Then @@ -353,7 +361,7 @@ begin end; -Procedure CharArray_To_WideStr(var a : widestring;p : pchar;l:longint);[Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR']; +Procedure fpc_CharArray_To_WideStr(var a : widestring;p : pchar;l:longint);[Public,Alias : 'FPC_CHARARRAY_TO_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} var i : longint; begin @@ -369,7 +377,7 @@ begin end; -Function WideStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_WIDESTR_COMPARE']; +Function fpc_WideStr_Compare(S1,S2 : Pointer): Longint;[Public,Alias : 'FPC_WIDESTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif} { Compares 2 WideStrings; The result is @@ -382,7 +390,7 @@ Var begin if S1=S2 then begin - WideStr_Compare:=0; + fpc_WideStr_Compare:=0; exit; end; Maxi:=Length(WideString(S1)); @@ -392,18 +400,18 @@ begin Temp:=CompareWord(S1^,S2^,MaxI); if temp=0 then temp:=Length(WideString(S1))-Length(WideString(S2)); - WideStr_Compare:=Temp; + fpc_WideStr_Compare:=Temp; end; -Procedure WideStr_CheckZero(p : pointer);[Public,Alias : 'FPC_WIDESTR_CHECKZERO']; +Procedure fpc_WideStr_CheckZero(p : pointer);[Public,Alias : 'FPC_WIDESTR_CHECKZERO']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if p=nil then HandleErrorFrame(201,get_frame); end; -Procedure WideStr_CheckRange(len,index : longint);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; +Procedure fpc_WideStr_CheckRange(len,index : longint);[Public,Alias : 'FPC_WIDESTR_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif} begin if (index>len) or (Index<1) then HandleErrorFrame(201,get_frame); @@ -412,7 +420,7 @@ end; {$ifndef INTERNSETLENGTH} Procedure SetLength (Var S : WideString; l : Longint); {$else INTERNSETLENGTH} -Procedure WideStr_SetLength (Var S : WideString; l : Longint);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; +Procedure fpc_WideStr_SetLength (Var S : WideString; l : Longint);[Public,Alias : 'FPC_WIDESTR_SETLENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} {$endif INTERNSETLENGTH} { Sets The length of string S to L. @@ -436,7 +444,7 @@ begin Temp:=Pointer(NewWideString(L)); if Length(S)>0 then Move(Pointer(S)^,Temp^,L*sizeof(WideChar)); - WideStr_decr_ref(Pointer(S)); + fpc_WideStr_decr_ref(Pointer(S)); Pointer(S):=Temp; end; { Force nil termination in case it gets shorter } @@ -447,7 +455,7 @@ begin begin { Length=0 } if Pointer(S)<>nil then - WideStr_decr_ref (Pointer(S)); + fpc_WideStr_decr_ref (Pointer(S)); Pointer(S):=Nil; end; end; @@ -473,8 +481,10 @@ begin end; {$endif INTERNLENGTH} +{ overloaded version of UniqueString for interface } +procedure UniqueString(Var S : WideString); [external name 'FPC_WIDESTR_UNIQUE']; -Procedure UniqueString(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE']; +Procedure fpc_widestr_Unique(Var S : WideString); [Public,Alias : 'FPC_WIDESTR_UNIQUE']; {$ifdef hascompilerproc} compilerproc; {$endif} { Make sure reference count of S is 1, using copy-on-write semantics. @@ -491,7 +501,7 @@ begin SNew:=NewWideString (L); Move (PWideChar(S)^,SNew^,(L+1)*sizeof(WideChar)); PWideRec(SNew-WideFirstOff)^.len:=L; - widestr_decr_ref (Pointer(S)); { Thread safe } + fpc_widestr_decr_ref (Pointer(S)); { Thread safe } Pointer(S):=SNew; end; end; @@ -656,70 +666,81 @@ begin Move (Buf[0],S[1],Len*2); end;} - -Function ValWideFloat(Const S : WideString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; +Function fpc_Val_Real_WideStr(Const S : WideString; Var Code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} Var - SS : String; + SS : String; begin - WideStr_To_ShortStr(SS,Pointer(S)); - ValWideFloat := ValFloat(SS,Code); -end; - - -Function ValWideUnsignedInt (Const S : WideString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_WIDESTR']; -Var - SS : ShortString; -begin - WideStr_To_ShortStr(SS,Pointer(S)); - ValWideUnsignedInt := ValUnsignedInt(SS,Code); -end; - - -Function ValWideSignedInt (DestSize: longint; Const S : WideString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR']; -Var - SS : ShortString; -begin - ValWideSignedInt:=0; - if length(S)>255 then - code:=256 + fpc_Val_Real_WideStr := 0; + if length(S) > 255 then + code := 256 else begin - WideStr_To_ShortStr (SS,Pointer(S)); - ValWideSignedInt := ValSignedInt(DestSize,SS,Code); - end; -end; - -Function ValWideUnsignedint64 (Const S : WideString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR']; -Var - SS : ShortString; -begin - ValWideUnsignedInt64:=0; - if length(S)>255 then - code:=256 - else - begin - WideStr_To_ShortStr(SS,Pointer(S)); - ValWideUnsignedInt64 := ValQWord(SS,Code); + SS := S; + Val(SS,fpc_Val_Real_WideStr,code); end; end; -Function ValWideSignedInt64 (Const S : WideString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR']; +Function fpc_Val_UInt_WideStr (Const S : WideString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} Var SS : ShortString; begin - ValWideSignedInt64:=0; + fpc_Val_UInt_WideStr := 0; + if length(S) > 255 then + code := 256 + else + begin + SS := S; + Val(SS,fpc_Val_UInt_WideStr,code); + end; +end; + + +Function fpc_Val_SInt_WideStr (DestSize: longint; Const S : WideString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} +Var + SS : ShortString; +begin + fpc_Val_SInt_WideStr:=0; if length(S)>255 then code:=256 else begin - WideStr_To_ShortStr (SS,Pointer(S)); - ValWideSignedInt64 := valInt64(SS,Code); + SS := S; + fpc_Val_SInt_WideStr := fpc_Val_SInt_ShortStr(DestSize,SS,Code); + end; +end; + +Function fpc_Val_UInt64_WideStr (Const S : WideString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} +Var + SS : ShortString; +begin + fpc_Val_UInt64_WideStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS := S; + Val(SS,fpc_Val_UInt64_WideStr,Code); + end; +end; + + +Function fpc_Val_SInt64_WideStr (Const S : WideString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR']; {$ifdef hascompilerproc} compilerproc; {$endif} +Var + SS : ShortString; +begin + fpc_Val_SInt64_WideStr:=0; + if length(S)>255 then + code:=256 + else + begin + SS := S; + Val(SS,fpc_Val_SInt64_WideStr,Code); end; end; -procedure WideStr_Float(d : ValReal;len,fr,rt : longint;var s : WideString);[public,alias:'FPC_WIDESTR_FLOAT']; +procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : longint;var s : WideString);[public,alias:'FPC_WIDESTR_FLOAT']; {$ifdef hascompilerproc} compilerproc; {$endif} var ss : shortstring; begin @@ -728,21 +749,21 @@ begin end; -Procedure WideStr_Cardinal(C : Cardinal;Len : Longint; Var S : WideString);[Public,Alias : 'FPC_WIDESTR_CARDINAL']; +Procedure fpc_WideStr_Cardinal(C : Cardinal;Len : Longint; Var S : WideString);[Public,Alias : 'FPC_WIDESTR_CARDINAL']; {$ifdef hascompilerproc} compilerproc; {$endif} Var SS : ShortString; begin - int_str_cardinal(C,Len,SS); + str(C:Len,SS); S:=SS; end; -Procedure WideStr_Longint(L : Longint; Len : Longint; Var S : WideString);[Public,Alias : 'FPC_WIDESTR_LONGINT']; +Procedure fpc_WideStr_Longint(L : Longint; Len : Longint; Var S : WideString);[Public,Alias : 'FPC_WIDESTR_LONGINT']; {$ifdef hascompilerproc} compilerproc; {$endif} Var SS : ShortString; begin - int_Str_Longint (L,Len,SS); + Str (L:Len,SS); S:=SS; end; @@ -750,7 +771,18 @@ end; { $Log$ - Revision 1.10 2001-07-16 12:33:08 jonas + Revision 1.11 2001-08-01 15:00:11 jonas + + "compproc" helpers + * renamed several helpers so that their name is the same as their + "public alias", which should facilitate the conversion of processor + specific code in the code generator to processor independent code + * some small fixes to the val_ansistring and val_widestring helpers + (always immediately exit if the source string is longer than 255 + chars) + * fixed fpc_dynarray_high and fpc_dynarray_length if the dynarray is + still nil (used to crash, now return resp -1 and 0) + + Revision 1.10 2001/07/16 12:33:08 jonas * fixed wrong public alieases for val(widestring,...) Revision 1.9 2001/07/09 21:15:41 peter