CoCalc -- compiled.h

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Views: ⁴¹⁵⁰⁶⁵
1
/****************************************************************************
2
**
3
*W  compiled.h                  GAP source                   Martin Schönert
4
**
5
**  This package defines macros and functions that are used by compiled code.
6
**  Those macros and functions should go into the appropriate packages.
7
*/
8

9
#ifndef GAP_COMPILED_H
10
#define GAP_COMPILED_H
11

12
#ifdef __cplusplus
13
extern "C" {
14
#define GAP_IN_EXTERN_C
15
#endif
16

17
#include        "system.h"              /* system dependent part           */
18

19
#include        "gasman.h"              /* garbage collector               */
20
#include        "objects.h"             /* objects                         */
21
#include        "scanner.h"             /* scanner                         */
22

23
#include        "gap.h"                 /* error handling, initialisation  */
24

25
#include        "read.h"                /* reader                          */
26

27
#include        "gvars.h"               /* global variables                */
28
#include        "calls.h"               /* generic call mechanism          */
29
#include        "opers.h"               /* generic operations              */
30

31
#include        "ariths.h"              /* basic arithmetic                */
32

33
#include        "integer.h"             /* integers                        */
34
#include        "rational.h"            /* rationals                       */
35
#include        "cyclotom.h"            /* cyclotomics                     */
36
#include        "finfield.h"            /* finite fields and ff elements   */
37
#include        "macfloat.h"            /* machine floats                  */
38

39
#include        "bool.h"                /* booleans                        */
40
#include        "permutat.h"            /* permutations                    */
41
#include        "trans.h"               /* transformation                  */
42
#include        "pperm.h"               /* partial perms                   */
43

44
#include        "records.h"             /* generic records                 */
45
#include        "precord.h"             /* plain records                   */
46

47
#include        "lists.h"               /* generic lists                   */
48
#include        "listoper.h"            /* operations for generic lists    */
49
#include        "listfunc.h"            /* functions for generic lists     */
50
#include        "plist.h"               /* plain lists                     */
51
#include        "set.h"                 /* plain sets                      */
52
#include        "vector.h"              /* functions for plain vectors     */
53
#include        "blister.h"             /* boolean lists                   */
54
#include        "range.h"               /* ranges                          */
55
#include        "string.h"              /* strings                         */
56

57
#include        "code.h"                /* coder                           */
58
#include        "tls.h"                 /* thread-local storage            */
59

60
#include        "objfgelm.h"            /* objects of free groups          */
61
#include        "objpcgel.h"            /* objects of polycyclic groups    */
62
#include        "objscoll.h"            /* single collector                */
63
#include        "objcftl.h"             /* from the left collect           */
64

65
#include        "dt.h"                  /* deep thought                    */
66
#include        "dteval.h"              /* deep thought evaluation          */
67

68
#include        "sctable.h"             /* structure constant table        */
69
#include        "costab.h"              /* coset table                     */
70
#include        "tietze.h"              /* tietze helper functions         */
71

72
#include        "exprs.h"               /* expressions                     */
73
#include        "stats.h"               /* statements                      */
74
#include        "funcs.h"               /* functions                       */
75

76

77
#include        "intrprtr.h"            /* interpreter                     */
78

79
#include        "compiler.h"            /* compiler                        */
80

81
#include        "compstat.h"            /* statically linked modules       */
82

83
#include        "saveload.h"            /* saving and loading              */
84

85
#include        "streams.h"             /* streams package                 */
86
#include        "sysfiles.h"            /* file input/output               */
87
#include        "weakptr.h"             /* weak pointers                   */
88

89
#include        "vars.h"                /* variables                       */
90

91
#include        "aobjects.h"            /* atomic variables                */
92
extern Obj InfoDecision;
93
extern Obj InfoDoPrint;
94
extern Obj CurrentAssertionLevel;
95

96
extern Obj NewAndFilter (
97
    Obj                 oper1,
98
    Obj                 oper2 );
99

100

101
/* types, should go into 'gvars.c' and 'records.c' * * * * * * * * * * * * */
102

103
typedef UInt    GVar;
104

105
typedef UInt    RNam;
106

107

108
/* checks, should go into 'gap.c'  * * * * * * * * * * * * * * * * * * * * */
109

110
#define CHECK_BOUND(obj,name) \
111
 if ( obj == 0 ) ErrorQuitBound(name);
112

113
#define CHECK_FUNC_RESULT(obj) \
114
 if ( obj == 0 ) ErrorQuitFuncResult();
115

116
#define CHECK_INT_SMALL(obj) \
117
 if ( ! IS_INTOBJ(obj) ) ErrorQuitIntSmall(obj);
118

119
#define CHECK_INT_SMALL_POS(obj) \
120
 if ( ! IS_POS_INTOBJ(obj) ) ErrorQuitIntSmallPos(obj);
121

122
#define CHECK_INT_POS(obj) \
123
 if ( TNUM_OBJ(obj) != T_INTPOS && ( ! IS_POS_INTOBJ(obj)) ) ErrorQuitIntPos(obj);
124

125
#define CHECK_BOOL(obj) \
126
 if ( obj != True && obj != False ) ErrorQuitBool(obj);
127

128
#define CHECK_FUNC(obj) \
129
 if ( TNUM_OBJ(obj) != T_FUNCTION ) ErrorQuitFunc(obj);
130

131
#define CHECK_NR_ARGS(narg,args) \
132
 if ( narg != LEN_PLIST(args) ) ErrorQuitNrArgs(narg,args);
133

134

135
/* higher variables, should go into 'vars.c' * * * * * * * * * * * * * * * */
136

137
#define SWITCH_TO_NEW_FRAME     SWITCH_TO_NEW_LVARS
138
#define SWITCH_TO_OLD_FRAME     SWITCH_TO_OLD_LVARS
139

140
#define CURR_FRAME              TLS(CurrLVars)
141
#define CURR_FRAME_1UP          ENVI_FUNC( PTR_BAG( CURR_FRAME     )[0] )
142
#define CURR_FRAME_2UP          ENVI_FUNC( PTR_BAG( CURR_FRAME_1UP )[0] )
143
#define CURR_FRAME_3UP          ENVI_FUNC( PTR_BAG( CURR_FRAME_2UP )[0] )
144
#define CURR_FRAME_4UP          ENVI_FUNC( PTR_BAG( CURR_FRAME_3UP )[0] )
145
#define CURR_FRAME_5UP          ENVI_FUNC( PTR_BAG( CURR_FRAME_4UP )[0] )
146
#define CURR_FRAME_6UP          ENVI_FUNC( PTR_BAG( CURR_FRAME_5UP )[0] )
147
#define CURR_FRAME_7UP          ENVI_FUNC( PTR_BAG( CURR_FRAME_6UP )[0] )
148

149
/* #define OBJ_LVAR(lvar)  TLS(PtrLVars)[(lvar)+2] */
150
#define OBJ_LVAR_0UP(lvar) \
151
    OBJ_LVAR(lvar)
152
#define OBJ_LVAR_1UP(lvar) \
153
    PTR_BAG(CURR_FRAME_1UP)[(lvar)+2]
154
#define OBJ_LVAR_2UP(lvar) \
155
    PTR_BAG(CURR_FRAME_2UP)[(lvar)+2]
156
#define OBJ_LVAR_3UP(lvar) \
157
    PTR_BAG(CURR_FRAME_3UP)[(lvar)+2]
158
#define OBJ_LVAR_4UP(lvar) \
159
    PTR_BAG(CURR_FRAME_4UP)[(lvar)+2]
160
#define OBJ_LVAR_5UP(lvar) \
161
    PTR_BAG(CURR_FRAME_5UP)[(lvar)+2]
162
#define OBJ_LVAR_6UP(lvar) \
163
    PTR_BAG(CURR_FRAME_6UP)[(lvar)+2]
164
#define OBJ_LVAR_7UP(lvar) \
165
    PTR_BAG(CURR_FRAME_7UP)[(lvar)+2]
166
#define OBJ_LVAR_8UP(lvar) \
167
    PTR_BAG(CURR_FRAME_8UP)[(lvar)+2]
168

169
/* #define ASS_LVAR(lvar,obj) do { TLS(PtrLVars)[(lvar)+2] = (obj); } while ( 0 ) */
170
#define ASS_LVAR_0UP(lvar,obj) \
171
    ASS_LVAR(lvar,obj)
172
#define ASS_LVAR_1UP(lvar,obj) \
173
    do { PTR_BAG(CURR_FRAME_1UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_1UP); } while ( 0 )
174
#define ASS_LVAR_2UP(lvar,obj) \
175
    do { PTR_BAG(CURR_FRAME_2UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_2UP); } while ( 0 )
176
#define ASS_LVAR_3UP(lvar,obj) \
177
    do { PTR_BAG(CURR_FRAME_3UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_3UP); } while ( 0 )
178
#define ASS_LVAR_4UP(lvar,obj) \
179
    do { PTR_BAG(CURR_FRAME_4UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_4UP); } while ( 0 )
180
#define ASS_LVAR_5UP(lvar,obj) \
181
    do { PTR_BAG(CURR_FRAME_5UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_5UP); } while ( 0 )
182
#define ASS_LVAR_6UP(lvar,obj) \
183
    do { PTR_BAG(CURR_FRAME_6UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_6UP); } while ( 0 )
184
#define ASS_LVAR_7UP(lvar,obj) \
185
    do { PTR_BAG(CURR_FRAME_7UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_7UP); } while ( 0 )
186
#define ASS_LVAR_8UP(lvar,obj) \
187
    do { PTR_BAG(CURR_FRAME_8UP)[(lvar)+2] = (obj); CHANGED_BAG(CURR_FRAME_8UP); } while ( 0 )
188

189

190
/* objects, should into 'objects.c'  * * * * * * * * * * * * * * * * * * * */
191

192
/* there should be a function for C_ELM_POSOBJ */
193
#define C_ELM_POSOBJ( elm, list, pos ) NOT_READY_YET
194

195

196
#define C_ELM_POSOBJ_NLE( elm, list, pos ) \
197
    if ( TNUM_OBJ(list) == T_POSOBJ ) { \
198
        elm = ELM_PLIST( list, pos ); \
199
    } \
200
    else { \
201
        elm = ELMW_LIST( list, pos ); \
202
    }
203

204
#define C_ASS_POSOBJ_INTOBJ( list, pos, elm ) \
205
    if ( TNUM_OBJ(list) == T_POSOBJ ) { \
206
        if ( SIZE_OBJ(list)/sizeof(Obj)-1 < pos ) { \
207
            ResizeBag( list, (pos+1)*sizeof(Obj) ); \
208
        } \
209
        SET_ELM_PLIST( list, pos, elm ); \
210
    } \
211
    else { \
212
        ASS_LIST( list, pos, elm ); \
213
    }
214

215
#define C_ASS_POSOBJ( list, pos, elm ) \
216
    if ( TNUM_OBJ(list) == T_POSOBJ ) { \
217
        if ( SIZE_OBJ(list)/sizeof(Obj)-1 < pos ) { \
218
            ResizeBag( list, (pos+1)*sizeof(Obj) ); \
219
        } \
220
        SET_ELM_PLIST( list, pos, elm ); \
221
        CHANGED_BAG(list); \
222
    } \
223
    else { \
224
        ASS_LIST( list, pos, elm ); \
225
    }
226

227

228

229
/* lists, should go into 'lists.c' * * * * * * * * * * * * * * * * * * * * */
230
#define C_LEN_LIST(len,list) \
231
 len = LENGTH(list);
232

233
#define C_LEN_LIST_FPL(len,list) \
234
 if ( IS_PLIST(list) ) { \
235
  len = INTOBJ_INT( LEN_PLIST(list) ); \
236
 } \
237
 else { \
238
  len = LENGTH(list); \
239
 }
240

241

242

243

244
#define C_ELM_LIST(elm,list,p) \
245
 elm = IS_POS_INTOBJ(p) ? ELM_LIST( list, INT_INTOBJ(p) ) : ELMB_LIST(list, p);
246

247
#define C_ELM_LIST_NLE(elm,list,p) \
248
 elm = IS_POS_INTOBJ(p) ? ELMW_LIST( list, INT_INTOBJ(p) ) : ELMB_LIST(list, p);
249

250
#define C_ELM_LIST_FPL(elm,list,p) \
251
 if ( IS_POS_INTOBJ(p) && IS_PLIST(list) ) { \
252
  if ( INT_INTOBJ(p) <= LEN_PLIST(list) ) { \
253
   elm = ELM_PLIST( list, INT_INTOBJ(p) ); \
254
   if ( elm == 0 ) elm = ELM_LIST( list, INT_INTOBJ(p) ); \
255
  } else elm = ELM_LIST( list, INT_INTOBJ(p) ); \
256
 } else C_ELM_LIST( elm, list, p )
257

258
#define C_ELM_LIST_NLE_FPL(elm,list,p) \
259
 if ( IS_POS_INTOBJ(p) && IS_PLIST(list) ) { \
260
  elm = ELM_PLIST( list, INT_INTOBJ(p) ); \
261
 } else C_ELM_LIST_NLE(elm, list, p)
262

263
#define C_ASS_LIST(list,p,rhs) \
264
  if (IS_POS_INTOBJ(p)) ASS_LIST( list, INT_INTOBJ(p), rhs ); \
265
  else ASSB_LIST(list, p, rhs);
266

267
#define C_ASS_LIST_FPL(list,p,rhs) \
268
 if ( IS_POS_INTOBJ(p) && TNUM_OBJ(list) == T_PLIST ) { \
269
  if ( LEN_PLIST(list) < INT_INTOBJ(p) ) { \
270
   GROW_PLIST( list, (UInt)INT_INTOBJ(p) ); \
271
   SET_LEN_PLIST( list, INT_INTOBJ(p) ); \
272
  } \
273
  SET_ELM_PLIST( list, INT_INTOBJ(p), rhs ); \
274
  CHANGED_BAG( list ); \
275
 } \
276
 else { \
277
  C_ASS_LIST( list, p, rhs ) \
278
 }
279

280
#define C_ASS_LIST_FPL_INTOBJ(list,p,rhs) \
281
 if ( IS_POS_INTOBJ(p) && TNUM_OBJ(list) == T_PLIST) { \
282
  if ( LEN_PLIST(list) < INT_INTOBJ(p) ) { \
283
   GROW_PLIST( list, (UInt)INT_INTOBJ(p) ); \
284
   SET_LEN_PLIST( list, INT_INTOBJ(p) ); \
285
  } \
286
  SET_ELM_PLIST( list, INT_INTOBJ(p), rhs ); \
287
 } \
288
 else { \
289
  C_ASS_LIST( list, p, rhs ) \
290
 }
291

292
#define C_ISB_LIST( list, pos) \
293
  ((IS_POS_INTOBJ(pos) ? ISB_LIST(list, INT_INTOBJ(pos)) : ISBB_LIST( list, pos)) ? True : False)
294

295
#define C_UNB_LIST( list, pos) \
296
   if (IS_POS_INTOBJ(pos)) UNB_LIST(list, INT_INTOBJ(pos)); else UNBB_LIST(list, pos);
297

298
extern  void            AddList (
299
            Obj                 list,
300
            Obj                 obj );
301

302
extern  void            AddPlist (
303
            Obj                 list,
304
            Obj                 obj );
305

306
#define C_ADD_LIST(list,obj) \
307
 AddList( list, obj );
308

309
#define C_ADD_LIST_FPL(list,obj) \
310
 if ( TNUM_OBJ(list) == T_PLIST) { \
311
  AddPlist( list, obj ); \
312
 } \
313
 else { \
314
  AddList( list, obj ); \
315
 }
316

317
#define GF_ITERATOR     ITERATOR
318
#define GF_IS_DONE_ITER IS_DONE_ITER
319
#define GF_NEXT_ITER    NEXT_ITER
320

321
extern  Obj             GF_ITERATOR;
322
extern  Obj             GF_IS_DONE_ITER;
323
extern  Obj             GF_NEXT_ITER;
324

325

326

327
/* More or less all of this will get inlined away */
328

329
/* Allocate a bag suitable for a size-byte integer of type type. 
330
   The allocation may need to be bigger than size bytes 
331
   due to limb size or other aspects of the representation */
332

333
static inline  Obj C_MAKE_INTEGER_BAG( UInt size, UInt type)  {
334
  /* Round size up to nearest multiple of INTEGER_ALLOCATION_SIZE */
335
  return NewBag(type,INTEGER_ALLOCATION_SIZE*
336
		((size + INTEGER_ALLOCATION_SIZE-1)/INTEGER_ALLOCATION_SIZE));
337
}
338

339

340
/* Set 2 bytes of data in an integer */
341

342
static inline void C_SET_LIMB2(Obj bag, UInt limbnumber, UInt2 value)  {
343

344
#if INTEGER_UNIT_SIZE == 2
345
  ((UInt2 *)ADDR_OBJ(bag))[limbnumber] = value;
346
#elif INTEGER_UNIT_SIZE == 4
347
  UInt4 *p;
348
  if (limbnumber % 2) {
349
    p = ((UInt4 *)ADDR_OBJ(bag)) + (limbnumber-1) / 2;
350
    *p = (*p & 0xFFFFUL) | ((UInt4)value << 16);
351
  } else {
352
    p = ((UInt4 *)ADDR_OBJ(bag)) + limbnumber / 2;
353
    *p = (*p & 0xFFFF0000UL) | (UInt4)value;
354
  }
355
#else
356
  UInt8 *p;
357
    p  = ((UInt8 *)ADDR_OBJ(bag)) + limbnumber/4;
358
    switch(limbnumber % 4) {
359
    case 0: 
360
      *p = (*p & 0xFFFFFFFFFFFF0000UL) | (UInt8)value;
361
      break;
362
    case 1:
363
      *p = (*p & 0xFFFFFFFF0000FFFFUL) | ((UInt8)value << 16);
364
      break;
365
    case 2:
366
      *p = (*p & 0xFFFF0000FFFFFFFFUL) | ((UInt8)value << 32);
367
      break;
368
    case 3:
369
      *p = (*p & 0x0000FFFFFFFFFFFFUL) | ((UInt8)value << 48);
370
      break;
371
    }
372
#endif  
373
}
374

375
static inline void C_SET_LIMB4(Obj bag, UInt limbnumber, UInt4 value)  {
376

377
#if INTEGER_UNIT_SIZE == 4
378
  ((UInt4 *)ADDR_OBJ(bag))[limbnumber] = value;
379
#elif INTEGER_UNIT_SIZE == 8
380
  UInt8 *p;
381
  if (limbnumber % 2) {
382
    p = ((UInt8*)ADDR_OBJ(bag)) + (limbnumber-1) / 2;
383
    *p = (*p & 0xFFFFFFFFUL) | ((UInt8)value << 32);
384
  } else {
385
    p = ((UInt8 *)ADDR_OBJ(bag)) + limbnumber / 2;
386
    *p = (*p & 0xFFFFFFFF00000000UL) | (UInt8)value;
387
  }
388
#else
389
  ((UInt2 *)ADDR_OBJ(bag))[2*limbnumber] = (UInt2)(value & 0xFFFFUL);
390
  ((UInt2 *)ADDR_OBJ(bag))[2*limbnumber+1] = (UInt2)(value >>16);
391
#endif  
392
}
393

394

395

396
static inline void C_SET_LIMB8(Obj bag, UInt limbnumber, UInt8 value)  { 
397
#if INTEGER_UNIT_SIZE == 8
398
  ((UInt8 *)ADDR_OBJ(bag))[limbnumber] = value;
399
#elif INTEGER_UNIT_SIZE == 4
400
  ((UInt4 *)ADDR_OBJ(bag))[2*limbnumber] = (UInt4)(value & 0xFFFFFFFFUL);
401
  ((UInt4 *)ADDR_OBJ(bag))[2*limbnumber+1] = (UInt4)(value >>32);
402
#else
403
  ((UInt2 *)ADDR_OBJ(bag))[4*limbnumber] = (UInt2)(value & 0xFFFFULL);
404
  ((UInt2 *)ADDR_OBJ(bag))[4*limbnumber+1] = (UInt2)((value & 0xFFFF0000ULL) >>16);
405
  ((UInt2 *)ADDR_OBJ(bag))[4*limbnumber+2] = (UInt2)((value & 0xFFFF00000000ULL) >>32);
406
  ((UInt2 *)ADDR_OBJ(bag))[4*limbnumber+3] = (UInt2)(value >>48);
407
#endif
408
}
409

410
/* C_MAKE_MED_INT handles numbers between 2^28 and 2^60 in magnitude,
411
   and is used in code compiled on 64 bit systems. If the target system
412
   is 64 bit an immediate integer is constructed. If the target is 32 bits then
413
   an 8-byte large integer is constructed using the representation-neutral 
414
   macros above 
415

416
   C_NORMALIZE_64BIT is called when a large integer has been
417
   constructed (because the literal was large on the compiling system)
418
   and might be small on the target system. */
419

420
 
421
#ifdef SYS_IS_64_BIT 
422
static inline Obj C_MAKE_MED_INT( Int8 value ) {
423
  return INTOBJ_INT(value);
424
}
425

426
static inline Obj C_NORMALIZE_64BIT(Obj o) {
427
  Int value =  *(Int *)ADDR_OBJ(o);
428
  if (value < 0)
429
    return o;
430
  if (TNUM_OBJ(o) == T_INTNEG)
431
    value = -value;
432
  if (-(1L << 60) <= value && value < (1L << 60))
433
    return INTOBJ_INT(value);
434
  else
435
    return o;    
436
}
437

438

439
#else
440
static inline Obj C_MAKE_MED_INT( Int8 value ) {
441
  Obj x;
442
  UInt type;
443
  if (value < 0) {
444
    type = T_INTNEG;
445
    value = -value;
446
  } else
447
    type = T_INTPOS;
448

449
  x = C_MAKE_INTEGER_BAG(8,type);
450
  C_SET_LIMB8(x,0,(UInt8)value);
451
  return x;
452
}
453

454
static inline Obj C_NORMALIZE_64BIT( Obj o) {
455
  return o;
456
}
457

458
#endif
459

460
#ifdef __cplusplus
461
}
462
#undef GAP_IN_EXTERN_C
463
#endif
464
    
465
#endif // GAP_COMPILED_H
466

467
/****************************************************************************
468
**
469
*E  compiled.h  . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
470
*/
471

472