Extend "compilerproc" with the optional ability to specify an index (same syntax as for "internproc") which allows to map the routine to a syssym.

git-svn-id: trunk@33890 -

compiler/msg/errore.msg

@@ -417,7 +417,7 @@ scan_e_illegal_asmcpu_specifier=02099_E_Illegal assembler CPU instruction set sp
 #
 # Parser
 #
-# 03345 is the last used one
+# 03346 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1553,6 +1553,9 @@ parser_e_packages_not_supported=03344_E_Dynamic packages not supported for targe
 % or it is at least not tested and thus disabled.
 parser_e_cannot_use_hardfloat_in_a_softfloat_environment=03345_E_The HardFloat directive cannot be used if soft float code is generated or fpu emulation is turned on
 % The \var{HardFloat} directive can only be used if an instruction set is used which supports floating point operations.
+parser_e_invalid_internal_function_index=03346_E_Index $1 is not a valid internal function index
+% The index specified for the \var{compilerproc} directive is not an index that's recognized
+% by the compiler.
 %
 %
 % \end{description}

compiler/pdecsub.pas

@@ -1652,6 +1652,23 @@ implementation
                         Procedure directive handlers
 ****************************************************************************}
 
+procedure pd_compilerproc(pd:tabstractprocdef);
+var
+  v : Tconstexprint;
+begin
+  { check for optional syssym index }
+  if try_to_consume(_COLON) then
+    begin
+      v:=get_intconst;
+      if (v<int64(low(longint))) or (v>int64(high(longint))) then
+        message3(type_e_range_check_error_bounds,tostr(v),tostr(low(longint)),tostr(high(longint)))
+      else if not assigned(tsyssym.find_by_number(longint(v.svalue))) then
+        message1(parser_e_invalid_internal_function_index,tostr(v))
+      else
+        tprocdef(pd).extnumber:=longint(v.svalue);
+    end;
+end;
+
 procedure pd_far(pd:tabstractprocdef);
 begin
   pd.declared_far;
@@ -2723,7 +2740,7 @@ const
     ),(
       idtok:_COMPILERPROC;
       pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
-      handler  : nil;
+      handler  : @pd_compilerproc;
       pocall   : pocall_none;
       pooption : [po_compilerproc];
       mutexclpocall : [];