+ "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)

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
 

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

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

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)
+
+}

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);
+  fpc_Val_Real_AnsiStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Real_AnsiStr,code);
+    end;
 end;
 
 
-Function ValAnsiUnsignedInt (Const S : AnsiString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_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
-  AnsiStr_To_ShortStr(SS,Pointer(S));
-  ValAnsiUnsignedInt := ValUnsignedInt(SS,Code);
+  fpc_Val_UInt_AnsiStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_UInt_AnsiStr,code);
+    end;
 end;
 
 
-Function ValAnsiSignedInt (DestSize: longint; Const S : AnsiString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_ANSISTR'];
+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
-  ValAnsiSignedInt:=0;
+  fpc_Val_SInt_AnsiStr:=0;
   if length(S)>255 then
     code:=256
   else
     begin
-       AnsiStr_To_ShortStr (SS,Pointer(S));
-       ValAnsiSignedInt := ValSignedInt(DestSize,SS,Code);
+       SS := S;
+       fpc_Val_SInt_AnsiStr := fpc_Val_SInt_ShortStr(DestSize,SS,Code);
     end;
 end;
 
-Function ValAnsiUnsignedint64 (Const S : AnsiString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_ANSISTR'];
+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
-  ValAnsiUnsignedInt64:=0;
+  fpc_Val_UInt64_AnsiStr:=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_UInt64_AnsiStr,Code);
     end;
 end;
 
 
-Function ValAnsiSignedInt64 (Const S : AnsiString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_ANSISTR'];
+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
-  ValAnsiSignedInt64:=0;
+  fpc_Val_SInt64_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_SInt64_AnsiStr,Code);
     end;
 end;
 
-
-procedure AnsiStr_Float(d : ValReal;len,fr,rt : longint;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT'];
+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

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)
+
+}

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]<realp^.high+1 then
                       begin
-                          finalizearray(pointer(realp)+sizeof(tdynarray)+ti^.elesize*dims[0],
+                          int_finalizearray(pointer(realp)+sizeof(tdynarray)+ti^.elesize*dims[0],
                             ti^.eletype,realp^.high-dims[0]+1,ti^.elesize);
                          reallocmem(realp,size);
                       end
@@ -198,7 +205,7 @@ procedure dynarray_setlength(var p : pointer;pti : pdynarraytypeinfo;
           if dimcount>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

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)
+
+}

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

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

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

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

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)<len then
@@ -325,7 +325,7 @@ begin
 end;
 
 
-procedure int_str_cardinal(v : cardinal;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_CARDINAL'];
+procedure fpc_shortstr_cardinal(v : cardinal;len : longint;var s : shortstring);[public,alias:'FPC_SHORTSTR_CARDINAL']; {$ifdef hascompilerproc} compilerproc; {$endif}
 begin
   int_str(v,s);
   if length(s)<len then
@@ -374,14 +374,13 @@ begin
   InitVal:=code;
 end;
 
-
-Function ValSignedInt(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_SHORTSTR'];
+Function fpc_Val_SInt_ShortStr(DestSize: longint; Const S: ShortString; var Code: ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 var
   u, temp, prev, maxValue: ValUInt;
   base : byte;
   negative : boolean;
 begin
-  ValSignedInt := 0;
+  fpc_Val_SInt_ShortStr := 0;
   Temp:=0;
   Code:=InitVal(s,negative,base);
   if Code>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)<prev) then
       begin
-        ValUnsignedInt:=0;
+        fpc_Val_UInt_Shortstr:=0;
         exit;
       end;
-     ValUnsignedInt:=ValUnsignedInt*ValUInt(base) + u;
+     fpc_Val_UInt_Shortstr:=fpc_Val_UInt_Shortstr*ValUInt(base) + u;
      inc(code);
    end;
   code := 0;
 end;
 
 
-Function ValFloat(const s : shortstring; var code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR'];
+Function fpc_Val_Real_ShortStr(const s : shortstring; var code : ValSInt): ValReal; [public, alias:'FPC_VAL_REAL_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
 var
   hd,
   esign,sign : valreal;
   exponent,i : longint;
   flags      : byte;
 begin
-  ValFloat:=0.0;
+  fpc_Val_Real_ShortStr:=0.0;
   code:=1;
   exponent:=0;
   esign:=1;
@@ -485,7 +490,8 @@ begin
    begin
    { Read integer part }
       flags:=flags or 1;
-      valfloat:=valfloat*10+(ord(s[code])-ord('0'));
+
+fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*10+(ord(s[code])-ord('0'));
       inc(code);
    end;
 { Decimal ? }
@@ -497,16 +503,16 @@ begin
         begin
            { Read fractional part. }
            flags:=flags or 2;
-           valfloat:=valfloat*10+(ord(s[code])-ord('0'));
+           fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr*10+(ord(s[code])-ord('0'));
            hd:=hd*10.0;
            inc(code);
         end;
-      valfloat:=valfloat/hd;
+      fpc_Val_Real_ShortStr:=fpc_Val_Real_ShortStr/hd;
    end;
  { Again, read integer and fractional part}
   if flags=0 then
    begin
-      valfloat:=0.0;
+      fpc_Val_Real_ShortStr:=0.0;
       exit;
    end;
  { Exponent ? }
@@ -523,7 +529,7 @@ begin
          end;
       if not(s[code] in ['0'..'9']) or (length(s)<code) then
         begin
-           valfloat:=0.0;
+           fpc_Val_Real_ShortStr:=0.0;
            exit;
         end;
       while (s[code] in ['0'..'9']) and (length(s)>=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
 

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

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

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);
+  fpc_Val_Real_WideStr := 0;
+  if length(S) > 255 then
+    code := 256
+  else
+    begin
+      SS := S;
+      Val(SS,fpc_Val_Real_WideStr,code);
+    end;
 end;
 
 
-Function ValWideUnsignedInt (Const S : WideString; Var Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_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
-  WideStr_To_ShortStr(SS,Pointer(S));
-  ValWideUnsignedInt := ValUnsignedInt(SS,Code);
-end;
+  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 ValWideSignedInt (DestSize: longint; Const S : WideString; Var Code : ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_WIDESTR'];
-Var
+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
-  ValWideSignedInt:=0;
+  fpc_Val_SInt_WideStr:=0;
   if length(S)>255 then
     code:=256
   else
     begin
-       WideStr_To_ShortStr (SS,Pointer(S));
-       ValWideSignedInt := ValSignedInt(DestSize,SS,Code);
+      SS := S;
+      fpc_Val_SInt_WideStr := fpc_Val_SInt_ShortStr(DestSize,SS,Code);
     end;
-end;
+end; 
 
-Function ValWideUnsignedint64 (Const S : WideString; Var Code : ValSInt): qword; [public, alias:'FPC_VAL_QWORD_WIDESTR'];
+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
-  ValWideUnsignedInt64:=0;
+  fpc_Val_UInt64_WideStr:=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_UInt64_WideStr,Code);
     end;
-end;
-
-
-Function ValWideSignedInt64 (Const S : WideString; Var Code : ValSInt): Int64; [public, alias:'FPC_VAL_INT64_WIDESTR'];
+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
-  ValWideSignedInt64:=0;
+  fpc_Val_SInt64_WideStr:=0;
   if length(S)>255 then
     code:=256
   else
     begin
-       WideStr_To_ShortStr (SS,Pointer(S));
-       ValWideSignedInt64 := valInt64(SS,Code);
+       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