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 contains the functions of the global variables package.
11 **
12 ** The global variables package is the part of the kernel that manages
13 ** global variables, i.e., the global namespace. A global variable binds an
14 ** identifier to a value.
15 **
16 ** A global variable can be automatic. That means that the global variable
17 ** binds the identifier to a function and an argument. When the value of
18 ** the global variable is needed, the function is called with the argument.
19 ** This function call should, as a side-effect, execute an assignment of a
20 ** value to the global variable, otherwise an error is signalled.
21 **
22 ** A global variable can have a number of internal copies, i.e., C variables
23 ** that always reference the same value as the global variable.
24 ** It can also have a special type of internal copy (a fopy) only used for
25 ** functions, where the internal copies
26 ** only reference the same value as the global variable if it is a function.
27 ** Otherwise the internal copies reference functions that signal an error.
28 */
29
30 #include "gvars.h"
31
32 #include "bool.h"
33 #include "calls.h"
34 #include "error.h"
35 #include "gapstate.h"
36 #include "integer.h"
37 #include "io.h"
38 #include "lists.h"
39 #include "modules.h"
40 #include "plist.h"
41 #include "stringobj.h"
42
43 #ifdef HPCGAP
44 #include "hpc/aobjects.h"
45 #include "hpc/guards.h"
46 #include "hpc/thread.h"
47 #include <pthread.h>
48 #endif
49
50
51 #ifdef HPCGAP
52 #define USE_GVAR_BUCKETS
53 #endif
54
55
56 #ifdef USE_GVAR_BUCKETS
57
58 #define GVAR_BUCKETS 1024
59 #define GVAR_BUCKET_SIZE 1024
60
61 #define GVAR_BUCKET(gvar) ((UInt)(gvar) / GVAR_BUCKET_SIZE)
62 #define GVAR_INDEX(gvar) ((UInt)(gvar) % GVAR_BUCKET_SIZE + 1)
63
64 #endif
65
66 /****************************************************************************
67 **
68 *V ValGVars . . . . . . . . . . . . . . . . . . values of global variables
69 *V PtrGVars . . . . . . . . . . . . . pointer to values of global variables
70 **
71 */
72 #ifdef USE_GVAR_BUCKETS
73 /*
74 ** 'ValGVars' references the bags containing the values of the global
75 ** variables.
76 **
77 ** 'PtrGVars' is a pointer to the 'ValGVars' bag+1. This makes it faster to
78 ** access global variables.
79 */
80 static Obj ValGVars[GVAR_BUCKETS];
81 static Obj * PtrGVars[GVAR_BUCKETS];
82 #else
83 /*
84 ** 'ValGVars' is the bag containing the values of the global variables.
85 **
86 ** 'PtrGVars' is a pointer to the 'ValGVars' bag. This makes it faster to
87 ** access global variables.
88 **
89 ** Since a garbage collection may move this bag around, the pointer
90 ** 'PtrGVars' must be recalculated afterwards. This is done in function
91 ** 'GVarsAfterCollectBags' which is called by 'VarsAfterCollectBags'.
92 */
93 static Obj ValGVars;
94 static Obj * PtrGVars;
95 #endif
96
97
98 #ifdef HPCGAP
99
100 /****************************************************************************
101 **
102 *V TLVars . . . . . . . . . . . . . . . . . . . . . thread-local variables
103 */
104
105 static Obj TLVars;
106
107 /****************************************************************************
108 **
109 *V GVarLock . . . . . . . . . . . . . . . . . . lock for global variables
110 **
111 ** This lock is only needed for accessing global variables by name rather
112 ** than index and to initialize copy/fopy information.
113 */
114
115 static pthread_rwlock_t GVarLock;
116 static void *GVarLockOwner;
117 static UInt GVarLockDepth;
118
LockGVars(int write)119 static void LockGVars(int write) {
120 if (PreThreadCreation)
121 return;
122 if (GVarLockOwner == GetTLS()) {
123 GVarLockDepth++;
124 return;
125 }
126 if (write) {
127 pthread_rwlock_wrlock(&GVarLock);
128 GVarLockOwner = GetTLS();
129 GVarLockDepth = 1;
130 }
131 else
132 pthread_rwlock_rdlock(&GVarLock);
133 }
134
UnlockGVars(void)135 static void UnlockGVars(void) {
136 if (PreThreadCreation)
137 return;
138 if (GVarLockOwner == GetTLS()) {
139 GVarLockDepth--;
140 if (GVarLockDepth != 0)
141 return;
142 GVarLockOwner = NULL;
143 }
144 pthread_rwlock_unlock(&GVarLock);
145 }
146
147 #endif
148
149 /****************************************************************************
150 **
151 *F VAL_GVAR(<gvar>) . . . . . . . . . . . . . . . value of global variable
152 **
153 ** 'VAL_GVAR' returns the value of the global variable <gvar>. If <gvar>
154 ** has no assigned value, 'VAL_GVAR' returns 0. In this case <gvar> might
155 ** be an automatic global variable, and one should call 'ValAutoGVar', which
156 ** will return the value of <gvar> after evaluating <gvar>-s expression, or
157 ** 0 if <gvar> was not an automatic variable.
158 **
159 */
160
161 #ifdef USE_GVAR_BUCKETS
162
163 // FIXME/TODO: Do we still need the VAL_GVAR_INTERN macro, or can we replace
164 // it by ValGVar everywhere? The difference is of course the memory barrier,
165 // which might cause a performance penalty (OTOH, not using it right now might
166 // or might not be a bug?!?)
167 #define VAL_GVAR_INTERN(gvar) (PtrGVars[GVAR_BUCKET(gvar)] \
168 [GVAR_INDEX(gvar)-1])
169
170 #else
171
172 #define VAL_GVAR_INTERN(gvar) PtrGVars[ (gvar) ]
173
174 #endif
175
176
ValGVar(UInt gvar)177 inline Obj ValGVar(UInt gvar) {
178 Obj result = VAL_GVAR_INTERN(gvar);
179 #ifdef HPCGAP
180 MEMBAR_READ();
181 #endif
182 return result;
183 }
184
185
186 /****************************************************************************
187 **
188 *V NameGVars . . . . . . . . . . . . . . . . . . . names of global variables
189 *V FlagsGVars . . . . . . . . . . . . flags of global variables (see below)
190 *V ExprGVars . . . . . . . . . . expressions for automatic global variables
191 *V CopiesGVars . . . . . . . . . . . . . internal copies of global variables
192 *V FopiesGVars . . . . . . . . internal function copies of global variables
193 */
194 #ifdef USE_GVAR_BUCKETS
195 static Obj NameGVars[GVAR_BUCKETS];
196 static Obj FlagsGVars[GVAR_BUCKETS];
197 static Obj ExprGVars[GVAR_BUCKETS];
198 static Obj CopiesGVars[GVAR_BUCKETS];
199 static Obj FopiesGVars[GVAR_BUCKETS];
200
201 #define ELM_GVAR_LIST( list, gvar ) \
202 ELM_PLIST( list[GVAR_BUCKET(gvar)], GVAR_INDEX(gvar) )
203
204 #define SET_ELM_GVAR_LIST( list, gvar, val ) \
205 SET_ELM_PLIST( list[GVAR_BUCKET(gvar)], GVAR_INDEX(gvar), val )
206
207 #define CHANGED_GVAR_LIST( list, gvar ) \
208 CHANGED_BAG( list[GVAR_BUCKET(gvar)] );
209
210 #else // USE_GVAR_BUCKETS
211
212 static Obj NameGVars;
213 static Obj FlagsGVars;
214 static Obj ExprGVars;
215 static Obj CopiesGVars;
216 static Obj FopiesGVars;
217
218 #define ELM_GVAR_LIST( list, gvar ) \
219 ELM_PLIST( list, gvar )
220
221 #define SET_ELM_GVAR_LIST( list, gvar, val ) \
222 SET_ELM_PLIST( list, gvar, val )
223
224 #define CHANGED_GVAR_LIST( list, gvar ) \
225 CHANGED_BAG( list );
226
227 #endif
228
229 // FlagsGVars contains information about global variables.
230 // Once cast to a GVarFlagInfo struct, this information is:
231 //
232 // gvarWriteFlag: A value of type GVarWriteFlag which denotes if the variable
233 // is Assignable, ReadOnly, or Constant.
234 // hasExprCopiesFopies: If the variable has ever had a non-default value
235 // assigned to ExprGVars, CopiesGVars or FopiesGVars. Note that this value is
236 // never cleared at present, so it can be set to 1 while these three arrays
237 // all have their default value, but if it is 0 these arrays definitely have
238 // their default values.
239
240 typedef enum {
241 GVarAssignable = 0,
242 GVarReadOnly = 1,
243 GVarConstant = 2,
244 } GVarWriteFlag;
245
246 typedef struct {
247 unsigned char gvarWriteFlag : 2;
248 unsigned char hasExprCopiesFopies : 1;
249 } GVarFlagInfo;
250
251 // If this size increases, the type used in GetGVarFlags and
252 // SetGVarFlags below must be changed
253 GAP_STATIC_ASSERT(sizeof(GVarFlagInfo) == sizeof(unsigned char),
254 "GVarFlagInfo size mismatch");
255
GetGVarFlagInfo(Int gvar)256 static GVarFlagInfo GetGVarFlagInfo(Int gvar)
257 {
258 unsigned char val = INT_INTOBJ(ELM_GVAR_LIST(FlagsGVars, gvar));
259 GVarFlagInfo info;
260 // This is technically the safest way of converting a struct to an integer
261 // and is optimised away by the compiler
262 memcpy(&info, &val, sizeof(GVarFlagInfo));
263 return info;
264 }
265
SetGVarFlagInfo(Int gvar,GVarFlagInfo info)266 static void SetGVarFlagInfo(Int gvar, GVarFlagInfo info)
267 {
268 unsigned char val;
269 // This is technically the safest way of converting an integer into a
270 // struct and is optimised away by the compiler
271 memcpy(&val, &info, sizeof(GVarFlagInfo));
272 SET_ELM_GVAR_LIST(FlagsGVars, gvar, INTOBJ_INT(val));
273 }
274
InitGVarFlagInfo(Int gvar)275 static void InitGVarFlagInfo(Int gvar)
276 {
277 // This is equal to setting all members of GVarFlagInfo to 0
278 SET_ELM_GVAR_LIST(FlagsGVars, gvar, INTOBJ_INT(0));
279 }
280
281
282 // Helper functions to more easily set members of GVarFlagInfo
SetGVarWriteState(Int gvar,GVarWriteFlag w)283 static void SetGVarWriteState(Int gvar, GVarWriteFlag w)
284 {
285 GVarFlagInfo info = GetGVarFlagInfo(gvar);
286 info.gvarWriteFlag = w;
287 SetGVarFlagInfo(gvar, info);
288 }
289
SetHasExprCopiesFopies(Int gvar,Int set)290 static void SetHasExprCopiesFopies(Int gvar, Int set)
291 {
292 GVarFlagInfo info = GetGVarFlagInfo(gvar);
293 info.hasExprCopiesFopies = set;
294 SetGVarFlagInfo(gvar, info);
295 }
296
297
298 /****************************************************************************
299 **
300 *V CountGVars . . . . . . . . . . . . number of global variables, as T_INT
301 */
302 static Obj CountGVars;
303
304 /****************************************************************************
305 **
306 *V TableGVars . . . . . . . . . . . . . . hashed table of global variables
307 */
308 static Obj TableGVars;
309
310
311 /****************************************************************************
312 **
313 *V ErrorMustEvalToFuncFunc . . . . . . . . . function that signals an error
314 *F ErrorMustEvalToFuncHandler(<self>,<args>) . handler that signals an error
315 **
316 ** 'ErrorMustEvalToFuncFunc' is a (variable number of args) function that
317 ** signals the error ``Function: <func> be a function''.
318 **
319 ** 'ErrorMustEvalToFuncHandler' is the handler that signals the error
320 ** ``Function: <func> must be a function''.
321 */
322 Obj ErrorMustEvalToFuncFunc;
323
ErrorMustEvalToFuncHandler(Obj self,Obj args)324 static Obj ErrorMustEvalToFuncHandler(Obj self, Obj args)
325 {
326 ErrorQuit(
327 "Function Calls: <func> must be a function",
328 0L, 0L );
329 return 0;
330 }
331
332
333 /****************************************************************************
334 **
335 *V ErrorMustHaveAssObjFunc . . . . . . . . . function that signals an error
336 *F ErrorMustHaveAssObjHandler(<self>,<args>) . handler that signals an error
337 **
338 ** 'ErrorMustHaveAssObjFunc' is a (variable number of args) function that
339 ** signals the error ``Variable: <<unknown>> must have an assigned value''.
340 **
341 ** 'ErrorMustHaveAssObjHandler' is the handler that signals the error
342 ** ``Variable: <<unknown>> must have an assigned value''.
343 */
344 Obj ErrorMustHaveAssObjFunc;
345
ErrorMustHaveAssObjHandler(Obj self,Obj args)346 static Obj ErrorMustHaveAssObjHandler(Obj self, Obj args)
347 {
348 ErrorQuit(
349 "Variable: <<unknown>> must have an assigned value",
350 0L, 0L );
351 return 0;
352 }
353
354
355 /****************************************************************************
356 **
357 *F AssGVar(<gvar>,<val>) . . . . . . . . . . . . assign to a global variable
358 **
359 ** 'AssGVar' assigns the value <val> to the global variable <gvar>.
360 */
361
362 static Obj REREADING; /* Copy of GAP global variable REREADING */
363
364 // We store pointers to C global variables as GAP immediate integers.
ELM_COPS_PLIST(Obj cops,UInt i)365 static Obj * ELM_COPS_PLIST(Obj cops, UInt i)
366 {
367 UInt val = UInt_ObjInt(ELM_PLIST(cops, i));
368 val <<= 2;
369 return (Obj *)val;
370 }
371
AssGVarInternal(UInt gvar,Obj val,Int hasExprCopiesFopies)372 static void AssGVarInternal(UInt gvar, Obj val, Int hasExprCopiesFopies)
373 {
374 Obj cops; /* list of internal copies */
375 Obj * copy; /* one copy */
376 UInt i; /* loop variable */
377 Obj onam; /* object of <name> */
378
379 /* assign the value to the global variable */
380 #ifdef HPCGAP
381 if (!VAL_GVAR_INTERN(gvar)) {
382 Obj expr = ExprGVar(gvar);
383 if (IS_INTOBJ(expr)) {
384 AssTLRecord(TLVars, INT_INTOBJ(expr), val);
385 return;
386 }
387 }
388 MEMBAR_WRITE();
389 #endif
390 VAL_GVAR_INTERN(gvar) = val;
391 CHANGED_GVAR_LIST( ValGVars, gvar );
392
393 /* assign name to a function */
394 #ifdef HPCGAP
395 if (IS_BAG_REF(val) && REGION(val) == 0) { /* public region? */
396 #endif
397 if (val != 0 && TNUM_OBJ(val) == T_FUNCTION && NAME_FUNC(val) == 0) {
398 onam = CopyToStringRep(NameGVar(gvar));
399 MakeImmutable(onam);
400 SET_NAME_FUNC(val, onam);
401 CHANGED_BAG(val);
402 }
403 #ifdef HPCGAP
404 }
405 #endif
406
407
408 if (!hasExprCopiesFopies) {
409 // No need to perform any of the remaining checks
410 return;
411 }
412
413 /* if the global variable was automatic, convert it to normal */
414 SET_ELM_GVAR_LIST( ExprGVars, gvar, 0 );
415
416 /* assign the value to all the internal copies */
417 cops = ELM_GVAR_LIST( CopiesGVars, gvar );
418 if ( cops != 0 ) {
419 for ( i = 1; i <= LEN_PLIST(cops); i++ ) {
420 copy = ELM_COPS_PLIST(cops, i);
421 *copy = val;
422 }
423 }
424
425 /* if the value is a function, assign it to all the internal fopies */
426 cops = ELM_GVAR_LIST( FopiesGVars, gvar );
427 #ifdef HPCGAP
428 if (IS_BAG_REF(val) && REGION(val) == 0) { /* public region? */
429 #endif
430 if ( cops != 0 && val != 0 && TNUM_OBJ(val) == T_FUNCTION ) {
431 for ( i = 1; i <= LEN_PLIST(cops); i++ ) {
432 copy = ELM_COPS_PLIST(cops, i);
433 *copy = val;
434 }
435 }
436 #ifdef HPCGAP
437 }
438 #endif
439
440 /* if the values is not a function, assign the error function */
441 else if ( cops != 0 && val != 0 /* && TNUM_OBJ(val) != T_FUNCTION */ ) {
442 for ( i = 1; i <= LEN_PLIST(cops); i++ ) {
443 copy = ELM_COPS_PLIST(cops, i);
444 *copy = ErrorMustEvalToFuncFunc;
445 }
446 }
447
448 /* if this was an unbind, assign the other error function */
449 else if ( cops != 0 /* && val == 0 */ ) {
450 for ( i = 1; i <= LEN_PLIST(cops); i++ ) {
451 copy = ELM_COPS_PLIST(cops, i);
452 *copy = ErrorMustHaveAssObjFunc;
453 }
454 }
455 }
456
AssGVar(UInt gvar,Obj val)457 void AssGVar(UInt gvar, Obj val)
458 {
459 GVarFlagInfo info = GetGVarFlagInfo(gvar);
460
461 if (info.gvarWriteFlag != GVarAssignable) {
462 /* make certain that the variable is not read only */
463 if ((REREADING != True) && info.gvarWriteFlag == GVarReadOnly) {
464 ErrorMayQuit("Variable: '%g' is read only", (Int)NameGVar(gvar),
465 0);
466 }
467
468 // Make certain variable is not constant
469 if (info.gvarWriteFlag == GVarConstant) {
470 ErrorMayQuit("Variable: '%g' is constant", (Int)NameGVar(gvar),
471 0L);
472 }
473 }
474
475 AssGVarInternal(gvar, val, info.hasExprCopiesFopies);
476 }
477
478 // This is a kernel-only variant of AssGVar which will change read-only
479 // variables, which is used for constants like:
480 // Time, MemoryAllocated, last, last2, last3
AssGVarWithoutReadOnlyCheck(UInt gvar,Obj val)481 void AssGVarWithoutReadOnlyCheck(UInt gvar, Obj val)
482 {
483 GVarFlagInfo info = GetGVarFlagInfo(gvar);
484
485 // Make certain variable is not constant
486 if (info.gvarWriteFlag == GVarConstant) {
487 ErrorMayQuit("Variable: '%g' is constant", (Int)NameGVar(gvar), 0L);
488 }
489
490 AssGVarInternal(gvar, val, info.hasExprCopiesFopies);
491 }
492
493
494 /****************************************************************************
495 **
496 *F ValAutoGVar(<gvar>) . . . . . . . . value of a automatic global variable
497 **
498 ** 'ValAutoGVar' returns the value of the global variable <gvar>. This will
499 ** be 0 if <gvar> has no assigned value. It will also cause a function
500 ** call, if <gvar> is automatic.
501 */
ValAutoGVar(UInt gvar)502 Obj ValAutoGVar (
503 UInt gvar )
504 {
505 Obj val;
506 Obj expr;
507 Obj func; /* function to call for automatic */
508 Obj arg; /* argument to pass for automatic */
509
510 val = ValGVar(gvar);
511
512 /* if this is an automatic variable, make the function call */
513 if ( val == 0 && (expr = ExprGVar(gvar)) != 0 ) {
514
515 #ifdef HPCGAP
516 if (IS_INTOBJ(expr)) {
517 /* thread-local variable */
518 return GetTLRecordField(TLVars, INT_INTOBJ(expr));
519 }
520 #endif
521 /* make the function call */
522 func = ELM_PLIST( expr, 1 );
523 arg = ELM_PLIST( expr, 2 );
524 CALL_1ARGS( func, arg );
525
526 /* if this is still an automatic variable, this is an error */
527 val = ValGVar(gvar);
528 if (val == 0) {
529 ErrorMayQuit("Variable: automatic variable '%g' must get a value "
530 "by function call",
531 (Int)NameGVar(gvar), 0);
532 }
533
534 }
535
536 /* return the value */
537 return val;
538 }
539
540 /****************************************************************************
541 **
542 *F ValGVarTL(<gvar>) . . . . . . . . value of a global/thread-local variable
543 **
544 ** 'ValGVarTL' returns the value of the global or thread-local variable
545 ** <gvar>.
546 */
547 #ifdef HPCGAP
ValGVarTL(UInt gvar)548 Obj ValGVarTL (
549 UInt gvar )
550 {
551 Obj expr;
552 Obj val;
553
554 val = ValGVar(gvar);
555 /* is this a thread-local variable? */
556 if ( val == 0 && (expr = ExprGVar(gvar)) != 0 ) {
557
558 if (IS_INTOBJ(expr)) {
559 /* thread-local variable */
560 return GetTLRecordField(TLVars, INT_INTOBJ(expr));
561 }
562 }
563
564 /* return the value */
565 return val;
566 }
567
FuncIsThreadLocalGVar(Obj self,Obj name)568 static Obj FuncIsThreadLocalGVar(Obj self, Obj name)
569 {
570 if (!IsStringConv(name))
571 ErrorMayQuit("IsThreadLocalGVar: argument must be a string (not a %s)",
572 (Int)TNAM_OBJ(name), 0L);
573
574 UInt gvar = GVarName(CONST_CSTR_STRING(name));
575 return (VAL_GVAR_INTERN(gvar) == 0 && IS_INTOBJ(ExprGVar(gvar))) ?
576 True: False;
577 }
578 #endif
579
580
581 #ifdef USE_GVAR_BUCKETS
NewGVarBucket(void)582 static Obj NewGVarBucket(void)
583 {
584 Obj result = NEW_PLIST(T_PLIST, GVAR_BUCKET_SIZE);
585 SET_LEN_PLIST(result, GVAR_BUCKET_SIZE);
586 #ifdef HPCGAP
587 MakeBagPublic(result);
588 #endif
589 return result;
590 }
591 #endif
592
NameGVar(UInt gvar)593 Obj NameGVar ( UInt gvar )
594 {
595 return ELM_GVAR_LIST( NameGVars, gvar );
596 }
597
ExprGVar(UInt gvar)598 Obj ExprGVar ( UInt gvar )
599 {
600 return ELM_GVAR_LIST( ExprGVars, gvar );
601 }
602
603 #define NSCHAR '@'
604
605 /* TL: Obj CurrNamespace = 0; */
606
FuncSET_NAMESPACE(Obj self,Obj str)607 static Obj FuncSET_NAMESPACE(Obj self, Obj str)
608 {
609 STATE(CurrNamespace) = str;
610 return 0;
611 }
612
FuncGET_NAMESPACE(Obj self)613 static Obj FuncGET_NAMESPACE(Obj self)
614 {
615 return STATE(CurrNamespace);
616 }
617
618
HashString(const Char * name)619 static inline UInt HashString( const Char * name )
620 {
621 UInt hash = 0;
622 while ( *name ) {
623 hash = 65599 * hash + *name++;
624 }
625 return hash;
626 }
627
628 /****************************************************************************
629 **
630 *F GVarName(<name>) . . . . . . . . . . . . . . global variable for a name
631 **
632 ** 'GVarName' returns the global variable with the name <name>.
633 */
GVarName(const Char * name)634 UInt GVarName (
635 const Char * name )
636 {
637 Obj gvar; /* global variable (as imm intval) */
638 Char gvarbuf[1024]; /* temporary copy for namespace */
639 const Char * cns; /* Pointer to current namespace */
640 UInt pos; /* hash position */
641 Obj string; /* temporary string value <name> */
642 Obj table; /* temporary copy of <TableGVars> */
643 Obj gvar2; /* one element of <table> */
644 UInt i; /* loop variable */
645 Int len; /* length of name */
646 UInt sizeGVars; // size of <TableGVars>
647
648 /* First see whether it could be namespace-local: */
649 cns = STATE(CurrNamespace) ? CONST_CSTR_STRING(STATE(CurrNamespace)) : "";
650 if (*cns) { /* only if a namespace is set */
651 len = strlen(name);
652 if (name[len-1] == NSCHAR) {
653 strlcpy(gvarbuf, name, 512);
654 strlcat(gvarbuf, cns, sizeof(gvarbuf));
655 name = gvarbuf;
656 }
657 }
658
659 /* start looking in the table at the following hash position */
660 const UInt hash = HashString( name );
661 #ifdef HPCGAP
662 LockGVars(0);
663 #endif
664
665 /* look through the table until we find a free slot or the global */
666 sizeGVars = LEN_PLIST(TableGVars);
667 pos = (hash % sizeGVars) + 1;
668 while ( (gvar = ELM_PLIST( TableGVars, pos )) != 0
669 && strncmp( CONST_CSTR_STRING( NameGVar( INT_INTOBJ(gvar) ) ), name, 1023 ) ) {
670 pos = (pos % sizeGVars) + 1;
671 }
672
673 #ifdef HPCGAP
674 if (gvar == 0 && !PreThreadCreation) {
675 /* upgrade to write lock and repeat search */
676 UnlockGVars();
677 LockGVars(1);
678
679 /* look through the table until we find a free slot or the global */
680 sizeGVars = LEN_PLIST(TableGVars);
681 pos = (hash % sizeGVars) + 1;
682 while ( (gvar = ELM_PLIST( TableGVars, pos )) != 0
683 && strncmp( CONST_CSTR_STRING( NameGVar( INT_INTOBJ(gvar) ) ), name, 1023 ) ) {
684 pos = (pos % sizeGVars) + 1;
685 }
686 }
687 #endif
688
689 /* if we did not find the global variable, make a new one and enter it */
690 /* (copy the name first, to avoid a stale pointer in case of a GC) */
691 if ( gvar == 0 ) {
692 const UInt numGVars = INT_INTOBJ(CountGVars) + 1;
693 CountGVars = INTOBJ_INT(numGVars);
694 gvar = INTOBJ_INT(numGVars);
695 SET_ELM_PLIST( TableGVars, pos, gvar );
696 if (name != gvarbuf)
697 strlcpy(gvarbuf, name, sizeof(gvarbuf));
698 string = MakeImmString(gvarbuf);
699
700 #ifdef USE_GVAR_BUCKETS
701 UInt gvar_bucket = GVAR_BUCKET(numGVars);
702 if (!ValGVars[gvar_bucket]) {
703 ValGVars[gvar_bucket] = NewGVarBucket();
704 PtrGVars[gvar_bucket] = ADDR_OBJ(ValGVars[gvar_bucket])+1;
705 NameGVars[gvar_bucket] = NewGVarBucket();
706 FlagsGVars[gvar_bucket] = NewGVarBucket();
707 ExprGVars[gvar_bucket] = NewGVarBucket();
708 CopiesGVars[gvar_bucket] = NewGVarBucket();
709 FopiesGVars[gvar_bucket] = NewGVarBucket();
710 }
711 #else
712 GROW_PLIST( ValGVars, numGVars );
713 SET_LEN_PLIST( ValGVars, numGVars );
714 GROW_PLIST( NameGVars, numGVars );
715 SET_LEN_PLIST( NameGVars, numGVars );
716 GROW_PLIST(FlagsGVars, numGVars);
717 SET_LEN_PLIST(FlagsGVars, numGVars);
718 GROW_PLIST( ExprGVars, numGVars );
719 SET_LEN_PLIST( ExprGVars, numGVars );
720 GROW_PLIST( CopiesGVars, numGVars );
721 SET_LEN_PLIST( CopiesGVars, numGVars );
722 GROW_PLIST( FopiesGVars, numGVars );
723 SET_LEN_PLIST( FopiesGVars, numGVars );
724 PtrGVars = ADDR_OBJ( ValGVars );
725 #endif
726 SET_ELM_GVAR_LIST( ValGVars, numGVars, 0 );
727 SET_ELM_GVAR_LIST( NameGVars, numGVars, string );
728 CHANGED_GVAR_LIST( NameGVars, numGVars );
729 InitGVarFlagInfo( numGVars );
730 SET_ELM_GVAR_LIST( ExprGVars, numGVars, 0 );
731 SET_ELM_GVAR_LIST( CopiesGVars, numGVars, 0 );
732 SET_ELM_GVAR_LIST( FopiesGVars, numGVars, 0 );
733
734 /* if the table is too crowded, make a larger one, rehash the names */
735 if ( sizeGVars < 3 * numGVars / 2 ) {
736 table = TableGVars;
737 sizeGVars = 2 * sizeGVars + 1;
738 TableGVars = NEW_PLIST( T_PLIST, sizeGVars );
739 SET_LEN_PLIST( TableGVars, sizeGVars );
740 #ifdef HPCGAP
741 MakeBagPublic(TableGVars);
742 #endif
743 for ( i = 1; i <= (sizeGVars-1)/2; i++ ) {
744 gvar2 = ELM_PLIST( table, i );
745 if ( gvar2 == 0 ) continue;
746 pos = HashString( CONST_CSTR_STRING( NameGVar( INT_INTOBJ(gvar2) ) ) );
747 pos = (pos % sizeGVars) + 1;
748 while ( ELM_PLIST( TableGVars, pos ) != 0 ) {
749 pos = (pos % sizeGVars) + 1;
750 }
751 SET_ELM_PLIST( TableGVars, pos, gvar2 );
752 }
753 }
754 }
755
756 #ifdef HPCGAP
757 UnlockGVars();
758 #endif
759
760 /* return the global variable */
761 return INT_INTOBJ(gvar);
762 }
763
764
765 /****************************************************************************
766 **
767 *F MakeReadOnlyGVar( <gvar> ) . . . . . . make a global variable read only
768 */
MakeReadOnlyGVar(UInt gvar)769 void MakeReadOnlyGVar (
770 UInt gvar )
771 {
772 if (IsConstantGVar(gvar)) {
773 ErrorMayQuit("Variable: '%g' is constant", (Int)NameGVar(gvar), 0L);
774 }
775 SetGVarWriteState(gvar, GVarReadOnly);
776 }
777
778 /****************************************************************************
779 **
780 *F MakeConstantGVar( <gvar> ) . . . . . . make a global variable constant
781 */
MakeConstantGVar(UInt gvar)782 void MakeConstantGVar(UInt gvar)
783 {
784 Obj val = ValGVar(gvar);
785 if (!IS_INTOBJ(val) && val != True && val != False) {
786 ErrorMayQuit(
787 "Variable: '%g' must be assigned a small integer, true or false",
788 (Int)NameGVar(gvar), 0L);
789 }
790 SetGVarWriteState(gvar, GVarConstant);
791 }
792
793
794 /****************************************************************************
795 **
796 *F MakeThreadLocalVar( <gvar> ) . . . . . . make a variable thread-local
797 */
798 #ifdef HPCGAP
MakeThreadLocalVar(UInt gvar,UInt rnam)799 void MakeThreadLocalVar (
800 UInt gvar,
801 UInt rnam )
802 {
803 Obj value = ValGVar(gvar);
804 VAL_GVAR_INTERN(gvar) = (Obj) 0;
805 if (IS_INTOBJ(ExprGVar(gvar)))
806 value = (Obj) 0;
807 SET_ELM_GVAR_LIST( ExprGVars, gvar, INTOBJ_INT(rnam) );
808 SetHasExprCopiesFopies(gvar, 1);
809 CHANGED_GVAR_LIST( ExprGVars, gvar );
810 if (value && TLVars)
811 SetTLDefault(TLVars, rnam, value);
812 }
813 #endif
814
815
816 /****************************************************************************
817 **
818 *F FuncMakeReadOnlyGVar(<self>,<name>) make a global variable read only
819 **
820 ** 'FuncMakeReadOnlyGVar' implements the function 'MakeReadOnlyGVar'.
821 **
822 ** 'MakeReadOnlyGVar( <name> )'
823 **
824 ** 'MakeReadOnlyGVar' make the global variable with the name <name> (which
825 ** must be a GAP string) read only.
826 */
FuncMakeReadOnlyGVar(Obj self,Obj name)827 static Obj FuncMakeReadOnlyGVar(Obj self, Obj name)
828 {
829 // check the argument
830 RequireStringRep("MakeReadOnlyGVar", name);
831
832 /* get the variable and make it read only */
833 MakeReadOnlyGVar(GVarName(CONST_CSTR_STRING(name)));
834
835 /* return void */
836 return 0;
837 }
838
839 /****************************************************************************
840 **
841 *F FuncMakeConstantGVar(<self>,<name>) make a global variable constant
842 **
843 ** 'FuncMakeConstantGVar' implements the function 'MakeConstantGVar'.
844 **
845 ** 'MakeConstantGVar( <name> )'
846 **
847 ** 'MakeConstantGVar' make the global variable with the name <name> (which
848 ** must be a GAP string) constant.
849 */
FuncMakeConstantGVar(Obj self,Obj name)850 static Obj FuncMakeConstantGVar(Obj self, Obj name)
851 {
852 // check the argument
853 RequireStringRep("MakeConstantGVar", name);
854
855 /* get the variable and make it read only */
856 MakeConstantGVar(GVarName(CONST_CSTR_STRING(name)));
857
858 /* return void */
859 return 0;
860 }
861
862 /****************************************************************************
863 **
864 *F MakeReadWriteGVar( <gvar> ) . . . . . . make a global variable read write
865 */
MakeReadWriteGVar(UInt gvar)866 void MakeReadWriteGVar (
867 UInt gvar )
868 {
869 if (IsConstantGVar(gvar)) {
870 ErrorMayQuit("Variable: '%g' is constant", (Int)NameGVar(gvar), 0L);
871 }
872 SetGVarWriteState(gvar, GVarAssignable);
873 }
874
875
876 /****************************************************************************
877 **
878 *F FuncMakeReadWriteGVar(<self>,<name>) make a global variable read write
879 **
880 ** 'FuncMakeReadWriteGVar' implements the function 'MakeReadWriteGVar'.
881 **
882 ** 'MakeReadWriteGVar( <name> )'
883 **
884 ** 'MakeReadWriteGVar' make the global variable with the name <name> (which
885 ** must be a GAP string) read and writable.
886 */
FuncMakeReadWriteGVar(Obj self,Obj name)887 static Obj FuncMakeReadWriteGVar(Obj self, Obj name)
888 {
889 // check the argument
890 RequireStringRep("MakeReadWriteGVar", name);
891
892 /* get the variable and make it read write */
893 MakeReadWriteGVar(GVarName(CONST_CSTR_STRING(name)));
894
895 /* return void */
896 return 0;
897 }
898
899 /****************************************************************************
900 **
901 *F IsReadOnlyGVar( <gvar> ) . . . . . . return status of a global variable
902 */
IsReadOnlyGVar(UInt gvar)903 Int IsReadOnlyGVar (
904 UInt gvar )
905 {
906 return GetGVarFlagInfo(gvar).gvarWriteFlag == GVarReadOnly;
907 }
908
909 /****************************************************************************
910 **
911 *F FuncIsReadOnlyGVar( <name> ) . . .handler for GAP function
912 **
913 */
914
FuncIsReadOnlyGVar(Obj self,Obj name)915 static Obj FuncIsReadOnlyGVar (
916 Obj self,
917 Obj name )
918 {
919 // check the argument
920 RequireStringRep("IsReadOnlyGVar", name);
921
922 /* get the answer */
923 return IsReadOnlyGVar(GVarName(CONST_CSTR_STRING(name))) ? True : False;
924 }
925
926 /****************************************************************************
927 **
928 *F IsConstantGVar( <gvar> ) . . . . . . return if a variable is a constant
929 */
IsConstantGVar(UInt gvar)930 Int IsConstantGVar(UInt gvar)
931 {
932 return GetGVarFlagInfo(gvar).gvarWriteFlag == GVarConstant;
933 }
934
935 /****************************************************************************
936 **
937 *F FuncIsConstantGVar( <name> ) . . .handler for GAP function
938 **
939 */
940
FuncIsConstantGVar(Obj self,Obj name)941 static Obj FuncIsConstantGVar(Obj self, Obj name)
942 {
943 // check the argument
944 RequireStringRep("IsConstantGVar", name);
945
946 /* get the answer */
947 return IsConstantGVar(GVarName(CONST_CSTR_STRING(name))) ? True : False;
948 }
949
950
951 /****************************************************************************
952 **
953 *F FuncAUTO() . . . . . . . . . . . . . make automatic global variables
954 **
955 ** 'FuncAUTO' implements the internal function 'AUTO'.
956 **
957 ** 'AUTO( <func>, <arg>, <name1>, ... )'
958 **
959 ** 'AUTO' makes the global variables, whose names are given the strings
960 ** <name1>, <name2>, ..., automatic. That means that when the value of one
961 ** of those global variables is requested, then the function <func> is
962 ** called and the argument <arg> is passed. This function call should,
963 ** cause the execution of an assignment to that global variable, otherwise
964 ** an error is signalled.
965 */
FuncAUTO(Obj self,Obj args)966 static Obj FuncAUTO(Obj self, Obj args)
967 {
968 Obj func; /* the function to call */
969 Obj arg; /* the argument to pass */
970 Obj list; /* function and argument list */
971 Obj name; /* one name (as a GAP string) */
972 UInt gvar; /* one global variable */
973 UInt i; /* loop variable */
974
975 /* get and check the function */
976 func = ELM_LIST( args, 1 );
977 RequireFunction("AUTO", func);
978
979 /* get the argument */
980 arg = ELM_LIST( args, 2 );
981
982 /* make the list of function and argument */
983 list = NewPlistFromArgs(func, arg);
984
985 /* make the global variables automatic */
986 for ( i = 3; i <= LEN_LIST(args); i++ ) {
987 name = ELM_LIST( args, i );
988 RequireStringRep("AUTO", name);
989 gvar = GVarName( CONST_CSTR_STRING(name) );
990 SET_ELM_GVAR_LIST( ValGVars, gvar, 0 );
991 SET_ELM_GVAR_LIST( ExprGVars, gvar, list );
992 SetHasExprCopiesFopies(gvar, 1);
993 CHANGED_GVAR_LIST( ExprGVars, gvar );
994 }
995
996 /* return void */
997 return 0;
998 }
999
1000
1001 /****************************************************************************
1002 **
1003 *F iscomplete( <name>, <len> ) . . . . . . . . find the completions of name
1004 *F completion( <name>, <len> ) . . . . . . . . find the completions of name
1005 */
iscomplete_gvar(Char * name,UInt len)1006 UInt iscomplete_gvar (
1007 Char * name,
1008 UInt len )
1009 {
1010 const Char * curr;
1011 UInt i, k;
1012 UInt numGVars;
1013
1014 numGVars = INT_INTOBJ(CountGVars);
1015 for ( i = 1; i <= numGVars; i++ ) {
1016 curr = CONST_CSTR_STRING( NameGVar( i ) );
1017 for ( k = 0; name[k] != 0 && curr[k] == name[k]; k++ ) ;
1018 if ( k == len && curr[k] == '\0' ) return 1;
1019 }
1020 return 0;
1021 }
1022
completion_gvar(Char * name,UInt len)1023 UInt completion_gvar (
1024 Char * name,
1025 UInt len )
1026 {
1027 const Char * curr;
1028 const Char * next;
1029 UInt i, k;
1030 UInt numGVars;
1031
1032 numGVars = INT_INTOBJ(CountGVars);
1033 next = 0;
1034 for ( i = 1; i <= numGVars; i++ ) {
1035 /* consider only variables which are currently bound for completion */
1036 if ( VAL_GVAR_INTERN( i ) || ELM_GVAR_LIST( ExprGVars, i )) {
1037 curr = CONST_CSTR_STRING( NameGVar( i ) );
1038 for ( k = 0; name[k] != 0 && curr[k] == name[k]; k++ ) ;
1039 if ( k < len || curr[k] <= name[k] ) continue;
1040 if ( next != 0 ) {
1041 for ( k = 0; curr[k] != '\0' && curr[k] == next[k]; k++ ) ;
1042 if ( k < len || next[k] < curr[k] ) continue;
1043 }
1044 next = curr;
1045 }
1046 }
1047
1048 if ( next != 0 ) {
1049 for ( k = 0; next[k] != '\0'; k++ )
1050 name[k] = next[k];
1051 name[k] = '\0';
1052 }
1053
1054 return next != 0;
1055 }
1056
1057
1058 /****************************************************************************
1059 **
1060 *F FuncIDENTS_GVAR( <self> ) . . . . . . . . . . idents of global variables
1061 */
FuncIDENTS_GVAR(Obj self)1062 static Obj FuncIDENTS_GVAR(Obj self)
1063 {
1064 Obj copy;
1065 UInt i;
1066 UInt numGVars;
1067 Obj strcopy;
1068
1069 #ifdef HPCGAP
1070 LockGVars(0);
1071 numGVars = INT_INTOBJ(CountGVars);
1072 UnlockGVars();
1073 #else
1074 numGVars = INT_INTOBJ(CountGVars);
1075 #endif
1076
1077 copy = NEW_PLIST_IMM( T_PLIST, numGVars );
1078 for ( i = 1; i <= numGVars; i++ ) {
1079 /* Copy the string here, because we do not want members of NameGVars
1080 * accessible to users, as these strings must not be changed */
1081 strcopy = CopyToStringRep( NameGVar( i ) );
1082 SET_ELM_PLIST( copy, i, strcopy );
1083 CHANGED_BAG( copy );
1084 }
1085 SET_LEN_PLIST( copy, numGVars );
1086 return copy;
1087 }
1088
FuncIDENTS_BOUND_GVARS(Obj self)1089 static Obj FuncIDENTS_BOUND_GVARS(Obj self)
1090 {
1091 Obj copy;
1092 UInt i, j;
1093 UInt numGVars;
1094 Obj strcopy;
1095
1096 #ifdef HPCGAP
1097 LockGVars(0);
1098 numGVars = INT_INTOBJ(CountGVars);
1099 UnlockGVars();
1100 #else
1101 numGVars = INT_INTOBJ(CountGVars);
1102 #endif
1103
1104 copy = NEW_PLIST_IMM( T_PLIST, numGVars );
1105 for ( i = 1, j = 1; i <= numGVars; i++ ) {
1106 if ( VAL_GVAR_INTERN( i ) || ELM_GVAR_LIST( ExprGVars, i ) ) {
1107 /* Copy the string here, because we do not want members of
1108 * NameGVars accessible to users, as these strings must not be
1109 * changed */
1110 strcopy = CopyToStringRep( NameGVar( i ) );
1111 SET_ELM_PLIST( copy, j, strcopy );
1112 CHANGED_BAG( copy );
1113 j++;
1114 }
1115 }
1116 SET_LEN_PLIST( copy, j - 1 );
1117 return copy;
1118 }
1119
1120 /****************************************************************************
1121 **
1122 *F FuncASS_GVAR( <self>, <gvar>, <val> ) . . . . assign to a global variable
1123 */
FuncASS_GVAR(Obj self,Obj gvar,Obj val)1124 static Obj FuncASS_GVAR(Obj self, Obj gvar, Obj val)
1125 {
1126 // check the argument
1127 RequireStringRep("ASS_GVAR", gvar);
1128
1129 AssGVar( GVarName( CONST_CSTR_STRING(gvar) ), val );
1130 return 0L;
1131 }
1132
1133
1134 /****************************************************************************
1135 **
1136 *F FuncISB_GVAR( <self>, <gvar> ) . . check assignment of a global variable
1137 */
FuncISB_GVAR(Obj self,Obj gvar)1138 static Obj FuncISB_GVAR(Obj self, Obj gvar)
1139 {
1140 // check the argument
1141 RequireStringRep("ISB_GVAR", gvar);
1142
1143 UInt gv = GVarName( CONST_CSTR_STRING(gvar) );
1144 if (VAL_GVAR_INTERN(gv))
1145 return True;
1146 Obj expr = ExprGVar(gv);
1147 #ifdef HPCGAP
1148 if (expr && !IS_INTOBJ(expr)) /* auto gvar */
1149 return True;
1150 if (!expr || !TLVars)
1151 return False;
1152 return GetTLRecordField(TLVars, INT_INTOBJ(expr)) ? True : False;
1153 #else
1154 return expr ? True : False;
1155 #endif
1156 }
1157
1158 /****************************************************************************
1159 **
1160 *F FuncIS_AUTO_GVAR( <self>, <gvar> ) . . check if a global variable is auto
1161 */
1162
FuncIS_AUTO_GVAR(Obj self,Obj gvar)1163 static Obj FuncIS_AUTO_GVAR(Obj self, Obj gvar)
1164 {
1165 // check the argument
1166 RequireStringRep("IS_AUTO_GVAR", gvar);
1167 Obj expr = ExprGVar(GVarName( CONST_CSTR_STRING(gvar) ) );
1168 return (expr && !IS_INTOBJ(expr)) ? True : False;
1169 }
1170
1171
1172 /****************************************************************************
1173 **
1174 *F FuncVAL_GVAR( <self>, <gvar> ) . . contents of a global variable
1175 */
1176
FuncVAL_GVAR(Obj self,Obj gvar)1177 static Obj FuncVAL_GVAR(Obj self, Obj gvar)
1178 {
1179 Obj val;
1180
1181 // check the argument
1182 RequireStringRep("VAL_GVAR", gvar);
1183
1184 /* get the value */
1185 val = ValAutoGVar( GVarName( CONST_CSTR_STRING(gvar) ) );
1186
1187 if (val == 0)
1188 ErrorMayQuit("VAL_GVAR: No value bound to %g", (Int)gvar, 0);
1189 return val;
1190 }
1191
1192 /****************************************************************************
1193 **
1194 *F FuncUNB_GVAR( <self>, <gvar> ) . . unbind a global variable
1195 */
1196
FuncUNB_GVAR(Obj self,Obj gvar)1197 static Obj FuncUNB_GVAR(Obj self, Obj gvar)
1198 {
1199 // check the argument
1200 RequireStringRep("UNB_GVAR", gvar);
1201
1202 /* */
1203 AssGVar( GVarName( CONST_CSTR_STRING(gvar) ), (Obj)0 );
1204 return (Obj) 0;
1205 }
1206
1207
1208
1209 /****************************************************************************
1210 **
1211 *F * * * * * * * * * * * * * copies and fopies * * * * * * * * * * * * * * *
1212 */
1213
1214
1215 /****************************************************************************
1216 **
1217 *V CopyAndFopyGVars . . . . . . kernel table of kernel copies and "fopies"
1218 **
1219 ** This needs to be kept inside the kernel so that the copies can be updated
1220 ** after loading a workspace.
1221 */
1222 typedef struct {
1223 Obj * copy;
1224 UInt isFopy;
1225 const Char * name;
1226 } StructCopyGVar;
1227
1228 enum {
1229 MAX_COPY_AND_FOPY_GVARS = 30000
1230 };
1231
1232 static StructCopyGVar CopyAndFopyGVars[MAX_COPY_AND_FOPY_GVARS];
1233 static Int NCopyAndFopyGVars = 0;
1234
1235
1236 /****************************************************************************
1237 **
1238 *F InitCopyGVar( <name>, <copy> ) . . declare C variable as copy of global
1239 **
1240 ** 'InitCopyGVar' makes the C variable <cvar> at address <copy> a copy of
1241 ** the global variable named <name> (which must be a kernel string).
1242 **
1243 ** The function only registers the information in <CopyAndFopyGVars>. At a
1244 ** latter stage one has to call 'UpdateCopyFopyInfo' to actually enter the
1245 ** information stored in <CopyAndFopyGVars> into a plain list.
1246 **
1247 ** This is OK for garbage collection, but a real problem for saving in any
1248 ** event, this information does not really want to be saved because it is
1249 ** kernel centred rather than workspace centred.
1250 */
InitCopyGVar(const Char * name,Obj * copy)1251 void InitCopyGVar (
1252 const Char * name ,
1253 Obj * copy )
1254 {
1255 /* make a record in the kernel for saving and loading */
1256 #ifdef HPCGAP
1257 LockGVars(1);
1258 #endif
1259 if ( NCopyAndFopyGVars >= MAX_COPY_AND_FOPY_GVARS ) {
1260 #ifdef HPCGAP
1261 UnlockGVars();
1262 #endif
1263 Panic("no room to record CopyGVar");
1264 }
1265 CopyAndFopyGVars[NCopyAndFopyGVars].copy = copy;
1266 CopyAndFopyGVars[NCopyAndFopyGVars].isFopy = 0;
1267 CopyAndFopyGVars[NCopyAndFopyGVars].name = name;
1268 NCopyAndFopyGVars++;
1269 #ifdef HPCGAP
1270 UnlockGVars();
1271 #endif
1272 }
1273
1274
1275 /****************************************************************************
1276 **
1277 *F InitFopyGVar( <name>, <copy> ) . . declare C variable as copy of global
1278 **
1279 ** 'InitFopyGVar' makes the C variable <cvar> at address <copy> a (function)
1280 ** copy of the global variable <gvar>, whose name is <name>. That means
1281 ** that whenever the value of <gvar> is a function, then <cvar> will
1282 ** reference the same value (i.e., will hold the same bag identifier). When
1283 ** the value of <gvar> is not a function, then <cvar> will reference a
1284 ** function that signals the error ``<func> must be a function''. When
1285 ** <gvar> has no assigned value, then <cvar> will reference a function that
1286 ** signals the error ``<gvar> must have an assigned value''.
1287 */
InitFopyGVar(const Char * name,Obj * copy)1288 void InitFopyGVar (
1289 const Char * name,
1290 Obj * copy )
1291 {
1292 /* make a record in the kernel for saving and loading */
1293 #ifdef HPCGAP
1294 LockGVars(1);
1295 #endif
1296 if ( NCopyAndFopyGVars >= MAX_COPY_AND_FOPY_GVARS ) {
1297 #ifdef HPCGAP
1298 UnlockGVars();
1299 #endif
1300 Panic("no room to record FopyGVar");
1301 }
1302 CopyAndFopyGVars[NCopyAndFopyGVars].copy = copy;
1303 CopyAndFopyGVars[NCopyAndFopyGVars].isFopy = 1;
1304 CopyAndFopyGVars[NCopyAndFopyGVars].name = name;
1305 NCopyAndFopyGVars++;
1306 #ifdef HPCGAP
1307 UnlockGVars();
1308 #endif
1309 }
1310
1311
1312 /****************************************************************************
1313 **
1314 *F UpdateCopyFopyInfo() . . . . . . . . . . convert kernel info into plist
1315 */
1316 static Int NCopyAndFopyDone = 0;
1317
1318 #ifdef HPCGAP
1319 static void DeclareAllGVars( void );
1320 #endif
1321
UpdateCopyFopyInfo(void)1322 void UpdateCopyFopyInfo ( void )
1323 {
1324 Obj cops; /* copies list */
1325 UInt gvar;
1326 const Char * name; /* name of the variable */
1327 Obj * copy; /* address of the copy */
1328
1329 #ifdef HPCGAP
1330 LockGVars(1);
1331 #endif
1332 /* loop over new copies and fopies */
1333 for ( ; NCopyAndFopyDone < NCopyAndFopyGVars; NCopyAndFopyDone++ ) {
1334 name = CopyAndFopyGVars[NCopyAndFopyDone].name;
1335 copy = CopyAndFopyGVars[NCopyAndFopyDone].copy;
1336 gvar = GVarName(name);
1337
1338 /* get the copies list and its length */
1339 if ( CopyAndFopyGVars[NCopyAndFopyDone].isFopy ) {
1340 cops = ELM_GVAR_LIST( FopiesGVars, gvar );
1341 if ( cops == 0 ) {
1342 cops = NEW_PLIST( T_PLIST, 0 );
1343 #ifdef HPCGAP
1344 MakeBagPublic(cops);
1345 #endif
1346 SET_ELM_GVAR_LIST( FopiesGVars, gvar, cops );
1347 SetHasExprCopiesFopies(gvar, 1);
1348 CHANGED_GVAR_LIST( FopiesGVars, gvar );
1349 }
1350 }
1351 else {
1352 cops = ELM_GVAR_LIST( CopiesGVars, gvar );
1353 if ( cops == 0 ) {
1354 cops = NEW_PLIST( T_PLIST, 0 );
1355 #ifdef HPCGAP
1356 MakeBagPublic(cops);
1357 #endif
1358 SET_ELM_GVAR_LIST( CopiesGVars, gvar, cops );
1359 SetHasExprCopiesFopies(gvar, 1);
1360 CHANGED_GVAR_LIST( CopiesGVars, gvar );
1361 }
1362 }
1363
1364 // append the copy to the copies list
1365 // As C global variables are 4-byte aligned,
1366 // we shift them down to make it more likely they
1367 // will fit in an immediate integer.
1368 GAP_ASSERT(((UInt)copy & 3) == 0);
1369 PushPlist(cops, ObjInt_UInt((UInt)copy >> 2));
1370
1371 /* now copy the value of <gvar> to <cvar> */
1372 Obj val = ValGVar(gvar);
1373 if ( CopyAndFopyGVars[NCopyAndFopyDone].isFopy ) {
1374 if ( val != 0 && IS_FUNC(val) ) {
1375 *copy = val;
1376 }
1377 else if ( val != 0 ) {
1378 *copy = ErrorMustEvalToFuncFunc;
1379 }
1380 else {
1381 *copy = ErrorMustHaveAssObjFunc;
1382 }
1383 }
1384 else {
1385 *copy = val;
1386 }
1387 }
1388 #ifdef HPCGAP
1389 DeclareAllGVars();
1390 UnlockGVars();
1391 #endif
1392 }
1393
1394
1395 /****************************************************************************
1396 **
1397 *F RemoveCopyFopyInfo() . . . remove the info about copies of gvars from ws
1398 */
RemoveCopyFopyInfo(void)1399 static void RemoveCopyFopyInfo( void )
1400 {
1401 #ifdef HPCGAP
1402 LockGVars(1);
1403 #endif
1404
1405 #ifdef USE_GVAR_BUCKETS
1406 UInt i, k, l;
1407
1408 for (k = 0; k < ARRAY_SIZE(CopiesGVars); ++k) {
1409 if (CopiesGVars[k] == 0)
1410 continue;
1411 l = LEN_PLIST(CopiesGVars[k]);
1412 for ( i = 1; i <= l; i++ )
1413 SET_ELM_PLIST( CopiesGVars[k], i, 0 );
1414 }
1415
1416 for (k = 0; k < ARRAY_SIZE(FopiesGVars); ++k) {
1417 if (FopiesGVars[k] == 0)
1418 continue;
1419 l = LEN_PLIST(FopiesGVars[k]);
1420 for ( i = 1; i <= l; i++ )
1421 SET_ELM_PLIST( FopiesGVars[k], i, 0 );
1422 }
1423
1424 #else
1425 UInt i, l;
1426
1427 l = LEN_PLIST(CopiesGVars);
1428 for ( i = 1; i <= l; i++ )
1429 SET_ELM_GVAR_LIST( CopiesGVars, i, 0 );
1430 l = LEN_PLIST(FopiesGVars);
1431 for ( i = 1; i <= l; i++ )
1432 SET_ELM_GVAR_LIST( FopiesGVars, i, 0 );
1433 #endif
1434
1435 NCopyAndFopyDone = 0;
1436
1437 #ifdef HPCGAP
1438 UnlockGVars();
1439 #endif
1440 }
1441
1442
1443 /****************************************************************************
1444 **
1445 */
GVarsAfterCollectBags(void)1446 static void GVarsAfterCollectBags(void)
1447 {
1448 #ifdef USE_GVAR_BUCKETS
1449 for (int i = 0; i < GVAR_BUCKETS; i++) {
1450 if (ValGVars[i])
1451 PtrGVars[i] = ADDR_OBJ( ValGVars[i] ) + 1;
1452 else
1453 break;
1454 }
1455 #else
1456 if (ValGVars)
1457 PtrGVars = ADDR_OBJ( ValGVars );
1458 #endif
1459 }
1460
1461
1462 #ifdef HPCGAP
1463
1464 static GVarDescriptor * FirstDeclaredGVar;
1465 static GVarDescriptor * LastDeclaredGVar;
1466
1467 /****************************************************************************
1468 **
1469 *F DeclareGVar(<gvar>, <name>) . . . . . . declare global variable by name
1470 *F GVarValue(<gvar>) . . . . . . . . . return value of <gvar>, 0 if unbound
1471 *F GVarObj(<gvar>) . . . . . . . . return value of <gvar>, error if unbound
1472 *F GVarFunction(<gvar>) . . return value of <gvar>, error if not a function
1473 *F GVarOptFunction(<gvar>) return value of <gvar>, 0 if unbound/no function
1474 *F SetGVar(<gvar>, <obj>) . . . . . . . . . . . . . assign <obj> to <gvar>
1475 */
1476
DeclareGVar(GVarDescriptor * gvar,const char * name)1477 void DeclareGVar(GVarDescriptor *gvar, const char *name)
1478 {
1479 gvar->ref = NULL;
1480 gvar->name = name;
1481 gvar->next = NULL;
1482 if (LastDeclaredGVar) {
1483 LastDeclaredGVar->next = gvar;
1484 LastDeclaredGVar = gvar;
1485 } else {
1486 FirstDeclaredGVar = gvar;
1487 LastDeclaredGVar = gvar;
1488 }
1489 }
1490
DeclareAllGVars(void)1491 static void DeclareAllGVars( void )
1492 {
1493 GVarDescriptor *gvar;
1494 for (gvar = FirstDeclaredGVar; gvar; gvar = gvar->next) {
1495 UInt index = GVarName(gvar->name);
1496 gvar->ref = &(VAL_GVAR_INTERN(index));
1497 }
1498 FirstDeclaredGVar = LastDeclaredGVar = 0;
1499 }
1500
GVarValue(GVarDescriptor * gvar)1501 Obj GVarValue(GVarDescriptor *gvar)
1502 {
1503 Obj result = *(gvar->ref);
1504 MEMBAR_READ();
1505 return result;
1506 }
1507
GVarObj(GVarDescriptor * gvar)1508 Obj GVarObj(GVarDescriptor *gvar)
1509 {
1510 Obj result = *(gvar->ref);
1511 if (!result)
1512 ErrorQuit("Global variable '%s' not initialized", (UInt)(gvar->name), 0L);
1513 MEMBAR_READ();
1514 return result;
1515 }
1516
GVarFunction(GVarDescriptor * gvar)1517 Obj GVarFunction(GVarDescriptor *gvar)
1518 {
1519 Obj result = *(gvar->ref);
1520 if (!result)
1521 ErrorQuit("Global variable '%s' not initialized", (UInt)(gvar->name), 0L);
1522 if (REGION(result))
1523 ErrorQuit("Global variable '%s' is not a function", (UInt)(gvar->name), 0L);
1524 ImpliedWriteGuard(result);
1525 if (TNUM_OBJ(result) != T_FUNCTION)
1526 ErrorQuit("Global variable '%s' is not a function", (UInt)(gvar->name), 0L);
1527 MEMBAR_READ();
1528 return result;
1529 }
1530
GVarOptFunction(GVarDescriptor * gvar)1531 Obj GVarOptFunction(GVarDescriptor *gvar)
1532 {
1533 Obj result = *(gvar->ref);
1534 if (!result)
1535 return (Obj) 0;
1536 if (REGION(result))
1537 return (Obj) 0;
1538 ImpliedWriteGuard(result);
1539 if (TNUM_OBJ(result) != T_FUNCTION)
1540 return (Obj) 0;
1541 MEMBAR_READ();
1542 return result;
1543 }
1544
SetGVar(GVarDescriptor * gvar,Obj obj)1545 void SetGVar(GVarDescriptor *gvar, Obj obj)
1546 {
1547 MEMBAR_WRITE();
1548 *(gvar->ref) = obj;
1549 }
1550
1551 #endif
1552
1553
1554 /****************************************************************************
1555 **
1556 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
1557 */
1558
1559
1560 /****************************************************************************
1561 **
1562 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
1563 */
1564 static StructGVarFunc GVarFuncs[] = {
1565
1566 GVAR_FUNC(MakeReadOnlyGVar, 1, "name"),
1567 GVAR_FUNC(MakeReadWriteGVar, 1, "name"),
1568 GVAR_FUNC(MakeConstantGVar, 1, "name"),
1569 GVAR_FUNC(IsReadOnlyGVar, 1, "name"),
1570 GVAR_FUNC(IsConstantGVar, 1, "name"),
1571 GVAR_FUNC(AUTO, -3, "func, arg, names..."),
1572
1573
1574 GVAR_FUNC(IDENTS_GVAR, 0, ""),
1575 GVAR_FUNC(IDENTS_BOUND_GVARS, 0, ""),
1576 GVAR_FUNC(ISB_GVAR, 1, "gvar"),
1577 GVAR_FUNC(IS_AUTO_GVAR, 1, "gvar"),
1578 GVAR_FUNC(ASS_GVAR, 2, "gvar, value"),
1579 GVAR_FUNC(VAL_GVAR, 1, "gvar"),
1580 GVAR_FUNC(UNB_GVAR, 1, "gvar"),
1581 GVAR_FUNC(SET_NAMESPACE, 1, "str"),
1582 GVAR_FUNC(GET_NAMESPACE, 0, ""),
1583 #ifdef HPCGAP
1584 GVAR_FUNC(IsThreadLocalGVar, 1, "name"),
1585 #endif
1586
1587 { 0, 0, 0, 0, 0 }
1588
1589 };
1590
1591
1592 /****************************************************************************
1593 **
1594 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
1595 */
InitKernel(StructInitInfo * module)1596 static Int InitKernel (
1597 StructInitInfo * module )
1598 {
1599 /* init global bags and handler */
1600 InitGlobalBag( &ErrorMustEvalToFuncFunc,
1601 "src/gvars.c:ErrorMustEvalToFuncFunc" );
1602 InitGlobalBag( &ErrorMustHaveAssObjFunc,
1603 "src/gvars.c:ErrorMustHaveAssObjFunc" );
1604 #ifdef USE_GVAR_BUCKETS
1605 int i;
1606 static char cookies[6][GVAR_BUCKETS][10];
1607
1608 for (i=0; i<GVAR_BUCKETS; i++) {
1609 sprintf((cookies[0][i]), "Vgv%d", i);
1610 sprintf((cookies[1][i]), "Ngv%d", i);
1611 sprintf((cookies[2][i]), "Wgv%d", i);
1612 sprintf((cookies[3][i]), "Egv%d", i);
1613 sprintf((cookies[4][i]), "Cgv%d", i);
1614 sprintf((cookies[5][i]), "Fgv%d", i);
1615 InitGlobalBag( ValGVars+i, (cookies[0][i]) );
1616 InitGlobalBag( NameGVars+i, (cookies[1][i]) );
1617 InitGlobalBag(FlagsGVars + i, (cookies[2][i]));
1618 InitGlobalBag( ExprGVars+i, (cookies[3][i]) );
1619 InitGlobalBag( CopiesGVars+i, (cookies[4][i]) );
1620 InitGlobalBag( FopiesGVars+i, (cookies[5][i]) );
1621 }
1622 #else
1623 InitGlobalBag( &ValGVars,
1624 "src/gvars.c:ValGVars" );
1625 InitGlobalBag( &NameGVars,
1626 "src/gvars.c:NameGVars" );
1627 InitGlobalBag(&FlagsGVars, "src/gvars.c:FlagsGVars");
1628 InitGlobalBag( &ExprGVars,
1629 "src/gvars.c:ExprGVars" );
1630 InitGlobalBag( &CopiesGVars,
1631 "src/gvars.c:CopiesGVars" );
1632 InitGlobalBag( &FopiesGVars,
1633 "src/gvars.c:FopiesGVars" );
1634 #endif
1635
1636 #if !defined(HPCGAP)
1637 InitGlobalBag( &STATE(CurrNamespace),
1638 "src/gvars.c:CurrNamespace" );
1639 #endif
1640
1641 CountGVars = INTOBJ_INT(0);
1642 InitGlobalBag( &CountGVars,
1643 "src/gvars.c:CountGVars" );
1644
1645 InitGlobalBag( &TableGVars,
1646 "src/gvars.c:TableGVars" );
1647
1648 InitHandlerFunc( ErrorMustEvalToFuncHandler,
1649 "src/gvars.c:ErrorMustEvalToFuncHandler" );
1650 InitHandlerFunc( ErrorMustHaveAssObjHandler,
1651 "src/gvars.c:ErrorMustHaveAssObjHandler" );
1652
1653 #ifdef USE_GASMAN
1654 // install post-GC callback
1655 RegisterAfterCollectFuncBags(GVarsAfterCollectBags);
1656 #endif
1657
1658 /* init filters and functions */
1659 InitHdlrFuncsFromTable( GVarFuncs );
1660
1661 #ifdef HPCGAP
1662 /* For thread-local variables */
1663 InitCopyGVar("ThreadVar", &TLVars);
1664 #endif
1665
1666 /* Get a copy of REREADING */
1667 ImportGVarFromLibrary("REREADING", &REREADING);
1668
1669
1670 /* return success */
1671 return 0;
1672 }
1673
1674
1675 /****************************************************************************
1676 **
1677 *F PostRestore( <module> ) . . . . . . . . . . . . . after restore workspace
1678 */
1679
PostRestore(StructInitInfo * module)1680 static Int PostRestore (
1681 StructInitInfo * module )
1682 {
1683 // restore PtrGVars
1684 GVarsAfterCollectBags();
1685
1686 /* update fopies and copies */
1687 UpdateCopyFopyInfo();
1688
1689 /* return success */
1690 return 0;
1691 }
1692
1693 /****************************************************************************
1694 **
1695 *F PreSave( <module> ) . . . . . . . . . . . . . before save workspace
1696 */
PreSave(StructInitInfo * module)1697 static Int PreSave (
1698 StructInitInfo * module )
1699 {
1700 RemoveCopyFopyInfo();
1701 return 0;
1702 }
1703
1704 /****************************************************************************
1705 **
1706 *F PostSave( <module> ) . . . . . . . . . . . . . after save workspace
1707 */
PostSave(StructInitInfo * module)1708 static Int PostSave (
1709 StructInitInfo * module )
1710 {
1711 UpdateCopyFopyInfo();
1712 return 0;
1713 }
1714
1715
1716 /****************************************************************************
1717 **
1718 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
1719 */
InitLibrary(StructInitInfo * module)1720 static Int InitLibrary (
1721 StructInitInfo * module )
1722 {
1723 #ifdef HPCGAP
1724 /* Init lock */
1725 pthread_rwlock_init(&GVarLock, NULL);
1726 #endif
1727
1728 /* make the error functions for 'AssGVar' */
1729 ErrorMustEvalToFuncFunc = NewFunctionC(
1730 "ErrorMustEvalToFunc", -1,"args", ErrorMustEvalToFuncHandler );
1731
1732 ErrorMustHaveAssObjFunc = NewFunctionC(
1733 "ErrorMustHaveAssObj", -1L,"args", ErrorMustHaveAssObjHandler );
1734
1735 #if !defined(USE_GVAR_BUCKETS)
1736 /* make the lists for global variables */
1737 ValGVars = NEW_PLIST( T_PLIST, 0 );
1738 NameGVars = NEW_PLIST( T_PLIST, 0 );
1739 FlagsGVars = NEW_PLIST(T_PLIST, 0);
1740 ExprGVars = NEW_PLIST( T_PLIST, 0 );
1741 CopiesGVars = NEW_PLIST( T_PLIST, 0 );
1742 FopiesGVars = NEW_PLIST( T_PLIST, 0 );
1743 #endif
1744
1745 /* make the list of global variables */
1746 TableGVars = NEW_PLIST( T_PLIST, 14033 );
1747 SET_LEN_PLIST( TableGVars, 14033 );
1748 #ifdef HPCGAP
1749 MakeBagPublic(TableGVars);
1750 #endif
1751
1752 /* fix C vars */
1753 PostRestore( module );
1754
1755 /* init filters and functions */
1756 InitGVarFuncsFromTable( GVarFuncs );
1757
1758 /* return success */
1759 return 0;
1760 }
1761
1762
1763 /****************************************************************************
1764 **
1765 *F CheckInit( <module> ) . . . . . . . . . . . . . . . check initialisation
1766 */
CheckInit(StructInitInfo * module)1767 static Int CheckInit (
1768 StructInitInfo * module )
1769 {
1770 Int success = 1;
1771
1772 if ( NCopyAndFopyGVars != NCopyAndFopyDone ) {
1773 success = 0;
1774 Pr( "#W failed to updated copies and fopies\n", 0L, 0L );
1775 }
1776
1777 /* return success */
1778 return ! success;
1779 }
1780
1781
InitModuleState(void)1782 static Int InitModuleState(void)
1783 {
1784 /* Create the current namespace: */
1785 STATE(CurrNamespace) = NEW_STRING(0);
1786 SET_LEN_STRING(STATE(CurrNamespace), 0);
1787
1788 // return success
1789 return 0;
1790 }
1791
1792
1793 /****************************************************************************
1794 **
1795 *F InitInfoGVars() . . . . . . . . . . . . . . . . . table of init functions
1796 */
1797 static StructInitInfo module = {
1798 // init struct using C99 designated initializers; for a full list of
1799 // fields, please refer to the definition of StructInitInfo
1800 .type = MODULE_BUILTIN,
1801 .name = "gvars",
1802 .initKernel = InitKernel,
1803 .initLibrary = InitLibrary,
1804 .checkInit = CheckInit,
1805 .preSave = PreSave,
1806 .postSave = PostSave,
1807 .postRestore = PostRestore,
1808 .initModuleState = InitModuleState,
1809 };
1810
InitInfoGVars(void)1811 StructInitInfo * InitInfoGVars ( void )
1812 {
1813 return &module;
1814 }
1815