2 * The Regina Rexx Interpreter
3 * Copyright (C) 1992 Anders Christensen <anders@pvv.unit.no>
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Library General Public
7 * License as published by the Free Software Foundation; either
8 * version 2 of the License, or (at your option) any later version.
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Library General Public License for more details.
15 * You should have received a copy of the GNU Library General Public
16 * License along with this library; if not, write to the Free
17 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 * Concept: Each REXX procedure (the top - or main - by default) has
22 * an array of hash-pointers. Routines that don't keep local
23 * variables (i.e hasn't seen a PROCEDURE) are using the hashpointers
24 * of the routine above them. The initial size of the array is
25 * vt->initialHashTableLength
27 * Each cell in this array is a pointer to a single-linked list of
28 * boxes. In common for all these boxes is that their name returns
29 * the same value when given as parameter to the hashfunc() function.
31 * Each of these boxes contains five variables: name, value, index,
32 * realbox and next. 'next' points to next box in the list.
34 * 'name' is the name of the variable, and 'value' is the value it
35 * contains. However, if 'realbox' is set, it points to another
36 * box which contains the real value of the variable. This mechanism
37 * gives support for EXPOSE'ing variables in PROCEDUREs.
39 * The 'index' is a pointer to another hashtable, and gives support
40 * for compound variables. If a variable is compound, its 'index' is
41 * set to point at the hashtable, each entry in this table do also
42 * point at the start of a single linked list of variable boxes, but
43 * these boxes has the 'after-the-period' part of the compound name
44 * as 'name'. The 'realbox', but not the 'index' may be set in these
47 * A variable is set when it exists in the datastructures, and the
48 * relevant 'value' pointer is non-NULL. When dropping a variable
49 * that is EXPOSE'ed, the 'value' is set to NULL.
51 * The 'test' and the 'test.' variables have two different
52 * variableboxes, and 'index' is only set in the box for 'test.'. A
53 * 'realbox' existing for 'test' makes it exposed. A 'realbox'
54 * 'test.' make the whole "array" exposed.
56 * A 'value' existing for 'test.' denotes the default value.
58 * Major performance improvements without much to do which should be
59 * implemented (FIXME):
61 * 1) Introduce a comparison function which uppercases the second argument
62 * only. The variable box itself always has the correct case. Just the
63 * script's name of the variable may have the "wrong" case.
64 * Check for contents when uppercasing numbers as well.
71 #include <stdio.h> /* f*ck sun, they can't write a proper assert!!! */
78 typedef struct { /* var_tsd: static variables of this module (thread-safe) */
80 variableptr first_invalid
;
94 /* We CAN'T increment current_valid on each new procedure (which results
95 * into create_new_varpool) and decrement it in procedure exit (which
96 * executes kill_variables). Imagine the following:
102 * > call proc1 (not endlessly, but at least one time)
104 * >proc2: procedure expose locvar
106 * In the first call to proc2 current_valid will be 3, proc2 returns, proc1
107 * will be executed at least once more and current_valid is 3, too. This is
108 * OK if and only if the variable accessment in proc1 and proc2 are distinct
109 * by a procedure counter (each procedure has its own number). This is NOT
110 * realized. Thus, we increment a separate counter (next_current_valid) each
111 * time a new procedure is called and assign the value to current_valid.
112 * On procedure return we set back current_valid to the current_value of
113 * this procedure instance which may be, but don't MUST be, current_level-1.
114 * Of course, this is bogus! The next_current_valid counter may wrap around
115 * and we run into trouble once more. We can reset next_current_valid to
116 * 2 (initial current_valid+1) savely iff current_valid==1. This prevents
117 * some problems with multiple calls to Rexx when started but don't help in
118 * one execution run. Since Regina is dog slow this will PROBABLY never
120 * For a correct way of operation see many compiler building books of
121 * languages with call by name.
122 * Former releases uses stupid generation counter mechanisms.
123 * FGC 27.09.98 (09/27/98)
125 long next_current_valid
;
141 var_hashtable
*var_table
;
142 var_hashtable
*pool0
;
143 treenode pool0nodes
[POOL0_CNT
][2];
144 int initialHashTableLength
;
147 #define SEEK_EXPOSED(ptr) if (ptr) \
149 for ( ; (ptr)->realbox; ptr = (ptr)->realbox ) \
152 #define REPLACE_VALUE(val,p) { if ( p->value ) \
153 Free_stringTSD( p->value ); \
156 p->flag = ( val ) ? VFLAG_STR : VFLAG_NONE; \
159 #define REPLACE_NUMBER(val,p) { if ( p->num ) \
161 FreeTSD( p->num->num ); \
166 p->flag = ( val ) ? VFLAG_NUM : VFLAG_NONE; \
170 static void regina_dprintf( const tsd_t
*TSD
, const char *fmt
, ... )
173 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
177 va_start( marker
, fmt
);
178 vfprintf( vt
->DebugFile
, fmt
, marker
);
179 fflush( vt
->DebugFile
);
182 # define DPRINT(x) if ( vt->DoDebug & 1) regina_dprintf x
183 # define DPRINT_2(x) if ( vt->DoDebug & 2 ) regina_dprintf x
184 # define DPRINT_3(x) if ( vt->DoDebug & 4 ) regina_dprintf x
185 # define DSTART DPRINT(( TSD, "%2u %4d ", TSD->thread_id, __LINE__ ))
186 # define DSTART_2 DPRINT_2(( TSD, "%2u %4d ", TSD->thread_id, __LINE__ ))
187 # define DSTART_3 DPRINT_3(( TSD, "%2u %4d ", TSD->thread_id, __LINE__ ))
188 # define DEND DPRINT(( TSD, "\n" ))
189 # define DEND_2 DPRINT_2(( TSD, "\n" ))
190 # define DEND_3 DPRINT_3(( TSD, "\n" ))
192 static const volatile char *PoolName( const tsd_t
*TSD
, Pool
*pool
,
196 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
198 if ( !vt
->DoDebug
) /* PoolName's return value isn't really used if */
199 return NULL
; /* debugging is turned off. */
200 if ( pool
== &vt
->NamePool
)
201 strcpy( vt
->PoolNameBuf
, "NAME" );
202 else if ( pool
== &vt
->ValuePool
)
203 strcpy( vt
->PoolNameBuf
, "VAL" );
204 else if ( pool
== &vt
->NumPool
)
205 strcpy( vt
->PoolNameBuf
, "NUM" );
206 else if ( pool
== &vt
->VarPool
)
207 strcpy( vt
->PoolNameBuf
, "VAR" );
210 for ( i
= 0; i
< pool
->size
; i
++ )
211 if ( pool
->Elems
[i
] == elem
)
213 sprintf( vt
->PoolNameBuf
+ strlen( vt
->PoolNameBuf
), "%u",
215 if ( i
>= pool
->size
)
218 if ( ( pool
->Elems
= (void **)realloc( pool
->Elems
,
219 pool
->size
* sizeof( void * ) ) ) == NULL
)
221 exiterror( ERR_STORAGE_EXHAUSTED
, 0 ) ;
224 pool
->Elems
[i
] = (void *) elem
;
225 return vt
->PoolNameBuf
;
228 #define DNAME(TSD,name,n) if ( vt->DoDebug & 1 ) DNAME2( TSD, name, n )
229 static void DNAME2( const tsd_t
*TSD
, const char *name
, const streng
* n
)
231 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
236 regina_dprintf( TSD
, "%s=",
240 regina_dprintf( TSD
, "NULL" );
243 regina_dprintf( TSD
, "\"%*.*s\"%s",
247 PoolName( TSD
, &vt
->NamePool
, n
) );
250 #define DVALUE(TSD,name,v) if ( vt->DoDebug & 1 ) DVALUE2( TSD, name, v )
251 static void DVALUE2( const tsd_t
*TSD
, const char *name
, const streng
* v
)
253 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
258 regina_dprintf( TSD
, "%s=",
262 regina_dprintf( TSD
, "NULL" );
265 regina_dprintf( TSD
, "\"%*.*s\"%s",
269 PoolName( TSD
, &vt
->ValuePool
, v
) );
272 #define DNUM(TSD,name,n) if ( vt->DoDebug & 1 ) DNUM2( TSD, name, n )
273 static void DNUM2( const tsd_t
*TSD
, const char *name
, const num_descr
* n
)
275 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
280 regina_dprintf( TSD
, "%s=",
284 regina_dprintf( TSD
, "NULL" );
287 regina_dprintf( TSD
, "\"%*.*s\"%s",
291 PoolName( TSD
, &vt
->NumPool
, n
) );
294 static int Dfindlevel(const tsd_t
*TSD
, cvariableptr v
)
300 curr
= TSD
->currlevel
;
306 for ( i
= 0; i
< curr
->vars
->size
; i
++ )
308 if ( curr
->vars
->tbl
[i
] == v
)
325 #define DVAR(TSD,name,v) if ( vt->DoDebug & 1 ) DVAR2( TSD, name, v )
326 static void DVAR2( const tsd_t
*TSD
, const char *name
, cvariableptr v
)
328 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
333 regina_dprintf( TSD
, "%s=",
337 regina_dprintf( TSD
, "NULL" );
341 regina_dprintf( TSD
, "%s,l=%d(",
342 PoolName( TSD
, &vt
->VarPool
, v
),
343 Dfindlevel( TSD
, v
) );
345 regina_dprintf( TSD
, "?" );
348 DNAME( TSD
, NULL
, v
->name
);
349 regina_dprintf( TSD
, "," );
350 DVALUE( TSD
, NULL
, v
->value
);
351 regina_dprintf( TSD
, "=" );
352 DNUM( TSD
, NULL
, v
->num
);
354 regina_dprintf( TSD
, ",hwired=%ld,valid=%ld",
355 v
->hwired
, v
->valid
);
358 regina_dprintf( TSD
, "->" );
359 DVAR( TSD
, NULL
, v
->realbox
);
361 regina_dprintf( TSD
, ")" );
363 # define DPRINTF(x) DSTART;DPRINT(x);DEND
364 # define DPRINTF_2(x) DSTART_2;DPRINT_2(x);DEND_2
365 # define DPRINTF_3(x) DSTART_3;DPRINT_3(x);DEND_3
367 #else /* !define(DEBUG) */
377 # define DNAME(t,n,v)
378 # define DVALUE(t,n,v)
382 # define DPRINTF_2(x)
383 # define DPRINTF_3(x)
388 * NEW_HASHTABLE_CHECK is invoked after a new entry has been added to the
389 * hashtable. Do a check for this special condition and set flag to 1 if
390 * a hashtable reorganisation should happen.
391 * One (maybe wrong) idea is to increase the table if 100% has been filled.
392 * NEVER EVER USE LESS THAN 40% CAPACITY! THIS MAY BE THE LOW WATER MARK!
394 #define NEW_HASHTABLE_CHECK(tbl,flag) /* */ \
395 (flag |= (((tbl)->e * 1 > (tbl)->size * 1) ? 1 : 0)) /* set to 5/4 for 80%*/
398 * COLLISION_CHECK is invoked after a collision has been detected.
399 * The check may happen rather often. KEEP IT SIMPLE!
400 * A hashtable reorganisation should/may happen in this case; this must be
401 * indicated by setting flag to 1.
402 * One (maybe wrong) idea is to increase the table if the number of collisions
403 * is bigger than two time of the number of read/write accesses.
405 #define COLLISION_CHECK(tbl,flag) /* */ \
406 (flag |= (((tbl)->w + (tbl)->r < (tbl)->c / 2) ? 1 : 0))
410 * The SEEK_VAR_... functions walk through the list of variable candidates
411 * in the bucket of the found hash with more or less help by other informations
412 * to minimize expensive comparisons.
414 #define SEEK_VAR_CMP(run,var,fullhash,tbl,flag) /* */ \
415 for ( ; (run); (run) = (run)->next ) \
417 if ( ( (run)->hash == (fullhash) ) && \
418 ( (run)->name->len == (var)->len ) && \
419 ( Str_cmp( run->name, var ) == 0 ) ) \
423 COLLISION_CHECK(tbl, flag); \
426 #define SEEK_VAR_CCMP(run,var,fullhash,tbl,flag) /* */ \
427 for ( ; (run); (run) = (run)->next ) \
429 if ( ( (run)->hash == (fullhash) ) && \
430 ( (run)->name->len == (var)->len ) && \
431 ( Str_ccmp( run->name, var ) == 0 ) ) \
435 COLLISION_CHECK(tbl, flag); \
438 #define SEEK_VAR_CNCMP(run,var,fullhash,tbl,l,flag) /* */ \
439 for ( ; (run); (run) = (run)->next ) \
441 if ( ( (run)->hash == (fullhash) ) && \
442 ( (run)->name->len == (l) ) && \
443 ( Str_cncmp( run->name, var, l ) == 0 ) ) \
447 COLLISION_CHECK(tbl, flag); \
450 #define SEEK_VAR_CNOCMP(run,var,fullhash,tbl,l,off,flag) /* */ \
451 for ( ; (run); (run) = (run)->next ) \
453 if ( ( (run)->hash == (fullhash) ) && \
454 ( (run)->name->len == (l) ) && \
455 ( Str_cnocmp( run->name, var, l, off ) == 0 ) ) \
459 COLLISION_CHECK(tbl, flag); \
462 static const streng
*getdirvalue_compound( tsd_t
*TSD
, var_hashtable
*vars
,
463 const streng
*name
);
466 * Allocates and initializes a hashtable for the variables. Can be used
467 * both for the main variable hash table, or for an compound variable.
469 static var_hashtable
*make_hash_table( const tsd_t
*TSD
, int size
)
471 var_hashtable
*tab
= (var_hashtable
*)MallocTSD( sizeof( var_hashtable
) );
478 size
= ( size
+ 1 ) * sizeof( variableptr
);
479 /* Last element needed to save current_valid */
481 tab
->tbl
= (variableptr
*)MallocTSD( size
);
482 memset( tab
->tbl
, 0, size
);
488 * known_reserved_variable returns 0 if the arguments don't be a known
489 * reserved variable as described in ANSI 6.2.3.1. The value is a
490 * POOL0_??? value otherwise.
492 * The argument don't has to be uppercased but must not contain whitespaces or
495 int known_reserved_variable( const char *name
, unsigned length
)
497 char upper
[20]; /* good maximum for predefined variable names */
500 * a fast breakout switch
502 if ( ( length
< 3 /* ".RC" */)
503 || ( length
> 10 /* ".ENDOFLINE" */)
504 || ( *name
!= '.' ) )
505 return POOL0_NOT_RESERVED
;
509 memcpy( upper
, name
, length
);
510 mem_upper( upper
, (int) length
);
513 * some magic stuff to reduce further errors
515 #define RET_IF(s) if ( ( length == sizeof( #s ) - 1 ) \
516 && ( memcmp( upper, #s, sizeof( #s ) - 1 ) == 0 ) ) \
527 return POOL0_NOT_RESERVED
;
530 void detach( const tsd_t
*TSD
, variableptr ptr
)
533 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
535 TSD
= TSD
; /* keep compiler happy */
538 assert( ptr
->hwired
> 0 );
541 DSTART
;DPRINT((TSD
,"detach: "));DVAR(TSD
,NULL
,ptr
);DEND
;
545 static void mark_ht( var_hashtable
*tab
)
547 variableptr vvptr
, vptr
;
553 markmemory( (char*)tab
->tbl
, TRC_HASHTAB
);
554 for ( i
= 0; i
< tab
->size
; i
++ )
556 for ( vptr
= tab
->tbl
[i
]; vptr
; vptr
= vptr
->next
)
558 markmemory( (char*)vptr
, TRC_VARBOX
);
560 markmemory( (char*)vptr
->name
, TRC_VARNAME
);
563 markmemory( vptr
->num
, TRC_VARVALUE
);
564 markmemory( vptr
->num
->num
, TRC_VARVALUE
);
567 markmemory( (char*)vptr
->value
, TRC_VARVALUE
);
570 markmemory( vptr
->index
, TRC_VARNAME
);
571 for ( j
= 0; j
< vptr
->index
->size
; j
++ )
573 for ( vvptr
= (vptr
->index
->tbl
)[j
]; vvptr
; vvptr
= vvptr
->next
)
575 markmemory( (char*)vvptr
, TRC_VARBOX
);
577 markmemory( (char*)vvptr
->name
, TRC_VARNAME
);
580 markmemory( vvptr
->num
, TRC_VARVALUE
);
581 markmemory( vvptr
->num
->num
, TRC_VARVALUE
);
584 markmemory( (char*)vvptr
->value
, TRC_VARVALUE
);
593 void markvariables( const tsd_t
*TSD
, cproclevel procptr
)
600 vt
= (var_tsd_t
*)TSD
->var_tsd
;
602 for ( ; procptr
; procptr
= procptr
->next
)
604 if ( procptr
->environment
)
605 markmemory( procptr
->environment
, TRC_VARBOX
);
606 if ( procptr
->prev_env
)
607 markmemory( procptr
->prev_env
, TRC_VARBOX
);
610 markmemory( procptr
->sig
, TRC_VARBOX
);
611 if ( procptr
->sig
->info
)
612 markmemory( procptr
->sig
->info
, TRC_VARBOX
);
613 if ( procptr
->sig
->descr
)
614 markmemory( procptr
->sig
->descr
, TRC_VARBOX
);
616 if ( procptr
->signal_continue
)
617 markmemory( procptr
->signal_continue
, TRC_VARBOX
);
618 if ( procptr
->traps
)
620 markmemory( procptr
->traps
, TRC_VARBOX
);
621 for ( i
= 0; i
< SIGNALS
; i
++ )
623 if ( procptr
->traps
[i
].name
)
624 markmemory( procptr
->traps
[i
].name
, TRC_VARBOX
);
628 mark_ht( procptr
->vars
);
629 markmemory( (char*)procptr
,TRC_PROCBOX
);
631 markmemory( (char*)procptr
->vars
, TRC_HASHTAB
);
634 for ( pptr
= procptr
->args
; pptr
; pptr
= pptr
->next
)
636 markmemory( (char*) pptr
, TRC_PROCARG
);
638 markmemory( (char*) pptr
->value
, TRC_PROCARG
);
643 mark_ht( vt
->pool0
);
644 markmemory( (char*)vt
->pool0
, TRC_HASHTAB
);
646 for ( vptr
= vt
->first_invalid
; vptr
; vptr
= vptr
->prev
)
648 markmemory( vptr
, TRC_VARBOX
);
651 #endif /* TRACEMEM */
653 static variableptr
newbox( const tsd_t
*TSD
, const streng
*name
,
654 streng
*value
, variableptr
*oldptr
, unsigned hash
)
659 vt
= (var_tsd_t
*)TSD
->var_tsd
;
661 DSTART
;DPRINT((TSD
,"newbox: "));DNAME(TSD
,NULL
,name
);DPRINT((TSD
," replaces "));
662 DVAR(TSD
,NULL
,*oldptr
);DEND
;
663 newptr
= (variableptr
)MallocTSD( sizeof( variable
) );
665 newptr
->index
= NULL
;
666 newptr
->next
= *oldptr
;
668 newptr
->realbox
= NULL
;
670 newptr
->name
= Str_dupTSD( name
);
673 newptr
->value
= value
;
676 newptr
->flag
= value
? VFLAG_STR
: VFLAG_NONE
;
679 newptr
->valid
= (long) vt
->current_valid
;
683 DSTART
;DPRINT((TSD
,"newbox: "));DVAR(TSD
,"rc",newptr
);DEND
;
687 static variableptr
make_stem( const tsd_t
*TSD
, const streng
*name
,
688 streng
*value
, variableptr
*oldptr
, int len
,
692 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
694 ptr
= newbox( TSD
, NULL
, value
, oldptr
, hash
);
695 ptr
->index
= make_hash_table( TSD
, vt
->initialHashTableLength
);
696 DPRINTF((TSD
,"make_hash_table: rc=%p",ptr
->index
));
697 ptr
->name
= Str_ndupTSD( name
, len
);
698 DSTART
;DPRINT((TSD
,"makestem: "));DVAR(TSD
,"rc",ptr
);DEND
;
708 #define RXVAR ( RXUPPER | RXLOWER | RXEXTRA )
709 #define RXCONST ( RXUPPER | RXLOWER | RXEXTRA | RXDIGIT | RXDOT )
710 #define RXMANT ( RXDIGIT | RXDOT )
711 #define CHAR_TYPE(c) char_types[(unsigned char) ( c )]
712 #define RXISDIGIT(a) ( CHAR_TYPE( a ) & RXDIGIT )
713 #define RXISUPPER(a) ( CHAR_TYPE( a ) & RXUPPER )
714 #define RXISLOWER(a) ( CHAR_TYPE( a ) & RXLOWER )
715 #define RXISEXTRA(a) ( CHAR_TYPE( a ) & RXEXTRA )
716 #define RXISDOT(a) ( CHAR_TYPE( a ) & RXDOT )
717 #define RXISWHITE(a) ( CHAR_TYPE( a ) & RXWHITE )
718 #define RXISVAR(a) ( CHAR_TYPE( a ) & RXVAR )
719 #define RXISCONST(a) ( CHAR_TYPE( a ) & RXCONST )
720 #define RXISMANT(a) ( CHAR_TYPE( a ) & RXMANT )
723 * 04.10.2003, FGC, FIXME: Is it allowed to move to the new scheme of
724 * character manipulation as defined in misc.c? I don't think so, because
725 * the lexer isn't/can't be changed to support CHANGING extended character
726 * sets. If you have a good idea, please let me know.
728 static const unsigned char char_types
[256] =
730 0, 0, 0, 0, 0, 0, 0, 0, /* nul - bel */
731 0, RXWHITE
, RXWHITE
, 0, RXWHITE
, 0, 0, RXWHITE
, /* bs - si */
732 0, 0, 0, 0, 0, 0, 0, 0, /* dle - etb */
733 0, 0, 0, 0, 0, 0, 0, 0, /* can - us */
734 RXWHITE
, RXEXTRA
, 0, RXEXTRA
, RXEXTRA
, 0, 0, 0, /* sp - ' */
735 0, 0, 0, 0, 0, 0, RXDOT
, 0, /* ( - / */
736 RXDIGIT
, RXDIGIT
, RXDIGIT
, RXDIGIT
, RXDIGIT
, RXDIGIT
, RXDIGIT
, RXDIGIT
, /* 0 - 7 */
737 RXDIGIT
, RXDIGIT
, 0, 0, 0, 0, 0, RXEXTRA
, /* 8 - ? */
738 RXEXTRA
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, /* @ - G */
739 RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, /* H - O */
740 RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, RXUPPER
, /* P - W */
741 RXUPPER
, RXUPPER
, RXUPPER
, 0, 0, 0, 0, RXEXTRA
, /* X - _ */
742 0, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, /* ` - g */
743 RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, /* h - o */
744 RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, RXLOWER
, /* p - w */
745 RXLOWER
, RXLOWER
, RXLOWER
, 0, 0, 0, 0, 0, /* x - del */
746 0, 0, 0, 0, 0, 0, 0, 0,
747 0, 0, 0, 0, 0, 0, 0, 0,
748 0, 0, 0, 0, 0, 0, 0, 0,
749 0, 0, 0, 0, 0, 0, 0, 0,
750 0, 0, 0, 0, 0, 0, 0, 0,
751 0, 0, 0, 0, 0, 0, 0, 0,
752 0, 0, 0, 0, 0, 0, 0, 0,
753 0, 0, 0, 0, 0, 0, 0, 0,
754 0, 0, 0, 0, 0, 0, 0, 0,
755 0, 0, 0, 0, 0, 0, 0, 0,
756 0, 0, 0, 0, 0, 0, 0, 0,
757 0, 0, 0, 0, 0, 0, 0, 0,
758 0, 0, 0, 0, 0, 0, 0, 0,
759 0, 0, 0, 0, 0, 0, 0, 0,
760 0, 0, 0, 0, 0, 0, 0, 0,
761 0, 0, 0, 0, 0, 0, 0, 0
765 * valid_var_symbol matches a symbol, which can be either a number, a
766 * var_symbol, or a const_symbol in terms of ANSI 6.3.2.96.
767 * see also: ANSI 6.2.2.29, 6.2.2.31, 6.2.2.35
768 * Note that 6.2.2.32 means to parse an exponential character only if it
769 * it part of a number. Thus, we have to parse the following:
770 * var_symbol=RXVAR RXCONST*
771 * const_symbol=RXCONST+
772 * number=( '.' RXDIGIT+ | ( RXDIGIT+ ( '.' RXDIGIT* )? ) ) exp?
773 * exp=( 'e' | 'E' ) ( '-' | '+' )? RXDIGIT+
774 * We split var_symbol into simple, stem, compound and return all
777 int valid_var_symbol( const streng
*name
)
779 const unsigned char *cptr
,*eptr
;
783 if ( name
->len
== 0 )
786 cptr
= (const unsigned char *) name
->value
;
787 eptr
= cptr
+ name
->len
;
793 * valid begin of a variable name. Lets check it. This can't be
794 * a number, thus we don't care about sign characters.
801 * the last character is properly loaded in ch
803 if ( RXISDOT( ch
) && ( dots
== 1 ) )
806 return SYMBOL_COMPOUND
;
807 return SYMBOL_SIMPLE
;
813 * characters after the first character are the same as of
814 * const_symbol. They don't share the sign behaviour, though.
816 } while ( RXISCONST( ch
) );
822 * Check for a reserved variable first.
823 * In all other cases we may have a number or a const_symbol.
825 if ( KNOWN_RESERVED( (char *)cptr
- 1, name
->len
) )
826 return SYMBOL_SIMPLE
;
830 * Breaking/ending the following loops means to check for a const_symbol
831 * with respect to the absense of a sign character.
835 * A number is a const_symbol with the exception of the sign within
836 * an exponent. Try parsing a number first and fall back to a const
837 * detection on error but keep a seen sign in mind.
842 * Check for a plain dot, which isn't a number, and for a following
846 return SYMBOL_CONSTANT
;
848 if ( !RXISDIGIT( ch
) )
853 return SYMBOL_NUMBER
;
857 * expect just RXDIGITs as the mantissa.
859 } while ( RXISDIGIT( ch
) );
863 if ( !RXISDIGIT( ch
) )
866 * expect RXDIGITs [ '.' RXDIGITs ] as the mantissa.
871 return SYMBOL_NUMBER
;
874 } while ( RXISDIGIT( ch
) );
878 return SYMBOL_NUMBER
;
881 if ( RXISDIGIT( ch
) )
885 return SYMBOL_NUMBER
;
888 } while ( RXISDIGIT( ch
) );
894 * We have to parse an exponent. ch has the current character.
896 if ( ( ch
!= 'e' ) && ( ch
!= 'E' ) )
900 return SYMBOL_CONSTANT
;
903 if ( ( ch
== '+' ) || ( ch
== '-' ) )
907 return SYMBOL_BAD
; /* something like "1.2E+" */
911 * parse the exponent value
913 if ( !RXISDIGIT( ch
) )
917 return SYMBOL_NUMBER
;
920 } while ( RXISDIGIT( ch
) );
926 * We have to check for a const_symbol. If a sign has occured until now
927 * we have a bad symbol.
928 * ch is loaded with the current character.
930 if ( sign
|| !RXISCONST( ch
) )
935 return SYMBOL_CONSTANT
;
938 } while ( RXISCONST( ch
) );
947 * Note: This is one of the most time-consuming routines. Be careful.
948 * It is a define to remove one time-consuming function call.
950 #define hashfunc(vt,name,start,stop,mod) /**/ \
951 (vt->hashval = ( (vt->fullhash = hashvalue_var( name, start, stop )) % \
955 * create a standard sized variable pool in a hash table.
957 var_hashtable
*create_new_varpool( const tsd_t
*TSD
, int size
)
960 var_hashtable
*retval
;
962 vt
= (var_tsd_t
*)TSD
->var_tsd
;
965 size
= vt
->initialHashTableLength
;
967 retval
= make_hash_table( TSD
, size
);
969 DPRINTF((TSD
,"make_hash_table: rc=%p", retval
));
970 DPRINTF((TSD
,"create_new_varpool:current_valid:new=%d, old=%d",
971 vt
->next_current_valid
,vt
->current_valid
));
972 retval
->tbl
[size
] = (variableptr
) vt
->current_valid
;
973 vt
->current_valid
= vt
->next_current_valid
++;
978 void set_ignore_novalue( const tsd_t
*TSD
)
982 vt
= (var_tsd_t
*)TSD
->var_tsd
;
983 vt
->ignore_novalue
= 1;
984 DPRINTF((TSD
,"set_ignore_novalue"));
987 void clear_ignore_novalue( const tsd_t
*TSD
)
991 vt
= (var_tsd_t
*)TSD
->var_tsd
;
992 vt
->ignore_novalue
= 0;
993 DPRINTF((TSD
,"clear_ignore_novalue"));
997 * variables_per_SAA changes the variable pool's interface so that an access by
998 * the SAA API works in the defined way, that is without tracing and without
999 * signalling a NOVALUE condition.
1000 * The returned value must be used to feed restore_variable_state() after the
1003 int variables_per_SAA( tsd_t
*TSD
)
1006 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1008 retval
= vt
->notrace
? 2 : 0;
1009 retval
|= vt
->ignore_novalue
? 1 : 0;
1011 vt
->ignore_novalue
= 1;
1012 DPRINTF((TSD
,"variables_per_SAA"));
1017 * restore_variable_state restores the state that was before the call to
1018 * variables_per_SAA(). Look there.
1020 void restore_variable_state( const tsd_t
*TSD
, int state
)
1022 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1024 vt
->notrace
= ( state
>> 1 ) & 1;
1025 vt
->ignore_novalue
= state
& 1;
1026 DPRINTF((TSD
,"restore_variable_state"));
1029 const streng
*get_it_anyway( tsd_t
*TSD
, const streng
*str
, int pool
)
1034 vt
= (var_tsd_t
*)TSD
->var_tsd
;
1037 vt
->ignore_novalue
= 1;
1038 ptr
= getvalue( TSD
, str
, pool
); /* changes the pool */
1039 vt
->ignore_novalue
= 0;
1043 exiterror( ERR_SYMBOL_EXPECTED
, 1, tmpstr_of( TSD
, str
) );
1045 DSTART
;DPRINT((TSD
,"get_it_anyway: "));DNAME(TSD
,"str",str
);DVALUE(TSD
,", rc",ptr
);DEND
;
1049 const streng
*get_it_anyway_compound( tsd_t
*TSD
, const streng
*str
)
1050 /* as get_it_anyway but specific to getdirvalue_compound */
1055 vt
= (var_tsd_t
*)TSD
->var_tsd
;
1058 vt
->ignore_novalue
= 1;
1059 ptr
= getdirvalue_compound( TSD
, TSD
->currlevel
->vars
, str
);
1060 vt
->ignore_novalue
= 0;
1064 exiterror( ERR_SYMBOL_EXPECTED
, 1, tmpstr_of( TSD
, str
) );
1066 DSTART
;DPRINT((TSD
,"get_it_anyway_compound:"));DNAME(TSD
,"str",str
);DVALUE(TSD
,", rc",ptr
);DEND
;
1070 int var_was_found( const tsd_t
*TSD
)
1074 vt
= (var_tsd_t
*)TSD
->var_tsd
;
1075 DPRINTF((TSD
,"var_was_found: rc=%d",vt
->foundflag
));
1076 return vt
->foundflag
;
1079 const streng
*isvariable( tsd_t
*TSD
, const streng
*str
)
1084 vt
= (var_tsd_t
*)TSD
->var_tsd
;
1085 vt
->ignore_novalue
= 1 ;
1086 ptr
= getvalue( TSD
, str
, -1 ); /* changes the pool */
1087 vt
->ignore_novalue
= 0;
1088 DSTART
;DPRINT((TSD
,"isvariable: "));DNAME(TSD
,"str",str
);
1089 DVALUE(TSD
,", rc",(vt
->foundflag
)?ptr
:NULL
);DEND
;
1090 if ( vt
->foundflag
)
1097 static void mark_variables( const tsd_t
*TSD
)
1102 vt
= (var_tsd_t
*)TSD
->var_tsd
;
1103 markmemory( vt
->tmpindex
, TRC_STATIC
);
1105 markmemory( vt
->ovalue
, TRC_STATIC
);
1107 markmemory( vt
->xvalue
, TRC_STATIC
);
1110 markmemory( vt
->odescr
, TRC_STATIC
);
1111 markmemory( vt
->odescr
->num
, TRC_STATIC
);
1113 for ( i
= 0; i
< POOL0_CNT
; i
++ )
1115 for ( j
= 0; j
< 2; j
++ )
1117 if ( vt
->pool0nodes
[i
][j
].name
!= NULL
)
1119 markmemory( vt
->pool0nodes
[i
][j
].name
, TRC_SPCV_NAME
);
1127 /* init_vars initializes the module.
1128 * Currently, we set up the thread specific data and check for environment
1129 * variables to change debugging behaviour.
1130 * The function returns 1 on success, 0 if memory is short.
1132 int init_vars( tsd_t
*TSD
)
1139 if ( TSD
->var_tsd
!= NULL
)
1142 if ( ( TSD
->var_tsd
= MallocTSD( sizeof( var_tsd_t
) ) ) == NULL
)
1144 vt
= (var_tsd_t
*)TSD
->var_tsd
;
1145 memset( vt
, 0, sizeof( var_tsd_t
) );
1146 vt
->initialHashTableLength
= 2003;
1151 if ( mygetenv( TSD
, "DEBUG_VARIABLE", junk
, sizeof( junk
) ) != NULL
)
1154 if (rx_isdigit(junk
[0]) && ((junk
[1] == ',') || (junk
[1] == '\0'))) {
1155 vt
->DoDebug
= junk
[0] - '0';
1157 vt
->DebugFile
= stderr
;
1158 if (junk
[0] && (junk
[1] == ',')) {
1159 if ((vt
->DebugFile
= fopen(junk
+ 2, "ab")) == NULL
)
1161 vt
->DebugFile
= stderr
;
1165 if ( mygetenv( TSD
, "DEBUG_HASHTABLENGTH", junk
, sizeof( junk
) ) != NULL
)
1170 if (sscanf(junk
, "%d %c", &v
, &c
) == 1)
1172 if ((v
>= 4) && (v
<= 10000))
1174 vt
->initialHashTableLength
= v
;
1182 regmarker( TSD
, mark_variables
);
1184 vt
->current_valid
= 1;
1185 vt
->next_current_valid
= 2;
1186 vt
->tmpindex
= Str_makeTSD( MAX_INDEX_LENGTH
);
1188 * pool 0 is not used by the user in most cases. Keep it small.
1190 vt
->pool0
= create_new_varpool( TSD
, 17 );
1193 * .RC, .RESULT, and .SIGL have dotless counterparts.
1195 vt
->pool0nodes
[POOL0_RC
][0].name
= Str_creTSD( ".RC" );
1196 vt
->pool0nodes
[POOL0_RC
][1].name
= Str_creTSD( "RC" );
1197 vt
->pool0nodes
[POOL0_RESULT
][0].name
= Str_creTSD( ".RESULT" );
1198 vt
->pool0nodes
[POOL0_RESULT
][1].name
= Str_creTSD( "RESULT" );
1199 vt
->pool0nodes
[POOL0_SIGL
][0].name
= Str_creTSD( ".SIGL" );
1200 vt
->pool0nodes
[POOL0_SIGL
][1].name
= Str_creTSD( "SIGL" );
1201 vt
->pool0nodes
[POOL0_RS
][0].name
= Str_creTSD( ".RS" );
1202 vt
->pool0nodes
[POOL0_MN
][0].name
= Str_creTSD( ".MN" );
1203 vt
->pool0nodes
[POOL0_LINE
][0].name
= Str_creTSD( ".LINE" );
1204 vt
->pool0nodes
[POOL0_ENDOFLINE
][0].name
= Str_creTSD( ".ENDOFLINE" );
1205 for ( i
= 0; i
< POOL0_CNT
; i
++ )
1207 for ( j
= 0; j
< 2; j
++ )
1209 if ( vt
->pool0nodes
[i
][j
].name
!= NULL
)
1210 vt
->pool0nodes
[i
][j
].type
= X_SIM_SYMBOL
;
1214 * We can set .ENDOFLINE here
1218 buf
[0] = 0x0a; buf
[1] = 0x00;
1220 buf
[0] = 0x0d; buf
[1] = 0x00;
1222 buf
[0] = 0x0d; buf
[1] = 0x0a; buf
[2] = 0x00;
1224 ptr
= Str_creTSD( buf
);
1225 set_reserved_value( TSD
, POOL0_ENDOFLINE
, ptr
, 0, VFLAG_STR
);
1227 DPRINTF((TSD
,"init_vars"));
1232 * This routine takes a ptr to a linked list of nodes, each describing
1233 * one element in a tail of a compound variable. Each of the elements
1234 * will eventually be cached, since they are retrieved through the
1235 * shortcut() routine.
1237 static streng
*fix_index( tsd_t
*TSD
, nodeptr thisptr
)
1240 const streng
*value
;
1244 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1247 osetting
= vt
->ignore_novalue
;
1248 vt
->ignore_novalue
= 1 ;
1250 DPRINTF((TSD
,"fix_index, start: thisptr=%p",thisptr
));
1251 freespc
= vt
->tmpindex
->max
;
1252 cptr
= vt
->tmpindex
->value
;
1256 assert( thisptr
->type
==X_CTAIL_SYMBOL
|| thisptr
->type
==X_VTAIL_SYMBOL
) ;
1257 if ( thisptr
->type
== X_CTAIL_SYMBOL
)
1258 value
= thisptr
->name
;
1262 value
= shortcut( TSD
, thisptr
) ;
1265 freespc
-= value
->len
;
1266 if ( freespc
-- <= 0 )
1268 large
= Str_makeTSD( vt
->tmpindex
->max
* 2 + value
->len
) ;
1269 memcpy( large
->value
, vt
->tmpindex
->value
, (cptr
-vt
->tmpindex
->value
)) ;
1270 cptr
= large
->value
+ (cptr
-vt
->tmpindex
->value
) ;
1271 freespc
+= (large
->max
- vt
->tmpindex
->max
) ;
1272 Free_stringTSD( vt
->tmpindex
) ;
1273 vt
->tmpindex
= large
;
1275 assert( freespc
>= 0 ) ;
1278 memcpy( cptr
, value
->value
, value
->len
) ;
1279 cptr
+= value
->len
;
1280 thisptr
= thisptr
->p
[0] ;
1286 vt
->tmpindex
->len
= cptr
- vt
->tmpindex
->value
;
1287 assert( vt
->tmpindex
->len
<= vt
->tmpindex
->max
) ;
1288 vt
->ignore_novalue
= osetting
;
1289 DSTART
;DPRINT((TSD
,"fix_index, end: thisptr=%p, "));DVALUE(TSD
,"rc",vt
->tmpindex
);DEND
;
1290 return vt
->tmpindex
;
1293 void expand_to_str( const tsd_t
*TSD
, variableptr ptr
)
1297 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1302 DSTART
;DPRINT((TSD
,"expand_to_str: "));DVAR(TSD
,"ptr",ptr
);DEND
;
1303 if ( flag
& VFLAG_STR
)
1306 if ( flag
& VFLAG_NUM
)
1309 ptr
->value
= str_norm( TSD
, ptr
->num
, ptr
->value
);
1310 ptr
->flag
|= VFLAG_STR
;
1312 DSTART
;DPRINT((TSD
,"expand_to_str: "));DVAR(TSD
,"ptr",ptr
);DEND
;
1315 static streng
*subst_index( const tsd_t
*TSD
, const streng
*name
, int start
,
1316 var_hashtable
*vars
, int *expand
)
1322 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1324 assert( start
< name
->len
) ;
1326 DPRINTF((TSD
,"subst_index: ?"));
1327 vt
->tmpindex
->len
= 0;
1332 nptr
= vars
->tbl
[hashfunc( vt
, name
, start
, &stop
, vars
->size
)];
1335 length
= stop
- start
;
1336 SEEK_VAR_CNOCMP( nptr
, name
, vt
->fullhash
, vars
, length
, start
, *expand
);
1337 SEEK_EXPOSED( nptr
);
1340 expand_to_str( TSD
, nptr
);
1342 if ( nptr
&& nptr
->value
)
1344 Str_catTSD( vt
->tmpindex
, nptr
->value
);
1349 cptr
= vt
->tmpindex
->value
+ vt
->tmpindex
->len
;
1350 for ( i
= start
; i
< stop
; i
++ )
1351 *cptr
++ = (char) rx_toupper( name
->value
[i
] );
1352 vt
->tmpindex
->len
= cptr
- vt
->tmpindex
->value
;
1355 if ( stop
>= Str_len( name
) )
1359 vt
->tmpindex
->value
[vt
->tmpindex
->len
++] = '.';
1362 return vt
->tmpindex
;
1366 * TRACEMEM_RELINK relinks a variablebox in the queue of vt->first_invalid.
1369 # define TRACEMEM_RELINK(ptr) { \
1370 ptr->prev = vt->first_invalid; \
1372 if ( vt->first_invalid ) \
1373 vt->first_invalid->next = ptr; \
1374 vt->first_invalid = ptr; \
1377 # define TRACEMEM_RELINK(ptr)
1381 * REMOVE_ELEMENT deletes the content of a variableptr.
1382 * The variable itself is NOT freed in most cases. The hollow body of the
1383 * variable persists. As far as I understood my old stuff, this prevents a
1384 * new variable lookup.
1386 #define REMOVE_ELEMENT(ptr, hashtbl) { \
1387 DSTART;DPRINT((TSD," "));DVAR(TSD,"ptr(del)",ptr);DEND; \
1388 Free_stringTSD( ptr->name ); \
1390 Free_stringTSD( ptr->value ); \
1394 FreeTSD( ptr->num->num ); \
1395 FreeTSD( ptr->num ); \
1398 if ( ptr->hwired ) \
1401 TRACEMEM_RELINK( ptr ); \
1411 * remove_foliage removes all elements of a stem unconditionally.
1412 * Exposed values, better the values and variables the current elements points
1413 * to, are not affected.
1414 * The stem's index itself is freed, too.
1416 static void remove_foliage( const tsd_t
*TSD
, var_hashtable
*index
)
1418 #if defined(DEBUG) || defined(TRACEMEM)
1419 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1420 unsigned start
= index
->e
;
1423 variableptr ptr
, tptr
;
1425 DPRINTF((TSD
,"remove_foliage: ?"));
1429 for ( i
= 0; i
< index
->size
; i
++ )
1431 if ( ( ptr
= index
->tbl
[i
] ) == NULL
)
1436 * Not needed here but it indicates an error elsewhere:
1438 /*assert( ptr->stem );*/
1445 * This indicates a serious problem. Regina doesn't allow branches
1446 * currently. (branch = stem within a stem)
1448 assert( ptr
->index
);
1449 remove_foliage( TSD
, ptr
->index
);
1452 REMOVE_ELEMENT( ptr
, index
);
1455 } while ( ptr
!= NULL
);
1457 FreeTSD( index
->tbl
);
1458 DPRINTF((TSD
," kill=%p",index
));
1459 DPRINTF_2((TSD
,"STATISTICS: %u(%u) in %u buckets, %u r, %u w, %u colls",
1460 index
->e
, start
, index
->size
, index
->r
,
1461 index
->w
, index
->c
));
1466 * assign_foliage manipulates the index of a stem. The index is the list of all
1467 * variables in the stem.
1468 * value is the value for the replacement and is read-only. The value may be
1470 * Each element in the index is either removed or reassigned depending on the
1471 * fact whether the element is local or exposed. A value of NULL leads to a
1472 * complete removal of the element which is equivalent to a "drop".
1473 * This fixes bug 732146, which removed all elements unconditionally after
1475 * ANSI 7.1.2 and 7.1.4 forces us to assign all exposed elements or to delete
1476 * all exposed elements. Note that a dropped and exposed variable should be
1477 * assigned in the formerly used variable pool (aka index), so we use a
1478 * technique which allows us to lookup such values (we don't delete the realbox
1479 * chain). On the other hand we really remove local variables to save space.
1481 static void assign_foliage( const tsd_t
*TSD
, var_hashtable
*index
,
1484 #if defined(DEBUG) || defined(TRACEMEM)
1485 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1489 variableptr ptr
, tptr
, *queue
, real
;
1490 streng
*nullptr = NULL
; /* allow REPLACE_VALUE macro to pass NULL value under C++ */
1492 DPRINTF((TSD
,"assign_foliage: ?"));
1496 for ( i
= 0; i
< index
->size
; i
++ )
1498 if ( ( ptr
= index
->tbl
[i
] ) == NULL
)
1501 queue
= &index
->tbl
[i
];
1505 * Not needed here but it indicates an error elsewhere:
1507 assert( ptr
->stem
);
1512 * We can't handle sub-stems.
1514 assert( ptr
->index
== NULL
);
1522 copy
= Str_dupTSD( val
);
1523 REPLACE_VALUE( copy
, real
);
1524 DSTART
;DPRINT((TSD
," "));DVAR(TSD
,"real(now)",real
);DEND
;
1526 else if ( real
->value
)
1528 REPLACE_VALUE( nullptr, real
);
1529 DSTART
;DPRINT((TSD
," "));DVAR(TSD
,"real(now)",real
);DEND
;
1533 queue
= &(ptr
->next
);
1539 REMOVE_ELEMENT( ptr
, index
);
1543 copy
= Str_dupTSD( val
);
1544 REPLACE_VALUE( copy
, ptr
);
1545 DSTART
;DPRINT((TSD
," "));DVAR(TSD
,"ptr(now)",ptr
);DEND
;
1547 queue
= &(ptr
->next
);
1552 } while ( ptr
!= NULL
);
1557 #undef REMOVE_ELEMENT
1558 #undef TRACEMEM_RELINK
1561 * reorgHashtable reorganises the hash table vars if a potential for better
1562 * results in the future is seen.
1563 * returns 0 if the table has its original structure.
1564 * returns 1 if the table has been reorganised.
1566 static int reorgHashtable( const tsd_t
*TSD
, var_hashtable
*vars
)
1569 unsigned newSize
, i
;
1570 variableptr
*newTbl
, *dest
;
1571 variableptr thisptr
, run
;
1573 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1576 NEW_HASHTABLE_CHECK( vars
, f1
);
1577 COLLISION_CHECK( vars
, f2
);
1581 * May happen in case of f2 where a ->r or ->w is set after the
1582 * collision detection. Ignore it. That is no bug.
1584 DPRINTF_2((TSD
,"reorgHashtable: %p/%p: BLIND ALERT", vars
, vars
->tbl
));
1589 * Try to use a low water mark of 33% capacity. If the collisions are
1590 * the reason, go below 25% capacity. (Now 20% G Fuchs 18/8/2008)
1592 newSize
= vars
->e
* ( ( f2
) ? 5 : 3 );
1593 if ( vars
->size
>= newSize
)
1596 * We can't help. Check the stupid hashfunc() in this case.
1598 DPRINTF_2((TSD
,"reorgHashtable: %p/%p: heavy collisions %u",
1599 vars
, vars
->tbl
, vars
->c
));
1606 newTbl
= (variableptr
*)MallocTSD( sizeof(variableptr
) * newSize
);
1607 memset( newTbl
, 0, sizeof(variableptr
) * newSize
);
1608 DPRINTF((TSD
,"reorgHashtable: %p -> %p Old(%u) New(%u)",
1609 vars
->tbl
,newTbl
,vars
->size
, newSize
));
1610 DPRINTF_2((TSD
,"reorgHashtable: changing size of %p/%p (%u) to %p/%p (%u), c=%u(%d)",
1611 vars
,vars
->tbl
,vars
->size
,vars
,newTbl
,newSize
, vars
->c
,f2
));
1613 for ( i
= 0; i
< vars
->size
; i
++ )
1622 dest
= newTbl
+ (thisptr
->hash
% newSize
);
1625 (*dest
)->prev
= thisptr
;
1627 thisptr
->next
= *dest
;
1629 thisptr
->prev
= NULL
;
1633 FreeTSD( vars
->tbl
);
1635 vars
->size
= newSize
;
1642 static variableptr
findsimple( const tsd_t
*TSD
, var_hashtable
*vars
,
1643 const streng
*name
, int *expand
)
1646 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1648 ptr
= vars
->tbl
[hashfunc( vt
, name
, 0, NULL
, vars
->size
)];
1649 SEEK_VAR_CCMP( ptr
, name
, vt
->fullhash
, vars
, *expand
);
1650 SEEK_EXPOSED( ptr
);
1653 DSTART
;DPRINT((TSD
,"findsimple: "));DNAME(TSD
,"name",name
);
1654 DVAR(TSD
,", vt->thespot=ptr",ptr
);DEND
;
1659 static int setvalue_simple( const tsd_t
*TSD
, var_hashtable
*vars
,
1660 const streng
*name
, streng
*value
)
1664 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1667 ptr
= findsimple( TSD
, vars
, name
, &rehash
);
1670 vt
->foundflag
= ptr
->flag
& VFLAG_BOTH
;
1671 REPLACE_VALUE( value
, ptr
);
1672 DSTART
;DPRINT((TSD
,"setvalue_simple: "));DVAR(TSD
,"replacement",ptr
);DEND
;
1677 vt
->thespot
= newbox( TSD
, name
, value
, &vars
->tbl
[vt
->hashval
],
1680 NEW_HASHTABLE_CHECK( vars
, rehash
);
1681 DSTART
;DPRINT((TSD
,"setvalue_simple: "));DVAR(TSD
,"new, vt->thespot",ptr
);DEND
;
1685 return reorgHashtable( TSD
, vars
);
1690 static const streng
*getvalue_simple( tsd_t
*TSD
, var_hashtable
*vars
,
1691 const streng
*name
)
1694 const streng
*value
;
1696 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1699 ptr
= findsimple( TSD
, vars
, name
, &rehash
);
1702 reorgHashtable( TSD
, vars
);
1705 vt
->foundflag
= ptr
&& ( ptr
->flag
& VFLAG_BOTH
);
1708 expand_to_str( TSD
, ptr
);
1710 if ( vt
->foundflag
)
1716 if ( !vt
->ignore_novalue
)
1717 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( value
), NULL
);
1721 tracevalue( TSD
, value
,(char) ( (ptr
) ? 'V' : 'L' ) );
1723 DSTART
;DPRINT((TSD
,"getvalue_simple: "));DNAME(TSD
,"name",name
);
1724 DVALUE(TSD
," rc",value
);DEND
;
1728 static int setvalue_stem( const tsd_t
*TSD
, var_hashtable
*vars
,
1729 const streng
*name
, streng
*value
)
1733 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1735 DPRINTF((TSD
,"setvalue_stem: ?"));
1738 ptr
= findsimple( TSD
, vars
, name
, &rehash
);
1742 vt
->foundflag
= ( ptr
->flag
& VFLAG_BOTH
);
1743 REPLACE_VALUE( value
, ptr
);
1745 assign_foliage( TSD
, ptr
->index
, value
);
1750 make_stem( TSD
, name
, value
, &vars
->tbl
[vt
->hashval
], name
->len
,
1753 NEW_HASHTABLE_CHECK( vars
, rehash
);
1758 return reorgHashtable( TSD
, vars
);
1763 static int setvalue_compound( tsd_t
*TSD
, var_hashtable
*vars
,
1764 const streng
*name
, streng
*value
)
1766 variableptr ptr
, nptr
, *nnptr
, *pptr
;
1767 int stop
, rehash
= 0, rehashIdx
= 0;
1769 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1771 DPRINTF((TSD
,"setvalue_compound: ?"));
1773 pptr
= &vars
->tbl
[hashfunc( vt
, name
, 0, &stop
, vars
->size
)];
1776 SEEK_VAR_CNCMP( ptr
, name
, vt
->fullhash
, vars
, stop
, rehash
);
1777 SEEK_EXPOSED( ptr
);
1781 ptr
= make_stem( TSD
, name
, NULL
, pptr
, stop
, vt
->fullhash
);
1783 NEW_HASHTABLE_CHECK( vars
, rehash
);
1791 indexstr
= subst_index( TSD
, name
, stop
, vars
, &rehash
);
1795 rehash
= reorgHashtable( TSD
, vars
);
1798 if ( vt
->subst
) /* trace it */
1799 tracecompound( TSD
, name
, stop
- 1, indexstr
, 'C' );
1802 nnptr
= &(ptr
->index
->tbl
[hashfunc( vt
, indexstr
, 0, NULL
, ptr
->index
->size
)]);
1804 SEEK_VAR_CMP( nptr
, indexstr
, vt
->fullhash
, ptr
->index
, rehashIdx
);
1805 SEEK_EXPOSED( nptr
);
1809 vt
->foundflag
= nptr
&& ( nptr
->flag
& VFLAG_BOTH
) ;
1810 REPLACE_VALUE( value
, nptr
);
1814 newbox( TSD
, indexstr
, value
, nnptr
, vt
->fullhash
);
1816 NEW_HASHTABLE_CHECK( ptr
->index
, rehashIdx
);
1817 (*nnptr
)->stem
= ptr
;
1823 rehashIdx
= reorgHashtable( TSD
, ptr
->index
);
1825 return rehash
| rehashIdx
;
1828 /* JH 20-10-99 */ /* To make Direct setting of stems Direct and not Symbolic. */
1829 /****************************************************************************
1831 * JH 13/12/1999 (Original code changes on 20/10/1999)
1833 * BUG022 To make Direct setting of stems Direct and not Symbolic.
1834 * - Adapted from setvalue_compound().
1835 * - Started using the global variable, vt->tmpindex, in place of the local,
1837 * - manually move the first stem name into vt->tmpindex, do not call
1838 * subst_index(), as that not only uppercases the tail, but also
1839 * does not uppercase the tail.
1842 ****************************************************************************/
1843 static int setdirvalue_compound( tsd_t
*TSD
, var_hashtable
*vars
,
1844 const streng
*name
, streng
*value
)
1846 variableptr ptr
, nptr
, *nnptr
, *pptr
;
1847 int rehash
= 0, rehashIdx
= 0;
1849 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1851 DPRINTF((TSD
,"setdirvalue_compound: ?"));
1855 * Get a good starting point, and find the stem/index separater.
1857 pptr
= &vars
->tbl
[hashfunc( vt
, name
, 0, &stop
, vars
->size
)];
1861 * Find the stem in the variable pool.
1864 SEEK_VAR_CNCMP( ptr
, name
, vt
->fullhash
, vars
, stop
, rehash
);
1865 SEEK_EXPOSED( ptr
);
1868 * If the stem does not exist, make one.
1872 ptr
= make_stem( TSD
, name
, NULL
, pptr
, stop
, vt
->fullhash
);
1874 NEW_HASHTABLE_CHECK( vars
, rehash
);
1884 rehash
= reorgHashtable( TSD
, vars
);
1887 vt
->tmpindex
->len
= 0;
1888 vt
->tmpindex
= Str_nocatTSD( vt
->tmpindex
, name
, name
->len
- stop
, stop
);
1891 * FIXME, FGC: vt->subst from "if" removed, but what shall we do here really?
1893 if ( !vt
->notrace
) /* trace it */
1894 tracecompound( TSD
, name
, stop
- 1, vt
->tmpindex
, 'C' );
1896 nnptr
= &((ptr
->index
->tbl
)[hashfunc( vt
, vt
->tmpindex
, 0, NULL
,
1897 ptr
->index
->size
)]);
1900 SEEK_VAR_CMP( nptr
, vt
->tmpindex
, vt
->fullhash
, ptr
->index
, rehashIdx
);
1901 SEEK_EXPOSED( nptr
);
1905 vt
->foundflag
= nptr
&& ( nptr
->flag
& VFLAG_BOTH
);
1906 REPLACE_VALUE( value
, nptr
);
1910 newbox( TSD
, vt
->tmpindex
, value
, nnptr
, vt
->fullhash
);
1912 NEW_HASHTABLE_CHECK( ptr
->index
, rehashIdx
);
1913 (*nnptr
)->stem
= ptr
;
1919 rehashIdx
= reorgHashtable( TSD
, ptr
->index
);
1921 return rehash
| rehashIdx
;
1924 static void expose_simple( const tsd_t
*TSD
, var_hashtable
*vars
,
1925 const streng
*name
)
1927 unsigned hashv
, hashn
;
1930 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1932 hashv
= hashfunc( vt
, name
, 0, NULL
, vt
->var_table
->size
);
1933 ptr
= vt
->var_table
->tbl
[hashv
];
1935 SEEK_VAR_CCMP( ptr
, name
, vt
->fullhash
, vt
->var_table
, rehash
);
1937 if ( ptr
) /* hey, you just exposed that one! */
1940 rehash
= 0; /* ignore here */
1941 hashn
= vt
->fullhash
% vars
->size
;
1942 ptr
= vars
->tbl
[hashn
];
1944 SEEK_VAR_CCMP( ptr
, name
, vt
->fullhash
, vars
, rehash
);
1945 SEEK_EXPOSED( ptr
);
1949 newbox( TSD
, name
, NULL
, &vars
->tbl
[hashn
], vt
->fullhash
);
1951 NEW_HASHTABLE_CHECK( vars
, rehash
);
1952 ptr
= vars
->tbl
[hashn
];
1957 reorgHashtable( TSD
, vars
);
1961 newbox( TSD
, name
, NULL
, &vt
->var_table
->tbl
[hashv
], vt
->fullhash
);
1963 NEW_HASHTABLE_CHECK( vt
->var_table
, rehash
);
1964 vt
->var_table
->tbl
[hashv
]->realbox
= ptr
;
1966 * exposing is done after create_new_varpool/assignment of current_valid:
1968 vt
->var_table
->tbl
[hashv
]->realbox
->valid
= vt
->current_valid
;
1971 reorgHashtable( TSD
, vt
->var_table
);
1974 DSTART
;DPRINT((TSD
,"expose_simple: "));DNAME(TSD
,"name",name
);DEND
;
1977 static void expose_stem( const tsd_t
*TSD
, var_hashtable
*vars
,
1978 const streng
*name
)
1980 variableptr ptr
,tptr
;
1981 unsigned hashv
, hashn
;
1982 int junk
, rehash
= 0;
1983 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
1985 DPRINTF((TSD
,"expose_stem: ?"));
1986 hashv
= hashfunc(vt
, name
, 0, &junk
, vt
->var_table
->size
);
1987 ptr
= vt
->var_table
->tbl
[hashv
];
1989 SEEK_VAR_CCMP( ptr
, name
, vt
->fullhash
, vt
->var_table
, rehash
);
1991 if ( ptr
&& ptr
->realbox
)
1992 return; /* once is enough !!! */
1995 hashn
= vt
->fullhash
% vars
->size
;
1996 tptr
= vars
->tbl
[hashn
];
1998 SEEK_VAR_CCMP( tptr
, name
, vt
->fullhash
, vars
, rehash
);
1999 SEEK_EXPOSED( tptr
);
2003 newbox( TSD
, name
, NULL
, &vars
->tbl
[hashn
], vt
->fullhash
);
2005 NEW_HASHTABLE_CHECK( vars
, rehash
);
2006 tptr
= vars
->tbl
[hashn
];
2007 tptr
->index
= make_hash_table( TSD
, vt
->initialHashTableLength
);
2008 DPRINTF((TSD
,"make_hash_table: rc=%p",tptr
->index
));
2012 reorgHashtable( TSD
, vars
);
2019 * The stem has been generated by an "expose STEM.x ... " and we now
2020 * have the variable "STEM.". The "STEM.x" had produced a new copy of
2021 * "STEM." because of the need to access "STEM.x", but now we have to
2022 * expose everything of "STEM.". We remove the index with the
2023 * realbox-chain of ".x" and make this "STEM." point to the exposed one.
2025 remove_foliage( TSD
, ptr
->index
);
2027 assert( ( ptr
->realbox
== NULL
) || ( ptr
->realbox
== tptr
) );
2028 ptr
->realbox
= tptr
;
2032 newbox( TSD
, name
, NULL
, &vt
->var_table
->tbl
[hashv
], vt
->fullhash
);
2034 NEW_HASHTABLE_CHECK( vt
->var_table
, rehash
);
2035 vt
->var_table
->tbl
[hashv
]->realbox
= tptr
; /* dont need ->index */
2039 reorgHashtable( TSD
, vt
->var_table
);
2043 static void expose_compound( tsd_t
*TSD
, var_hashtable
*vars
,
2044 const streng
*name
)
2046 unsigned hashv
, hashn
, fh
, hashv2
, hashn2
;
2047 int length
, rehash
= 0;
2049 variableptr ptr
, nptr
, tptr
, tiptr
;
2052 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2054 DPRINTF((TSD
,"expose_compound: ?"));
2055 hashv
= hashfunc( vt
, name
, 0, &cptr
, vt
->var_table
->size
);
2056 ptr
= vt
->var_table
->tbl
[hashv
];
2060 SEEK_VAR_CNCMP( ptr
, name
, fh
, vt
->var_table
, length
, rehash
);
2061 if ( ptr
&& ptr
->realbox
)
2062 return; /* whole array already exposed */
2064 hashn
= fh
% vars
->size
;
2065 if ( !ptr
) /* array does not exist */
2067 make_stem( TSD
, name
, NULL
, &vt
->var_table
->tbl
[hashv
], length
, fh
);
2069 NEW_HASHTABLE_CHECK( vt
->var_table
, rehash
);
2070 ptr
= vt
->var_table
->tbl
[hashv
];
2073 indexstr
= subst_index( TSD
, name
, cptr
, vt
->var_table
, &rehash
);
2077 reorgHashtable( TSD
, vt
->var_table
);
2081 if ( vt
->subst
) /* trace it */
2082 tracecompound( TSD
, name
, cptr
- 1, indexstr
, 'C');
2084 hashv2
= hashfunc( vt
, indexstr
, 0, NULL
, ptr
->index
->size
);
2085 nptr
= ptr
->index
->tbl
[hashv2
];
2087 SEEK_VAR_CMP( nptr
, indexstr
, vt
->fullhash
, ptr
->index
, rehash
);
2089 if ( nptr
&& nptr
->realbox
)
2093 newbox( TSD
, indexstr
, NULL
, &ptr
->index
->tbl
[hashv2
], vt
->fullhash
);
2095 NEW_HASHTABLE_CHECK( ptr
->index
, rehash
);
2096 nptr
= ptr
->index
->tbl
[hashv2
];
2101 reorgHashtable( TSD
, ptr
->index
);
2105 tptr
= vars
->tbl
[hashn
];
2107 SEEK_VAR_CNCMP( tptr
, name
, fh
, vars
, length
, rehash
);
2108 SEEK_EXPOSED( tptr
);
2112 make_stem( TSD
, name
, NULL
, &vars
->tbl
[hashn
], length
, fh
);
2114 NEW_HASHTABLE_CHECK( vars
, rehash
);
2115 tptr
= vars
->tbl
[hashn
];
2119 reorgHashtable( TSD
, vars
);
2123 hashn2
= vt
->fullhash
% tptr
->index
->size
;
2124 tiptr
= tptr
->index
->tbl
[hashn2
];
2126 SEEK_VAR_CMP( tiptr
, indexstr
, vt
->fullhash
, tptr
->index
, rehash
);
2127 SEEK_EXPOSED( tiptr
);
2132 * hopefully no new setting of vt->fullhash has happened during the last
2135 newbox( TSD
, indexstr
, NULL
, &tptr
->index
->tbl
[hashn2
], vt
->fullhash
);
2137 NEW_HASHTABLE_CHECK( tptr
->index
, rehash
);
2138 tiptr
= tptr
->index
->tbl
[hashn2
];
2143 reorgHashtable( TSD
, tptr
->index
);
2146 nptr
->realbox
= tiptr
;
2149 static const streng
*getvalue_compound( tsd_t
*TSD
, var_hashtable
*vars
,
2150 const streng
*name
)
2155 variableptr ptr
, nptr
;
2159 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2161 DPRINTF((TSD
,"getvalue_compound: ?"));
2162 hashv
= hashfunc( vt
, name
, 0, &stop
, vars
->size
);
2163 ptr
= vars
->tbl
[hashv
];
2164 baselength
= ++stop
;
2166 SEEK_VAR_CNCMP( ptr
, name
, vt
->fullhash
, vars
, baselength
, rehash
);
2167 SEEK_EXPOSED( ptr
);
2169 indexstr
= subst_index( TSD
, name
, stop
, vars
, &rehash
);
2173 reorgHashtable( TSD
, vars
);
2177 if ( vt
->subst
&& !vt
->notrace
) /* trace it */
2178 tracecompound( TSD
, name
, baselength
- 1, indexstr
, 'C' );
2182 hashv
= hashfunc( vt
, indexstr
, 0, NULL
, ptr
->index
->size
);
2183 nptr
= ptr
->index
->tbl
[hashv
];
2185 SEEK_VAR_CMP( nptr
, indexstr
, vt
->fullhash
, ptr
->index
, rehash
);
2186 SEEK_EXPOSED( nptr
);
2188 if ( !nptr
) /* find default value */
2191 vt
->foundflag
= nptr
->flag
& VFLAG_BOTH
;
2192 expand_to_str( TSD
, nptr
);
2201 reorgHashtable( TSD
, ptr
->index
);
2204 if ( vt
->foundflag
)
2205 value
= nptr
->value
;
2208 if ( !vt
->ignore_novalue
)
2209 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( name
), NULL
) ;
2212 Free_stringTSD( vt
->ovalue
);
2214 vt
->ovalue
= value
= Str_makeTSD( stop
+ 1 + Str_len( indexstr
) );
2215 Str_ncatTSD( value
, name
, stop
);
2216 Str_catTSD( value
, indexstr
);
2223 /* JH 20-10-99 */ /* To make Direct setting of stems Direct and not Symbolic. */
2224 /****************************************************************************
2226 * JH 13/12/1999 (Original code changes on 20/10/1999)
2228 * BUG022 To make Direct setting of stems Direct and not Symbolic.
2229 * - Adapted from getvalue_compound().
2230 * - Started using the global variable, vt->tmpindex, in place of the local,
2232 * - manually move the first stem name into vt->tmpindex, do not call
2233 * subst_index(), as that not only uppercases the tail, but also
2234 * does not uppercase the tail.
2237 ****************************************************************************/
2238 static const streng
*getdirvalue_compound( tsd_t
*TSD
, var_hashtable
*vars
,
2239 const streng
*name
)
2241 int baselength
, rehash
= 0;
2243 variableptr ptr
, nptr
;
2246 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2248 DPRINTF((TSD
,"getdirvalue_compound: ?"));
2250 * Get a good starting point, and find the stem/index separater.
2252 hashv
= hashfunc( vt
, name
, 0, &stop
, vars
->size
);
2253 ptr
= vars
->tbl
[hashv
];
2254 baselength
= ++stop
;
2257 * Find the stem in the variable pool.
2259 SEEK_VAR_CNCMP( ptr
, name
, vt
->fullhash
, vars
, baselength
, rehash
);
2260 SEEK_EXPOSED( ptr
);
2264 reorgHashtable( TSD
, vars
);
2268 vt
->tmpindex
->len
= 0;
2269 vt
->tmpindex
= Str_nocatTSD( vt
->tmpindex
, name
, name
->len
- stop
, stop
);
2272 * FIXME, FGC: vt->subst from "if" removed, but what shall we do here really?
2274 if ( !vt
->notrace
) /* trace it */
2275 tracecompound( TSD
, name
, baselength
- 1, vt
->tmpindex
, 'C' );
2279 hashv
= hashfunc( vt
, vt
->tmpindex
, 0, NULL
, ptr
->index
->size
);
2280 nptr
= ptr
->index
->tbl
[hashv
];
2283 * Find the index in the variable pool.
2285 SEEK_VAR_CMP( nptr
, vt
->tmpindex
, vt
->fullhash
, ptr
->index
, rehash
);
2286 SEEK_EXPOSED( nptr
);
2289 * If the stem exists, but the index doesn't, this counts as found.
2291 if ( !nptr
) /* find default value */
2294 vt
->foundflag
= nptr
->flag
& VFLAG_BOTH
;
2295 expand_to_str( TSD
, nptr
);
2304 reorgHashtable( TSD
, ptr
->index
);
2308 if ( vt
->foundflag
)
2309 value
= nptr
->value
;
2312 if ( !vt
->ignore_novalue
)
2313 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( name
), NULL
) ;
2316 * Since this is a direct, we can use the name without change.
2318 value
= (streng
*) name
;
2326 * getPool returns the variable pool of the specified pool number. The number
2327 * may be -1 for "autoselect". *isRes is set to 1 if the name is a reserved
2328 * variable, 0 otherwise.
2330 static var_hashtable
*getPool( const tsd_t
*TSD
, const streng
*name
, int pool
,
2333 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2337 if ( KNOWN_RESERVED( name
->value
, Str_len( name
) ) )
2340 if ( ( pool
== 0 ) || ( pool
== -1 ) )
2350 return TSD
->currlevel
->vars
;
2353 * The slow part. We have to find the true pool for the given number.
2354 * Each system manages a part of the proclevels. We have to walk back
2355 * through the sysinfo chain until we find the containing system and
2356 * pick up the desired proclevel afterwards.
2358 s
= TSD
->systeminfo
;
2359 while ( s
->currlevel0
->pool
> pool
)
2362 assert( s
!= NULL
);
2365 if ( s
== TSD
->systeminfo
)
2368 * We can use the previous-chain which may be faster.
2370 if ( pool
> ( TSD
->currlevel
->pool
- s
->currlevel0
->pool
) / 2
2371 + s
->currlevel0
->pool
)
2374 while ( p
->pool
!= pool
)
2377 assert( p
!= NULL
);
2384 while ( p
->pool
!= pool
)
2387 assert( p
!= NULL
);
2393 * This is the entry-level routine that will take the parameters,
2394 * decide what kind of variable it is (simple, stem or compound) and
2395 * call the appropriate routine to do the dirty work.
2396 * pool is -1 (select the appropriate one) or a pool number.
2398 void setvalue( tsd_t
*TSD
, const streng
*name
, streng
*value
, int pool
)
2400 int i
, isRes
, len
=Str_len( name
);
2401 var_hashtable
*vars
;
2403 assert( value
->len
<= value
->max
);
2405 vars
= getPool( TSD
, name
, pool
, &isRes
);
2408 setvalue_simple( TSD
, vars
, name
, value
);
2411 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2415 setvalue_simple( TSD
, vars
, name
, value
);
2416 else if ( i
+ 1 == len
)
2417 setvalue_stem( TSD
, vars
, name
, value
);
2419 setvalue_compound( TSD
, vars
, name
, value
);
2424 * This is the entry-level routine used by the Variable Pool Interface
2425 * to set stem variables directly. (no translation on the index name.)
2426 * As setvalue() does, it will take the parameters,
2427 * decide what kind of variable it is (simple, stem or compound) and
2428 * call the appropriate routine to do the dirty work
2430 /* JH 20-10-99 */ /* To make Direct setting of stems Direct and not Symbolic. */
2431 /****************************************************************************
2433 * JH 13/12/1999 (Original code changes on 20/10/1999)
2435 * BUG022 To make Direct setting of stems Direct and not Symbolic.
2436 * - Adapted from setvalue().
2437 * - changed call from setvalue_compound() to setdirvalue_compound().
2440 ****************************************************************************/
2441 void setdirvalue( tsd_t
*TSD
, const streng
*name
, streng
*value
)
2444 int i
, len
=Str_len( name
);
2445 var_hashtable
*vars
;
2447 assert( value
->len
<= value
->max
);
2449 if ( KNOWN_RESERVED( name
->value
, len
) )
2451 vt
= (var_tsd_t
*)TSD
->var_tsd
;
2452 setvalue_simple( TSD
, vt
->pool0
, name
, value
);
2456 vars
= TSD
->currlevel
->vars
;
2458 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2462 setvalue_simple( TSD
, vars
, name
, value
);
2463 else if ( i
+ 1 == len
)
2464 setvalue_stem( TSD
, vars
, name
, value
);
2466 setdirvalue_compound( TSD
, vars
, name
, value
);
2470 void expose_var( tsd_t
*TSD
, const streng
*name
)
2473 var_hashtable
*vars
;
2474 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2476 if ( !vt
->var_table
)
2479 * First call to expose_var of X_PROC in interpret().
2482 vt
->var_table
= create_new_varpool( TSD
, 0 );
2488 * Last call to expose_var of X_PROC in interpret().
2489 * Use the new table as the current table.
2491 TSD
->currlevel
->vars
= vt
->var_table
;
2492 TSD
->currlevel
->varflag
= 1;
2493 vt
->var_table
= NULL
;
2497 len
= Str_len( name
);
2498 if ( KNOWN_RESERVED( name
->value
, len
) )
2499 expose_simple( TSD
, vt
->pool0
, name
);
2502 vars
= TSD
->currlevel
->vars
;
2504 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2508 expose_simple( TSD
, vars
, name
);
2509 else if ( i
+ 1 == len
)
2510 expose_stem( TSD
, vars
, name
);
2512 expose_compound( TSD
, vars
, name
);
2516 const streng
*getvalue( tsd_t
*TSD
, const streng
*name
, int pool
)
2518 int i
, isRes
, len
=Str_len( name
);
2519 var_hashtable
*vars
;
2521 vars
= getPool( TSD
, name
, pool
, &isRes
);
2524 return getvalue_simple( TSD
, vars
, name
);
2526 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2530 * getvalue_stem is equivalent to getvalue_simple
2533 return getvalue_simple( TSD
, vars
, name
);
2535 return getvalue_compound( TSD
, vars
, name
);
2538 /* JH 20-10-99 */ /* To make Direct setting of stems Direct and not Symbolic. */
2539 /****************************************************************************
2541 * JH 13/12/1999 (Original code changes on 20/10/1999)
2543 * BUG022 To make Direct setting of stems Direct and not Symbolic.
2544 * - Adapted from getvalue().
2545 * - changed call from getvalue_compound() to getdirvalue_compound().
2548 ****************************************************************************/
2549 const streng
*getdirvalue( tsd_t
*TSD
, const streng
*name
)
2552 int i
, len
=Str_len( name
);
2553 var_hashtable
*vars
;
2555 if ( ( i
= KNOWN_RESERVED( name
->value
, len
) ) != 0 )
2557 vt
= (var_tsd_t
*)TSD
->var_tsd
;
2558 return getvalue_simple( TSD
, vt
->pool0
, name
);
2561 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2564 vars
= TSD
->currlevel
->vars
;
2567 return getvalue_simple( TSD
, vars
, name
);
2569 return getdirvalue_compound( TSD
, vars
, name
);
2572 static void drop_var_simple( const tsd_t
*TSD
, var_hashtable
*vars
,
2573 const streng
*name
)
2577 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2580 ptr
= findsimple( TSD
, vars
, name
, &rehash
);
2581 DSTART
;DPRINT((TSD
,"drop_var_simple: "));DNAME(TSD
,"name",name
);DVAR(TSD
,", var",ptr
);
2587 vt
->foundflag
= ptr
->flag
& VFLAG_BOTH
;
2588 ptr
->flag
= VFLAG_NONE
;
2591 Free_stringTSD( ptr
->value
);
2596 FreeTSD( ptr
->num
->num
);
2597 FreeTSD( ptr
->num
);
2603 reorgHashtable( TSD
, vars
);
2607 static void drop_var_stem( const tsd_t
*TSD
, var_hashtable
*vars
,
2608 const streng
*name
)
2612 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2614 DPRINTF((TSD
,"drop_var_stem: ?"));
2616 ptr
= findsimple( TSD
, vars
, name
, &rehash
);
2621 vt
->foundflag
= ptr
->flag
& VFLAG_BOTH
;
2622 ptr
->flag
= VFLAG_NONE
;
2625 Free_stringTSD( ptr
->value
);
2630 FreeTSD( ptr
->num
->num
);
2631 FreeTSD( ptr
->num
);
2635 assert( ptr
->index
);
2637 assign_foliage( TSD
, ptr
->index
, NULL
);
2641 reorgHashtable( TSD
, vars
);
2645 static void drop_var_compound( tsd_t
*TSD
, var_hashtable
*vars
,
2646 const streng
*name
)
2650 variableptr ptr
, nptr
=NULL
;
2652 int stop
, rehash
= 0;
2653 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2655 DPRINTF((TSD
,"drop_var_compound: ?"));
2656 hashv
= hashfunc( vt
, name
, 0, &stop
, vars
->size
);
2657 ptr
= vars
->tbl
[hashv
];
2658 baselength
= ++stop
;
2661 SEEK_VAR_CNCMP( ptr
, name
, vt
->fullhash
, vars
, baselength
, rehash
);
2662 SEEK_EXPOSED( ptr
);
2664 indexstr
= subst_index( TSD
, name
, stop
, vars
, &rehash
);
2668 reorgHashtable( TSD
, vars
);
2672 if ( vt
->subst
&& !vt
->notrace
) /* trace it */
2673 tracecompound( TSD
, name
, baselength
- 1, indexstr
, 'C' );
2677 hashv
= hashfunc( vt
, indexstr
, 0, NULL
, ptr
->index
->size
);
2678 nptr
= ptr
->index
->tbl
[hashv
];
2680 SEEK_VAR_CMP( nptr
, indexstr
, vt
->fullhash
, ptr
->index
, rehash
);
2681 SEEK_EXPOSED( nptr
);
2685 reorgHashtable( TSD
, ptr
->index
);
2689 vt
->foundflag
= nptr
&& ( nptr
->flag
& VFLAG_BOTH
);
2693 nptr
->flag
= VFLAG_NONE
;
2696 FreeTSD( nptr
->value
);
2701 FreeTSD( nptr
->num
->num
);
2702 FreeTSD( nptr
->num
);
2709 * We are playing with the NULL-ptr ... take care !
2712 setvalue_compound( TSD
, vars
, name
, NULL
);
2716 /* JH 20-10-99 */ /* To make Direct setting of stems Direct and not Symbolic. */
2717 /****************************************************************************
2719 * JH 13/12/1999 (Original code changes on 20/10/1999)
2721 * BUG022 To make Direct setting of stems Direct and not Symbolic.
2722 * - Adapted from drop_var_compound().
2723 * - Started using the global variable, vt->tmpindex, in place of the local,
2725 * - manually move the first stem name into vt->tmpindex, do not call
2726 * subst_index(), as that not only uppercases the tail, but also
2727 * does not uppercase the tail.
2728 * - changed call from setvalue_compound() to setdirvalue_compound().
2731 ****************************************************************************/
2732 static void drop_dirvar_compound( tsd_t
*TSD
, var_hashtable
*vars
,
2733 const streng
*name
)
2737 variableptr ptr
, nptr
=NULL
;
2738 int stop
, rehash
= 0;
2739 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2741 DPRINTF((TSD
,"drop_dirvar_compound: ?"));
2742 hashv
= hashfunc( vt
, name
, 0, &stop
, vars
->size
);
2743 ptr
= vars
->tbl
[hashv
];
2744 baselength
= ++stop
;
2747 SEEK_VAR_CNCMP( ptr
, name
, vt
->fullhash
, vars
, baselength
, rehash
);
2748 SEEK_EXPOSED( ptr
);
2750 vt
->tmpindex
->len
= 0;
2751 vt
->tmpindex
= Str_nocatTSD( vt
->tmpindex
, name
, name
->len
- stop
, stop
);
2755 reorgHashtable( TSD
, vars
);
2760 * FIXME, FGC: vt->subst isn't set anywhere.
2762 if ( vt
->subst
&& !vt
->notrace
) /* trace it */
2763 tracecompound( TSD
, name
, baselength
- 1, vt
->tmpindex
, 'C' );
2767 hashv
= hashfunc( vt
, vt
->tmpindex
, 0, NULL
, ptr
->index
->size
);
2768 nptr
= ptr
->index
->tbl
[hashv
];
2770 SEEK_VAR_CMP( nptr
, vt
->tmpindex
, vt
->fullhash
, ptr
->index
, rehash
);
2771 SEEK_EXPOSED( nptr
);
2775 reorgHashtable( TSD
, ptr
->index
);
2779 vt
->foundflag
= nptr
&& ( nptr
->flag
& VFLAG_BOTH
);
2783 nptr
->flag
= VFLAG_NONE
;
2786 FreeTSD( nptr
->value
);
2791 FreeTSD( nptr
->num
->num
);
2792 FreeTSD( nptr
->num
);
2799 * We are playing with the NULL-ptr ... take care !
2802 setdirvalue_compound( TSD
, vars
, name
, NULL
);
2806 void drop_var( tsd_t
*TSD
, const streng
*name
)
2809 int i
, len
=Str_len( name
);
2810 var_hashtable
*vars
;
2812 if ( ( i
= KNOWN_RESERVED( name
->value
, len
) ) != 0 )
2814 vt
= (var_tsd_t
*)TSD
->var_tsd
;
2815 drop_var_simple( TSD
, vt
->pool0
, name
);
2819 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2822 vars
= TSD
->currlevel
->vars
;
2825 drop_var_simple( TSD
, vars
, name
);
2826 else if ( i
+ 1 == len
)
2827 drop_var_stem( TSD
, vars
, name
);
2829 drop_var_compound( TSD
, vars
, name
);
2833 /* JH 20-10-99 */ /* To make Direct setting of stems Direct and not Symbolic. */
2834 /****************************************************************************
2836 * JH 13/12/1999 (Original code changes on 20/10/1999)
2838 * BUG022 To make Direct setting of stems Direct and not Symbolic.
2839 * - Adapted from drop_var(). Changed call drop_var_compound() to
2840 * drop_dirvar_compound(). *** May need to do the same for drop_var_stem(). ****
2842 ****************************************************************************/
2843 void drop_dirvar( tsd_t
*TSD
, const streng
*name
)
2846 int i
, len
=Str_len( name
);
2847 var_hashtable
*vars
;
2849 if ( ( i
= KNOWN_RESERVED( name
->value
, len
) ) != 0 )
2851 vt
= (var_tsd_t
*)TSD
->var_tsd
;
2852 drop_var_simple( TSD
, vt
->pool0
, name
);
2856 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2859 vars
= TSD
->currlevel
->vars
;
2862 drop_var_simple( TSD
, vars
, name
);
2863 else if ( i
+ 1 == len
)
2864 drop_var_stem( TSD
, vars
, name
);
2866 drop_dirvar_compound( TSD
, vars
, name
);
2870 static void upper_var_simple( tsd_t
*TSD
, var_hashtable
*vars
,
2871 const streng
*name
)
2876 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2879 ptr
= findsimple( TSD
, vars
, name
, &rehash
);
2882 reorgHashtable( TSD
, vars
);
2885 vt
->foundflag
= ptr
&& (ptr
->flag
& VFLAG_BOTH
);
2889 expand_to_str( TSD
, ptr
);
2892 if ( vt
->foundflag
)
2897 tracevalue( TSD
, value
, 'V' );
2903 tracevalue( TSD
, name
, 'L' );
2904 if ( !vt
->ignore_novalue
)
2905 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( name
), NULL
) ;
2908 DSTART
;DPRINT((TSD
,"upper_var_simple: "));DNAME(TSD
,"name",name
);
2909 DVALUE(TSD
," rc",value
);DEND
;
2912 static void upper_var_compound( tsd_t
*TSD
, var_hashtable
*vars
,
2913 const streng
*name
)
2915 int baselength
, rehash
= 0;
2917 variableptr ptr
, nptr
;
2921 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
2923 DPRINTF((TSD
,"upper_var_compound: ?"));
2925 hashv
= hashfunc( vt
, name
, 0, &stop
, vars
->size
);
2926 ptr
= vars
->tbl
[hashv
];
2927 baselength
= ++stop
;
2929 SEEK_VAR_CNCMP( ptr
, name
, vt
->fullhash
, vars
, baselength
, rehash
);
2932 indexstr
= subst_index( TSD
, name
, stop
, vars
, &rehash
);
2936 reorgHashtable( TSD
, vars
);
2940 if ( vt
->subst
&& !vt
->notrace
) /* trace it */
2941 tracecompound( TSD
, name
, baselength
- 1, indexstr
, 'C' );
2945 hashv
= hashfunc( vt
, indexstr
, 0, NULL
, ptr
->index
->size
);
2946 nptr
= ptr
->index
->tbl
[hashv
];
2948 SEEK_VAR_CMP( nptr
, indexstr
, vt
->fullhash
, ptr
->index
, rehash
);
2949 SEEK_EXPOSED( nptr
);
2953 reorgHashtable( TSD
, ptr
->index
);
2959 vt
->foundflag
= nptr
&& ( nptr
->flag
& VFLAG_BOTH
);
2962 expand_to_str( TSD
, nptr
);
2964 if ( vt
->foundflag
)
2966 value
= nptr
->value
;
2969 tracevalue( TSD
, value
, 'V' );
2974 tracevalue( TSD
, name
, 'L' );
2975 if ( !vt
->ignore_novalue
)
2976 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( name
), NULL
) ;
2982 void upper_var( tsd_t
*TSD
, const streng
*name
)
2985 int i
, len
=Str_len( name
);
2986 var_hashtable
*vars
;
2988 if ( ( i
= KNOWN_RESERVED( name
->value
, len
) ) != 0 )
2990 vt
= (var_tsd_t
*)TSD
->var_tsd
;
2991 upper_var_simple( TSD
, vt
->pool0
, name
);
2995 for ( i
= 0; ( i
< len
) && ( name
->value
[i
] != '.' ); i
++ )
2998 vars
= TSD
->currlevel
->vars
;
3001 upper_var_simple( TSD
, vars
, name
);
3002 else if ( i
+ 1 == len
)
3003 exiterror( ERR_INVALID_STEM
, 0 );
3006 set_ignore_novalue( TSD
);
3007 upper_var_compound( TSD
, vars
, name
);
3008 clear_ignore_novalue( TSD
);
3013 void kill_variables( const tsd_t
*TSD
, var_hashtable
*array
)
3017 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3018 DPRINTF((TSD
,"kill_variables: current_valid:old=%ld, new=%ld",
3019 vt
->current_valid
,(long) array
->tbl
[array
->size
]));
3021 vt
->current_valid
= (long) array
->tbl
[array
->size
];
3023 remove_foliage( TSD
, array
);
3025 if ( vt
->current_valid
== 1 )
3026 vt
->next_current_valid
= 2;
3027 assert( vt
->current_valid
);
3031 * This is the shortcut method for retrieving the value of a variable.
3032 * It requires you to have a nodeptr, which may contain a shortcut
3033 * pointer into the variable pool. Unless, such a shortcut pointer is
3034 * established, if possible.
3035 * Note: This is one of the most time-consuming routines. Be careful.
3037 const streng
*shortcut( tsd_t
*TSD
, nodeptr thisptr
)
3039 const streng
*result
;
3044 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3046 DSTART
;DPRINT((TSD
,"shortcut: "));DNAME(TSD
,"thisptr->name",thisptr
->name
);DEND
;
3047 if ( ( vptr
= thisptr
->u
.varbx
) != NULL
)
3049 if ( vptr
->valid
== vt
->current_valid
)
3051 DSTART
;DPRINT((TSD
,"shortcut: "));DVAR(TSD
,"valid vptr",vptr
);
3052 DPRINT((TSD
," on start"));DEND
;
3054 SEEK_EXPOSED( vptr
);
3055 if ( vptr
->flag
& VFLAG_STR
)
3056 result
= vptr
->value
;
3057 else if ( vptr
->flag
& VFLAG_NUM
)
3059 expand_to_str( TSD
, vptr
);
3060 result
= vptr
->value
;
3065 result
= vptr
->name
;
3066 if ( !vt
->ignore_novalue
)
3067 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( result
), NULL
);
3069 DSTART
;DPRINT((TSD
,"shortcut: "));DVAR(TSD
,"valid vptr",vptr
);
3070 DPRINT((TSD
," on end"));DEND
;
3072 if ( TSD
->trace_stat
== 'I' )
3073 tracevalue( TSD
, result
, ch
);
3075 assert( !result
|| result
->len
<= result
->max
);
3076 DSTART
;DPRINT((TSD
,"shortcut: "));DVALUE(TSD
,"rc",result
);DEND
;
3081 DSTART
;DPRINT((TSD
,"shortcut: "));DVAR(TSD
,"INVALID vptr",vptr
);
3082 DPRINT((TSD
," on start"));DEND
;
3083 if ( --vptr
->hwired
== 0 )
3088 vptr
->prev
->next
= vptr
->next
;
3090 vptr
->next
->prev
= vptr
->prev
;
3092 vt
->first_invalid
= vptr
->prev
;
3095 * See comment on REMOVE_ELEMENT why we just remove the body
3099 thisptr
->u
.varbx
= NULL
;
3103 result
= getvalue( TSD
, thisptr
->name
, -1 ); /* changes the pool */
3106 vt
->thespot
->hwired
++;
3107 thisptr
->u
.varbx
= vt
->thespot
;
3110 DSTART
;DPRINT((TSD
,"shortcut: "));DVAR(TSD
,"new vt->thespot",vt
->thespot
);DEND
;
3111 DSTART
;DPRINT((TSD
,"shortcut: "));DVALUE(TSD
,"rc",result
);DEND
;
3112 assert( !result
|| result
->len
<= result
->max
);
3116 num_descr
*shortcutnum( tsd_t
*TSD
, nodeptr thisptr
)
3120 const streng
*resstr
;
3123 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3125 DSTART
;DPRINT((TSD
,"shortcutnum: "));DNAME(TSD
,"thisptr->name",thisptr
->name
);DEND
;
3126 if ( ( vptr
= thisptr
->u
.varbx
) != NULL
)
3128 if ( vptr
->valid
== vt
->current_valid
)
3130 DSTART
;DPRINT((TSD
,"shortcutnum: "));DVAR(TSD
,"valid vptr",vptr
);
3131 DPRINT((TSD
," on start"));DEND
;
3132 SEEK_EXPOSED( vptr
);
3133 if ( vptr
->flag
& VFLAG_NUM
)
3136 if ( TSD
->trace_stat
== 'I' )
3137 tracenumber( TSD
, result
, 'V' );
3139 else if ( vptr
->flag
& VFLAG_STR
)
3143 FreeTSD( vptr
->num
->num
);
3144 FreeTSD( vptr
->num
);
3146 if ( TSD
->trace_stat
== 'I' )
3147 tracevalue( TSD
, vptr
->value
, 'V' );
3148 vptr
->num
= is_a_descr( TSD
, vptr
->value
);
3150 vptr
->flag
|= VFLAG_NUM
;
3156 if ( TSD
->trace_stat
== 'I' )
3157 tracevalue( TSD
, thisptr
->name
, 'L' );
3158 if ( !vt
->ignore_novalue
)
3159 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( thisptr
->name
), NULL
);
3161 DSTART
;DPRINT((TSD
,"shortcutnum: "));DVAR(TSD
,"valid vptr",vptr
);
3162 DPRINT((TSD
," on end"));DEND
;
3163 DSTART
;DPRINT((TSD
,"shortcutnum: "));DNUM(TSD
,"rc",result
);DEND
;
3168 DSTART
;DPRINT((TSD
,"shortcutnum: "));DVAR(TSD
,"INVALID vptr",vptr
);
3169 DPRINT((TSD
," on start"));DEND
;
3170 if ( --vptr
->hwired
== 0 )
3175 vptr
->prev
->next
= vptr
->next
;
3177 vptr
->next
->prev
= vptr
->prev
;
3179 vt
->first_invalid
= vptr
->prev
;
3182 * See comment on REMOVE_ELEMENT why we just remove the body
3184 FreeTSD( thisptr
->u
.varbx
);
3186 thisptr
->u
.varbx
= NULL
;
3190 resstr
= getvalue( TSD
, thisptr
->name
, -1 ); /* changes the pool */
3193 vt
->thespot
->hwired
++;
3194 thisptr
->u
.varbx
= vt
->thespot
;
3195 if ( vt
->thespot
->num
)
3197 if ( vt
->thespot
->flag
& VFLAG_NUM
)
3198 return vt
->thespot
->num
;
3199 FreeTSD( vt
->thespot
->num
->num
);
3200 FreeTSD( vt
->thespot
->num
);
3203 vt
->thespot
->num
= is_a_descr( TSD
, resstr
);
3204 if ( vt
->thespot
->num
)
3205 vt
->thespot
->flag
|= VFLAG_NUM
;
3211 FreeTSD( vt
->odescr
->num
);
3212 FreeTSD( vt
->odescr
);
3214 vt
->odescr
= is_a_descr( TSD
, resstr
);
3215 DSTART
;DPRINT((TSD
,"shortcutnum: "));DVALUE(TSD
,"NO!!! vt->thespot, resstr",resstr
);DEND
;
3216 DSTART
;DPRINT((TSD
,"shortcutnum: "));DNUM(TSD
,"rc",vt
->odescr
);DEND
;
3219 DSTART
;DPRINT((TSD
,"shortcutnum: "));DVAR(TSD
,"new vt->thespot",vt
->thespot
);DEND
;
3220 DSTART
;DPRINT((TSD
,"shortcutnum: "));DNUM(TSD
,"rc",vt
->thespot
->num
);DEND
;
3222 return vt
->thespot
->num
;
3226 * Note: This is one of the most time-consuming routines. Be careful.
3228 void setshortcut( tsd_t
*TSD
, nodeptr thisptr
, streng
*value
)
3233 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3235 assert( !value
|| value
->len
<= value
->max
);
3236 DSTART
;DPRINT((TSD
,"setshortcut: "));DNAME(TSD
,"thisptr->name",thisptr
->name
);
3237 DVALUE(TSD
,", value",value
);DEND
;
3239 if ( ( vptr
= thisptr
->u
.varbx
) != NULL
)
3241 if ( vptr
->valid
== vt
->current_valid
)
3243 DSTART
;DPRINT((TSD
,"setshortcut: "));DVAR(TSD
,"valid vptr",vptr
);
3244 DPRINT((TSD
," on start"));DEND
;
3245 SEEK_EXPOSED( vptr
);
3247 Free_stringTSD( vptr
->value
);
3250 FreeTSD( vptr
->num
->num
);
3251 FreeTSD( vptr
->num
);
3254 vptr
->flag
= value
? VFLAG_STR
: VFLAG_NONE
;
3255 vptr
->value
= value
;
3256 DSTART
;DPRINT((TSD
,"setshortcut: "));DVAR(TSD
,"valid vptr",vptr
);
3257 DPRINT((TSD
," on end"));DEND
;
3262 DSTART
;DPRINT((TSD
,"setshortcut: "));DVAR(TSD
,"INVALID vptr",vptr
);
3263 DPRINT((TSD
," on start"));DEND
;
3264 if ( --vptr
->hwired
== 0 )
3269 vptr
->prev
->next
= vptr
->next
;
3271 vptr
->next
->prev
= vptr
->prev
;
3273 vt
->first_invalid
= vptr
->prev
;
3276 * See comment on REMOVE_ELEMENT why we just remove the body
3278 FreeTSD( thisptr
->u
.varbx
);
3280 thisptr
->u
.varbx
= NULL
;
3284 setvalue( TSD
, thisptr
->name
, value
, -1 );
3287 vt
->thespot
->hwired
++;
3288 thisptr
->u
.varbx
= vt
->thespot
;
3290 DSTART
;DPRINT((TSD
,"setshortcut: "));DVAR(TSD
,"vt->thespot",vt
->thespot
);
3291 DPRINT((TSD
," on end"));DEND
;
3295 * sets the varbox in this to the given value, creating it if it doesn't
3296 * exists. this->name is set to the string-representation of value; if
3297 * string_val is non-NULL, string_val is used instead. string_val must not
3300 void setshortcutnum( tsd_t
*TSD
, nodeptr thisptr
, num_descr
*value
,
3301 streng
*string_val
)
3306 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3307 assert( value
->size
);
3309 DSTART
;DPRINT((TSD
,"setshortcutnum: "));DNAME(TSD
,"thisptr->name",thisptr
->name
);
3310 DNUM(TSD
,", value",value
);DEND
;
3311 if ( ( vptr
= thisptr
->u
.varbx
) != NULL
)
3313 if ( vptr
->valid
== vt
->current_valid
)
3315 DSTART
;DPRINT((TSD
,"setshortcutnum: "));DVAR(TSD
,"valid vptr",vptr
);
3316 DPRINT((TSD
," on start"));DEND
;
3317 SEEK_EXPOSED( vptr
);
3320 FreeTSD( vptr
->num
->num
);
3321 FreeTSD( vptr
->num
);
3325 Free_stringTSD( vptr
->value
);
3328 vptr
->flag
= value
? VFLAG_NUM
: VFLAG_NONE
;
3330 DSTART
;DPRINT((TSD
,"setshortcutnum: "));DVAR(TSD
,"valid vptr",vptr
);
3331 DPRINT((TSD
," on end"));DEND
;
3336 DSTART
;DPRINT((TSD
,"setshortcutnum: "));DVAR(TSD
,"INVALID vptr",vptr
);
3337 DPRINT((TSD
," on start"));DEND
;
3338 if ( --vptr
->hwired
== 0 )
3343 vptr
->prev
->next
= vptr
->next
;
3345 vptr
->next
->prev
= vptr
->prev
;
3347 vt
->first_invalid
= vptr
->prev
;
3350 * See comment on REMOVE_ELEMENT why we just remove the body
3352 FreeTSD( thisptr
->u
.varbx
);
3354 thisptr
->u
.varbx
= NULL
;
3358 if ( string_val
== NULL
)
3359 string_val
= str_norm( TSD
, value
, NULL
);
3360 setvalue( TSD
, thisptr
->name
, string_val
, -1 );
3363 vt
->thespot
->hwired
++;
3366 if ( vt
->thespot
->num
)
3368 FreeTSD( vt
->thespot
->num
->num
);
3369 FreeTSD( vt
->thespot
->num
);
3371 vt
->thespot
->num
= value
;
3372 vt
->thespot
->flag
|= VFLAG_NUM
;
3374 thisptr
->u
.varbx
= vt
->thespot
;
3378 FreeTSD( value
->num
);
3381 DSTART
;DPRINT((TSD
,"setshortcutnum: "));DVAR(TSD
,"vt->thespot",vt
->thespot
);DEND
;
3382 DSTART
;DPRINT((TSD
,"setshortcutnum: "));DVAR(TSD
,"thisptr->u.varbx",thisptr
->u
.varbx
);
3383 DPRINT((TSD
," on end"));DEND
;
3386 streng
*fix_compound( tsd_t
*TSD
, nodeptr thisptr
, streng
*newstr
)
3388 variableptr iptr
,ptr
;
3391 unsigned hhash
, thash
, hfh
= 0;
3392 int rehash
= 0, rehashIdx
= 0;
3395 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3396 DPRINTF((TSD
,"fix_compound: ?"));
3398 hhash
= (unsigned) -1; /* Intentionally erroneous */
3400 assert( !newstr
|| newstr
->len
<= newstr
->max
);
3402 iptr
= thisptr
->u
.varbx
;
3405 if ( iptr
->valid
!= vt
->current_valid
)
3407 if ( ( --iptr
->hwired
== 0 ) && !iptr
->valid
)
3411 iptr
->prev
->next
= iptr
->next
;
3412 if ( thisptr
->u
.varbx
->next
)
3413 iptr
->next
->prev
= iptr
->prev
;
3415 vt
->first_invalid
= iptr
->prev
;
3418 * See comment on REMOVE_ELEMENT why we just remove the body
3422 iptr
= thisptr
->u
.varbx
= NULL
;
3428 hhash
= hashfunc( vt
, thisptr
->name
, 0, NULL
, TSD
->currlevel
->vars
->size
);
3429 iptr
= TSD
->currlevel
->vars
->tbl
[hhash
];
3431 TSD
->currlevel
->vars
->r
++;
3433 * The stem's name is uppercased both in the parsing tree as in our
3434 * variable pool --> no need to Str_ccmp the elements.
3436 SEEK_VAR_CMP( iptr
, thisptr
->name
, hfh
, TSD
->currlevel
->vars
, rehash
);
3437 SEEK_EXPOSED( iptr
);
3441 thisptr
->u
.varbx
= iptr
;
3444 else if ( newstr
&& thisptr
->p
[0] )
3446 if ( setvalue_simple( TSD
, TSD
->currlevel
->vars
, thisptr
->name
, NULL
) )
3449 hhash
= hfh
% TSD
->currlevel
->vars
->size
;
3452 iptr
->index
= make_hash_table( TSD
, vt
->initialHashTableLength
);
3453 DPRINTF((TSD
,"make_hash_table: rc=%p",iptr
->index
));
3458 assert( thisptr
->p
[0] );
3459 indeks
= fix_index( TSD
, thisptr
->p
[0] );
3462 tracecompound( TSD
, thisptr
->name
, thisptr
->name
->len
- 1, indeks
, 'C' );
3466 thash
= hashfunc( vt
, indeks
, 0, NULL
, iptr
->index
->size
);
3467 ptr
= iptr
->index
->tbl
[thash
];
3469 SEEK_VAR_CMP( ptr
, indeks
, vt
->fullhash
, iptr
->index
, rehashIdx
);
3470 SEEK_EXPOSED( ptr
);
3474 vt
->foundflag
= ptr
!= NULL
;
3475 if ( vt
->foundflag
)
3477 REPLACE_VALUE( newstr
, ptr
);
3481 newbox( TSD
, indeks
, newstr
, &iptr
->index
->tbl
[thash
], vt
->fullhash
);
3483 NEW_HASHTABLE_CHECK( iptr
->index
, rehashIdx
);
3484 iptr
->index
->tbl
[thash
]->stem
= iptr
;
3489 vt
->foundflag
= ptr
&& ( ptr
->flag
& VFLAG_BOTH
);
3492 if ( ptr
->flag
& VFLAG_STR
)
3494 else if ( ptr
->flag
& VFLAG_NUM
)
3496 expand_to_str( TSD
, ptr
);
3502 else if ( iptr
->flag
& VFLAG_STR
)
3503 value
= iptr
->value
;
3504 else if ( iptr
->flag
& VFLAG_NUM
)
3506 expand_to_str( TSD
, iptr
);
3507 value
= iptr
->value
;
3512 tracevalue( TSD
, value
, 'V' );
3519 iptr
= newbox( TSD
, thisptr
->name
, NULL
,
3520 &TSD
->currlevel
->vars
->tbl
[hhash
], hfh
);
3521 TSD
->currlevel
->vars
->e
++;
3522 NEW_HASHTABLE_CHECK( TSD
->currlevel
->vars
, rehash
);
3523 iptr
->index
= make_hash_table( TSD
, vt
->initialHashTableLength
);
3524 DPRINTF((TSD
,"make_hash_table: rc=%p",iptr
->index
));
3525 thash
= hashfunc( vt
, indeks
, 0, NULL
, iptr
->index
->size
);
3527 newbox( TSD
, indeks
, newstr
, &iptr
->index
->tbl
[thash
], vt
->fullhash
);
3529 NEW_HASHTABLE_CHECK( iptr
->index
, rehashIdx
);
3530 iptr
->index
->tbl
[thash
]->stem
= iptr
;
3536 Free_stringTSD( vt
->xvalue
);
3537 vt
->xvalue
= Str_makeTSD( thisptr
->name
->len
+ indeks
->len
);
3538 vt
->xvalue
= Str_catTSD( vt
->xvalue
, thisptr
->name
);
3539 vt
->xvalue
= Str_catTSD( vt
->xvalue
, indeks
);
3540 tracevalue( TSD
, vt
->xvalue
, 'L' );
3541 if ( !vt
->ignore_novalue
)
3542 condition_hook( TSD
, SIGNAL_NOVALUE
, 0, 0, -1, Str_dupTSD( vt
->xvalue
), NULL
) ;
3549 reorgHashtable( TSD
, iptr
->index
);
3553 reorgHashtable( TSD
, TSD
->currlevel
->vars
);
3556 assert( !value
|| value
->len
<= value
->max
);
3561 * queries or sets the varbox in this depending on the presence of new. If
3562 * new is set, varbox in this is set to the given value, creating it if it
3563 * doesn't exists. this->name is set in this case to the string-representation
3564 * of value; if string_val is non-NULL, string_val is used instead.
3565 * string_val must not be used later.
3566 * The current or new value of the variable is returned in all cases, it may
3569 num_descr
*fix_compoundnum( tsd_t
*TSD
, nodeptr thisptr
, num_descr
*newdescr
,
3570 streng
*string_val
)
3572 variableptr iptr
, ptr
;
3575 int rehash
= 0, rehashIdx
= 0;
3576 unsigned hhash
, hfh
= 0, thash
;
3579 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3580 DPRINTF((TSD
,"fix_compoundnum: ?"));
3582 thash
= hhash
= 0x12345678; /* Intentionally errorneous */
3584 iptr
= thisptr
->u
.varbx
;
3587 if ( iptr
->valid
!= vt
->current_valid
)
3589 if ( ( --iptr
->hwired
== 0 ) && !iptr
->valid
)
3593 iptr
->prev
->next
= iptr
->next
;
3594 if ( thisptr
->u
.varbx
->next
)
3595 iptr
->next
->prev
= iptr
->prev
;
3597 vt
->first_invalid
= iptr
->prev
;
3600 * See comment on REMOVE_ELEMENT why we just remove the body
3604 iptr
= thisptr
->u
.varbx
= NULL
;
3610 hhash
= hashfunc( vt
, thisptr
->name
, 0, NULL
, TSD
->currlevel
->vars
->size
);
3611 iptr
= TSD
->currlevel
->vars
->tbl
[hhash
];
3613 TSD
->currlevel
->vars
->r
++;
3615 * The stem's name is uppercased both in the parsing tree as in our
3616 * variable pool --> no need to Str_ccmp the elements.
3618 SEEK_VAR_CMP( iptr
, thisptr
->name
, hfh
, TSD
->currlevel
->vars
, rehash
);
3619 SEEK_EXPOSED( iptr
);
3623 thisptr
->u
.varbx
= iptr
;
3626 else if ( newdescr
&& thisptr
->p
[0] )
3628 if ( setvalue_simple( TSD
, TSD
->currlevel
->vars
, thisptr
->name
, NULL
) )
3631 hhash
= hfh
% TSD
->currlevel
->vars
->size
;
3634 iptr
->index
= make_hash_table( TSD
, vt
->initialHashTableLength
);
3635 DPRINTF((TSD
,"make_hash_table: rc=%p",iptr
->index
));
3639 assert( thisptr
->p
[0] );
3640 indeks
= fix_index( TSD
, thisptr
->p
[0] );
3643 tracecompound( TSD
, thisptr
->name
, thisptr
->name
->len
- 1, indeks
, 'C' );
3647 thash
= hashfunc( vt
, indeks
, 0, NULL
, iptr
->index
->size
);
3648 ptr
= iptr
->index
->tbl
[thash
];
3650 SEEK_VAR_CMP( ptr
, indeks
, vt
->fullhash
, iptr
->index
, rehashIdx
);
3651 SEEK_EXPOSED( ptr
);
3655 vt
->foundflag
= ptr
!= NULL
;
3656 if ( vt
->foundflag
)
3658 REPLACE_NUMBER( newdescr
, ptr
);
3662 newbox( TSD
, indeks
, NULL
, &iptr
->index
->tbl
[thash
], vt
->fullhash
);
3664 NEW_HASHTABLE_CHECK( iptr
->index
, rehashIdx
);
3665 ptr
= iptr
->index
->tbl
[thash
];
3667 ptr
->num
= newdescr
;
3668 ptr
->flag
= VFLAG_NUM
;
3670 if ( ptr
->value
!= NULL
)
3671 Free_stringTSD( ptr
->value
);
3673 if ( string_val
!= NULL
)
3674 ptr
->flag
|= VFLAG_STR
;
3676 ptr
->flag
&= ~VFLAG_STR
;
3677 ptr
->value
= string_val
;
3681 vt
->foundflag
= ptr
&& ( ptr
->flag
& VFLAG_BOTH
);
3684 if ( ptr
->flag
& VFLAG_NUM
)
3687 tracenumber( TSD
, value
, 'V' );
3689 else if ( ptr
->flag
& VFLAG_STR
)
3693 FreeTSD( ptr
->num
->num
);
3694 FreeTSD( ptr
->num
);
3696 ptr
->num
= is_a_descr( TSD
, ptr
->value
);
3697 if ( ( value
= ptr
->num
) != NULL
)
3699 tracevalue( TSD
, ptr
->value
, 'V' );
3700 ptr
->flag
|= VFLAG_NUM
;
3706 else if ( iptr
->flag
& VFLAG_NUM
)
3709 tracenumber( TSD
, value
, 'V' );
3711 else if ( iptr
->flag
& VFLAG_STR
)
3715 FreeTSD( iptr
->num
->num
);
3716 FreeTSD( iptr
->num
);
3718 iptr
->num
= is_a_descr( TSD
, iptr
->value
);
3719 if ( ( value
= iptr
->num
) != NULL
)
3721 iptr
->flag
|= VFLAG_NUM
;
3722 tracevalue( TSD
, iptr
->value
, 'V' );
3737 * b) left part of X_NASSIGN
3738 * c) thisptr->p[0] is NULL
3739 * according to this function, interprt.c and yaccsrc.y.
3741 * We have to be a X_HEAD_SYMBOL. X_HEAD_SYMBOL are created by
3742 * create_head in yaccsrc.y only if thisptr->p[0] != NULL.
3744 * --> This code will never be executed!
3745 * Reenable this only if you check the presence of stringval and
3747 * Comment last visited on 12.12.2003, this makes sense.
3748 * If no response by users are made, the else-part of "#if 1" should
3749 * be removed at the end of 2010.
3752 fprintf( stderr
, "Regina internal error detected in %s, line %u.\n"
3753 "Please, send an email to M.Hessling@qut.edu.au.\n",
3754 __FILE__
, __LINE__
);
3757 iptr
= newbox( TSD
, thisptr
->name
, NULL
, &TSD
->currlevel
->vars
[hhash
],
3759 TSD
->currlevel
->vars
->e
++;
3760 NEW_HASHTABLE_CHECK( TSD
->currlevel
->vars
, rehash
);
3761 iptr
->index
= make_hash_table( TSD
, vt
->initialHashTableLength
);
3762 DPRINTF((TSD
,"make_hash_table: rc=%p",iptr
->index
));
3763 thash
= hashfunc( vt
, indeks
, 0, NULL
);
3765 newbox( TSD
, indeks
, NULL
, &iptr
->index
->tbl
[thash
], vt
->fullhash
);
3767 NEW_HASHTABLE_CHECK( iptr
->index
, rehashIdx
);
3768 ptr
= iptr
->index
[thash
];
3770 ptr
->num
= newdescr
;
3771 ptr
->flag
= VFLAG_NUM
;
3772 if ( string_val
!= NULL
)
3773 ptr
->flag
|= VFLAG_STR
;
3774 ptr
->value
= string_val
;
3780 tracecompound( TSD
, thisptr
->name
, thisptr
->name
->len
- 1, indeks
, 'L' );
3786 reorgHashtable( TSD
, iptr
->index
);
3790 reorgHashtable( TSD
, TSD
->currlevel
->vars
);
3797 * get_realbox returns either p or the realbox associated with p if it exists.
3798 * This function is NULL-pointer safe.
3800 static variableptr
get_realbox( variableptr p
)
3804 if ( p
->realbox
== NULL
)
3806 for ( p
= p
->realbox
; p
->realbox
; p
= p
->realbox
)
3812 * get_next_variable either initializes the iteration system (reset != 0) or
3813 * it returns the next variable of the variable's array. We have to do some
3814 * extra housekeeping to become reentrant in each call.
3816 * NULL is returned in initializing or after all variables are processed.
3818 * This function returns the variables of the current PROCEDURE frame only
3819 * and has a similar function dumpvars in debug.c.
3821 variableptr
get_next_variable( tsd_t
*TSD
, int reset
)
3826 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3828 DPRINTF((TSD
,"get_next_variable: ?"));
3832 * Initializes the 4 loop variables and returns NULL.
3833 * rstem and rtail are the corresponding "realbox" shadows of pstem
3834 * and ptail. This fixes bug 681991.
3836 vt
->pstem
= vt
->ptail
= NULL
;
3837 vt
->stemidx
= vt
->tailidx
= 0;
3838 vt
->rstem
= vt
->rtail
= NULL
;
3843 * We have to do some tricks to change the four nested loops (see dumpvars)
3844 * into a reentrant loop system. The loop itself is identical to that one
3850 * While the masterindex stemidx isn't out of range.
3855 * Something's left in the masterindex's iterator pstem.
3857 if ( vt
->rstem
->index
)
3860 * This works as the outer loop pair, but for stem variables.
3867 vt
->ptail
= vt
->ptail
->next
;
3868 vt
->rtail
= get_realbox( vt
->ptail
);
3872 if ( vt
->tailidx
>= vt
->rstem
->index
->size
)
3875 vt
->ptail
= vt
->rstem
->index
->tbl
[vt
->tailidx
++];
3876 vt
->rtail
= get_realbox( vt
->ptail
);
3880 vt
->ptail
= vt
->rtail
= NULL
;
3884 vt
->pstem
= vt
->pstem
->next
;
3885 vt
->rstem
= get_realbox( vt
->pstem
);
3889 if ( vt
->stemidx
>= TSD
->currlevel
->vars
->size
)
3892 vt
->pstem
= TSD
->currlevel
->vars
->tbl
[vt
->stemidx
++];
3893 vt
->rstem
= get_realbox( vt
->pstem
);
3902 /* this was an attempt to mimic the behaviour of Object Rexx stem
3903 * assignment, but proved non-ANSI complient, so was dropped. I leave
3904 * it here so I can remember how to work with the variable pool ;-)
3906 void copy_stem( tsd_t
*TSD
, nodeptr dststem
, cnodeptr srcstem
)
3908 Changed too much
, never
try to use it anyway
! FGC
3911 * set default value of dststem to default value of srcstem
3912 * for each valid stem of srcstem, set dststem value to src value
3918 vt
= (var_tsd_t
*)TSD
->var_tsd
;
3920 DPRINTF((TSD
,"copy_stem: ?"));
3921 drop_var( dststem
->name
);
3922 ptr
= findsimple( TSD
, srcstem
->name
);
3928 * The srcstem has a default value, so set the dststem's
3929 * default value to this...
3931 setvalue_stem( TSD
, dststem
->name
, ptr
->value
);
3936 * The srcstem does not have a default value, so set the dststem's
3937 * default value to the name of the srcstem...
3939 setvalue_stem( TSD
, dststem
->name
, ptr
->name
);
3943 * THE following code copies all explicitly set variables in the srcstem
3944 * to the equivalent dststem compound values, but this is NOT the way
3945 * that the ANSI standard states the behaviour should be :-(
3947 * Find each variable for srcstem, and set dststem equivalents...
3951 for ( j
= 0; j
< HASHTABLENGTH
; j
++ )
3953 if ( ( tptr
= (ptr
->index
)[j
] ) != NULL
)
3955 for ( ; tptr
; tptr
= tptr
->next
)
3959 newname
= Str_makeTSD( Str_len( dststem
->name
) + 1 + Str_len( tptr
->name
) );
3960 Str_ncpyTSD( newname
, dststem
->name
, Str_len( dststem
->name
) );
3961 Str_catTSD( newname
, tptr
->name
);
3964 setvalue_compound( TSD
, newname
, tptr
->value
);
3969 * If the srcstem compund variable was dropped,
3970 * then to make the destination compund variable
3971 * also "appear" to be dropped, call the following
3972 * line, otherwise leave it excluded.
3975 setvalue_compound( TSD
, newname
, NULL
);
3978 Free_stringTSD( newname
);
3989 * The source stem doesn't exist, so set the default value of
3990 * dststem to the name of the srcstem.
3992 setvalue_stem( TSD
, dststem
->name
, srcstem
->name
);
3999 * set_reserved_value sets reserved values (those with a leading dot) and
4000 * their normal counterparts.
4001 * poolid is one of the POOL0_??? ids and one of var_str or val_int is
4002 * honoured depending on vflag, which may be either VFLAG_NONE, VFLAG_STR,
4004 * We do our best to maximize the throughput here, but keep in mind that
4005 * a plain setvalue invoked by the external variable interface may interfere
4006 * with our values. So we can't hurry ahead the dot-variables any more.
4008 void set_reserved_value( tsd_t
*TSD
, int poolid
, streng
*val_str
, int val_int
,
4011 var_tsd_t
*vt
= (var_tsd_t
*)TSD
->var_tsd
;
4014 assert( ( poolid
> 0 ) && ( poolid
< POOL0_CNT
) );
4016 if ( vflag
== VFLAG_NONE
)
4018 drop_var_simple( TSD
, vt
->pool0
, vt
->pool0nodes
[poolid
][0].name
);
4019 drop_var_simple( TSD
, TSD
->currlevel
->vars
,
4020 vt
->pool0nodes
[poolid
][1].name
);
4024 if ( vflag
== VFLAG_NUM
)
4025 val_str
= int_to_streng( TSD
, val_int
);
4028 * We can prevent a variable-box-switch by setting the current_valid flag
4029 * to a const value. Because the value always uses pool0 we can safely set
4030 * the flag. Don't do it for non-dot variables.
4032 cv
= vt
->current_valid
;
4033 vt
->current_valid
= 1;
4034 setshortcut( TSD
, &vt
->pool0nodes
[poolid
][0], val_str
);
4035 vt
->current_valid
= cv
;
4037 if ( vt
->pool0nodes
[poolid
][1].name
)
4040 val_str
= Str_dupTSD( val_str
);
4041 setshortcut( TSD
, &vt
->pool0nodes
[poolid
][1], val_str
);