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 immediate interpreter package.
11 **
12 ** The immediate interpreter package is the part of the interpreter that
13 ** interprets code immediately (while it is read). Its functions are called
14 ** from the reader. When it encounters constructs that it cannot interpret
15 ** immediately, it switches into coding mode, and delegates the work to the
16 ** coder.
17 */
18
19 #include "intrprtr.h"
20
21 #include "ariths.h"
22 #include "bool.h"
23 #include "calls.h"
24 #include "code.h"
25 #include "error.h"
26 #include "funcs.h"
27 #include "gapstate.h"
28 #include "gvars.h"
29 #include "hookintrprtr.h"
30 #include "info.h"
31 #include "integer.h"
32 #include "io.h"
33 #include "lists.h"
34 #include "modules.h"
35 #include "opers.h"
36 #include "permutat.h"
37 #include "plist.h"
38 #include "precord.h"
39 #include "range.h"
40 #include "read.h"
41 #include "records.h"
42 #include "stringobj.h"
43 #include "vars.h"
44
45 #ifdef HPCGAP
46 #include "hpc/aobjects.h"
47 #include "hpc/guards.h"
48 #endif
49
50 /****************************************************************************
51 **
52 *V IntrReturning . . . . . . . . . . . interpreter is currently returning
53 **
54 ** If 'IntrReturning' is non-zero, the interpreter is currently returning.
55 ** The interpreter switches to this mode when it finds a return-statement.
56 ** If it interprets a return-value-statement, it sets 'IntrReturning' to 1.
57 ** If it interprets a return-void-statement, it sets 'IntrReturning' to 2.
58 ** If it interprets a quit-statement, it sets 'IntrReturning' to 8.
59 */
60 /* TL: UInt IntrReturning; */
61
62
63 /****************************************************************************
64 **
65 *V IntrIgnoring . . . . . . . . . interpreter is currently ignoring actions
66 **
67 ** If 'IntrIgnoring' is non-zero, the interpreter is currently ignoring
68 ** actions. The interpreter switches to this mode for the right operand of
69 ** 'or' and 'and' constructs where the left operand already determines the
70 ** outcome.
71 **
72 ** This mode is also used in Info and Assert, when arguments are not printed.
73 */
74 /* TL: UInt IntrIgnoring; */
75
76
77 /****************************************************************************
78 **
79 *V IntrCoding . . . . . . . . . . . interpreter is currently coding actions
80 **
81 ** If 'IntrCoding' is non-zero, the interpreter is currently coding actions.
82 ** The interpreter switches to this mode for constructs that it cannot
83 ** directly interpret, such as loops or function bodies.
84 */
85 /* TL: UInt IntrCoding; */
86
87 // INTERPRETER_PROFILE_HOOK deals with profiling of immediately executed
88 // code.
89 // If STATE(IntrCoding) is true, profiling is handled by the AST
90 // generation and execution. Otherwise, we always mark the line as
91 // read, and mark as executed if STATE(IntrReturning) and STATE(IntrIgnoring)
92 // are both false.
93 //
94 // IgnoreLevel gives the highest value of IntrIgnoring which means this
95 // statement is NOT ignored (this is usually, but not always, 0)
96 #define INTERPRETER_PROFILE_HOOK(ignoreLevel) \
97 if (!STATE(IntrCoding)) { \
98 InterpreterHook(GetInputFilenameID(), STATE(InterpreterStartLine), \
99 STATE(IntrReturning) || \
100 (STATE(IntrIgnoring) > ignoreLevel)); \
101 } \
102 STATE(InterpreterStartLine) = 0;
103
104
105 // Put the profiling hook into SKIP_IF_RETURNING, as this is run in
106 // (nearly) every part of the interpreter, avoid lots of extra code.
107 #define SKIP_IF_RETURNING() \
108 INTERPRETER_PROFILE_HOOK(0); \
109 SKIP_IF_RETURNING_NO_PROFILE_HOOK();
110
111 // Need to
112 #define SKIP_IF_RETURNING_NO_PROFILE_HOOK() \
113 if (STATE(IntrReturning) > 0) { \
114 return; \
115 }
116
117 #define SKIP_IF_IGNORING() if ( STATE(IntrIgnoring) > 0 ) { return; }
118
119
120 /****************************************************************************
121 **
122 *F StackObj . . . . . . . . . . . . . . . . . . . . . . . . . values stack
123 *F PushObj(<val>) . . . . . . . . . . . . . . . . push value onto the stack
124 *F PushVoidObj() . . . . . . . . . . . . . . push void value onto the stack
125 *F PopObj() . . . . . . . . . . . . . . . . . . . pop value from the stack
126 *F PopVoidObj() . . . . . . . . . . . . . . . . . pop value from the stack
127 **
128 ** 'StackObj' is the stack of values.
129 **
130 ** 'PushObj' pushes the value <val> onto the values stack. It is an error
131 ** to push the void value. The stack is automatically resized if necessary.
132 **
133 ** 'PushVoidObj' pushes the void value onto the values stack. This value is
134 ** the value of if-statements and loops and procedure calls.
135 **
136 ** 'PopObj' returns the top element from the values stack and pops it. It
137 ** is an error if the stack is empty or if the top element is void.
138 **
139 ** 'PopVoidObj' returns the top element from the values stack and pops it.
140 ** It is an error if the stack is empty but not if the top element is void.
141 **
142 ** Since interpreters can nest, there can be more than one values stack.
143 ** The bottom element of each values stack is the 'StackObj' which was
144 ** active when the current interpreter was started and which will be made
145 ** active again when the current interpreter will stop.
146 */
147 /* TL: Obj IntrState; */
148
149 /* TL: Obj StackObj; */
150
PushObj(Obj val)151 static void PushObj(Obj val)
152 {
153 assert( val != 0 );
154 PushPlist( STATE(StackObj), val );
155 }
156
157 /* Special marker value to denote that a function returned no value, so we
158 * can produce a useful error message. This value only ever appears on the
159 * stack, and should never be visible outside the Push and Pop methods below
160 *
161 * The only place other than these methods which access the stack is
162 * the permutation reader, but it only directly accesses values it wrote,
163 * so it will not see this magic value. */
164 static Obj VoidReturnMarker;
165
PushFunctionVoidReturn(void)166 static void PushFunctionVoidReturn(void)
167 {
168 PushPlist( STATE(StackObj), (Obj)&VoidReturnMarker );
169 }
170
PushVoidObj(void)171 void PushVoidObj(void)
172 {
173 PushPlist( STATE(StackObj), (Obj)0 );
174 }
175
PopObj(void)176 static Obj PopObj(void)
177 {
178 Obj val = PopPlist( STATE(StackObj) );
179
180 if (val == (Obj)&VoidReturnMarker) {
181 ErrorQuit(
182 "Function call: <func> must return a value",
183 0L, 0L );
184 }
185
186 // return the popped value (which must be non-void)
187 assert( val != 0 );
188 return val;
189 }
190
PopVoidObj(void)191 static Obj PopVoidObj(void)
192 {
193 Obj val = PopPlist( STATE(StackObj) );
194
195 // Treat a function which returned no value the same as 'void'
196 if (val == (Obj)&VoidReturnMarker) {
197 val = 0;
198 }
199
200 // return the popped value (which may be void)
201 return val;
202 }
203
204
205 /****************************************************************************
206 **
207 *F IntrBegin() . . . . . . . . . . . . . . . . . . . . start an interpreter
208 *F IntrEnd(<error>,<result>) . . . . . . . . . . . . . stop an interpreter
209 **
210 ** 'IntrBegin' starts a new interpreter in context <frame>. If in doubt,
211 ** pass STATE(BottomLVars) as <frame>
212 **
213 ** 'IntrEnd' stops the current interpreter.
214 **
215 ** If <error> is non-zero a syntax error was found by the reader, and the
216 ** interpreter only clears up the mess.
217 **
218 ** If 'IntrEnd' returns 'STATUS_END', then no return-statement or
219 ** quit-statement was interpreted. If 'IntrEnd' returns 'STATUS_RETURN_VAL',
220 ** then a return-value-statement was interpreted and in this case the return
221 ** value is assigned to the address <result> points at (but only if <result>
222 ** is not 0). If 'IntrEnd' returns 'STATUS_RETURN_VOID', then a
223 ** return-void-statement was interpreted. If 'IntrEnd' returns 'STATUS_QUIT',
224 ** then a quit-statement was interpreted.
225 */
IntrBegin(Obj frame)226 void IntrBegin ( Obj frame )
227 {
228 /* remember old interpreter state */
229 if (!STATE(IntrState))
230 STATE(IntrState) = NEW_PLIST(T_PLIST, 16);
231 PushPlist(STATE(IntrState), STATE(StackObj));
232
233 /* allocate a new values stack */
234 STATE(StackObj) = NEW_PLIST( T_PLIST, 64 );
235
236 /* must be in immediate (non-ignoring, non-coding) mode */
237 assert( STATE(IntrIgnoring) == 0 );
238 assert( STATE(IntrCoding) == 0 );
239
240 /* no return-statement was yet interpreted */
241 STATE(IntrReturning) = 0;
242
243 /* start an execution environment */
244 ExecBegin(frame);
245 }
246
IntrEnd(UInt error,Obj * result)247 ExecStatus IntrEnd(UInt error, Obj *result)
248 {
249 UInt intrReturning; /* interpreted return-statement? */
250
251 /* if everything went fine */
252 if ( ! error ) {
253
254 /* leave the execution environment */
255 ExecEnd( 0UL );
256
257 /* remember whether the interpreter interpreted a return-statement */
258 intrReturning = STATE(IntrReturning);
259 STATE(IntrReturning) = 0;
260
261 /* must be back in immediate (non-ignoring, non-coding) mode */
262 assert( STATE(IntrIgnoring) == 0 );
263 assert( STATE(IntrCoding) == 0 );
264
265 /* and the stack must contain the result value (which may be void) */
266 assert( LEN_PLIST(STATE(StackObj)) == 1 );
267 if (result)
268 *result = PopVoidObj();
269
270 }
271
272 /* otherwise clean up the mess */
273 else {
274
275 /* leave the execution environment */
276 ExecEnd( 1UL );
277
278 /* clean up the coder too */
279 if ( STATE(IntrCoding) > 0 ) { CodeEnd( 1UL ); }
280
281 /* remember that we had an error */
282 intrReturning = STATUS_ERROR;
283 STATE(IntrReturning) = 0;
284
285 /* must be back in immediate (non-ignoring, non-coding) mode */
286 STATE(IntrIgnoring) = 0;
287 STATE(IntrCoding) = 0;
288
289 /* dummy result value (probably ignored) */
290 if (result)
291 *result = 0;
292 }
293
294 // switch back to the old state
295 STATE(StackObj) = PopPlist(STATE(IntrState));
296
297 /* indicate whether a return-statement was interpreted */
298 return intrReturning;
299 }
300
301
IntrAbortCoding(Obj lvars)302 void IntrAbortCoding(Obj lvars)
303 {
304 if (STATE(IntrCoding)) {
305 CodeEnd(1);
306 STATE(IntrCoding)--;
307 SWITCH_TO_OLD_LVARS(lvars);
308 }
309 }
310
311
312 /****************************************************************************
313 **
314 *F IntrFuncCallBegin() . . . . . . . . . . . interpret function call, begin
315 *F IntrFuncCallEnd(<funccall>,<options>, <nr>) interpret function call, end
316 **
317 ** 'IntrFuncCallBegin' is an action to interpret a function call. It is
318 ** called by the reader when it encounters the parenthesis '(', i.e.,
319 ** *after* the function expression is read.
320 **
321 ** 'IntrFuncCallEnd' is an action to interpret a function call. It is
322 ** called by the reader when it encounters the parenthesis ')', i.e.,
323 ** *after* the argument expressions are read. <funccall> is 1 if this is a
324 ** function call, and 0 if this is a procedure call. <nr> is the number of
325 ** arguments. <options> is 1 if options were present after the ':' in which
326 ** case the options have been read already.
327 */
IntrFuncCallBegin(void)328 void IntrFuncCallBegin ( void )
329 {
330 /* ignore or code */
331 SKIP_IF_RETURNING();
332 SKIP_IF_IGNORING();
333 if ( STATE(IntrCoding) > 0 ) { CodeFuncCallBegin(); return; }
334
335 }
336
337 static Obj PushOptions;
338 static Obj PopOptions;
339
IntrFuncCallEnd(UInt funccall,UInt options,UInt nr)340 void IntrFuncCallEnd (
341 UInt funccall,
342 UInt options,
343 UInt nr )
344 {
345 Obj func; /* function */
346 Obj a1; /* first argument */
347 Obj a2; /* second argument */
348 Obj a3; /* third argument */
349 Obj a4; /* fourth argument */
350 Obj a5; /* fifth argument */
351 Obj a6; /* sixth argument */
352 Obj args; /* argument list */
353 Obj argi; /* <i>-th argument */
354 Obj val; /* return value of function */
355 Obj opts; /* record of options */
356 UInt i; /* loop variable */
357
358 /* ignore or code */
359 SKIP_IF_RETURNING_NO_PROFILE_HOOK();
360 SKIP_IF_IGNORING();
361 if ( STATE(IntrCoding) > 0 ) {
362 CodeFuncCallEnd( funccall, options, nr );
363 return; }
364
365
366 if (options) {
367 opts = PopObj();
368 CALL_1ARGS(PushOptions, opts);
369 }
370
371 /* get the arguments from the stack */
372 a1 = a2 = a3 = a4 = a5 = a6 = args = 0;
373 if ( nr <= 6 ) {
374 if ( 6 <= nr ) { a6 = PopObj(); }
375 if ( 5 <= nr ) { a5 = PopObj(); }
376 if ( 4 <= nr ) { a4 = PopObj(); }
377 if ( 3 <= nr ) { a3 = PopObj(); }
378 if ( 2 <= nr ) { a2 = PopObj(); }
379 if ( 1 <= nr ) { a1 = PopObj(); }
380 } else {
381 args = NEW_PLIST( T_PLIST, nr );
382 SET_LEN_PLIST( args, nr );
383 for ( i = nr; 1 <= i; i-- ) {
384 argi = PopObj();
385 SET_ELM_PLIST( args, i, argi );
386 }
387 }
388
389 /* get and check the function from the stack */
390 func = PopObj();
391 if ( TNUM_OBJ(func) != T_FUNCTION ) {
392 if ( nr <= 6 ) {
393 args = NEW_PLIST( T_PLIST_DENSE, nr );
394 SET_LEN_PLIST( args, nr );
395 switch(nr) {
396 case 6: SET_ELM_PLIST(args,6,a6);
397 case 5: SET_ELM_PLIST(args,5,a5);
398 case 4: SET_ELM_PLIST(args,4,a4);
399 case 3: SET_ELM_PLIST(args,3,a3);
400 case 2: SET_ELM_PLIST(args,2,a2);
401 case 1: SET_ELM_PLIST(args,1,a1);
402 }
403 }
404 val = DoOperation2Args(CallFuncListOper, func, args);
405 } else {
406 /* call the function */
407 if ( 0 == nr ) { val = CALL_0ARGS( func ); }
408 else if ( 1 == nr ) { val = CALL_1ARGS( func, a1 ); }
409 else if ( 2 == nr ) { val = CALL_2ARGS( func, a1, a2 ); }
410 else if ( 3 == nr ) { val = CALL_3ARGS( func, a1, a2, a3 ); }
411 else if ( 4 == nr ) { val = CALL_4ARGS( func, a1, a2, a3, a4 ); }
412 else if ( 5 == nr ) { val = CALL_5ARGS( func, a1, a2, a3, a4, a5 ); }
413 else if ( 6 == nr ) { val = CALL_6ARGS( func, a1, a2, a3, a4, a5, a6 ); }
414 else { val = CALL_XARGS( func, args ); }
415
416 if (STATE(UserHasQuit) || STATE(UserHasQUIT)) {
417 /* the procedure must have called READ() and the user quit
418 from a break loop inside it */
419 ReadEvalError();
420 }
421 }
422
423 if (options)
424 CALL_0ARGS(PopOptions);
425
426 /* push the value onto the stack */
427 if ( val == 0 )
428 PushFunctionVoidReturn();
429 else
430 PushObj( val );
431 }
432
433
434 /****************************************************************************
435 **
436 *F IntrFuncExprBegin(<narg>,<nloc>,<nams>) . interpret function expr, begin
437 *F IntrFuncExprEnd(<nr>) . . . . . . . . . . . interpret function expr, end
438 **
439 ** 'IntrFuncExprBegin' is an action to interpret a function expression. It
440 ** is called when the reader encounters the beginning of a function
441 ** expression. <narg> is the number of arguments (-1 if the function takes
442 ** a variable number of arguments), <nloc> is the number of locals, <nams>
443 ** is a list of local variable names.
444 **
445 ** 'IntrFuncExprEnd' is an action to interpret a function expression. It is
446 ** called when the reader encounters the end of a function expression. <nr>
447 ** is the number of statements in the body of the function.
448 */
IntrFuncExprBegin(Int narg,Int nloc,Obj nams,Int startLine)449 void IntrFuncExprBegin (
450 Int narg,
451 Int nloc,
452 Obj nams,
453 Int startLine)
454 {
455 /* ignore or code */
456 SKIP_IF_RETURNING();
457 SKIP_IF_IGNORING();
458
459 if (STATE(IntrCoding) == 0) {
460 CodeBegin();
461 }
462 STATE(IntrCoding)++;
463
464 /* code a function expression */
465 CodeFuncExprBegin( narg, nloc, nams, startLine );
466 }
467
IntrFuncExprEnd(UInt nr)468 void IntrFuncExprEnd(UInt nr)
469 {
470 /* ignore or code */
471 SKIP_IF_RETURNING();
472 SKIP_IF_IGNORING();
473
474 /* otherwise must be coding */
475 assert(STATE(IntrCoding) > 0);
476
477 STATE(IntrCoding)--;
478 CodeFuncExprEnd(nr, 1);
479
480 if (STATE(IntrCoding) == 0) {
481 // switch back to immediate mode and get the function
482 Obj func = CodeEnd(0);
483
484 // push the function
485 PushObj(func);
486 }
487 }
488
489
490 /****************************************************************************
491 **
492 *F IntrIfBegin() . . . . . . . . interpret if-statement, begin of statement
493 *F IntrIfElif() . . . . . . . interpret if-statement, begin of elif-branch
494 *F IntrIfElse() . . . . . . . interpret if-statement, begin of else-branch
495 *F IntrIfBeginBody() . . . . . . . . . interpret if-statement, begin of body
496 *F IntrIfEndBody(<nr>) . . . . . . . . . interpret if-statement, end of body
497 *F IntrIfEnd(<nr>) . . . . . . . . interpret if-statement, end of statement
498 **
499 ** 'IntrIfBegin' is an action to interpret an if-statement. It is called
500 ** when the reader encounters the 'if', i.e., *before* the condition is
501 ** read.
502 **
503 ** 'IntrIfElif' is an action to interpret an if-statement. It is called
504 ** when the reader encounters an 'elif', i.e., *before* the condition is
505 ** read.
506 **
507 ** 'IntrIfElse' is an action to interpret an if-statement. It is called
508 ** when the reader encounters an 'else'.
509 **
510 ** 'IntrIfBeginBody' is an action to interpret an if-statement. It is
511 ** called when the reader encounters the beginning of the statement body of
512 ** an 'if', 'elif', or 'else' branch, i.e., *after* the condition is read.
513 **
514 ** 'IntrIfEndBody' is an action to interpret an if-statement. It is called
515 ** when the reader encounters the end of the statements body of an 'if',
516 ** 'elif', or 'else' branch. <nr> is the number of statements in the body.
517 **
518 ** 'IntrIfEnd' is an action to interpret an if-statement. It is called when
519 ** the reader encounters the end of the statement. <nr> is the number of
520 ** 'if', 'elif', or 'else' branches.
521 */
IntrIfBegin(void)522 void IntrIfBegin ( void )
523 {
524 /* ignore or code */
525 SKIP_IF_RETURNING();
526
527 // if IntrIgnoring is positive, increment it, as IntrIgnoring == 1 has a
528 // special meaning when parsing if-statements -- it is used to skip
529 // interpreting or coding branches of the if-statement which never will
530 // be executed, either because a previous branch is always executed
531 // (i.e., it has a 'true' condition), or else because the current branch
532 // has a 'false' condition
533 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)++; return; }
534 if ( STATE(IntrCoding) > 0 ) { CodeIfBegin(); return; }
535
536 }
537
IntrIfElif(void)538 void IntrIfElif ( void )
539 {
540 /* ignore or code */
541 SKIP_IF_RETURNING();
542 SKIP_IF_IGNORING();
543 if ( STATE(IntrCoding) > 0 ) { CodeIfElif(); return; }
544
545 }
546
IntrIfElse(void)547 void IntrIfElse ( void )
548 {
549 /* ignore or code */
550 SKIP_IF_RETURNING();
551 SKIP_IF_IGNORING();
552 if ( STATE(IntrCoding) > 0 ) { CodeIfElse(); return; }
553
554
555 /* push 'true' (to execute body of else-branch) */
556 PushObj( True );
557 }
558
IntrIfBeginBody(void)559 void IntrIfBeginBody ( void )
560 {
561 Obj cond; /* value of condition */
562
563 /* ignore or code */
564 SKIP_IF_RETURNING();
565 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)++; return; }
566 if ( STATE(IntrCoding) > 0 ) {
567 STATE(IntrIgnoring) = CodeIfBeginBody();
568 return;
569 }
570
571
572 /* get and check the condition */
573 cond = PopObj();
574 if ( cond != True && cond != False ) {
575 RequireArgumentEx(0, cond, "<expr>", "must be 'true' or 'false'");
576 }
577
578 /* if the condition is 'false', ignore the body */
579 if ( cond == False ) {
580 STATE(IntrIgnoring) = 1;
581 }
582 }
583
IntrIfEndBody(UInt nr)584 Int IntrIfEndBody (
585 UInt nr )
586 {
587 UInt i; /* loop variable */
588
589 /* explicitly check interpreter hooks, as not using SKIP_IF_RETURNING */
590 INTERPRETER_PROFILE_HOOK(0);
591
592 /* ignore or code */
593 if ( STATE(IntrReturning) > 0 ) { return 0; }
594 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)--; return 0; }
595 if ( STATE(IntrCoding) > 0 ) {
596 STATE(IntrIgnoring) = CodeIfEndBody( nr );
597 return 1;
598 }
599
600 /* otherwise drop the values for the statements executed in the body */
601 for ( i = nr; 1 <= i; i-- ) {
602 PopVoidObj();
603 }
604
605 /* one branch of the if-statement was executed, ignore the others */
606 STATE(IntrIgnoring) = 1;
607
608 return 1;
609 }
610
IntrIfEnd(UInt nr)611 void IntrIfEnd (
612 UInt nr )
613 {
614 // ignore or code
615 INTERPRETER_PROFILE_HOOK(1);
616 SKIP_IF_RETURNING_NO_PROFILE_HOOK();
617
618 if ( STATE(IntrIgnoring) > 1 ) { STATE(IntrIgnoring)--; return; }
619
620 // if one branch was executed (ignoring the others), reset IntrIgnoring
621 if ( STATE(IntrIgnoring) == 1 ) {
622 STATE(IntrIgnoring) = 0;
623 }
624
625 if ( STATE(IntrCoding) > 0 ) { CodeIfEnd( nr ); return; }
626
627 PushVoidObj();
628 }
629
630
631 /****************************************************************************
632 **
633 *F IntrForBegin() . . . . . . . interpret for-statement, begin of statement
634 *F IntrForIn() . . . . . . . . . . . . . interpret for-statement, 'in'-read
635 *F IntrForBeginBody() . . . . . . . interpret for-statement, begin of body
636 *F IntrForEndBody(<nr>) . . . . . . . interpret for-statement, end of body
637 *F IntrForEnd() . . . . . . . . . interpret for-statement, end of statement
638 **
639 ** 'IntrForBegin' is an action to interpret a for-statement. It is called
640 ** when the reader encounters the 'for', i.e., *before* the variable is
641 ** read.
642 **
643 ** 'IntrForIn' is an action to interpret a for-statement. It is called when
644 ** the reader encounters the 'in', i.e., *after* the variable is read, but
645 ** *before* the list expression is read.
646 **
647 ** 'IntrForBeginBody' is an action to interpret a for-statement. It is
648 ** called when the reader encounters the beginning of the statement body,
649 ** i.e., *after* the list expression is read.
650 **
651 ** 'IntrForEndBody' is an action to interpret a for-statement. It is called
652 ** when the reader encounters the end of the statement body. <nr> is the
653 ** number of statements in the body.
654 **
655 ** 'IntrForEnd' is an action to interpret a for-statement. It is called
656 ** when the reader encounters the end of the statement, i.e., immediately
657 ** after 'IntrForEndBody'.
658 **
659 ** Since loops cannot be interpreted immediately, the interpreter calls the
660 ** coder to create a procedure (with no arguments) and calls that.
661 */
IntrForBegin(void)662 void IntrForBegin ( void )
663 {
664 /* ignore */
665 SKIP_IF_RETURNING();
666 SKIP_IF_IGNORING();
667
668 if (STATE(IntrCoding) == 0)
669 StartFakeFuncExpr(0);
670
671 STATE(IntrCoding)++;
672
673 /* code a for loop */
674 CodeForBegin();
675 }
676
IntrForIn(void)677 void IntrForIn ( void )
678 {
679 /* ignore */
680 SKIP_IF_RETURNING();
681 SKIP_IF_IGNORING();
682
683 /* otherwise must be coding */
684 assert( STATE(IntrCoding) > 0 );
685 CodeForIn();
686 }
687
IntrForBeginBody(void)688 void IntrForBeginBody ( void )
689 {
690 /* ignore */
691 SKIP_IF_RETURNING();
692 SKIP_IF_IGNORING();
693
694 /* otherwise must be coding */
695 assert( STATE(IntrCoding) > 0 );
696 CodeForBeginBody();
697 }
698
IntrForEndBody(UInt nr)699 void IntrForEndBody (
700 UInt nr )
701 {
702 /* ignore */
703 SKIP_IF_RETURNING();
704 SKIP_IF_IGNORING();
705
706 /* otherwise must be coding */
707 assert(STATE(IntrCoding) > 0);
708 CodeForEndBody(nr);
709 }
710
IntrForEnd(void)711 void IntrForEnd ( void )
712 {
713 /* ignore */
714 SKIP_IF_RETURNING();
715 SKIP_IF_IGNORING();
716
717 /* otherwise must be coding */
718 assert( STATE(IntrCoding) > 0 );
719
720 STATE(IntrCoding)--;
721 CodeForEnd();
722
723 if (STATE(IntrCoding) == 0)
724 FinishAndCallFakeFuncExpr();
725 }
726
727
728 /****************************************************************************
729 **
730 *F IntrWhileBegin() . . . . . interpret while-statement, begin of statement
731 *F IntrWhileBeginBody() . . . . . interpret while-statement, begin of body
732 *F IntrWhileEndBody(<nr>) . . . . . interpret while-statement, end of body
733 *F IntrWhileEnd() . . . . . . . interpret while-statement, end of statement
734 **
735 ** 'IntrWhileBegin' is an action to interpret a while-statement. It is
736 ** called when the reader encounters the 'while', i.e., *before* the
737 ** condition is read.
738 **
739 ** 'IntrWhileBeginBody' is an action to interpret a while-statement. It is
740 ** called when the reader encounters the beginning of the statement body,
741 ** i.e., *after* the condition is read.
742 **
743 ** 'IntrWhileEndBody' is an action to interpret a while-statement. It is
744 ** called when the reader encounters the end of the statement body. <nr> is
745 ** the number of statements in the body.
746 **
747 ** 'IntrWhileEnd' is an action to interpret a while-statement. It is called
748 ** when the reader encounters the end of the statement, i.e., immediate
749 ** after 'IntrWhileEndBody'.
750 **
751 ** Since loops cannot be interpreted immediately, the interpreter calls the
752 ** coder to create a procedure (with no arguments) and calls that.
753 */
IntrWhileBegin(void)754 void IntrWhileBegin ( void )
755 {
756 /* ignore */
757 SKIP_IF_RETURNING();
758 SKIP_IF_IGNORING();
759
760 if (STATE(IntrCoding) == 0)
761 StartFakeFuncExpr(0);
762
763 STATE(IntrCoding)++;
764
765 /* code a while loop */
766 CodeWhileBegin();
767 }
768
IntrWhileBeginBody(void)769 void IntrWhileBeginBody ( void )
770 {
771 /* ignore */
772 SKIP_IF_RETURNING();
773 SKIP_IF_IGNORING();
774
775 /* otherwise must be coding */
776 assert( STATE(IntrCoding) > 0 );
777 CodeWhileBeginBody();
778 }
779
IntrWhileEndBody(UInt nr)780 void IntrWhileEndBody (
781 UInt nr )
782 {
783 /* ignore */
784 SKIP_IF_RETURNING();
785 SKIP_IF_IGNORING();
786
787 /* otherwise must be coding */
788 assert( STATE(IntrCoding) > 0 );
789 CodeWhileEndBody( nr );
790 }
791
IntrWhileEnd(void)792 void IntrWhileEnd ( void )
793 {
794 /* ignore or code */
795 SKIP_IF_RETURNING();
796 SKIP_IF_IGNORING();
797
798 /* otherwise must be coding */
799 assert( STATE(IntrCoding) > 0 );
800
801 STATE(IntrCoding)--;
802 CodeWhileEnd();
803
804 if (STATE(IntrCoding) == 0)
805 FinishAndCallFakeFuncExpr();
806 }
807
808
809 /****************************************************************************
810 **
811 *F IntrQualifiedExprBegin( UInt qual ) . . . . interpret expression guarded
812 ** by readwrite or readonly
813 *F IntrQualifiedExprEnd( )
814 ** by readwrite or readonly
815 **
816 */
IntrQualifiedExprBegin(UInt qual)817 void IntrQualifiedExprBegin(UInt qual)
818 {
819 /* ignore or code */
820 SKIP_IF_RETURNING();
821 SKIP_IF_IGNORING();
822
823 /* otherwise must be coding */
824 GAP_ASSERT(STATE(IntrCoding) > 0);
825 CodeQualifiedExprBegin(qual);
826 }
827
IntrQualifiedExprEnd(void)828 void IntrQualifiedExprEnd( void )
829 {
830 /* ignore or code */
831 SKIP_IF_RETURNING();
832 SKIP_IF_IGNORING();
833
834 /* otherwise must be coding */
835 GAP_ASSERT(STATE(IntrCoding) > 0);
836 CodeQualifiedExprEnd();
837 }
838
839 /****************************************************************************
840 **
841 *F IntrAtomicBegin() . . . . interpret atomic-statement, begin of statement
842 *F IntrAtomicBeginBody(<nrexprs>) interpret atomic-statement, begin of body
843 *F IntrAtomicEndBody(<nrstats>) . . interpret atomic-statement, end of body
844 *F IntrAtomicEnd() . . . . . . interpret atomic-statement, end of statement
845 **
846 ** 'IntrAtomicBegin' is an action to interpret an atomic-statement. It is
847 ** called when the reader encounters the 'atomic', i.e., *before* the
848 ** expressions to be locked are read.
849 **
850 ** 'IntrAtomicBeginBody' is an action to interpret an atomic-statement. It
851 ** is called when the reader encounters the beginning of the statement body,
852 ** i.e., *after* the expressions to be locked are read. <nrexprs> is the
853 ** number of expressions to be locked
854 **
855 ** 'IntrAtomicEndBody' is an action to interpret an atomic-statement. It is
856 ** called when the reader encounters the end of the statement body.
857 ** <nrstats> is the number of statements in the body.
858 **
859 ** 'IntrAtomicEnd' is an action to interpret an atomic-statement. It is
860 ** called when the reader encounters the end of the statement, i.e.,
861 ** immediately after 'IntrAtomicEndBody'.
862 **
863 ** These functions only do something meaningful inside HPC-GAP; in plain
864 ** GAP, they are simply placeholders.
865 */
IntrAtomicBegin(void)866 void IntrAtomicBegin ( void )
867 {
868 /* ignore */
869 SKIP_IF_RETURNING();
870 SKIP_IF_IGNORING();
871
872 if (STATE(IntrCoding) == 0)
873 StartFakeFuncExpr(GetInputLineNumber());
874
875 STATE(IntrCoding)++;
876
877 CodeAtomicBegin();
878 }
879
IntrAtomicBeginBody(UInt nrexprs)880 void IntrAtomicBeginBody ( UInt nrexprs )
881 {
882 /* ignore */
883 SKIP_IF_RETURNING();
884 SKIP_IF_IGNORING();
885
886 /* otherwise must be coding */
887 assert(STATE(IntrCoding) > 0);
888 CodeAtomicBeginBody(nrexprs);
889 }
890
IntrAtomicEndBody(Int nrstats)891 void IntrAtomicEndBody (
892 Int nrstats )
893 {
894 /* ignore */
895 SKIP_IF_RETURNING();
896 SKIP_IF_IGNORING();
897
898 // must be coding
899 assert(STATE(IntrCoding) > 0);
900 CodeAtomicEndBody(nrstats);
901 }
902
IntrAtomicEnd(void)903 void IntrAtomicEnd ( void )
904 {
905 /* ignore or code */
906 SKIP_IF_RETURNING();
907 SKIP_IF_IGNORING();
908
909 /* otherwise must be coding */
910 assert(STATE(IntrCoding) > 0);
911
912 STATE(IntrCoding)--;
913 CodeAtomicEnd();
914
915 if (STATE(IntrCoding) == 0)
916 FinishAndCallFakeFuncExpr();
917 }
918
919
920 /****************************************************************************
921 **
922 *F IntrRepeatBegin() . . . . interpret repeat-statement, begin of statement
923 *F IntrRepeatBeginBody() . . . . . interpret repeat-statement, begin of body
924 *F IntrRepeatEndBody(<nr>) . . . . . interpret repeat-statement, end of body
925 *F IntrRepeatEnd() . . . . . . interpret repeat-statement, end of statement
926 **
927 ** 'IntrRepeatBegin" is an action to interpret a repeat-statement. It is
928 ** called when the read encounters the 'repeat'.
929 **
930 ** 'IntrRepeatBeginBody' is an action to interpret a repeat-statement. It
931 ** is called when the reader encounters the beginning of the statement body,
932 ** i.e., immediately after 'IntrRepeatBegin'.
933 **
934 ** 'IntrRepeatEndBody' is an action to interpret a repeat-statement. It is
935 ** called when the reader encounters the end of the statement body, i.e.,
936 ** *before* the condition is read. <nr> is the number of statements in the
937 ** body.
938 **
939 ** 'IntrRepeatEnd' is an action to interpret a repeat-statement. It is
940 ** called when the reader encounters the end of the statement, i.e., *after*
941 ** the condition is read.
942 **
943 ** Since loops cannot be interpreted immediately, the interpreter calls the
944 ** coder to create a procedure (with no arguments) and calls that.
945 */
IntrRepeatBegin(void)946 void IntrRepeatBegin ( void )
947 {
948 /* ignore */
949 SKIP_IF_RETURNING();
950 SKIP_IF_IGNORING();
951
952 if (STATE(IntrCoding) == 0)
953 StartFakeFuncExpr(GetInputLineNumber());
954
955 STATE(IntrCoding)++;
956
957 /* code a repeat loop */
958 CodeRepeatBegin();
959 }
960
IntrRepeatBeginBody(void)961 void IntrRepeatBeginBody ( void )
962 {
963 /* ignore */
964 SKIP_IF_RETURNING();
965 SKIP_IF_IGNORING();
966
967 /* otherwise must be coding */
968 assert( STATE(IntrCoding) > 0 );
969 CodeRepeatBeginBody();
970 }
971
IntrRepeatEndBody(UInt nr)972 void IntrRepeatEndBody (
973 UInt nr )
974 {
975 /* ignore */
976 SKIP_IF_RETURNING();
977 SKIP_IF_IGNORING();
978
979 /* otherwise must be coding */
980 assert( STATE(IntrCoding) > 0 );
981 CodeRepeatEndBody( nr );
982 }
983
IntrRepeatEnd(void)984 void IntrRepeatEnd ( void )
985 {
986 /* ignore */
987 SKIP_IF_RETURNING();
988 SKIP_IF_IGNORING();
989
990 /* otherwise must be coding */
991 assert( STATE(IntrCoding) > 0 );
992
993 STATE(IntrCoding)--;
994 CodeRepeatEnd();
995
996 if (STATE(IntrCoding) == 0)
997 FinishAndCallFakeFuncExpr();
998 }
999
1000
1001 /****************************************************************************
1002 **
1003 *F IntrBreak() . . . . . . . . . . . . . . . . . . interpret break-statement
1004 **
1005 ** 'IntrBreak' is the action to interpret a break-statement. It is called
1006 ** when the reader encounters a 'break;'.
1007 **
1008 ** Break-statements are always coded (if they are not ignored), since they
1009 ** can only appear in loops.
1010 */
IntrBreak(void)1011 void IntrBreak ( void )
1012 {
1013 /* ignore */
1014 SKIP_IF_RETURNING();
1015 SKIP_IF_IGNORING();
1016
1017 /* otherwise must be coding */
1018 GAP_ASSERT(STATE(IntrCoding) > 0);
1019 CodeBreak();
1020 }
1021
1022
1023 /****************************************************************************
1024 **
1025 *F IntrContinue() . . . . . . . . . . . . . . . interpret continue-statement
1026 **
1027 ** 'IntrContinue' is the action to interpret a continue-statement. It is
1028 ** called when the reader encounters a 'continue;'.
1029 **
1030 ** Continue-statements are always coded (if they are not ignored), since
1031 ** they can only appear in loops.
1032 */
IntrContinue(void)1033 void IntrContinue ( void )
1034 {
1035 /* ignore */
1036 SKIP_IF_RETURNING();
1037 SKIP_IF_IGNORING();
1038
1039 /* otherwise must be coding */
1040 GAP_ASSERT(STATE(IntrCoding) > 0);
1041 CodeContinue();
1042 }
1043
1044
1045 /****************************************************************************
1046 **
1047 *F IntrReturnObj() . . . . . . . . . . . . interpret return-value-statement
1048 **
1049 ** 'IntrReturnObj' is the action to interpret a return-value-statement. It
1050 ** is called when the reader encounters a 'return <expr>;', but *after*
1051 ** reading the expression <expr>.
1052 */
IntrReturnObj(void)1053 void IntrReturnObj ( void )
1054 {
1055 Obj val; /* return value */
1056
1057 /* ignore or code */
1058 SKIP_IF_RETURNING();
1059 SKIP_IF_IGNORING();
1060 if ( STATE(IntrCoding) > 0 ) { CodeReturnObj(); return; }
1061
1062
1063 /* empty the values stack and push the return value */
1064 val = PopObj();
1065 SET_LEN_PLIST( STATE(StackObj), 0 );
1066 PushObj( val );
1067
1068 /* indicate that a return-value-statement was interpreted */
1069 STATE(IntrReturning) = STATUS_RETURN_VAL;
1070 }
1071
1072
1073 /****************************************************************************
1074 **
1075 *F IntrReturnVoid() . . . . . . . . . . . . interpret return-void-statement
1076 **
1077 ** 'IntrReturnVoid' is the action to interpret a return-void-statement. It
1078 ** is called when the reader encounters a 'return;'.
1079 */
IntrReturnVoid(void)1080 void IntrReturnVoid ( void )
1081 {
1082 /* ignore or code */
1083 SKIP_IF_RETURNING();
1084 SKIP_IF_IGNORING();
1085 if ( STATE(IntrCoding) > 0 ) { CodeReturnVoid(); return; }
1086
1087
1088 /* empty the values stack and push the void value */
1089 SET_LEN_PLIST( STATE(StackObj), 0 );
1090 PushVoidObj();
1091
1092 /* indicate that a return-void-statement was interpreted */
1093 STATE(IntrReturning) = STATUS_RETURN_VOID;
1094 }
1095
1096
1097 /****************************************************************************
1098 **
1099 *F IntrQuit() . . . . . . . . . . . . . . . . . . interpret quit-statement
1100 **
1101 ** 'IntrQuit' is the action to interpret a quit-statement. It is called
1102 ** when the reader encounters a 'quit;'.
1103 */
IntrQuit(void)1104 void IntrQuit ( void )
1105 {
1106 /* ignore or code */
1107 SKIP_IF_RETURNING();
1108 SKIP_IF_IGNORING();
1109
1110 /* 'quit' is not allowed in functions (by the reader) */
1111 assert( STATE(IntrCoding) == 0 );
1112
1113 /* empty the values stack and push the void value */
1114 SET_LEN_PLIST( STATE(StackObj), 0 );
1115 PushVoidObj();
1116
1117 /* indicate that a quit-statement was interpreted */
1118 STATE(IntrReturning) = STATUS_QUIT;
1119 }
1120
1121 /****************************************************************************
1122 **
1123 *F IntrQUIT() . . . . . . . . . . . . . . . . . . interpret quit-statement
1124 **
1125 ** 'IntrQUIT' is the action to interpret a quit-statement. It is called
1126 ** when the reader encounters a 'QUIT;'.
1127 */
IntrQUIT(void)1128 void IntrQUIT ( void )
1129 {
1130 /* ignore or code */
1131 SKIP_IF_RETURNING();
1132 SKIP_IF_IGNORING();
1133
1134 /* 'QUIT' is not allowed in functions (by the reader) */
1135 assert( STATE(IntrCoding) == 0 );
1136
1137 /* empty the values stack and push the void value */
1138 SET_LEN_PLIST( STATE(StackObj), 0 );
1139 PushVoidObj();
1140
1141 /* indicate that a QUIT-statement was interpreted */
1142 STATE(IntrReturning) = STATUS_QQUIT;
1143 }
1144
1145 /****************************************************************************
1146 **
1147 *F IntrHelp()
1148 **
1149 ** 'IntrHelp' is the action to interpret a help statement.
1150 **
1151 */
IntrHelp(Obj topic)1152 void IntrHelp(Obj topic)
1153 {
1154 UInt hgvar;
1155 Obj help;
1156 Obj res;
1157
1158 SKIP_IF_RETURNING();
1159 SKIP_IF_IGNORING();
1160
1161 // '?' is not allowed in functions (by the reader)
1162 assert( STATE(IntrCoding) == 0 );
1163
1164 /* FIXME: Hard coded function name */
1165 hgvar = GVarName("HELP");
1166 help = ValGVar(hgvar);
1167 if (!help) {
1168 ErrorQuit(
1169 "Global variable \"HELP\" is not defined. Cannot access help", 0,
1170 0);
1171 }
1172 if (!IS_FUNC(help)) {
1173 ErrorQuit(
1174 "Global variable \"HELP\" is not a function. Cannot access help",
1175 0, 0);
1176 }
1177
1178 res = CALL_1ARGS(help, topic);
1179 if (res)
1180 PushObj(res);
1181 else
1182 PushVoidObj();
1183 }
1184
1185
1186 /****************************************************************************
1187 **
1188 *F IntrOrL() . . . . . . . . . . interpret or-expression, left operand read
1189 *F IntrOr() . . . . . . . . . . interpret or-expression, right operand read
1190 **
1191 ** 'IntrOrL' is an action to interpret an or-expression. It is called when
1192 ** the reader encounters the 'or' keyword, i.e., *after* the left operand is
1193 ** read but *before* the right operand is read.
1194 **
1195 ** 'IntrOr' is an action to interpret an or-expression. It is called when
1196 ** the reader encountered the end of the expression, i.e., *after* both
1197 ** operands are read.
1198 */
IntrOrL(void)1199 void IntrOrL ( void )
1200 {
1201 Obj opL; /* value of left operand */
1202
1203 /* ignore or code */
1204 SKIP_IF_RETURNING();
1205 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)++; return; }
1206 if ( STATE(IntrCoding) > 0 ) { CodeOrL(); return; }
1207
1208
1209 /* if the left operand is 'true', ignore the right operand */
1210 opL = PopObj();
1211 PushObj( opL );
1212 if ( opL == True ) {
1213 PushObj( opL );
1214 STATE(IntrIgnoring) = 1;
1215 }
1216 }
1217
IntrOr(void)1218 void IntrOr ( void )
1219 {
1220 Obj opL; /* value of left operand */
1221 Obj opR; /* value of right operand */
1222
1223 /* ignore or code */
1224 SKIP_IF_RETURNING();
1225 if ( STATE(IntrIgnoring) > 1 ) { STATE(IntrIgnoring)--; return; }
1226 if ( STATE(IntrCoding) > 0 ) { CodeOr(); return; }
1227
1228
1229 /* stop ignoring things now */
1230 STATE(IntrIgnoring) = 0;
1231
1232 /* get the operands */
1233 opR = PopObj();
1234 opL = PopObj();
1235
1236 /* if the left operand is 'true', this is the result */
1237 if ( opL == True ) {
1238 PushObj( opL );
1239 }
1240
1241 /* if the left operand is 'false', the result is the right operand */
1242 else if ( opL == False ) {
1243 if ( opR == True || opR == False ) {
1244 PushObj( opR );
1245 }
1246 else {
1247 RequireArgumentEx(0, opR, "<expr>", "must be 'true' or 'false'");
1248 }
1249 }
1250
1251 /* signal an error */
1252 else {
1253 RequireArgumentEx(0, opL, "<expr>", "must be 'true' or 'false'");
1254 }
1255 }
1256
1257
1258 /****************************************************************************
1259 **
1260 *F IntrAndL() . . . . . . . . . interpret and-expression, left operand read
1261 *F IntrAnd() . . . . . . . . . interpret and-expression, right operand read
1262 **
1263 ** 'IntrAndL' is an action to interpret an and-expression. It is called
1264 ** when the reader encounters the 'and' keyword, i.e., *after* the left
1265 ** operand is read but *before* the right operand is read.
1266 **
1267 ** 'IntrAnd' is an action to interpret an and-expression. It is called when
1268 ** the reader encountered the end of the expression, i.e., *after* both
1269 ** operands are read.
1270 */
IntrAndL(void)1271 void IntrAndL ( void )
1272 {
1273 Obj opL; /* value of left operand */
1274
1275 /* ignore or code */
1276 SKIP_IF_RETURNING();
1277 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)++; return; }
1278 if ( STATE(IntrCoding) > 0 ) { CodeAndL(); return; }
1279
1280
1281 /* if the left operand is 'false', ignore the right operand */
1282 opL = PopObj();
1283 PushObj( opL );
1284 if ( opL == False ) {
1285 PushObj( opL );
1286 STATE(IntrIgnoring) = 1;
1287 }
1288 }
1289
IntrAnd(void)1290 void IntrAnd ( void )
1291 {
1292 Obj opL; /* value of left operand */
1293 Obj opR; /* value of right operand */
1294
1295 /* ignore or code */
1296 SKIP_IF_RETURNING();
1297 if ( STATE(IntrIgnoring) > 1 ) { STATE(IntrIgnoring)--; return; }
1298 if ( STATE(IntrCoding) > 0 ) { CodeAnd(); return; }
1299
1300
1301 /* stop ignoring things now */
1302 STATE(IntrIgnoring) = 0;
1303
1304 /* get the operands */
1305 opR = PopObj();
1306 opL = PopObj();
1307
1308 /* if the left operand is 'false', this is the result */
1309 if ( opL == False ) {
1310 PushObj( opL );
1311 }
1312
1313 /* if the left operand is 'true', the result is the right operand */
1314 else if ( opL == True ) {
1315 if ( opR == False || opR == True ) {
1316 PushObj( opR );
1317 }
1318 else {
1319 RequireArgumentEx(0, opR, "<expr>", "must be 'true' or 'false'");
1320 }
1321 }
1322
1323 /* handle the 'and' of two filters */
1324 else if (IS_FILTER(opL)) {
1325 PushObj(NewAndFilter(opL, opR));
1326 }
1327
1328 /* signal an error */
1329 else {
1330 RequireArgumentEx(0, opL, "<expr>",
1331 "must be 'true' or 'false' or a filter");
1332 }
1333 }
1334
1335
1336 /****************************************************************************
1337 **
1338 *F IntrNot() . . . . . . . . . . . . . . . . . . . interpret not-expression
1339 **
1340 ** 'IntrNot' is the action to interpret a not-expression. It is called when
1341 ** the reader encounters a not-expression, *after* the operand is read.
1342 */
IntrNot(void)1343 void IntrNot ( void )
1344 {
1345 Obj val; /* value, result */
1346 Obj op; /* operand */
1347
1348 /* ignore or code */
1349 SKIP_IF_RETURNING();
1350 SKIP_IF_IGNORING();
1351 if ( STATE(IntrCoding) > 0 ) { CodeNot(); return; }
1352
1353
1354 /* get and check the operand */
1355 op = PopObj();
1356 if ( op != True && op != False ) {
1357 RequireArgumentEx(0, op, "<expr>", "must be 'true' or 'false'");
1358 }
1359
1360 /* negate the operand */
1361 val = (op == False ? True : False);
1362
1363 /* push the result */
1364 PushObj( val );
1365 }
1366
1367
1368 /****************************************************************************
1369 **
1370 *F IntrEq() . . . . . . . . . . . . . . . . . . . . interpret =-expression
1371 *F IntrNe() . . . . . . . . . . . . . . . . . . . . interpret <>-expression
1372 *F IntrLt() . . . . . . . . . . . . . . . . . . . . interpret <-expression
1373 *F IntrGe() . . . . . . . . . . . . . . . . . . . . interpret >=-expression
1374 *F IntrGt() . . . . . . . . . . . . . . . . . . . . interpret >-expression
1375 *F IntrLe() . . . . . . . . . . . . . . . . . . . . interpret <=-expression
1376 **
1377 ** 'IntrEq', 'IntrNe', 'IntrLt', 'IntrGe', 'IntrGt', and 'IntrLe' are the
1378 ** actions to interpret the respective operator expression. They are called
1379 ** by the reader *after* *both* operands are read.
1380 */
StackSwap(void)1381 static void StackSwap(void)
1382 {
1383 Obj opL; /* left operand */
1384 Obj opR; /* right operand */
1385
1386 /* get the operands */
1387 opR = PopObj();
1388 opL = PopObj();
1389
1390 /* push the operands in reverse order */
1391 PushObj( opR );
1392 PushObj( opL );
1393 }
1394
IntrEq(void)1395 void IntrEq ( void )
1396 {
1397 Obj val; /* value, result */
1398 Obj opL; /* left operand */
1399 Obj opR; /* right operand */
1400
1401 /* ignore or code */
1402 SKIP_IF_RETURNING();
1403 SKIP_IF_IGNORING();
1404 if ( STATE(IntrCoding) > 0 ) { CodeEq(); return; }
1405
1406
1407 /* get the operands */
1408 opR = PopObj();
1409 opL = PopObj();
1410
1411 /* compare them */
1412 val = (EQ( opL, opR ) ? True : False);
1413
1414 /* push the result */
1415 PushObj( val );
1416 }
1417
IntrNe(void)1418 void IntrNe ( void )
1419 {
1420 /* ignore or code */
1421 SKIP_IF_RETURNING();
1422 SKIP_IF_IGNORING();
1423 if ( STATE(IntrCoding) > 0 ) { CodeNe(); return; }
1424
1425
1426 /* '<left> <> <right>' is 'not <left> = <right>' */
1427 IntrEq();
1428 IntrNot();
1429 }
1430
IntrLt(void)1431 void IntrLt ( void )
1432 {
1433 Obj val; /* value, result */
1434 Obj opL; /* left operand */
1435 Obj opR; /* right operand */
1436
1437 /* ignore or code */
1438 SKIP_IF_RETURNING();
1439 SKIP_IF_IGNORING();
1440 if ( STATE(IntrCoding) > 0 ) { CodeLt(); return; }
1441
1442
1443 /* get the operands */
1444 opR = PopObj();
1445 opL = PopObj();
1446
1447 /* compare them */
1448 val = (LT( opL, opR ) ? True : False);
1449
1450 /* push the result */
1451 PushObj( val );
1452 }
1453
IntrGe(void)1454 void IntrGe ( void )
1455 {
1456 /* ignore or code */
1457 SKIP_IF_RETURNING();
1458 SKIP_IF_IGNORING();
1459 if ( STATE(IntrCoding) > 0 ) { CodeGe(); return; }
1460
1461
1462 /* '<left> >= <right>' is 'not <left> < <right>' */
1463 IntrLt();
1464 IntrNot();
1465 }
1466
IntrGt(void)1467 void IntrGt ( void )
1468 {
1469 /* ignore or code */
1470 SKIP_IF_RETURNING();
1471 SKIP_IF_IGNORING();
1472 if ( STATE(IntrCoding) > 0 ) { CodeGt(); return; }
1473
1474
1475 /* '<left> > <right>' is '<right> < <left>' */
1476 StackSwap();
1477 IntrLt();
1478 }
1479
IntrLe(void)1480 void IntrLe ( void )
1481 {
1482 /* ignore or code */
1483 SKIP_IF_RETURNING();
1484 SKIP_IF_IGNORING();
1485 if ( STATE(IntrCoding) > 0 ) { CodeLe(); return; }
1486
1487
1488 /* '<left> <= <right>' is 'not <right> < <left>' */
1489 StackSwap();
1490 IntrLt();
1491 IntrNot();
1492 }
1493
1494
1495 /****************************************************************************
1496 **
1497 *F IntrIn() . . . . . . . . . . . . . . . . . . . . interpret in-expression
1498 **
1499 ** 'IntrIn' is the action to interpret an in-expression. It is called by
1500 ** the reader *after* *both* operands are read.
1501 */
IntrIn(void)1502 void IntrIn ( void )
1503 {
1504 Obj val; /* value, result */
1505 Obj opL; /* left operand */
1506 Obj opR; /* right operand */
1507
1508 /* ignore or code */
1509 SKIP_IF_RETURNING();
1510 SKIP_IF_IGNORING();
1511 if ( STATE(IntrCoding) > 0 ) { CodeIn(); return; }
1512
1513
1514 /* get the operands */
1515 opR = PopObj();
1516 opL = PopObj();
1517
1518 /* perform the test */
1519 val = (IN( opL, opR ) ? True : False);
1520
1521 /* push the result */
1522 PushObj( val );
1523 }
1524
1525
1526 /****************************************************************************
1527 **
1528 *F IntrSum() . . . . . . . . . . . . . . . . . . . . interpret +-expression
1529 *F IntrAInv() . . . . . . . . . . . . . . . . interpret unary --expression
1530 *F IntrDiff() . . . . . . . . . . . . . . . . . . . interpret --expression
1531 *F IntrProd() . . . . . . . . . . . . . . . . . . . interpret *-expression
1532 *F IntrQuo() . . . . . . . . . . . . . . . . . . . . interpret /-expression
1533 *F IntrMod() . . . . . . . . . . . . . . . . . . interpret mod-expression
1534 *F IntrPow() . . . . . . . . . . . . . . . . . . . . interpret ^-expression
1535 **
1536 ** 'IntrSum', 'IntrDiff', 'IntrProd', 'IntrQuo', 'IntrMod', and 'IntrPow'
1537 ** are the actions to interpret the respective operator expression. They
1538 ** are called by the reader *after* *both* operands are read.
1539 */
IntrSum(void)1540 void IntrSum ( void )
1541 {
1542 Obj val; /* value, result */
1543 Obj opL; /* left operand */
1544 Obj opR; /* right operand */
1545
1546 /* ignore or code */
1547 SKIP_IF_RETURNING();
1548 SKIP_IF_IGNORING();
1549 if ( STATE(IntrCoding) > 0 ) { CodeSum(); return; }
1550
1551
1552 /* get the operands */
1553 opR = PopObj();
1554 opL = PopObj();
1555
1556 /* compute the sum */
1557 val = SUM( opL, opR );
1558
1559 /* push the result */
1560 PushObj( val );
1561 }
1562
IntrAInv(void)1563 void IntrAInv ( void )
1564 {
1565 Obj val; /* value, result */
1566 Obj opL; /* left operand */
1567
1568 /* ignore or code */
1569 SKIP_IF_RETURNING();
1570 SKIP_IF_IGNORING();
1571 if ( STATE(IntrCoding) > 0 ) { CodeAInv(); return; }
1572
1573
1574 /* get the operand */
1575 opL = PopObj();
1576
1577 /* compute the additive inverse */
1578 val = AINV( opL );
1579
1580 /* push the result */
1581 PushObj( val );
1582 }
1583
IntrDiff(void)1584 void IntrDiff ( void )
1585 {
1586 Obj val; /* value, result */
1587 Obj opL; /* left operand */
1588 Obj opR; /* right operand */
1589
1590 /* ignore or code */
1591 SKIP_IF_RETURNING();
1592 SKIP_IF_IGNORING();
1593 if ( STATE(IntrCoding) > 0 ) { CodeDiff(); return; }
1594
1595
1596 /* get the operands */
1597 opR = PopObj();
1598 opL = PopObj();
1599
1600 /* compute the difference */
1601 val = DIFF( opL, opR );
1602
1603 /* push the result */
1604 PushObj( val );
1605 }
1606
IntrProd(void)1607 void IntrProd ( void )
1608 {
1609 Obj val; /* value, result */
1610 Obj opL; /* left operand */
1611 Obj opR; /* right operand */
1612
1613 /* ignore or code */
1614 SKIP_IF_RETURNING();
1615 SKIP_IF_IGNORING();
1616 if ( STATE(IntrCoding) > 0 ) { CodeProd(); return; }
1617
1618
1619 /* get the operands */
1620 opR = PopObj();
1621 opL = PopObj();
1622
1623 /* compute the product */
1624 val = PROD( opL, opR );
1625
1626 /* push the result */
1627 PushObj( val );
1628 }
1629
IntrQuo(void)1630 void IntrQuo ( void )
1631 {
1632 Obj val; /* value, result */
1633 Obj opL; /* left operand */
1634 Obj opR; /* right operand */
1635
1636 /* ignore or code */
1637 SKIP_IF_RETURNING();
1638 SKIP_IF_IGNORING();
1639 if ( STATE(IntrCoding) > 0 ) { CodeQuo(); return; }
1640
1641
1642 /* get the operands */
1643 opR = PopObj();
1644 opL = PopObj();
1645
1646 /* compute the quotient */
1647 val = QUO( opL, opR );
1648
1649 /* push the result */
1650 PushObj( val );
1651 }
1652
IntrMod(void)1653 void IntrMod ( void )
1654 {
1655 Obj val; /* value, result */
1656 Obj opL; /* left operand */
1657 Obj opR; /* right operand */
1658
1659 /* ignore or code */
1660 SKIP_IF_RETURNING();
1661 SKIP_IF_IGNORING();
1662 if ( STATE(IntrCoding) > 0 ) { CodeMod(); return; }
1663
1664
1665 /* get the operands */
1666 opR = PopObj();
1667 opL = PopObj();
1668
1669 /* compute the remainder */
1670 val = MOD( opL, opR );
1671
1672 /* push the result */
1673 PushObj( val );
1674 }
1675
IntrPow(void)1676 void IntrPow ( void )
1677 {
1678 Obj val; /* value, result */
1679 Obj opL; /* left operand */
1680 Obj opR; /* right operand */
1681
1682 /* ignore or code */
1683 SKIP_IF_RETURNING();
1684 SKIP_IF_IGNORING();
1685 if ( STATE(IntrCoding) > 0 ) { CodePow(); return; }
1686
1687
1688 /* get the operands */
1689 opR = PopObj();
1690 opL = PopObj();
1691
1692 /* compute the power */
1693 val = POW( opL, opR );
1694
1695 /* push the result */
1696 PushObj( val );
1697 }
1698
1699
1700 /****************************************************************************
1701 **
1702 *F IntrIntExpr(<str>) . . . . . . . . interpret literal integer expression
1703 **
1704 ** 'IntrIntExpr' is the action to interpret a literal integer expression.
1705 ** <str> is the integer as a (null terminated) C character string.
1706 */
IntrIntExpr(Obj string,Char * str)1707 void IntrIntExpr(Obj string, Char * str)
1708 {
1709 /* ignore or code */
1710 SKIP_IF_RETURNING();
1711 SKIP_IF_IGNORING();
1712
1713 Obj val = IntStringInternal(string, str);
1714 GAP_ASSERT(val != Fail);
1715
1716 if (STATE(IntrCoding) > 0) {
1717 CodeIntExpr(val);
1718 }
1719 else {
1720 // push the integer value
1721 PushObj(val);
1722 }
1723 }
1724
1725
1726 /****************************************************************************
1727 **
1728 *F IntrFloatExpr(<str>) . . . . . . . . interpret literal float expression
1729 **
1730 ** 'IntrFloatExpr' is the action to interpret a literal float expression.
1731 ** <str> is the float as a (null terminated) C character string.
1732 */
1733
1734 static Obj CONVERT_FLOAT_LITERAL_EAGER;
1735
ConvertFloatLiteralEager(Obj str)1736 static Obj ConvertFloatLiteralEager(Obj str)
1737 {
1738 Char * chars = (Char *)CHARS_STRING(str);
1739 UInt len = GET_LEN_STRING(str);
1740 Char mark = '\0';
1741 if (chars[len - 1] == '_') {
1742 SET_LEN_STRING(str, len - 1);
1743 chars[len - 1] = '\0';
1744 }
1745 else if (chars[len - 2] == '_') {
1746 mark = chars[len - 1];
1747 SET_LEN_STRING(str, len - 2);
1748 chars[len - 2] = '\0';
1749 }
1750 Obj res = CALL_2ARGS(CONVERT_FLOAT_LITERAL_EAGER, str, ObjsChar[(UInt)mark]);
1751 if (res == Fail)
1752 ErrorQuit("failed to convert float literal", 0, 0);
1753 return res;
1754 }
1755
IntrFloatExpr(Obj string,Char * str)1756 void IntrFloatExpr(Obj string, Char * str)
1757 {
1758 /* ignore or code */
1759 SKIP_IF_RETURNING();
1760 SKIP_IF_IGNORING();
1761 if (string == 0)
1762 string = MakeString(str);
1763 if ( STATE(IntrCoding) > 0 ) {
1764 CodeFloatExpr(string);
1765 return;
1766 }
1767
1768 PushObj(ConvertFloatLiteralEager(string));
1769 }
1770
1771
1772 /****************************************************************************
1773 **
1774 *F IntrIntObjExpr() . . . . . . . 'interpret' a GAP small integer
1775 **
1776 ** 'IntrIntObjExpr' is the action to 'interpret' a existing GAP small
1777 ** integer. This is used for implementing constants.
1778 */
IntrIntObjExpr(Obj val)1779 void IntrIntObjExpr(Obj val)
1780 {
1781 /* ignore or code */
1782 SKIP_IF_RETURNING();
1783 SKIP_IF_IGNORING();
1784 if (STATE(IntrCoding) > 0) {
1785 CodeIntExpr(val);
1786 return;
1787 }
1788
1789
1790 /* push the value */
1791 PushObj(val);
1792 }
1793
1794 /****************************************************************************
1795 **
1796 *F IntrTrueExpr() . . . . . . . . . . . . interpret literal true expression
1797 **
1798 ** 'IntrTrueExpr' is the action to interpret a literal true expression.
1799 */
IntrTrueExpr(void)1800 void IntrTrueExpr ( void )
1801 {
1802 /* ignore or code */
1803 SKIP_IF_RETURNING();
1804 SKIP_IF_IGNORING();
1805 if ( STATE(IntrCoding) > 0 ) { CodeTrueExpr(); return; }
1806
1807
1808 /* push the value */
1809 PushObj( True );
1810 }
1811
1812
1813 /****************************************************************************
1814 **
1815 *F IntrFalseExpr() . . . . . . . . . . . interpret literal false expression
1816 **
1817 ** 'IntrFalseExpr' is the action to interpret a literal false expression.
1818 */
IntrFalseExpr(void)1819 void IntrFalseExpr ( void )
1820 {
1821 /* ignore or code */
1822 SKIP_IF_RETURNING();
1823 SKIP_IF_IGNORING();
1824 if ( STATE(IntrCoding) > 0 ) { CodeFalseExpr(); return; }
1825
1826
1827 /* push the value */
1828 PushObj( False );
1829 }
1830
1831
1832 /****************************************************************************
1833 **
1834 *F IntrTildeExpr() . . . . . . . . . . . . interpret tilde expression
1835 **
1836 ** 'IntrTildeExpr' is the action to interpret a tilde expression.
1837 **
1838 ** 'Tilde' is the identifier for the operator '~', used in
1839 ** expressions such as '[ [ 1, 2 ], ~[ 1 ] ]'.
1840 **
1841 */
IntrTildeExpr(void)1842 void IntrTildeExpr ( void )
1843 {
1844 /* ignore or code */
1845 SKIP_IF_RETURNING();
1846 SKIP_IF_IGNORING();
1847 if ( STATE(IntrCoding) > 0 ) { CodeTildeExpr(); return; }
1848
1849 if(! (STATE(Tilde)) ) {
1850 ErrorQuit("'~' does not have a value here", 0L, 0L);
1851 }
1852
1853 /* push the value */
1854 PushObj( STATE(Tilde) );
1855 }
1856
1857
1858 /****************************************************************************
1859 **
1860 *F IntrCharExpr(<chr>) . . . . . . . interpret literal character expression
1861 **
1862 ** 'IntrCharExpr' is the action to interpret a literal character expression.
1863 ** <chr> is the C character.
1864 */
IntrCharExpr(Char chr)1865 void IntrCharExpr (
1866 Char chr )
1867 {
1868 /* ignore or code */
1869 SKIP_IF_RETURNING();
1870 SKIP_IF_IGNORING();
1871 if ( STATE(IntrCoding) > 0 ) { CodeCharExpr( chr ); return; }
1872
1873
1874 /* push the value */
1875 PushObj( ObjsChar[ (UChar)chr ] );
1876 }
1877
1878
1879 /****************************************************************************
1880 **
1881 *F IntrPermCycle(<nr>) . . . . . . interpret literal permutation expression
1882 *F IntrPerm(<nr>) . . . . . . . . interpret literal permutation expression
1883 */
GetFromStack(Obj cycle,Int j)1884 static Obj GetFromStack(Obj cycle, Int j)
1885 {
1886 return PopObj();
1887 }
1888
IntrPermCycle(UInt nrx,UInt nrc)1889 void IntrPermCycle (
1890 UInt nrx,
1891 UInt nrc )
1892 {
1893 Obj perm; /* permutation */
1894 UInt m; /* maximal entry in permutation */
1895
1896 /* ignore or code */
1897 SKIP_IF_RETURNING();
1898 SKIP_IF_IGNORING();
1899 if ( STATE(IntrCoding) > 0 ) { CodePermCycle(nrx,nrc); return; }
1900
1901
1902 /* get the permutation (allocate for the first cycle) */
1903 if ( nrc == 1 ) {
1904 m = 0;
1905 perm = NEW_PERM4( 0 );
1906 }
1907 else {
1908 const UInt countObj = LEN_PLIST(STATE(StackObj));
1909 m = INT_INTOBJ( ELM_LIST( STATE(StackObj), countObj - nrx ) );
1910 perm = ELM_LIST( STATE(StackObj), countObj - nrx - 1 );
1911 }
1912
1913 m = ScanPermCycle(perm, m, 0, nrx, GetFromStack);
1914
1915 /* push the permutation (if necessary, drop permutation first) */
1916 if ( nrc != 1 ) { PopObj(); PopObj(); }
1917 PushObj( perm );
1918 PushObj( INTOBJ_INT(m) );
1919 }
1920
IntrPerm(UInt nrc)1921 void IntrPerm (
1922 UInt nrc )
1923 {
1924 Obj perm; /* permutation, result */
1925 UInt m; /* maximal entry in permutation */
1926
1927 /* ignore or code */
1928 SKIP_IF_RETURNING();
1929 SKIP_IF_IGNORING();
1930 if ( STATE(IntrCoding) > 0 ) { CodePerm(nrc); return; }
1931
1932
1933 /* special case for identity permutation */
1934 if ( nrc == 0 ) {
1935 perm = NEW_PERM2( 0 );
1936 }
1937
1938 /* otherwise */
1939 else {
1940
1941 /* get the permutation and its maximal entry */
1942 m = INT_INTOBJ( PopObj() );
1943 perm = PopObj();
1944
1945 /* if possible represent the permutation with short entries */
1946 TrimPerm(perm, m);
1947 }
1948
1949 /* push the result */
1950 PushObj( perm );
1951 }
1952
1953
1954 /****************************************************************************
1955 **
1956 *F IntrListExprBegin(<top>) . . . . . . . . . . interpret list expr, begin
1957 *F IntrListExprBeginElm(<pos>) . . . . . interpret list expr, begin element
1958 *F IntrListExprEndElm() . . . . . . . . . interpret list expr, end element
1959 *F IntrListExprEnd(<nr>,<range>,<top>,<tilde>) . . interpret list expr, end
1960 */
IntrListExprBegin(UInt top)1961 void IntrListExprBegin (
1962 UInt top )
1963 {
1964 Obj list; /* new list */
1965 Obj old; /* old value of '~' */
1966
1967 /* ignore or code */
1968 SKIP_IF_RETURNING();
1969 SKIP_IF_IGNORING();
1970 if ( STATE(IntrCoding) > 0 ) { CodeListExprBegin( top ); return; }
1971
1972
1973 /* allocate the new list */
1974 list = NewEmptyPlist();
1975
1976 /* if this is an outmost list, save it for reference in '~' */
1977 /* (and save the old value of '~' on the values stack) */
1978 if ( top ) {
1979 old = STATE(Tilde);
1980 if ( old != 0 ) { PushObj( old ); }
1981 else { PushVoidObj(); }
1982 STATE(Tilde) = list;
1983 }
1984
1985 /* push the list */
1986 PushObj( list );
1987 }
1988
IntrListExprBeginElm(UInt pos)1989 void IntrListExprBeginElm (
1990 UInt pos )
1991 {
1992 /* ignore or code */
1993 SKIP_IF_RETURNING();
1994 SKIP_IF_IGNORING();
1995 if ( STATE(IntrCoding) > 0 ) { CodeListExprBeginElm( pos ); return; }
1996
1997
1998 /* remember this position on the values stack */
1999 PushObj( INTOBJ_INT(pos) );
2000 }
2001
IntrListExprEndElm(void)2002 void IntrListExprEndElm ( void )
2003 {
2004 Obj list; /* list that is currently made */
2005 Obj pos; /* position */
2006 UInt p; /* position, as a C integer */
2007 Obj val; /* value to assign into list */
2008
2009 /* ignore or code */
2010 SKIP_IF_RETURNING();
2011 SKIP_IF_IGNORING();
2012 if ( STATE(IntrCoding) > 0 ) { CodeListExprEndElm(); return; }
2013
2014
2015 /* get the value */
2016 val = PopObj();
2017
2018 /* get the position */
2019 pos = PopObj();
2020 p = INT_INTOBJ( pos );
2021
2022 /* get the list */
2023 list = PopObj();
2024
2025 /* assign the element into the list */
2026 ASS_LIST( list, p, val );
2027
2028 /* push the list again */
2029 PushObj( list );
2030 }
2031
IntrListExprEnd(UInt nr,UInt range,UInt top,UInt tilde)2032 void IntrListExprEnd (
2033 UInt nr,
2034 UInt range,
2035 UInt top,
2036 UInt tilde )
2037 {
2038 Obj list; /* the list, result */
2039 Obj old; /* old value of '~' */
2040 Int low; /* low value of range */
2041 Int inc; /* increment of range */
2042 Int high; /* high value of range */
2043 Obj val; /* temporary value */
2044
2045 /* ignore or code */
2046 SKIP_IF_RETURNING();
2047 SKIP_IF_IGNORING();
2048 if ( STATE(IntrCoding) > 0 ) { CodeListExprEnd(nr,range,top,tilde); return; }
2049
2050
2051 /* if this was a top level expression, restore the value of '~' */
2052 if ( top ) {
2053 list = PopObj();
2054 old = PopVoidObj();
2055 STATE(Tilde) = old;
2056 PushObj( list );
2057 }
2058
2059 /* if this was a range, convert the list to a range */
2060 if ( range ) {
2061 /* get the list */
2062 list = PopObj();
2063
2064 /* get the low value */
2065 val = ELM_LIST( list, 1 );
2066 low = GetSmallIntEx("Range", val, "<first>");
2067
2068 /* get the increment */
2069 if ( nr == 3 ) {
2070 val = ELM_LIST( list, 2 );
2071 Int v = GetSmallIntEx("Range", val, "<second>");
2072 if ( v == low ) {
2073 ErrorQuit(
2074 "Range: <second> must not be equal to <first> (%d)",
2075 (Int)low, 0L );
2076 }
2077 inc = v - low;
2078 }
2079 else {
2080 inc = 1;
2081 }
2082
2083 /* get and check the high value */
2084 val = ELM_LIST( list, LEN_LIST(list) );
2085 Int v = GetSmallIntEx("Range", val, "<last>");
2086 if ( (v - low) % inc != 0 ) {
2087 ErrorQuit(
2088 "Range: <last>-<first> (%d) must be divisible by <inc> (%d)",
2089 (Int)(v-low), (Int)inc );
2090 }
2091 high = v;
2092
2093 /* if <low> is larger than <high> the range is empty */
2094 if ( (0 < inc && high < low) || (inc < 0 && low < high) ) {
2095 list = NewEmptyPlist();
2096 }
2097
2098 /* if <low> is equal to <high> the range is a singleton list */
2099 else if ( low == high ) {
2100 list = NEW_PLIST( T_PLIST_CYC_SSORT, 1 );
2101 SET_LEN_PLIST( list, 1 );
2102 SET_ELM_PLIST( list, 1, INTOBJ_INT(low) );
2103 }
2104
2105 /* else make the range */
2106 else {
2107 /* length must be a small integer as well */
2108 if ((high-low) / inc >= INT_INTOBJ_MAX) {
2109 ErrorQuit("Range: the length of a range must be a small integer",
2110 0, 0);
2111 }
2112
2113 if ( 0 < inc )
2114 list = NEW_RANGE_SSORT();
2115 else
2116 list = NEW_RANGE_NSORT();
2117 SET_LEN_RANGE( list, (high-low) / inc + 1 );
2118 SET_LOW_RANGE( list, low );
2119 SET_INC_RANGE( list, inc );
2120 }
2121
2122 /* push the list again */
2123 PushObj( list );
2124 }
2125 else {
2126 /* give back unneeded memory */
2127 list = PopObj( );
2128 /* Might have transformed into another type of list */
2129 if (IS_PLIST(list)) {
2130 SHRINK_PLIST(list, LEN_PLIST(list));
2131 }
2132 PushObj( list );
2133 }
2134 }
2135
2136
2137 /****************************************************************************
2138 **
2139 *F IntrStringExpr(<str>) . . . . . . . . interpret literal string expression
2140 */
IntrStringExpr(Obj string)2141 void IntrStringExpr (
2142 Obj string )
2143 {
2144 /* ignore or code */
2145 SKIP_IF_RETURNING();
2146 SKIP_IF_IGNORING();
2147 if ( STATE(IntrCoding) > 0 ) { CodeStringExpr( string ); return; }
2148
2149
2150 /* push the string, already newly created */
2151 PushObj( string );
2152 }
2153
IntrPragma(Obj pragma)2154 void IntrPragma (
2155 Obj pragma )
2156 {
2157 SKIP_IF_RETURNING();
2158 SKIP_IF_IGNORING();
2159 if ( STATE(IntrCoding) > 0 ) {
2160 CodePragma( pragma );
2161 } else {
2162 // Push a void when interpreting
2163 PushVoidObj();
2164 }
2165 }
2166
2167 /****************************************************************************
2168 **
2169 *F IntrRecExprBegin(<top>) . . . . . . . . . . interpret record expr, begin
2170 *F IntrRecExprBeginElmName(<rnam>) . . interpret record expr, begin element
2171 *F IntrRecExprBeginElmExpr() . . . . . interpret record expr, begin element
2172 *F IntrRecExprEndElmExpr() . . . . . . . interpret record expr, end element
2173 *F IntrRecExprEnd(<nr>,<top>,<tilde>) . . . . . interpret record expr, end
2174 */
IntrRecExprBegin(UInt top)2175 void IntrRecExprBegin (
2176 UInt top )
2177 {
2178 Obj record; /* new record */
2179 Obj old; /* old value of '~' */
2180
2181 /* ignore or code */
2182 SKIP_IF_RETURNING();
2183 SKIP_IF_IGNORING();
2184 if ( STATE(IntrCoding) > 0 ) { CodeRecExprBegin( top ); return; }
2185
2186
2187 /* allocate the new record */
2188 record = NEW_PREC( 0 );
2189
2190 /* if this is an outmost record, save it for reference in '~' */
2191 /* (and save the old value of '~' on the values stack) */
2192 if ( top ) {
2193 old = STATE(Tilde);
2194 if ( old != 0 ) { PushObj( old ); }
2195 else { PushVoidObj(); }
2196 STATE(Tilde) = record;
2197 }
2198
2199 /* push the record */
2200 PushObj( record );
2201 }
2202
IntrRecExprBeginElmName(UInt rnam)2203 void IntrRecExprBeginElmName (
2204 UInt rnam )
2205 {
2206 /* ignore or code */
2207 SKIP_IF_RETURNING();
2208 SKIP_IF_IGNORING();
2209 if ( STATE(IntrCoding) > 0 ) { CodeRecExprBeginElmName( rnam ); return; }
2210
2211
2212 /* remember the name on the values stack */
2213 PushObj( (Obj)rnam );
2214 }
2215
IntrRecExprBeginElmExpr(void)2216 void IntrRecExprBeginElmExpr ( void )
2217 {
2218 UInt rnam; /* record name */
2219
2220 /* ignore or code */
2221 SKIP_IF_RETURNING();
2222 SKIP_IF_IGNORING();
2223 if ( STATE(IntrCoding) > 0 ) { CodeRecExprBeginElmExpr(); return; }
2224
2225
2226 /* convert the expression to a record name */
2227 rnam = RNamObj( PopObj() );
2228
2229 /* remember the name on the values stack */
2230 PushObj( (Obj)rnam );
2231 }
2232
IntrRecExprEndElm(void)2233 void IntrRecExprEndElm ( void )
2234 {
2235 Obj record; /* record that is currently made */
2236 UInt rnam; /* name of record element */
2237 Obj val; /* value of record element */
2238
2239 /* ignore or code */
2240 SKIP_IF_RETURNING();
2241 SKIP_IF_IGNORING();
2242 if ( STATE(IntrCoding) > 0 ) { CodeRecExprEndElm(); return; }
2243
2244
2245 /* get the value */
2246 val = PopObj();
2247
2248 /* get the record name */
2249 rnam = (UInt)PopObj();
2250
2251 /* get the record */
2252 record = PopObj();
2253
2254 /* assign the value into the record */
2255 ASS_REC( record, rnam, val );
2256
2257 /* push the record again */
2258 PushObj( record );
2259 }
2260
IntrRecExprEnd(UInt nr,UInt top,UInt tilde)2261 void IntrRecExprEnd (
2262 UInt nr,
2263 UInt top,
2264 UInt tilde )
2265 {
2266 Obj record; /* record that is currently made */
2267 Obj old; /* old value of '~' */
2268
2269 /* ignore or code */
2270 SKIP_IF_RETURNING();
2271 SKIP_IF_IGNORING();
2272 if ( STATE(IntrCoding) > 0 ) { CodeRecExprEnd(nr,top,tilde); return; }
2273
2274
2275 /* if this was a top level expression, restore the value of '~' */
2276 if ( top ) {
2277 record = PopObj();
2278 old = PopVoidObj();
2279 STATE(Tilde) = old;
2280 PushObj( record );
2281 }
2282 }
2283
2284 /****************************************************************************
2285 **
2286 *F IntrFuncCallOptionsBegin() . . . .. . . . . . interpret options, begin
2287 *F IntrFuncCallOptionsBeginElmName(<rnam>). interpret options, begin element
2288 *F IntrFuncCallOptionsBeginElmExpr() . .. . interpret options, begin element
2289 *F IntrFuncCallOptionsEndElm() . . .. . . . interpret options, end element
2290 *F IntrFuncCallOptionsEndElmEmpty() .. . . . interpret options, end element
2291 *F IntrFuncCallOptionsEnd(<nr>) . . . . . . . . interpret options, end
2292 **
2293 ** The net effect of all of these is to leave a record object on the stack
2294 ** where IntrFuncCallEnd can use it
2295 */
IntrFuncCallOptionsBegin(void)2296 void IntrFuncCallOptionsBegin ( void )
2297 {
2298 Obj record; /* new record */
2299
2300 /* ignore or code */
2301 SKIP_IF_RETURNING();
2302 SKIP_IF_IGNORING();
2303 if ( STATE(IntrCoding) > 0 ) { CodeFuncCallOptionsBegin( ); return; }
2304
2305
2306 /* allocate the new record */
2307 record = NEW_PREC( 0 );
2308 /* push the record */
2309 PushObj( record );
2310 }
2311
IntrFuncCallOptionsBeginElmName(UInt rnam)2312 void IntrFuncCallOptionsBeginElmName (
2313 UInt rnam )
2314 {
2315 /* ignore or code */
2316 SKIP_IF_RETURNING();
2317 SKIP_IF_IGNORING();
2318 if ( STATE(IntrCoding) > 0 ) { CodeFuncCallOptionsBeginElmName( rnam ); return; }
2319
2320
2321 /* remember the name on the values stack */
2322 PushObj( (Obj)rnam );
2323 }
2324
IntrFuncCallOptionsBeginElmExpr(void)2325 void IntrFuncCallOptionsBeginElmExpr ( void )
2326 {
2327 UInt rnam; /* record name */
2328
2329 /* ignore or code */
2330 SKIP_IF_RETURNING();
2331 SKIP_IF_IGNORING();
2332 if ( STATE(IntrCoding) > 0 ) { CodeFuncCallOptionsBeginElmExpr(); return; }
2333
2334
2335 /* convert the expression to a record name */
2336 rnam = RNamObj( PopObj() );
2337
2338 /* remember the name on the values stack */
2339 PushObj( (Obj)rnam );
2340 }
2341
IntrFuncCallOptionsEndElm(void)2342 void IntrFuncCallOptionsEndElm ( void )
2343 {
2344 Obj record; /* record that is currently made */
2345 UInt rnam; /* name of record element */
2346 Obj val; /* value of record element */
2347
2348 /* ignore or code */
2349 SKIP_IF_RETURNING();
2350 SKIP_IF_IGNORING();
2351 if ( STATE(IntrCoding) > 0 ) { CodeFuncCallOptionsEndElm(); return; }
2352
2353
2354 /* get the value */
2355 val = PopObj();
2356
2357 /* get the record name */
2358 rnam = (UInt)PopObj();
2359
2360 /* get the record */
2361 record = PopObj();
2362
2363 /* assign the value into the record */
2364 ASS_REC( record, rnam, val );
2365
2366 /* push the record again */
2367 PushObj( record );
2368 }
2369
IntrFuncCallOptionsEndElmEmpty(void)2370 void IntrFuncCallOptionsEndElmEmpty ( void )
2371 {
2372 Obj record; /* record that is currently made */
2373 UInt rnam; /* name of record element */
2374 Obj val; /* value of record element */
2375
2376 /* ignore or code */
2377 SKIP_IF_RETURNING();
2378 SKIP_IF_IGNORING();
2379 if ( STATE(IntrCoding) > 0 ) { CodeFuncCallOptionsEndElmEmpty(); return; }
2380
2381
2382 /* get the value */
2383 val = True;
2384
2385 /* get the record name */
2386 rnam = (UInt)PopObj();
2387
2388 /* get the record */
2389 record = PopObj();
2390
2391 /* assign the value into the record */
2392 ASS_REC( record, rnam, val );
2393
2394 /* push the record again */
2395 PushObj( record );
2396 }
2397
IntrFuncCallOptionsEnd(UInt nr)2398 void IntrFuncCallOptionsEnd ( UInt nr )
2399 {
2400 /* ignore or code */
2401 SKIP_IF_RETURNING();
2402 SKIP_IF_IGNORING();
2403 if ( STATE(IntrCoding) > 0 ) { CodeFuncCallOptionsEnd(nr); return; }
2404
2405
2406 }
2407
2408
2409 /****************************************************************************
2410 **
2411 *F IntrAssLVar(<lvar>) . . . . . . . . . . . . interpret assignment to local
2412 */
IntrAssLVar(UInt lvar)2413 void IntrAssLVar (
2414 UInt lvar )
2415 {
2416 Obj val;
2417 /* ignore */
2418 SKIP_IF_RETURNING();
2419 SKIP_IF_IGNORING();
2420
2421 /* otherwise must be coding */
2422 if ( STATE(IntrCoding) > 0 )
2423 CodeAssLVar( lvar );
2424
2425 /* Or in the break loop */
2426 else {
2427 val = PopObj();
2428 ASS_LVAR(lvar, val);
2429 PushObj(val);
2430 }
2431 }
2432
IntrUnbLVar(UInt lvar)2433 void IntrUnbLVar (
2434 UInt lvar )
2435 {
2436 /* ignore */
2437 SKIP_IF_RETURNING();
2438 SKIP_IF_IGNORING();
2439
2440 /* otherwise must be coding */
2441 if ( STATE(IntrCoding) > 0 )
2442 CodeUnbLVar( lvar );
2443
2444 /* or in the break loop */
2445 else {
2446 ASS_LVAR(lvar,0);
2447 PushVoidObj();
2448 }
2449 }
2450
2451
2452 /****************************************************************************
2453 **
2454 *F IntrRefLVar(<lvar>) . . . . . . . . . . . . interpret reference to local
2455 */
IntrRefLVar(UInt lvar)2456 void IntrRefLVar (
2457 UInt lvar )
2458 {
2459 Obj val;
2460 /* ignore */
2461 SKIP_IF_RETURNING();
2462 SKIP_IF_IGNORING();
2463
2464 /* otherwise must be coding */
2465 if ( STATE(IntrCoding) > 0 )
2466 CodeRefLVar( lvar );
2467
2468 /* or in the break loop */
2469
2470 else {
2471 val = OBJ_LVAR(lvar);
2472 if (val == 0) {
2473 ErrorMayQuit("Variable: '%g' must have an assigned value",
2474 (Int)NAME_LVAR(lvar), 0);
2475 }
2476 PushObj(val);
2477 }
2478 }
2479
IntrIsbLVar(UInt lvar)2480 void IntrIsbLVar (
2481 UInt lvar )
2482 {
2483 /* ignore */
2484 SKIP_IF_RETURNING();
2485 SKIP_IF_IGNORING();
2486
2487 /* otherwise must be coding */
2488 if( STATE(IntrCoding) > 0 )
2489 CodeIsbLVar( lvar );
2490
2491 /* or debugging */
2492 else {
2493 PushObj(OBJ_LVAR(lvar) != (Obj)0 ? True : False);
2494 }
2495 }
2496
2497
2498 /****************************************************************************
2499 **
2500 *F IntrAssHVar(<hvar>) . . . . . . . . . . . interpret assignment to higher
2501 */
IntrAssHVar(UInt hvar)2502 void IntrAssHVar (
2503 UInt hvar )
2504 {
2505 Obj val;
2506 /* ignore */
2507 SKIP_IF_RETURNING();
2508 SKIP_IF_IGNORING();
2509
2510 /* otherwise must be coding */
2511 if( STATE(IntrCoding) > 0 )
2512 CodeAssHVar( hvar );
2513 /* Or in the break loop */
2514 else {
2515 val = PopObj();
2516 ASS_HVAR(hvar, val);
2517 PushObj(val);
2518 }
2519 }
2520
IntrUnbHVar(UInt hvar)2521 void IntrUnbHVar (
2522 UInt hvar )
2523 {
2524 /* ignore */
2525 SKIP_IF_RETURNING();
2526 SKIP_IF_IGNORING();
2527
2528 /* otherwise must be coding */
2529 if ( STATE(IntrCoding) > 0 )
2530 CodeUnbHVar( hvar );
2531 /* or debugging */
2532 else {
2533 ASS_HVAR(hvar, 0);
2534 PushVoidObj();
2535 }
2536 }
2537
2538
2539 /****************************************************************************
2540 **
2541 *F IntrRefHVar(<hvar>) . . . . . . . . . . . . interpret reference to higher
2542 */
IntrRefHVar(UInt hvar)2543 void IntrRefHVar (
2544 UInt hvar )
2545 {
2546 Obj val;
2547 /* ignore */
2548 SKIP_IF_RETURNING();
2549 SKIP_IF_IGNORING();
2550
2551 /* otherwise must be coding */
2552 if( STATE(IntrCoding) > 0 )
2553 CodeRefHVar( hvar );
2554 /* or debugging */
2555 else {
2556 val = OBJ_HVAR(hvar);
2557 while (val == 0) {
2558 ErrorMayQuit("Variable: '%g' must have an assigned value",
2559 (Int)NAME_HVAR((UInt)(hvar)), 0);
2560 }
2561 PushObj(val);
2562 }
2563 }
2564
IntrIsbHVar(UInt hvar)2565 void IntrIsbHVar (
2566 UInt hvar )
2567 {
2568 /* ignore */
2569 SKIP_IF_RETURNING();
2570 SKIP_IF_IGNORING();
2571
2572 /* otherwise must be coding */
2573 if( STATE(IntrCoding) > 0 )
2574 CodeIsbHVar( hvar );
2575 /* or debugging */
2576 else
2577 PushObj((OBJ_HVAR(hvar) != (Obj) 0) ? True : False);
2578 }
2579
2580
2581 /****************************************************************************
2582 **
2583 *F IntrAssDVar(<dvar>) . . . . . . . . . . . . interpret assignment to debug
2584 */
2585
IntrAssDVar(UInt dvar,UInt depth)2586 void IntrAssDVar (
2587 UInt dvar,
2588 UInt depth )
2589 {
2590 Obj rhs; /* right hand side */
2591 Obj context;
2592
2593 /* ignore or code */
2594 SKIP_IF_RETURNING();
2595 SKIP_IF_IGNORING();
2596
2597 if ( STATE(IntrCoding) > 0 ) {
2598 ErrorQuit( "Variable: <debug-variable-%d-%d> cannot be used here",
2599 dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
2600 }
2601
2602
2603 /* get the right hand side */
2604 rhs = PopObj();
2605
2606 /* assign the right hand side */
2607 context = STATE(ErrorLVars);
2608 while (depth--)
2609 context = PARENT_LVARS(context);
2610 ASS_HVAR_WITH_CONTEXT(context, dvar, rhs);
2611
2612 /* push the right hand side again */
2613 PushObj( rhs );
2614 }
2615
IntrUnbDVar(UInt dvar,UInt depth)2616 void IntrUnbDVar (
2617 UInt dvar,
2618 UInt depth )
2619 {
2620 Obj context;
2621
2622 /* ignore or code */
2623 SKIP_IF_RETURNING();
2624 SKIP_IF_IGNORING();
2625
2626 if ( STATE(IntrCoding) > 0 ) {
2627 ErrorQuit( "Variable: <debug-variable-%d-%d> cannot be used here",
2628 dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
2629 }
2630
2631 /* assign the right hand side */
2632 context = STATE(ErrorLVars);
2633 while (depth--)
2634 context = PARENT_LVARS(context);
2635 ASS_HVAR_WITH_CONTEXT(context, dvar, (Obj)0);
2636
2637 /* push void */
2638 PushVoidObj();
2639 }
2640
2641
2642 /****************************************************************************
2643 **
2644 *F IntrRefDVar(<dvar>) . . . . . . . . . . . . interpret reference to debug
2645 */
IntrRefDVar(UInt dvar,UInt depth)2646 void IntrRefDVar (
2647 UInt dvar,
2648 UInt depth )
2649 {
2650 Obj val; /* value, result */
2651 Obj context;
2652
2653 /* ignore or code */
2654 SKIP_IF_RETURNING();
2655 SKIP_IF_IGNORING();
2656
2657 if ( STATE(IntrCoding) > 0 ) {
2658 ErrorQuit( "Variable: <debug-variable-%d-%d> cannot be used here",
2659 dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
2660 }
2661
2662 /* get and check the value */
2663 context = STATE(ErrorLVars);
2664 while (depth--)
2665 context = PARENT_LVARS(context);
2666 val = OBJ_HVAR_WITH_CONTEXT(context, dvar);
2667 if ( val == 0 ) {
2668 ErrorQuit( "Variable: <debug-variable-%d-%d> must have a value",
2669 dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
2670 }
2671
2672 /* push the value */
2673 PushObj( val );
2674 }
2675
IntrIsbDVar(UInt dvar,UInt depth)2676 void IntrIsbDVar (
2677 UInt dvar,
2678 UInt depth )
2679 {
2680 Obj val; /* value, result */
2681 Obj context;
2682
2683 /* ignore or code */
2684 SKIP_IF_RETURNING();
2685 SKIP_IF_IGNORING();
2686
2687 if ( STATE(IntrCoding) > 0 ) {
2688 ErrorQuit( "Variable: <debug-variable-%d-%d> cannot be used here",
2689 dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
2690 }
2691
2692 /* get the value */
2693 context = STATE(ErrorLVars);
2694 while (depth--)
2695 context = PARENT_LVARS(context);
2696 val = OBJ_HVAR_WITH_CONTEXT(context, dvar);
2697
2698 /* push the value */
2699 PushObj( (val != 0 ? True : False) );
2700 }
2701
2702
2703 /****************************************************************************
2704 **
2705 *F IntrAssGVar(<gvar>) . . . . . . . . . . . interpret assignment to global
2706 */
IntrAssGVar(UInt gvar)2707 void IntrAssGVar (
2708 UInt gvar )
2709 {
2710 Obj rhs; /* right hand side */
2711
2712 /* ignore or code */
2713 SKIP_IF_RETURNING();
2714 SKIP_IF_IGNORING();
2715 if ( STATE(IntrCoding) > 0 ) { CodeAssGVar( gvar ); return; }
2716
2717
2718 /* get the right hand side */
2719 rhs = PopObj();
2720
2721 /* assign the right hand side */
2722 AssGVar( gvar, rhs );
2723
2724 /* push the right hand side again */
2725 PushObj( rhs );
2726 }
2727
IntrUnbGVar(UInt gvar)2728 void IntrUnbGVar (
2729 UInt gvar )
2730 {
2731 /* ignore or code */
2732 SKIP_IF_RETURNING();
2733 SKIP_IF_IGNORING();
2734 if ( STATE(IntrCoding) > 0 ) { CodeUnbGVar( gvar ); return; }
2735
2736
2737 /* assign the right hand side */
2738 AssGVar( gvar, (Obj)0 );
2739
2740 /* push void */
2741 PushVoidObj();
2742 }
2743
2744
2745 /****************************************************************************
2746 **
2747 *F IntrRefGVar(<gvar>) . . . . . . . . . . . . interpret reference to global
2748 */
IntrRefGVar(UInt gvar)2749 void IntrRefGVar (
2750 UInt gvar )
2751 {
2752 Obj val; /* value, result */
2753
2754 /* ignore or code */
2755 SKIP_IF_RETURNING();
2756 SKIP_IF_IGNORING();
2757 if ( STATE(IntrCoding) > 0 ) { CodeRefGVar( gvar ); return; }
2758
2759
2760 /* get and check the value */
2761 if ( (val = ValAutoGVar( gvar )) == 0 ) {
2762 ErrorQuit(
2763 "Variable: '%g' must have a value",
2764 (Int)NameGVar(gvar), 0L );
2765 }
2766
2767 /* push the value */
2768 PushObj( val );
2769 }
2770
IntrIsbGVar(UInt gvar)2771 void IntrIsbGVar (
2772 UInt gvar )
2773 {
2774 Obj val; /* value, result */
2775
2776 /* ignore or code */
2777 SKIP_IF_RETURNING();
2778 SKIP_IF_IGNORING();
2779 if ( STATE(IntrCoding) > 0 ) { CodeIsbGVar( gvar ); return; }
2780
2781
2782 /* get the value */
2783 val = ValAutoGVar( gvar );
2784
2785 /* push the value */
2786 PushObj( (val != 0 ? True : False) );
2787 }
2788
2789
2790 /****************************************************************************
2791 **
2792 *F IntrAssList() . . . . . . . . . . . . . . interpret assignment to a list
2793 *F IntrAsssList() . . . . . . . . . interpret multiple assignment to a list
2794 *F IntrAssListLevel(<level>) . . . . . interpret assignment to several lists
2795 *F IntrAsssListLevel(<level>) . . intr multiple assignment to several lists
2796 */
IntrAssList(Int narg)2797 void IntrAssList ( Int narg )
2798 {
2799 Obj list; /* list */
2800 Obj pos; /* position */
2801 Obj rhs; /* right hand side */
2802
2803 GAP_ASSERT(narg == 1 || narg == 2);
2804
2805 /* ignore or code */
2806 SKIP_IF_RETURNING();
2807 SKIP_IF_IGNORING();
2808 if ( STATE(IntrCoding) > 0 ) { CodeAssList( narg); return; }
2809
2810 /* get the right hand side */
2811 rhs = PopObj();
2812
2813 if (narg == 1) {
2814 /* get the position */
2815 pos = PopObj();
2816
2817 /* get the list (checking is done by 'ASS_LIST' or 'ASSB_LIST') */
2818 list = PopObj();
2819
2820 /* assign to the element of the list */
2821 if (IS_POS_INTOBJ(pos)) {
2822 ASS_LIST( list, INT_INTOBJ(pos), rhs );
2823 }
2824 else {
2825 ASSB_LIST(list, pos, rhs);
2826 }
2827 }
2828 else if (narg == 2) {
2829 Obj col = PopObj();
2830 Obj row = PopObj();
2831 list = PopObj();
2832
2833 ASS_MAT(list, row, col, rhs);
2834 }
2835
2836 /* push the right hand side again */
2837 PushObj( rhs );
2838 }
2839
2840
IntrAsssList(void)2841 void IntrAsssList ( void )
2842 {
2843 Obj list; /* list */
2844 Obj poss; /* positions */
2845 Obj rhss; /* right hand sides */
2846
2847 /* ignore or code */
2848 SKIP_IF_RETURNING();
2849 SKIP_IF_IGNORING();
2850 if ( STATE(IntrCoding) > 0 ) { CodeAsssList(); return; }
2851
2852
2853 /* get the right hand sides */
2854 rhss = PopObj();
2855 RequireDenseList("List Assignments", rhss);
2856
2857 /* get and check the positions */
2858 poss = PopObj();
2859 CheckIsPossList("List Assignments", poss);
2860 RequireSameLength("List Assignments", rhss, poss);
2861
2862 /* get the list (checking is done by 'ASSS_LIST') */
2863 list = PopObj();
2864
2865 /* assign to several elements of the list */
2866 ASSS_LIST( list, poss, rhss );
2867
2868 /* push the right hand sides again */
2869 PushObj( rhss );
2870 }
2871
IntrAssListLevel(Int narg,UInt level)2872 void IntrAssListLevel (
2873 Int narg,
2874 UInt level )
2875 {
2876 Obj lists; /* lists, left operand */
2877 Obj pos; /* position, left operand */
2878 Obj rhss; /* right hand sides, right operand */
2879 Obj ixs;
2880 Int i;
2881
2882 /* ignore or code */
2883 SKIP_IF_RETURNING();
2884 SKIP_IF_IGNORING();
2885 if ( STATE(IntrCoding) > 0 ) { CodeAssListLevel( narg, level ); return; }
2886
2887 /* get right hand sides (checking is done by 'AssListLevel') */
2888 rhss = PopObj();
2889
2890 ixs = NEW_PLIST(T_PLIST, narg);
2891 for (i = narg; i > 0; i--) {
2892 /* get and check the position */
2893 pos = PopObj();
2894 SET_ELM_PLIST(ixs, i, pos);
2895 CHANGED_BAG(ixs);
2896 }
2897 SET_LEN_PLIST(ixs, narg);
2898
2899 /* get lists (if this works, then <lists> is nested <level> deep, */
2900 /* checking it is nested <level>+1 deep is done by 'AssListLevel') */
2901 lists = PopObj();
2902
2903 /* assign the right hand sides to the elements of several lists */
2904 AssListLevel( lists, ixs, rhss, level );
2905
2906 /* push the assigned values again */
2907 PushObj( rhss );
2908 }
2909
IntrAsssListLevel(UInt level)2910 void IntrAsssListLevel (
2911 UInt level )
2912 {
2913 Obj lists; /* lists, left operand */
2914 Obj poss; /* position, left operand */
2915 Obj rhss; /* right hand sides, right operand */
2916
2917 /* ignore or code */
2918 SKIP_IF_RETURNING();
2919 SKIP_IF_IGNORING();
2920 if ( STATE(IntrCoding) > 0 ) { CodeAsssListLevel( level ); return; }
2921
2922
2923 /* get right hand sides (checking is done by 'AsssListLevel') */
2924 rhss = PopObj();
2925
2926 /* get and check the positions */
2927 poss = PopObj();
2928 CheckIsPossList("List Assignments", poss);
2929
2930 /* get lists (if this works, then <lists> is nested <level> deep, */
2931 /* checking it is nested <level>+1 deep is done by 'AsssListLevel') */
2932 lists = PopObj();
2933
2934 /* assign the right hand sides to several elements of several lists */
2935 AsssListLevel( lists, poss, rhss, level );
2936
2937 /* push the assigned values again */
2938 PushObj( rhss );
2939 }
2940
IntrUnbList(Int narg)2941 void IntrUnbList ( Int narg )
2942 {
2943 Obj list; /* list */
2944 Obj pos; /* position */
2945
2946 GAP_ASSERT(narg == 1 || narg == 2);
2947
2948 /* ignore or code */
2949 SKIP_IF_RETURNING();
2950 SKIP_IF_IGNORING();
2951 if ( STATE(IntrCoding) > 0 ) { CodeUnbList( narg); return; }
2952
2953 if (narg == 1) {
2954 /* get and check the position */
2955 pos = PopObj();
2956
2957 /* get the list (checking is done by 'UNB_LIST' or 'UNBB_LIST') */
2958 list = PopObj();
2959
2960 /* unbind the element */
2961 if (IS_POS_INTOBJ(pos)) {
2962 UNB_LIST( list, INT_INTOBJ(pos) );
2963 }
2964 else {
2965 UNBB_LIST(list, pos);
2966 }
2967 }
2968 else if (narg == 2) {
2969 Obj col = PopObj();
2970 Obj row = PopObj();
2971 list = PopObj();
2972
2973 UNB_MAT(list, row, col);
2974 }
2975
2976 /* push void */
2977 PushVoidObj();
2978 }
2979
2980
2981 /****************************************************************************
2982 **
2983 *F IntrElmList() . . . . . . . . . . . . . . . interpret selection of a list
2984 *F IntrElmsList() . . . . . . . . . interpret multiple selection of a list
2985 *F IntrElmListLevel(<level>) . . . . . interpret selection of several lists
2986 *F IntrElmsListLevel(<level>) . . intr multiple selection of several lists
2987 */
IntrElmList(Int narg)2988 void IntrElmList ( Int narg )
2989 {
2990 Obj elm; /* element, result */
2991 Obj list; /* list, left operand */
2992 Obj pos; /* position, right operand */
2993
2994 GAP_ASSERT(narg == 1 || narg == 2);
2995
2996 /* ignore or code */
2997 SKIP_IF_RETURNING();
2998 SKIP_IF_IGNORING();
2999 if ( STATE(IntrCoding) > 0 ) { CodeElmList( narg ); return; }
3000
3001 if (narg == 1) {
3002 /* get the position */
3003 pos = PopObj();
3004
3005 /* get the list (checking is done by 'ELM_LIST') */
3006 list = PopObj();
3007
3008 /* get the element of the list */
3009 if (IS_POS_INTOBJ(pos)) {
3010 elm = ELM_LIST( list, INT_INTOBJ( pos ) );
3011 }
3012 else {
3013 elm = ELMB_LIST( list, pos );
3014 }
3015 }
3016 else /*if (narg == 2)*/ {
3017 Obj col = PopObj();
3018 Obj row = PopObj();
3019 list = PopObj();
3020
3021 elm = ELM_MAT(list, row, col);
3022 }
3023
3024 /* push the element */
3025 PushObj( elm );
3026 }
3027
IntrElmsList(void)3028 void IntrElmsList ( void )
3029 {
3030 Obj elms; /* elements, result */
3031 Obj list; /* list, left operand */
3032 Obj poss; /* positions, right operand */
3033
3034 /* ignore or code */
3035 SKIP_IF_RETURNING();
3036 SKIP_IF_IGNORING();
3037 if ( STATE(IntrCoding) > 0 ) { CodeElmsList(); return; }
3038
3039
3040 /* get and check the positions */
3041 poss = PopObj();
3042 CheckIsPossList("List Elements", poss);
3043
3044 /* get the list (checking is done by 'ELMS_LIST') */
3045 list = PopObj();
3046
3047 /* select several elements from the list */
3048 elms = ELMS_LIST( list, poss );
3049
3050 /* push the elements */
3051 PushObj( elms );
3052 }
3053
IntrElmListLevel(Int narg,UInt level)3054 void IntrElmListLevel ( Int narg,
3055 UInt level )
3056 {
3057 Obj lists; /* lists, left operand */
3058 Obj pos; /* position, right operand */
3059 Obj ixs;
3060 Int i;
3061
3062 /* ignore or code */
3063 SKIP_IF_RETURNING();
3064 SKIP_IF_IGNORING();
3065 if ( STATE(IntrCoding) > 0 ) { CodeElmListLevel( narg, level ); return; }
3066
3067 /* get the positions */
3068 ixs = NEW_PLIST(T_PLIST, narg);
3069 for (i = narg; i > 0; i--) {
3070 pos = PopObj();
3071 SET_ELM_PLIST(ixs,i,pos);
3072 CHANGED_BAG(ixs);
3073 }
3074 SET_LEN_PLIST(ixs, narg);
3075
3076 /* get lists (if this works, then <lists> is nested <level> deep, */
3077 /* checking it is nested <level>+1 deep is done by 'ElmListLevel') */
3078 lists = PopObj();
3079
3080 /* select the elements from several lists (store them in <lists>) */
3081 ElmListLevel( lists, ixs, level );
3082
3083 /* push the elements */
3084 PushObj( lists );
3085 }
3086
IntrElmsListLevel(UInt level)3087 void IntrElmsListLevel (
3088 UInt level )
3089 {
3090 Obj lists; /* lists, left operand */
3091 Obj poss; /* positions, right operand */
3092
3093 /* ignore or code */
3094 SKIP_IF_RETURNING();
3095 SKIP_IF_IGNORING();
3096 if ( STATE(IntrCoding) > 0 ) { CodeElmsListLevel( level ); return; }
3097
3098
3099 /* get and check the positions */
3100 poss = PopObj();
3101 CheckIsPossList("List Elements", poss);
3102
3103 /* get lists (if this works, then <lists> is nested <level> deep, */
3104 /* checking it is nested <level>+1 deep is done by 'ElmsListLevel') */
3105 lists = PopObj();
3106
3107 /* select several elements from several lists (store them in <lists>) */
3108 ElmsListLevel( lists, poss, level );
3109
3110 /* push the elements */
3111 PushObj( lists );
3112 }
3113
IntrIsbList(Int narg)3114 void IntrIsbList ( Int narg )
3115 {
3116 Obj isb; /* isbound, result */
3117 Obj list; /* list, left operand */
3118 Obj pos; /* position, right operand */
3119
3120 GAP_ASSERT(narg == 1 || narg == 2);
3121
3122 /* ignore or code */
3123 SKIP_IF_RETURNING();
3124 SKIP_IF_IGNORING();
3125 if ( STATE(IntrCoding) > 0 ) { CodeIsbList(narg); return; }
3126
3127 if (narg == 1) {
3128 /* get and check the position */
3129 pos = PopObj();
3130
3131 /* get the list (checking is done by 'ISB_LIST' or 'ISBB_LIST') */
3132 list = PopObj();
3133
3134 /* get the result */
3135 if (IS_POS_INTOBJ(pos)) {
3136 isb = ISB_LIST( list, INT_INTOBJ(pos) ) ? True : False;
3137 }
3138 else {
3139 isb = ISBB_LIST( list, pos ) ? True : False;
3140 }
3141 }
3142 else /*if (narg == 2)*/ {
3143 Obj col = PopObj();
3144 Obj row = PopObj();
3145 list = PopObj();
3146
3147 isb = ISB_MAT(list, row, col) ? True : False;
3148 }
3149
3150 /* push the result */
3151 PushObj( isb );
3152 }
3153
3154
3155 /****************************************************************************
3156 **
3157 *F IntrAssRecName(<rnam>) . . . . . . . . interpret assignment to a record
3158 *F IntrAssRecExpr() . . . . . . . . . . . interpret assignment to a record
3159 */
IntrAssRecName(UInt rnam)3160 void IntrAssRecName (
3161 UInt rnam )
3162 {
3163 Obj record; /* record, left operand */
3164 Obj rhs; /* rhs, right operand */
3165
3166 /* ignore or code */
3167 SKIP_IF_RETURNING();
3168 SKIP_IF_IGNORING();
3169 if ( STATE(IntrCoding) > 0 ) { CodeAssRecName( rnam ); return; }
3170
3171
3172 /* get the right hand side */
3173 rhs = PopObj();
3174
3175 /* get the record (checking is done by 'ASS_REC') */
3176 record = PopObj();
3177
3178 /* assign the right hand side to the element of the record */
3179 ASS_REC( record, rnam, rhs );
3180
3181 /* push the assigned value */
3182 PushObj( rhs );
3183 }
3184
IntrAssRecExpr(void)3185 void IntrAssRecExpr ( void )
3186 {
3187 Obj record; /* record, left operand */
3188 UInt rnam; /* name, left operand */
3189 Obj rhs; /* rhs, right operand */
3190
3191 /* ignore or code */
3192 SKIP_IF_RETURNING();
3193 SKIP_IF_IGNORING();
3194 if ( STATE(IntrCoding) > 0 ) { CodeAssRecExpr(); return; }
3195
3196
3197 /* get the right hand side */
3198 rhs = PopObj();
3199
3200 /* get the name and convert it to a record name */
3201 rnam = RNamObj( PopObj() );
3202
3203 /* get the record (checking is done by 'ASS_REC') */
3204 record = PopObj();
3205
3206 /* assign the right hand side to the element of the record */
3207 ASS_REC( record, rnam, rhs );
3208
3209 /* push the assigned value */
3210 PushObj( rhs );
3211 }
3212
IntrUnbRecName(UInt rnam)3213 void IntrUnbRecName (
3214 UInt rnam )
3215 {
3216 Obj record; /* record, left operand */
3217
3218 /* ignore or code */
3219 SKIP_IF_RETURNING();
3220 SKIP_IF_IGNORING();
3221 if ( STATE(IntrCoding) > 0 ) { CodeUnbRecName( rnam ); return; }
3222
3223
3224 /* get the record (checking is done by 'UNB_REC') */
3225 record = PopObj();
3226
3227 /* assign the right hand side to the element of the record */
3228 UNB_REC( record, rnam );
3229
3230 /* push void */
3231 PushVoidObj();
3232 }
3233
IntrUnbRecExpr(void)3234 void IntrUnbRecExpr ( void )
3235 {
3236 Obj record; /* record, left operand */
3237 UInt rnam; /* name, left operand */
3238
3239 /* ignore or code */
3240 SKIP_IF_RETURNING();
3241 SKIP_IF_IGNORING();
3242 if ( STATE(IntrCoding) > 0 ) { CodeUnbRecExpr(); return; }
3243
3244
3245 /* get the name and convert it to a record name */
3246 rnam = RNamObj( PopObj() );
3247
3248 /* get the record (checking is done by 'UNB_REC') */
3249 record = PopObj();
3250
3251 /* assign the right hand side to the element of the record */
3252 UNB_REC( record, rnam );
3253
3254 /* push void */
3255 PushVoidObj();
3256 }
3257
3258
3259 /****************************************************************************
3260 **
3261 *F IntrElmRecName(<rnam>) . . . . . . . . . interpret selection of a record
3262 *F IntrElmRecExpr() . . . . . . . . . . . . interpret selection of a record
3263 */
IntrElmRecName(UInt rnam)3264 void IntrElmRecName (
3265 UInt rnam )
3266 {
3267 Obj elm; /* element, result */
3268 Obj record; /* the record, left operand */
3269
3270 /* ignore or code */
3271 SKIP_IF_RETURNING();
3272 SKIP_IF_IGNORING();
3273 if ( STATE(IntrCoding) > 0 ) { CodeElmRecName( rnam ); return; }
3274
3275
3276 /* get the record (checking is done by 'ELM_REC') */
3277 record = PopObj();
3278
3279 /* select the element of the record */
3280 elm = ELM_REC( record, rnam );
3281
3282 /* push the element */
3283 PushObj( elm );
3284 }
3285
IntrElmRecExpr(void)3286 void IntrElmRecExpr ( void )
3287 {
3288 Obj elm; /* element, result */
3289 Obj record; /* the record, left operand */
3290 UInt rnam; /* the name, right operand */
3291
3292 /* ignore or code */
3293 SKIP_IF_RETURNING();
3294 SKIP_IF_IGNORING();
3295 if ( STATE(IntrCoding) > 0 ) { CodeElmRecExpr(); return; }
3296
3297
3298 /* get the name and convert it to a record name */
3299 rnam = RNamObj( PopObj() );
3300
3301 /* get the record (checking is done by 'ELM_REC') */
3302 record = PopObj();
3303
3304 /* select the element of the record */
3305 elm = ELM_REC( record, rnam );
3306
3307 /* push the element */
3308 PushObj( elm );
3309 }
3310
IntrIsbRecName(UInt rnam)3311 void IntrIsbRecName (
3312 UInt rnam )
3313 {
3314 Obj isb; /* element, result */
3315 Obj record; /* the record, left operand */
3316
3317 /* ignore or code */
3318 SKIP_IF_RETURNING();
3319 SKIP_IF_IGNORING();
3320 if ( STATE(IntrCoding) > 0 ) { CodeIsbRecName( rnam ); return; }
3321
3322
3323 /* get the record (checking is done by 'ISB_REC') */
3324 record = PopObj();
3325
3326 /* get the result */
3327 isb = (ISB_REC( record, rnam ) ? True : False);
3328
3329 /* push the result */
3330 PushObj( isb );
3331 }
3332
IntrIsbRecExpr(void)3333 void IntrIsbRecExpr ( void )
3334 {
3335 Obj isb; /* element, result */
3336 Obj record; /* the record, left operand */
3337 UInt rnam; /* the name, right operand */
3338
3339 /* ignore or code */
3340 SKIP_IF_RETURNING();
3341 SKIP_IF_IGNORING();
3342 if ( STATE(IntrCoding) > 0 ) { CodeIsbRecExpr(); return; }
3343
3344
3345 /* get the name and convert it to a record name */
3346 rnam = RNamObj( PopObj() );
3347
3348 /* get the record (checking is done by 'ISB_REC') */
3349 record = PopObj();
3350
3351 /* get the result */
3352 isb = (ISB_REC( record, rnam ) ? True : False);
3353
3354 /* push the result */
3355 PushObj( isb );
3356 }
3357
3358
3359 /****************************************************************************
3360 **
3361 *F IntrAssPosObj() . . . . . . . . . . . . . interpret assignment to a list
3362 */
IntrAssPosObj(void)3363 void IntrAssPosObj ( void )
3364 {
3365 Obj list; /* list */
3366 Obj pos; /* position */
3367 Int p; /* position, as a C integer */
3368 Obj rhs; /* right hand side */
3369
3370 /* ignore or code */
3371 SKIP_IF_RETURNING();
3372 SKIP_IF_IGNORING();
3373 if ( STATE(IntrCoding) > 0 ) { CodeAssPosObj(); return; }
3374
3375
3376 /* get the right hand side */
3377 rhs = PopObj();
3378
3379 /* get and check the position */
3380 pos = PopObj();
3381 p = GetPositiveSmallIntEx("PosObj Assignment", pos, "<position>");
3382
3383 /* get the list (checking is done by 'ASS_LIST') */
3384 list = PopObj();
3385
3386 /* assign to the element of the list */
3387 AssPosObj( list, p, rhs );
3388
3389 /* push the right hand side again */
3390 PushObj( rhs );
3391 }
3392
IntrUnbPosObj(void)3393 void IntrUnbPosObj ( void )
3394 {
3395 Obj list; /* list */
3396 Obj pos; /* position */
3397 Int p; /* position, as a C integer */
3398
3399 /* ignore or code */
3400 SKIP_IF_RETURNING();
3401 SKIP_IF_IGNORING();
3402 if ( STATE(IntrCoding) > 0 ) { CodeUnbPosObj(); return; }
3403
3404
3405 /* get and check the position */
3406 pos = PopObj();
3407 p = GetPositiveSmallIntEx("PosObj Assignment", pos, "<position>");
3408
3409 /* get the list (checking is done by 'UNB_LIST') */
3410 list = PopObj();
3411
3412 /* unbind the element */
3413 UnbPosObj( list, p );
3414
3415 /* push void */
3416 PushVoidObj();
3417 }
3418
3419
3420 /****************************************************************************
3421 **
3422 *F IntrElmPosObj() . . . . . . . . . . . . . . interpret selection of a list
3423 */
IntrElmPosObj(void)3424 void IntrElmPosObj ( void )
3425 {
3426 Obj elm; /* element, result */
3427 Obj list; /* list, left operand */
3428 Obj pos; /* position, right operand */
3429 Int p; /* position, as C integer */
3430
3431 /* ignore or code */
3432 SKIP_IF_RETURNING();
3433 SKIP_IF_IGNORING();
3434 if ( STATE(IntrCoding) > 0 ) { CodeElmPosObj(); return; }
3435
3436
3437 /* get and check the position */
3438 pos = PopObj();
3439 p = GetPositiveSmallIntEx("PosObj Element", pos, "<position>");
3440
3441 /* get the list (checking is done by 'ELM_LIST') */
3442 list = PopObj();
3443
3444 /* get the element of the list */
3445 elm = ElmPosObj( list, p );
3446
3447 /* push the element */
3448 PushObj( elm );
3449 }
3450
IntrIsbPosObj(void)3451 void IntrIsbPosObj ( void )
3452 {
3453 Obj isb; /* isbound, result */
3454 Obj list; /* list, left operand */
3455 Obj pos; /* position, right operand */
3456 Int p; /* position, as C integer */
3457
3458 /* ignore or code */
3459 SKIP_IF_RETURNING();
3460 SKIP_IF_IGNORING();
3461 if ( STATE(IntrCoding) > 0 ) { CodeIsbPosObj(); return; }
3462
3463
3464 /* get and check the position */
3465 pos = PopObj();
3466 p = GetPositiveSmallIntEx("PosObj Element", pos, "<position>");
3467
3468 /* get the list (checking is done by 'ISB_LIST') */
3469 list = PopObj();
3470
3471 /* get the result */
3472 isb = IsbPosObj( list, p ) ? True : False;
3473
3474 /* push the result */
3475 PushObj( isb );
3476 }
3477
3478
3479 /****************************************************************************
3480 **
3481 *F IntrAssComObjName(<rnam>) . . . . . . . interpret assignment to a record
3482 *F IntrAssComObjExpr() . . . . . . . . . . interpret assignment to a record
3483 */
IntrAssComObjName(UInt rnam)3484 void IntrAssComObjName (
3485 UInt rnam )
3486 {
3487 Obj record; /* record, left operand */
3488 Obj rhs; /* rhs, right operand */
3489
3490 /* ignore or code */
3491 SKIP_IF_RETURNING();
3492 SKIP_IF_IGNORING();
3493 if ( STATE(IntrCoding) > 0 ) { CodeAssComObjName( rnam ); return; }
3494
3495
3496 /* get the right hand side */
3497 rhs = PopObj();
3498
3499 /* get the record (checking is done by 'ASS_REC') */
3500 record = PopObj();
3501
3502 /* assign the right hand side to the element of the record */
3503 AssComObj( record, rnam, rhs );
3504
3505 /* push the assigned value */
3506 PushObj( rhs );
3507 }
3508
IntrAssComObjExpr(void)3509 void IntrAssComObjExpr ( void )
3510 {
3511 Obj record; /* record, left operand */
3512 UInt rnam; /* name, left operand */
3513 Obj rhs; /* rhs, right operand */
3514
3515 /* ignore or code */
3516 SKIP_IF_RETURNING();
3517 SKIP_IF_IGNORING();
3518 if ( STATE(IntrCoding) > 0 ) { CodeAssComObjExpr(); return; }
3519
3520
3521 /* get the right hand side */
3522 rhs = PopObj();
3523
3524 /* get the name and convert it to a record name */
3525 rnam = RNamObj( PopObj() );
3526
3527 /* get the record (checking is done by 'ASS_REC') */
3528 record = PopObj();
3529
3530 /* assign the right hand side to the element of the record */
3531 AssComObj( record, rnam, rhs );
3532
3533 /* push the assigned value */
3534 PushObj( rhs );
3535 }
3536
IntrUnbComObjName(UInt rnam)3537 void IntrUnbComObjName (
3538 UInt rnam )
3539 {
3540 Obj record; /* record, left operand */
3541
3542 /* ignore or code */
3543 SKIP_IF_RETURNING();
3544 SKIP_IF_IGNORING();
3545 if ( STATE(IntrCoding) > 0 ) { CodeUnbComObjName( rnam ); return; }
3546
3547
3548 /* get the record (checking is done by 'UNB_REC') */
3549 record = PopObj();
3550
3551 /* unbind the element of the record */
3552 UnbComObj( record, rnam );
3553
3554 /* push void */
3555 PushVoidObj();
3556 }
3557
IntrUnbComObjExpr(void)3558 void IntrUnbComObjExpr ( void )
3559 {
3560 Obj record; /* record, left operand */
3561 UInt rnam; /* name, left operand */
3562
3563 /* ignore or code */
3564 SKIP_IF_RETURNING();
3565 SKIP_IF_IGNORING();
3566 if ( STATE(IntrCoding) > 0 ) { CodeUnbComObjExpr(); return; }
3567
3568
3569 /* get the name and convert it to a record name */
3570 rnam = RNamObj( PopObj() );
3571
3572 /* get the record (checking is done by 'UNB_REC') */
3573 record = PopObj();
3574
3575 /* unbind the element of the record */
3576 UnbComObj( record, rnam );
3577
3578 /* push void */
3579 PushVoidObj();
3580 }
3581
3582
3583 /****************************************************************************
3584 **
3585 *F IntrElmComObjName(<rnam>) . . . . . . . . interpret selection of a record
3586 *F IntrElmComObjExpr() . . . . . . . . . . . interpret selection of a record
3587 */
IntrElmComObjName(UInt rnam)3588 void IntrElmComObjName (
3589 UInt rnam )
3590 {
3591 Obj elm; /* element, result */
3592 Obj record; /* the record, left operand */
3593
3594 /* ignore or code */
3595 SKIP_IF_RETURNING();
3596 SKIP_IF_IGNORING();
3597 if ( STATE(IntrCoding) > 0 ) { CodeElmComObjName( rnam ); return; }
3598
3599
3600 /* get the record (checking is done by 'ELM_REC') */
3601 record = PopObj();
3602
3603 /* select the element of the record */
3604 elm = ElmComObj( record, rnam );
3605
3606 /* push the element */
3607 PushObj( elm );
3608 }
3609
IntrElmComObjExpr(void)3610 void IntrElmComObjExpr ( void )
3611 {
3612 Obj elm; /* element, result */
3613 Obj record; /* the record, left operand */
3614 UInt rnam; /* the name, right operand */
3615
3616 /* ignore or code */
3617 SKIP_IF_RETURNING();
3618 SKIP_IF_IGNORING();
3619 if ( STATE(IntrCoding) > 0 ) { CodeElmComObjExpr(); return; }
3620
3621
3622 /* get the name and convert it to a record name */
3623 rnam = RNamObj( PopObj() );
3624
3625 /* get the record (checking is done by 'ELM_REC') */
3626 record = PopObj();
3627
3628 /* select the element of the record */
3629 elm = ElmComObj( record, rnam );
3630
3631 /* push the element */
3632 PushObj( elm );
3633 }
3634
IntrIsbComObjName(UInt rnam)3635 void IntrIsbComObjName (
3636 UInt rnam )
3637 {
3638 Obj isb; /* element, result */
3639 Obj record; /* the record, left operand */
3640
3641 /* ignore or code */
3642 SKIP_IF_RETURNING();
3643 SKIP_IF_IGNORING();
3644 if ( STATE(IntrCoding) > 0 ) { CodeIsbComObjName( rnam ); return; }
3645
3646
3647 /* get the record (checking is done by 'ISB_REC') */
3648 record = PopObj();
3649
3650 /* get the result */
3651 isb = IsbComObj( record, rnam ) ? True : False;
3652
3653 /* push the result */
3654 PushObj( isb );
3655 }
3656
IntrIsbComObjExpr(void)3657 void IntrIsbComObjExpr ( void )
3658 {
3659 Obj isb; /* element, result */
3660 Obj record; /* the record, left operand */
3661 UInt rnam; /* the name, right operand */
3662
3663 /* ignore or code */
3664 SKIP_IF_RETURNING();
3665 SKIP_IF_IGNORING();
3666 if ( STATE(IntrCoding) > 0 ) { CodeIsbComObjExpr(); return; }
3667
3668
3669 /* get the name and convert it to a record name */
3670 rnam = RNamObj( PopObj() );
3671
3672 /* get the record (checking is done by 'ISB_REC') */
3673 record = PopObj();
3674
3675 /* get the result */
3676 isb = IsbComObj( record, rnam ) ? True : False;
3677
3678 /* push the result */
3679 PushObj( isb );
3680 }
3681
3682 /****************************************************************************
3683 **
3684 *F IntrEmpty() . . . . . . . . . . . . . Interpret an empty statement body
3685 **
3686 */
3687
IntrEmpty(void)3688 void IntrEmpty ( void )
3689 {
3690 /* ignore or code */
3691 SKIP_IF_RETURNING();
3692 SKIP_IF_IGNORING();
3693 if ( STATE(IntrCoding) > 0 ) { CodeEmpty(); return; }
3694
3695
3696 /* interpret */
3697 PushVoidObj();
3698
3699 }
3700
3701
3702 /****************************************************************************
3703 **
3704 *F IntrInfoBegin() . . . . . . . . . start interpretation of Info statement
3705 *F IntrInfoMiddle() . . . . . . shift to interpreting printable statements
3706 *F IntrInfoEnd( <narg> ) . . Info statement complete, <narg> things to print
3707 *V InfoDecision . . . . . . . . . . . fopy of the InfoDecision GAP function
3708 **
3709 ** These are the actions which are used to interpret an Info statement:
3710 **
3711 ** IntrInfoBegin is called after the Info is read
3712 **
3713 ** IntrInfoMiddle is called after reading two arguments, because we can
3714 ** now decide whether we should evaluate or ignore the remaining arguments
3715 **
3716 ** IntrInfoEnd is called when the closing ')' is detected and should
3717 ** trigger the actual printing, if needed. The argument is the number of
3718 ** things to print
3719 */
3720
3721
IntrInfoBegin(void)3722 void IntrInfoBegin( void )
3723 {
3724 /* ignore or code */
3725 SKIP_IF_RETURNING();
3726 SKIP_IF_IGNORING();
3727 if ( STATE(IntrCoding) > 0 ) { CodeInfoBegin(); return; }
3728
3729 }
3730
3731
IntrInfoMiddle(void)3732 void IntrInfoMiddle( void )
3733 {
3734
3735 Obj selectors; /* first argument of Info */
3736 Obj level; /* second argument of Info */
3737 Obj selected; /* GAP Boolean answer to whether this message
3738 gets printed or not */
3739
3740 /* ignore or code */
3741 SKIP_IF_RETURNING();
3742 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)++; return; }
3743 if ( STATE(IntrCoding) > 0 ) { CodeInfoMiddle(); return; }
3744
3745
3746 level = PopObj();
3747 selectors = PopObj();
3748
3749 selected = InfoCheckLevel(selectors, level);
3750
3751 if (selected == False)
3752 STATE(IntrIgnoring) = 1;
3753 else {
3754 PushObj(selectors);
3755 PushObj(level);
3756 }
3757 }
3758
IntrInfoEnd(UInt narg)3759 void IntrInfoEnd( UInt narg )
3760 {
3761
3762 Obj args; /* gathers up the arguments to be printed */
3763
3764 /* ignore or code */
3765 INTERPRETER_PROFILE_HOOK(1);
3766 SKIP_IF_RETURNING_NO_PROFILE_HOOK();
3767
3768 if (STATE(IntrIgnoring) > 1) {
3769 STATE(IntrIgnoring)--;
3770 return;
3771 }
3772 if ( STATE(IntrCoding) > 0 ) { CodeInfoEnd( narg ); return; }
3773
3774
3775 /* print if necessary */
3776 if ( STATE(IntrIgnoring) > 0 )
3777 STATE(IntrIgnoring)--;
3778 else {
3779 args = NEW_PLIST( T_PLIST, narg);
3780 SET_LEN_PLIST(args, narg);
3781 while (narg > 0)
3782 SET_ELM_PLIST(args, narg--, PopObj());
3783
3784 Obj level = PopObj();
3785 Obj selectors = PopObj();
3786
3787 InfoDoPrint(selectors, level, args);
3788 }
3789
3790 /* If we actually executed this statement at all
3791 (even if we printed nothing) then return a Void */
3792 if (STATE(IntrIgnoring) == 0)
3793 PushVoidObj();
3794 }
3795
3796
3797 /****************************************************************************
3798 **
3799 *F IntrAssertBegin() . . . . . . . start interpretation of Assert statement
3800 *F IntrAssertAfterLevel() . . called after the first argument has been read
3801 **
3802 ** At this stage, we can decide whether to evaluate the second argument --
3803 ** the check in question
3804 **
3805 *F IntrAssertAfterCondition() called after the second argument has been read
3806 **
3807 ** At this point we know whether there is an assertion failure. We still
3808 ** need to read the third argument if any, to decide what to do about it;
3809 ** one of:
3810 **
3811 *F IntrAssertEnd2Args() . . . . called after reading the closing parenthesis
3812 *F IntrAssertEnd3Args() . . . . called after reading the closing parenthesis
3813 **
3814 *V CurrentAssertionLevel . . . . . . . . . . . . . . copy of GAP variable
3815 **
3816 **
3817 ** STATE(IntrIgnoring) is increased by (a total of) 2 if an assertion either
3818 ** is not tested (because we were Ignoring when we got to it, or due to
3819 ** level) or is tested and passes
3820 */
3821
3822 Obj CurrentAssertionLevel;
3823
IntrAssertBegin(void)3824 void IntrAssertBegin ( void )
3825 {
3826 /* ignore or code */
3827 SKIP_IF_RETURNING();
3828 SKIP_IF_IGNORING();
3829 if ( STATE(IntrCoding) > 0 ) { CodeAssertBegin(); return; }
3830
3831 }
3832
3833
IntrAssertAfterLevel(void)3834 void IntrAssertAfterLevel ( void )
3835 {
3836 Obj level;
3837
3838 /* ignore or code */
3839 SKIP_IF_RETURNING();
3840 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)++; return; }
3841 if ( STATE(IntrCoding) > 0 ) { CodeAssertAfterLevel(); return; }
3842
3843
3844 level = PopObj();
3845
3846 if (LT( CurrentAssertionLevel, level))
3847 STATE(IntrIgnoring) = 1;
3848 }
3849
IntrAssertAfterCondition(void)3850 void IntrAssertAfterCondition ( void )
3851 {
3852 Obj condition;
3853
3854 /* ignore or code */
3855 SKIP_IF_RETURNING();
3856 if ( STATE(IntrIgnoring) > 0 ) { STATE(IntrIgnoring)++; return; }
3857 if ( STATE(IntrCoding) > 0 ) { CodeAssertAfterCondition(); return; }
3858
3859
3860 condition = PopObj();
3861
3862 if (condition == True)
3863 STATE(IntrIgnoring)= 2;
3864 else if (condition != False)
3865 RequireArgumentEx("Assert", condition, "<cond>",
3866 "must be 'true' or 'false'");
3867 }
3868
IntrAssertEnd2Args(void)3869 void IntrAssertEnd2Args ( void )
3870 {
3871 /* ignore or code */
3872 INTERPRETER_PROFILE_HOOK(2);
3873 SKIP_IF_RETURNING_NO_PROFILE_HOOK();
3874 if (STATE(IntrIgnoring) > 2) {
3875 STATE(IntrIgnoring) -= 2;
3876 return;
3877 }
3878 if ( STATE(IntrCoding) > 0 ) { CodeAssertEnd2Args(); return; }
3879
3880
3881 if ( STATE(IntrIgnoring) == 0 )
3882 AssertionFailure();
3883 else
3884 STATE(IntrIgnoring) -= 2;
3885
3886 GAP_ASSERT(STATE(IntrIgnoring) == 0);
3887 PushVoidObj();
3888 }
3889
3890
IntrAssertEnd3Args(void)3891 void IntrAssertEnd3Args ( void )
3892 {
3893 Obj message;
3894 /* ignore or code */
3895 INTERPRETER_PROFILE_HOOK(2);
3896 SKIP_IF_RETURNING_NO_PROFILE_HOOK();
3897 if ( STATE(IntrIgnoring) > 2 ) { STATE(IntrIgnoring) -= 2; return; }
3898 if ( STATE(IntrCoding) > 0 ) { CodeAssertEnd3Args(); return; }
3899
3900
3901 if ( STATE(IntrIgnoring) == 0 ) {
3902 message = PopVoidObj();
3903 if (message != (Obj) 0 ) {
3904 if (IS_STRING_REP( message ))
3905 PrintString1(message);
3906 else
3907 PrintObj(message);
3908 }
3909 } else
3910 STATE(IntrIgnoring) -= 2;
3911
3912 GAP_ASSERT(STATE(IntrIgnoring) == 0);
3913 PushVoidObj();
3914 }
3915
3916
3917 /****************************************************************************
3918 **
3919 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
3920 */
3921
3922
3923 /****************************************************************************
3924 **
3925 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
3926 */
InitKernel(StructInitInfo * module)3927 static Int InitKernel (
3928 StructInitInfo * module )
3929 {
3930 #if !defined(HPCGAP)
3931 InitGlobalBag( &STATE(IntrState), "src/intrprtr.c:IntrState" );
3932 InitGlobalBag( &STATE(StackObj), "src/intrprtr.c:StackObj" );
3933 InitGlobalBag( &STATE(ErrorLVars), "STATE(ErrorLVars)" );
3934
3935
3936 /* Ensure that the value in '~' does not get garbage collected */
3937 InitGlobalBag( &STATE(Tilde), "STATE(Tilde)" );
3938 #endif
3939
3940 InitCopyGVar( "CurrentAssertionLevel", &CurrentAssertionLevel );
3941 InitFopyGVar( "CONVERT_FLOAT_LITERAL_EAGER", &CONVERT_FLOAT_LITERAL_EAGER);
3942
3943 /* The work of handling Options is also delegated*/
3944 ImportFuncFromLibrary( "PushOptions", &PushOptions );
3945 ImportFuncFromLibrary( "PopOptions", &PopOptions );
3946
3947 /* return success */
3948 return 0;
3949 }
3950
3951
3952 /****************************************************************************
3953 **
3954 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
3955 */
InitLibrary(StructInitInfo * module)3956 static Int InitLibrary (
3957 StructInitInfo * module )
3958 {
3959 UInt lev;
3960
3961 /* The Assertion level is also controlled at GAP level */
3962 lev = GVarName("CurrentAssertionLevel");
3963 AssGVar( lev, INTOBJ_INT(0) );
3964
3965 /* return success */
3966 return 0;
3967 }
3968
InitModuleState(void)3969 static Int InitModuleState(void)
3970 {
3971 STATE(IntrCoding) = 0;
3972 STATE(IntrIgnoring) = 0;
3973 STATE(IntrReturning) = 0;
3974
3975 // return success
3976 return 0;
3977 }
3978
3979
3980 /****************************************************************************
3981 **
3982 *F InitInfoIntrprtr() . . . . . . . . . . . . . . . table of init functions
3983 */
3984 static StructInitInfo module = {
3985 // init struct using C99 designated initializers; for a full list of
3986 // fields, please refer to the definition of StructInitInfo
3987 .type = MODULE_BUILTIN,
3988 .name = "intrprtr",
3989 .initKernel = InitKernel,
3990 .initLibrary = InitLibrary,
3991
3992 .initModuleState = InitModuleState,
3993 };
3994
InitInfoIntrprtr(void)3995 StructInitInfo * InitInfoIntrprtr ( void )
3996 {
3997 return &module;
3998 }
3999