1 /****************************************************************************
2 **
3 **  This file is part of GAP, a system for computational discrete algebra.
4 **
5 **  Copyright of GAP belongs to its developers, whose names are too numerous
6 **  to list here. Please refer to the COPYRIGHT file for details.
7 **
8 **  SPDX-License-Identifier: GPL-2.0-or-later
9 **
10 **  This file  declares the functions of the  generic function call mechanism
11 **  package.
12 **
13 **  This package defines the *call mechanism* through which one GAP function,
14 **  named the *caller*, can temporarily transfer control to another function,
15 **  named the *callee*.
16 **
17 **  There are *compiled functions* and  *interpreted functions*.  Thus  there
18 **  are four possible pairings of caller and callee.
19 **
20 **  If the caller is compiled,  then the call comes directly from the caller.
21 **  If it  is interpreted, then   the call comes  from one  of the  functions
22 **  'EvalFunccall<i>args' that implement evaluation of function calls.
23 **
24 **  If the callee is compiled,  then the call goes  directly  to the  callee.
25 **  If   it is interpreted,   then the  call   goes to one  of  the  handlers
26 **  'DoExecFunc<i>args' that implement execution of function bodies.
27 **
28 **  The call mechanism makes it in any case unneccessary for the calling code
29 **  to  know  whether the callee  is  a compiled or  an interpreted function.
30 **  Likewise the called code need not know, actually cannot know, whether the
31 **  caller is a compiled or an interpreted function.
32 **
33 **  Also the call mechanism checks that the number of arguments passed by the
34 **  caller is the same as the number of arguments  expected by the callee, or
35 **  it  collects the arguments   in a list  if  the callee allows  a variable
36 **  number of arguments.
37 **
38 **  Finally the call mechanism profiles all functions if requested.
39 **
40 **  All this has very little overhead.  In the  case of one compiled function
41 **  calling  another compiled function, which expects fewer than 4 arguments,
42 **  with no profiling, the overhead is only a couple of instructions.
43 */
44 
45 #ifndef GAP_CALLS_H
46 #define GAP_CALLS_H
47 
48 #include "gaputils.h"
49 #include "objects.h"
50 
51 
52 typedef Obj (* ObjFunc_0ARGS) (Obj self);
53 typedef Obj (* ObjFunc_1ARGS) (Obj self, Obj a1);
54 typedef Obj (* ObjFunc_2ARGS) (Obj self, Obj a1, Obj a2);
55 typedef Obj (* ObjFunc_3ARGS) (Obj self, Obj a1, Obj a2, Obj a3);
56 typedef Obj (* ObjFunc_4ARGS) (Obj self, Obj a1, Obj a2, Obj a3, Obj a4);
57 typedef Obj (* ObjFunc_5ARGS) (Obj self, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5);
58 typedef Obj (* ObjFunc_6ARGS) (Obj self, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, Obj a6);
59 
60 
61 /****************************************************************************
62 **
63 *F  HDLR_FUNC(<func>,<i>) . . . . . . . . . <i>-th call handler of a function
64 *F  NAME_FUNC(<func>) . . . . . . . . . . . . . . . . . .  name of a function
65 *F  NARG_FUNC(<func>) . . . . . . . . . . . number of arguments of a function
66 *F  NAMS_FUNC(<func>) . . . . . . . .  names of local variables of a function
67 *F  NAMI_FUNC(<func>) . . . . . . name of <i>-th local variable of a function
68 *F  PROF_FUNC(<func>) . . . . . . . . profiling information bag of a function
69 *F  NLOC_FUNC(<func>) . . . . . . . . . . . .  number of locals of a function
70 *F  BODY_FUNC(<func>) . . . . . . . . . . . . . . . . . .  body of a function
71 *F  ENVI_FUNC(<func>) . . . . . . . . . . . . . . . environment of a function
72 **
73 **  These functions make it possible to access the various components of a
74 **  function.
75 **
76 **  'HDLR_FUNC(<func>,<i>)' is the <i>-th handler of the function <func>.
77 **
78 **  'NAME_FUNC(<func>)' is the name of the function.
79 **
80 **  'NARG_FUNC(<func>)' is the number of arguments (-1  if  <func>  accepts a
81 **  variable number of arguments).
82 **
83 **  'NAMS_FUNC(<func>)'  is the list of the names of the local variables,
84 **
85 **  'NAMI_FUNC(<func>,<i>)' is the name of the <i>-th local variable.
86 **
87 **  'PROF_FUNC(<func>)' is the profiling information bag.
88 **
89 **  'NLOC_FUNC(<func>)' is the number of local variables of  the  interpreted
90 **  function <func>.
91 **
92 **  'BODY_FUNC(<func>)' is the body.
93 **
94 **  'ENVI_FUNC(<func>)'  is the  environment (i.e., the local  variables bag)
95 **  that was current when <func> was created.
96 **
97 **  'LCKS_FUNC(<func>)' is a string that contains the lock mode for the
98 **  arguments of <func>. Each byte corresponds to the mode for an argument:
99 **  0 means no lock, 1 means a read-only lock, 2 means a read-write lock.
100 **  The value of the bag can be null, in which case no argument requires a
101 **  lock. Only used in HPC-GAP.
102 */
103 typedef struct {
104     ObjFunc handlers[8];
105     Obj name;
106     Obj nargs;
107     Obj namesOfArgsAndLocals;
108     Obj prof;
109     Obj nloc;
110     Obj body;
111     Obj envi;
112 #ifdef HPCGAP
113     Obj locks;
114 #endif
115     // additional data follows for operations
116 } FuncBag;
117 
FUNC(Obj func)118 EXPORT_INLINE FuncBag * FUNC(Obj func)
119 {
120     GAP_ASSERT(TNUM_OBJ(func) == T_FUNCTION);
121     return (FuncBag *)ADDR_OBJ(func);
122 }
123 
CONST_FUNC(Obj func)124 EXPORT_INLINE const FuncBag * CONST_FUNC(Obj func)
125 {
126     GAP_ASSERT(TNUM_OBJ(func) == T_FUNCTION);
127     return (const FuncBag *)CONST_ADDR_OBJ(func);
128 }
129 
130 
HDLR_FUNC(Obj func,Int i)131 EXPORT_INLINE ObjFunc HDLR_FUNC(Obj func, Int i)
132 {
133     GAP_ASSERT(0 <= i && i < 8);
134     return CONST_FUNC(func)->handlers[i];
135 }
136 
NAME_FUNC(Obj func)137 EXPORT_INLINE Obj NAME_FUNC(Obj func)
138 {
139     return CONST_FUNC(func)->name;
140 }
141 
NARG_FUNC(Obj func)142 EXPORT_INLINE Int NARG_FUNC(Obj func)
143 {
144     return INT_INTOBJ(CONST_FUNC(func)->nargs);
145 }
146 
NAMS_FUNC(Obj func)147 EXPORT_INLINE Obj NAMS_FUNC(Obj func)
148 {
149     return CONST_FUNC(func)->namesOfArgsAndLocals;
150 }
151 
152 Obj NAMI_FUNC(Obj func, Int i);
153 
PROF_FUNC(Obj func)154 EXPORT_INLINE Obj PROF_FUNC(Obj func)
155 {
156     return CONST_FUNC(func)->prof;
157 }
158 
NLOC_FUNC(Obj func)159 EXPORT_INLINE UInt NLOC_FUNC(Obj func)
160 {
161     return INT_INTOBJ(CONST_FUNC(func)->nloc);
162 }
163 
BODY_FUNC(Obj func)164 EXPORT_INLINE Obj BODY_FUNC(Obj func)
165 {
166     return CONST_FUNC(func)->body;
167 }
168 
ENVI_FUNC(Obj func)169 EXPORT_INLINE Obj ENVI_FUNC(Obj func)
170 {
171     return CONST_FUNC(func)->envi;
172 }
173 
174 #ifdef HPCGAP
LCKS_FUNC(Obj func)175 EXPORT_INLINE Obj LCKS_FUNC(Obj func)
176 {
177     return CONST_FUNC(func)->locks;
178 }
179 
180 #endif
181 
SET_HDLR_FUNC(Obj func,Int i,ObjFunc hdlr)182 EXPORT_INLINE void SET_HDLR_FUNC(Obj func, Int i, ObjFunc hdlr)
183 {
184     GAP_ASSERT(0 <= i && i < 8);
185     FUNC(func)->handlers[i] = hdlr;
186 }
187 
188 void SET_NAME_FUNC(Obj func, Obj name);
189 
SET_NARG_FUNC(Obj func,Int nargs)190 EXPORT_INLINE void SET_NARG_FUNC(Obj func, Int nargs)
191 {
192     FUNC(func)->nargs = INTOBJ_INT(nargs);
193 }
194 
SET_NAMS_FUNC(Obj func,Obj namesOfArgsAndLocals)195 EXPORT_INLINE void SET_NAMS_FUNC(Obj func, Obj namesOfArgsAndLocals)
196 {
197     FUNC(func)->namesOfArgsAndLocals = namesOfArgsAndLocals;
198 }
199 
SET_PROF_FUNC(Obj func,Obj prof)200 EXPORT_INLINE void SET_PROF_FUNC(Obj func, Obj prof)
201 {
202     FUNC(func)->prof = prof;
203 }
204 
SET_NLOC_FUNC(Obj func,UInt nloc)205 EXPORT_INLINE void SET_NLOC_FUNC(Obj func, UInt nloc)
206 {
207     FUNC(func)->nloc = INTOBJ_INT(nloc);
208 }
209 
SET_BODY_FUNC(Obj func,Obj body)210 EXPORT_INLINE void SET_BODY_FUNC(Obj func, Obj body)
211 {
212     GAP_ASSERT(TNUM_OBJ(body) == T_BODY);
213     FUNC(func)->body = body;
214 }
215 
SET_ENVI_FUNC(Obj func,Obj envi)216 EXPORT_INLINE void SET_ENVI_FUNC(Obj func, Obj envi)
217 {
218     FUNC(func)->envi = envi;
219 }
220 
221 #ifdef HPCGAP
SET_LCKS_FUNC(Obj func,Obj locks)222 EXPORT_INLINE void SET_LCKS_FUNC(Obj func, Obj locks)
223 {
224     FUNC(func)->locks = locks;
225 }
226 #endif
227 
228 /****************************************************************************
229 *
230 *F  IsKernelFunction( <func> )
231 **
232 **  'IsKernelFunction' returns 1 if <func> is a kernel function (i.e.
233 **  compiled from C code), and 0 otherwise.
234 */
235 Int IsKernelFunction(Obj func);
236 
237 
HDLR_0ARGS(Obj func)238 EXPORT_INLINE ObjFunc_0ARGS HDLR_0ARGS(Obj func)
239 {
240     return (ObjFunc_0ARGS)HDLR_FUNC(func, 0);
241 }
242 
HDLR_1ARGS(Obj func)243 EXPORT_INLINE ObjFunc_1ARGS HDLR_1ARGS(Obj func)
244 {
245     return (ObjFunc_1ARGS)HDLR_FUNC(func, 1);
246 }
247 
HDLR_2ARGS(Obj func)248 EXPORT_INLINE ObjFunc_2ARGS HDLR_2ARGS(Obj func)
249 {
250     return (ObjFunc_2ARGS)HDLR_FUNC(func, 2);
251 }
252 
HDLR_3ARGS(Obj func)253 EXPORT_INLINE ObjFunc_3ARGS HDLR_3ARGS(Obj func)
254 {
255     return (ObjFunc_3ARGS)HDLR_FUNC(func, 3);
256 }
257 
HDLR_4ARGS(Obj func)258 EXPORT_INLINE ObjFunc_4ARGS HDLR_4ARGS(Obj func)
259 {
260     return (ObjFunc_4ARGS)HDLR_FUNC(func, 4);
261 }
262 
HDLR_5ARGS(Obj func)263 EXPORT_INLINE ObjFunc_5ARGS HDLR_5ARGS(Obj func)
264 {
265     return (ObjFunc_5ARGS)HDLR_FUNC(func, 5);
266 }
267 
HDLR_6ARGS(Obj func)268 EXPORT_INLINE ObjFunc_6ARGS HDLR_6ARGS(Obj func)
269 {
270     return (ObjFunc_6ARGS)HDLR_FUNC(func, 6);
271 }
272 
HDLR_XARGS(Obj func)273 EXPORT_INLINE ObjFunc_1ARGS HDLR_XARGS(Obj func)
274 {
275     return (ObjFunc_1ARGS)HDLR_FUNC(func, 7);
276 }
277 
278 
279 /****************************************************************************
280 **
281 *F  IS_FUNC( <obj> )  . . . . . . . . . . . . . check if object is a function
282 */
IS_FUNC(Obj obj)283 EXPORT_INLINE int IS_FUNC(Obj obj)
284 {
285     return TNUM_OBJ(obj) == T_FUNCTION;
286 }
287 
288 
289 /****************************************************************************
290 **
291 *F  CALL_0ARGS(<func>)  . . . . . . . . . call a function with 0    arguments
292 *F  CALL_1ARGS(<func>,<arg1>) . . . . . . call a function with 1    arguments
293 *F  CALL_2ARGS(<func>,<arg1>...)  . . . . call a function with 2    arguments
294 *F  CALL_3ARGS(<func>,<arg1>...)  . . . . call a function with 3    arguments
295 *F  CALL_4ARGS(<func>,<arg1>...)  . . . . call a function with 4    arguments
296 *F  CALL_5ARGS(<func>,<arg1>...)  . . . . call a function with 5    arguments
297 *F  CALL_6ARGS(<func>,<arg1>...)  . . . . call a function with 6    arguments
298 *F  CALL_XARGS(<func>,<args>) . . . . . . call a function with more arguments
299 **
300 **  'CALL_<i>ARGS' passes control  to  the function  <func>, which must  be a
301 **  function object  ('T_FUNCTION').  It returns the  return value of <func>.
302 **  'CALL_0ARGS' is for calls passing   no arguments, 'CALL_1ARGS' for  calls
303 **  passing one argument, and so on.   'CALL_XARGS' is for calls passing more
304 **  than 5 arguments, where the arguments must be collected  in a plain list,
305 **  and this plain list must then be passed.
306 **
307 **  'CALL_<i>ARGS' can be used independently  of whether the called  function
308 **  is a compiled   or interpreted function.    It checks that the number  of
309 **  passed arguments is the same  as the number of  arguments expected by the
310 **  callee,  or it collects the  arguments in a list  if  the callee allows a
311 **  variable number of arguments.
312 */
CALL_0ARGS(Obj f)313 EXPORT_INLINE Obj CALL_0ARGS(Obj f)
314 {
315     return HDLR_0ARGS(f)(f);
316 }
317 
CALL_1ARGS(Obj f,Obj a1)318 EXPORT_INLINE Obj CALL_1ARGS(Obj f, Obj a1)
319 {
320     return HDLR_1ARGS(f)(f, a1);
321 }
322 
CALL_2ARGS(Obj f,Obj a1,Obj a2)323 EXPORT_INLINE Obj CALL_2ARGS(Obj f, Obj a1, Obj a2)
324 {
325     return HDLR_2ARGS(f)(f, a1, a2);
326 }
327 
CALL_3ARGS(Obj f,Obj a1,Obj a2,Obj a3)328 EXPORT_INLINE Obj CALL_3ARGS(Obj f, Obj a1, Obj a2, Obj a3)
329 {
330     return HDLR_3ARGS(f)(f, a1, a2, a3);
331 }
332 
CALL_4ARGS(Obj f,Obj a1,Obj a2,Obj a3,Obj a4)333 EXPORT_INLINE Obj CALL_4ARGS(Obj f, Obj a1, Obj a2, Obj a3, Obj a4)
334 {
335     return HDLR_4ARGS(f)(f, a1, a2, a3, a4);
336 }
337 
CALL_5ARGS(Obj f,Obj a1,Obj a2,Obj a3,Obj a4,Obj a5)338 EXPORT_INLINE Obj CALL_5ARGS(Obj f, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5)
339 {
340     return HDLR_5ARGS(f)(f, a1, a2, a3, a4, a5);
341 }
342 
CALL_6ARGS(Obj f,Obj a1,Obj a2,Obj a3,Obj a4,Obj a5,Obj a6)343 EXPORT_INLINE Obj CALL_6ARGS(Obj f, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, Obj a6)
344 {
345     return HDLR_6ARGS(f)(f, a1, a2, a3, a4, a5, a6);
346 }
347 
CALL_XARGS(Obj f,Obj as)348 EXPORT_INLINE Obj CALL_XARGS(Obj f, Obj as)
349 {
350     return HDLR_XARGS(f)(f, as);
351 }
352 
353 
354 /****************************************************************************
355 **
356 *F  CALL_0ARGS_PROF( <func>, <arg1> ) . . . . .  call a prof func with 0 args
357 *F  CALL_1ARGS_PROF( <func>, <arg1>, ... )  . .  call a prof func with 1 args
358 *F  CALL_2ARGS_PROF( <func>, <arg1>, ... )  . .  call a prof func with 2 args
359 *F  CALL_3ARGS_PROF( <func>, <arg1>, ... )  . .  call a prof func with 3 args
360 *F  CALL_4ARGS_PROF( <func>, <arg1>, ... )  . .  call a prof func with 4 args
361 *F  CALL_5ARGS_PROF( <func>, <arg1>, ... )  . .  call a prof func with 5 args
362 *F  CALL_6ARGS_PROF( <func>, <arg1>, ... )  . .  call a prof func with 6 args
363 *F  CALL_XARGS_PROF( <func>, <arg1>, ... )  . .  call a prof func with X args
364 **
365 **  'CALL_<i>ARGS_PROF' is used   in the profile  handler 'DoProf<i>args'  to
366 **  call  the  real  handler  stored  in the   profiling  information of  the
367 **  function.
368 */
CALL_0ARGS_PROF(Obj f)369 EXPORT_INLINE Obj CALL_0ARGS_PROF(Obj f)
370 {
371     return HDLR_0ARGS(PROF_FUNC(f))(f);
372 }
373 
CALL_1ARGS_PROF(Obj f,Obj a1)374 EXPORT_INLINE Obj CALL_1ARGS_PROF(Obj f, Obj a1)
375 {
376     return HDLR_1ARGS(PROF_FUNC(f))(f, a1);
377 }
378 
CALL_2ARGS_PROF(Obj f,Obj a1,Obj a2)379 EXPORT_INLINE Obj CALL_2ARGS_PROF(Obj f, Obj a1, Obj a2)
380 {
381     return HDLR_2ARGS(PROF_FUNC(f))(f, a1, a2);
382 }
383 
CALL_3ARGS_PROF(Obj f,Obj a1,Obj a2,Obj a3)384 EXPORT_INLINE Obj CALL_3ARGS_PROF(Obj f, Obj a1, Obj a2, Obj a3)
385 {
386     return HDLR_3ARGS(PROF_FUNC(f))(f, a1, a2, a3);
387 }
388 
CALL_4ARGS_PROF(Obj f,Obj a1,Obj a2,Obj a3,Obj a4)389 EXPORT_INLINE Obj CALL_4ARGS_PROF(Obj f, Obj a1, Obj a2, Obj a3, Obj a4)
390 {
391     return HDLR_4ARGS(PROF_FUNC(f))(f, a1, a2, a3, a4);
392 }
393 
CALL_5ARGS_PROF(Obj f,Obj a1,Obj a2,Obj a3,Obj a4,Obj a5)394 EXPORT_INLINE Obj CALL_5ARGS_PROF(Obj f, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5)
395 {
396     return HDLR_5ARGS(PROF_FUNC(f))(f, a1, a2, a3, a4, a5);
397 }
398 
CALL_6ARGS_PROF(Obj f,Obj a1,Obj a2,Obj a3,Obj a4,Obj a5,Obj a6)399 EXPORT_INLINE Obj CALL_6ARGS_PROF(Obj f, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, Obj a6)
400 {
401     return HDLR_6ARGS(PROF_FUNC(f))(f, a1, a2, a3, a4, a5, a6);
402 }
403 
CALL_XARGS_PROF(Obj f,Obj as)404 EXPORT_INLINE Obj CALL_XARGS_PROF(Obj f, Obj as)
405 {
406     return HDLR_XARGS(PROF_FUNC(f))(f, as);
407 }
408 
409 
410 /****************************************************************************
411 **
412 *F * * * * * * * * * * * * *  create a new function * * * * * * * * * * * * *
413 */
414 
415 /****************************************************************************
416 **
417 *F  InitHandlerFunc( <handler>, <cookie> ) . . . . . . . . register a handler
418 **
419 **  Every handler should  be registered (once) before  it is installed in any
420 **  function bag. This is needed so that it can be  identified when loading a
421 **  saved workspace.  <cookie> should be a  unique  C string, identifying the
422 **  handler
423 */
424 
425 void InitHandlerFunc(ObjFunc hdlr, const Char * cookie);
426 
427 #ifdef USE_GASMAN
428 
429 const Char * CookieOfHandler(ObjFunc hdlr);
430 
431 ObjFunc HandlerOfCookie(const Char * cookie);
432 
433 void SortHandlers(UInt byWhat);
434 
435 void CheckAllHandlers(void);
436 
437 #endif
438 
439 /****************************************************************************
440 **
441 *F  NewFunction( <name>, <narg>, <nams>, <hdlr> )  . . .  make a new function
442 *F  NewFunctionC( <name>, <narg>, <nams>, <hdlr> ) . . .  make a new function
443 *F  NewFunctionT( <type>, <size>, <name>, <narg>, <nams>, <hdlr> )
444 **
445 **  'NewFunction' creates and returns a new function.  <name> must be  a  GAP
446 **  string containing the name of the function.  <narg> must be the number of
447 **  arguments, where -1 means a variable number of arguments.  <nams> must be
448 **  a GAP list containg the names  of  the  arguments.  <hdlr>  must  be  the
449 **  C function (accepting <self> and  the  <narg>  arguments)  that  will  be
450 **  called to execute the function.
451 **
452 **  'NewFunctionC' does the same as 'NewFunction',  but  expects  <name>  and
453 **  <nams> as C strings.
454 **
455 **  'NewFunctionT' does the same as 'NewFunction', but allows to specify  the
456 **  <type> and <size> of the newly created bag.
457 */
458 Obj NewFunction(Obj name, Int narg, Obj nams, ObjFunc hdlr);
459 
460 Obj NewFunctionC(const Char * name,
461                  Int          narg,
462                  const Char * nams,
463                  ObjFunc      hdlr);
464 
465 Obj NewFunctionT(
466     UInt type, UInt size, Obj name, Int narg, Obj nams, ObjFunc hdlr);
467 
468 
469 /****************************************************************************
470 **
471 *F  ArgStringToList( <nams_c> )
472 **
473 **  'ArgStringToList' takes a C string <nams_c> containing a list of comma
474 **  separated argument names, and turns it into a plist of strings, ready
475 **  to be passed to 'NewFunction' as <nams>.
476 */
477 Obj ArgStringToList(const Char * nams_c);
478 
479 
480 /****************************************************************************
481 **
482 *F * * * * * * * * * * * * * type and print function  * * * * * * * * * * * *
483 */
484 
485 /****************************************************************************
486 **
487 *F  PrintFunction( <func> )   . . . . . . . . . . . . . . .  print a function
488 **
489 **  'PrintFunction' prints  the   function  <func> .
490 */
491 void PrintFunction(Obj func);
492 
493 void PrintKernelFunction(Obj func);
494 
495 
496 /****************************************************************************
497 **
498 **  'CallFuncList( <func>, <list> )'
499 **
500 **  'CallFuncList' calls the  function <func> with the arguments list <list>,
501 **  i.e., it is equivalent to '<func>( <list>[1], <list>[2]... )'.
502 */
503 
504 Obj CallFuncList(Obj func, Obj list);
505 
506 extern Obj CallFuncListOper;
507 
508 /****************************************************************************
509 **
510 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
511 */
512 
513 /****************************************************************************
514 **
515 *F  InitInfoCalls() . . . . . . . . . . . . . . . . . table of init functions
516 */
517 StructInitInfo * InitInfoCalls ( void );
518 
519 
520 #endif // GAP_CALLS_H
521