2 * The Regina Rexx Interpreter
3 * Copyright (C) 1992-1994 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.
20 #define NO_CTYPE_REPLACEMENT
24 /* Do _not_ use stddef, anders! _not_ stddef! Remember that!!!
25 (it breaks on suns running gcc without fixincludes */
28 #if defined(HAVE_ASSERT_H)
32 #if defined(TIME_WITH_SYS_TIME)
33 # include <sys/time.h>
36 # if defined(HAVE_SYS_TIME_H)
37 # include <sys/time.h>
43 #if defined(_AMIGA) && !defined(__AROS__)
44 const char *Version
="$VER: "PARSE_VERSION_STRING
" "__AMIGADATE__
" $";
46 static const long __stack
= 0x6000;
51 * The idea is to initialize the character operation table only once.
52 * Everything is cached until the end of the process.
53 * We need the uppercase/lowercase conversion table and we need a table
54 * for the state information of each character.
56 * One great benefit is a homogeneous world of characters where an
57 * attribute "is an uppercase letter" persists between different library
58 * calls. If one has ever tried these stupid HP printer drivers for NT,
59 * he/she will like this feature.
62 PROTECTION_VAR( locale_info
)
63 static char *locale_lc_ctype
= NULL
;
64 unsigned char_info
[257] = {0, }; /*
65 * Last char indicates what attributes
70 unsigned char u_to_l
[256] = { /* initially the identity */
71 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
72 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
73 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
74 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f,
75 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
76 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f,
77 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,
78 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f,
79 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,
80 0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f,
81 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57,
82 0x58, 0x59, 0x5a, 0x5b, 0x5c, 0x5d, 0x5e, 0x5f,
83 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
84 0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f,
85 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
86 0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x7d, 0x7e, 0x7f,
87 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
88 0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f,
89 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
90 0x98, 0x99, 0x9a, 0x9b, 0x9c, 0x9d, 0x9e, 0x9f,
91 0xa0, 0xa1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7,
92 0xa8, 0xa9, 0xaa, 0xab, 0xac, 0xad, 0xae, 0xaf,
93 0xb0, 0xb1, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, 0xb7,
94 0xb8, 0xb9, 0xba, 0xbb, 0xbc, 0xbd, 0xbe, 0xbf,
95 0xc0, 0xc1, 0xc2, 0xc3, 0xc4, 0xc5, 0xc6, 0xc7,
96 0xc8, 0xc9, 0xca, 0xcb, 0xcc, 0xcd, 0xce, 0xcf,
97 0xd0, 0xd1, 0xd2, 0xd3, 0xd4, 0xd5, 0xd6, 0xd7,
98 0xd8, 0xd9, 0xda, 0xdb, 0xdc, 0xdd, 0xde, 0xdf,
99 0xe0, 0xe1, 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, 0xe7,
100 0xe8, 0xe9, 0xea, 0xeb, 0xec, 0xed, 0xee, 0xef,
101 0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7,
102 0xf8, 0xf9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff
105 unsigned char l_to_u
[256] = { /* initially the identity */
106 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
107 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
108 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17,
109 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f,
110 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27,
111 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f,
112 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,
113 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f,
114 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,
115 0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f,
116 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57,
117 0x58, 0x59, 0x5a, 0x5b, 0x5c, 0x5d, 0x5e, 0x5f,
118 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
119 0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f,
120 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77,
121 0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x7d, 0x7e, 0x7f,
122 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,
123 0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f,
124 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,
125 0x98, 0x99, 0x9a, 0x9b, 0x9c, 0x9d, 0x9e, 0x9f,
126 0xa0, 0xa1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7,
127 0xa8, 0xa9, 0xaa, 0xab, 0xac, 0xad, 0xae, 0xaf,
128 0xb0, 0xb1, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, 0xb7,
129 0xb8, 0xb9, 0xba, 0xbb, 0xbc, 0xbd, 0xbe, 0xbf,
130 0xc0, 0xc1, 0xc2, 0xc3, 0xc4, 0xc5, 0xc6, 0xc7,
131 0xc8, 0xc9, 0xca, 0xcb, 0xcc, 0xcd, 0xce, 0xcf,
132 0xd0, 0xd1, 0xd2, 0xd3, 0xd4, 0xd5, 0xd6, 0xd7,
133 0xd8, 0xd9, 0xda, 0xdb, 0xdc, 0xdd, 0xde, 0xdf,
134 0xe0, 0xe1, 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, 0xe7,
135 0xe8, 0xe9, 0xea, 0xeb, 0xec, 0xed, 0xee, 0xef,
136 0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7,
137 0xf8, 0xf9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff
141 * This function must be called at the very start of the program. It sets
142 * the used character locale. Valid values are the empty string or an OS
145 void set_locale_info( const char *info
)
147 setlocale( LC_CTYPE
, info
);
149 setlocale( LC_MESSAGES
, info
);
154 * This function loads one piece of character information. The information
155 * is stored system wide, and the information will persist over a fork() call.
157 static void load_info( unsigned infobit
)
159 #define AUTO_LOAD( name, rxbit ) { for ( i = 0; i < 256; i++ ) { \
161 char_info[i] |= rxbit; \
164 char *current_locale
;
167 THREAD_PROTECT( locale_info
)
170 * The desired information may have been collected during the
171 * THREAD_PROTECT step by another thread. Test it.
173 if ( ( char_info
[256] & infobit
) == 0 )
175 if ( locale_lc_ctype
== NULL
)
178 * Get the current locale for every following usage.
180 if ( ( current_locale
= setlocale( LC_CTYPE
, NULL
) ) == NULL
)
181 current_locale
= "C";
182 if ( ( current_locale
= strdup( current_locale
) ) == NULL
)
183 current_locale
= "C";
185 locale_lc_ctype
= current_locale
;
186 setlocale( LC_CTYPE
, current_locale
);
188 current_locale
= setlocale( LC_CTYPE
, NULL
);
191 * The standard locale is loaded. Now collect the infos.
196 AUTO_LOAD( islower
, infobit
);
197 for ( i
= 0; i
< 256; i
++ )
199 if ( char_info
[i
] & RX_ISLOWER
)
200 u_to_l
[(unsigned char) toupper( i
)] = (unsigned char) i
;
205 AUTO_LOAD( isupper
, infobit
);
206 for ( i
= 0; i
< 256; i
++ )
208 if ( char_info
[i
] & RX_ISUPPER
)
209 l_to_u
[(unsigned char) tolower( i
)] = (unsigned char) i
;
214 AUTO_LOAD( isalpha
, infobit
);
218 AUTO_LOAD( isalnum
, infobit
);
222 AUTO_LOAD( isdigit
, infobit
);
226 AUTO_LOAD( isxdigit
, infobit
);
230 AUTO_LOAD( ispunct
, infobit
);
234 AUTO_LOAD( isspace
, infobit
);
238 AUTO_LOAD( isprint
, infobit
);
242 AUTO_LOAD( isgraph
, infobit
);
246 AUTO_LOAD( iscntrl
, infobit
);
251 setlocale( LC_CTYPE
, current_locale
);
252 char_info
[256] |= infobit
;
255 THREAD_UNPROTECT( locale_info
)
259 #define Is_expand( c, bit ) if ( ! ( char_info[256] & bit ) ) \
261 return char_info[(unsigned char) c] & bit
264 Is_expand( c
, RX_ISLOWER
);
269 Is_expand( c
, RX_ISUPPER
);
274 Is_expand( c
, RX_ISALPHA
);
279 Is_expand( c
, RX_ISALNUM
);
284 Is_expand( c
, RX_ISDIGIT
);
287 int Isxdigit( int c
)
289 Is_expand( c
, RX_ISXDIGIT
);
294 Is_expand( c
, RX_ISPUNCT
);
299 Is_expand( c
, RX_ISSPACE
);
304 Is_expand( c
, RX_ISPRINT
);
309 Is_expand( c
, RX_ISGRAPH
);
314 Is_expand( c
, RX_ISCNTRL
);
320 if ( ! ( char_info
[256] & RX_ISUPPER
) )
321 load_info( RX_ISUPPER
);
322 return l_to_u
[ (unsigned char) c
];
327 if ( ! ( char_info
[256] & RX_ISLOWER
) )
328 load_info( RX_ISLOWER
);
329 return u_to_l
[ (unsigned char) c
];
332 void mem_upper( void *m
, int length
)
334 unsigned char *c
= (unsigned char *) m
;
336 if ( ! ( char_info
[256] & RX_ISUPPER
) )
337 load_info( RX_ISUPPER
);
339 while ( length
-- > 0 )
346 void mem_lower( void *m
, int length
)
348 unsigned char *c
= (unsigned char *) m
;
350 if ( ! ( char_info
[256] & RX_ISLOWER
) )
351 load_info( RX_ISLOWER
);
353 while ( length
-- > 0 )
360 int mem_cmpic( const void *buf1
, const void *buf2
, int len
)
362 * Function : Compares two memory buffers for equality;
363 * case insensitive. Same as memicmp() Microsoft C.
364 * Parameters: buf1 - first buffer
365 * buf2 - second buffer
366 * len - number of characters to compare.
367 * Return : <0 if buf1 < buf2
372 const unsigned char *b1
= (const unsigned char *) buf1
;
373 const unsigned char *b2
= (const unsigned char *) buf2
;
376 if ( ! ( char_info
[256] & RX_ISLOWER
) )
377 load_info( RX_ISLOWER
);
384 return( (int) c1
) - ( (int) c2
);
391 void getsecs( time_t *secs
, time_t *usecs
)
393 #if defined(HAVE_GETTIMEOFDAY)
394 struct timeval times
;
396 gettimeofday(×
, NULL
) ;
397 *secs
= times
.tv_sec
;
398 *usecs
= times
.tv_usec
;
400 if (times
.tv_usec
< 0)
402 *usecs
= (times
.tv_usec
+ 1000000) ;
403 *secs
= times
.tv_sec
- 1 ;
405 assert( *secs
>=0 && *usecs
>=0 ) ;
407 #elif defined(HAVE_FTIME)
408 struct timeb timebuffer
;
411 *secs
= timebuffer
.time
;
412 *usecs
= timebuffer
.millitm
* 1000;
413 assert( *secs
>=0 && *usecs
>=0 ) ;
417 assert( *secs
>=0 && *usecs
>=0 ) ;
422 const char *system_type( void )
429 # if defined(__EMX__)
430 if (_osmode
== DOS_MODE
)
439 #elif defined(__CYGWIN__)
443 #elif defined(__AROS__)
445 #elif defined(__MORPHOS__)
447 #elif defined(_AMIGA) || defined(AMIGA)
449 #elif defined(__QNX__)
451 #elif defined(__BEOS__)
453 #elif defined(__WINS__)
454 return "EPOC32-WINS" ;
455 #elif defined(__EPOC32__)
456 return "EPOC32-MARM" ;
463 #if !defined(HAVE_STRERROR)
465 * Sigh! This must probably be done this way, although it's incredibly
466 * backwards. Some versions of gcc comes with a complete set of ANSI C
467 * include files, which contains the definition of strerror(). However,
468 * that function does not exist in the default libraries of SunOS.
469 * To circumvent that problem, strerror() is #define'd to get_sys_errlist()
470 * in config.h, and here follows the definition of that function.
471 * Originally, strerror() was #defined to sys_errlist[x], but that does
472 * not work if string.h contains a declaration of the (non-existing)
473 * function strerror().
475 * So, this is a mismatch between the include files and the library, and
476 * it should not create problems for Regina. However, the _user_ will not
477 * encounter any problems until he compiles Regina, so we'll have to
478 * clean up after a buggy installation of the C compiler!
480 const char *get_sys_errlist( int num
)
482 extern char *sys_errlist
[] ;
483 return sys_errlist
[num
] ;
488 double cpu_time( void )
490 #ifndef CLOCKS_PER_SEC
492 * Lots of systems don't seem to get this ANSI C piece of code correctly
493 * but most of them seems to use one million ... Using a million for
494 * those systems that haven't defined CLOCKS_PER_SEC may give an incorrect
495 * value if clock() does not return microseconds!
497 # define CLOCKS_PER_SEC 1000000
499 return ((double)(clock()))/((double)(CLOCKS_PER_SEC
)) ;
502 /* HIGHBIT is an unsigned with the highest bit set */
503 #define HIGHBIT (((unsigned) 1) << ((sizeof(unsigned) * CHAR_BIT) - 1))
505 /* hashvalue computes a value for hashing from a string content. Use
506 * hashvalue_ic for a case insensitive version.
507 * length may less than 0. The string length is computed by strlen() in this
509 * The return value might be modified by the %-operator for real hash
512 unsigned hashvalue(const char *string
, int length
)
514 unsigned retval
= 0, wrap
;
515 const unsigned char *ptr
= (const unsigned char *) string
; /* unsigned char makes it fast */
519 length
= strlen(string
);
522 c
= *ptr
++; /* Yes this is slower but believe in your optimizer! */
524 wrap
= (retval
& HIGHBIT
) ? 1 : 0;
532 /* hashvalue_ic computes a value for hashing from a string content. Use
533 * hashvalue for a case significant version. This is case insensitive.
534 * length may less than 0. The string length is computed by strlen() in this
536 * The return value might be modified by the %-operator for real hash
539 unsigned hashvalue_ic(const char *string
, int length
)
541 unsigned retval
= 0, wrap
;
542 const unsigned char *ptr
= (const unsigned char *) string
; /* unsigned char makes it fast */
546 length
= strlen( string
);
548 if ( ! ( char_info
[256] & RX_ISLOWER
) )
549 load_info( RX_ISLOWER
);
555 wrap
= (retval
& HIGHBIT
) ? 1 : 0;
564 * hashvalue_var computes a value for hashing from a variable name.
565 * The computing starts at the start'th character in name and stops either
566 * at the end of the string or at the next dot. The later one only happens
567 * if stop != NULL. In this case, the dot's position is returned in *stop.
568 * Note: This is one of the most time-consuming routines. Be careful.
570 unsigned hashvalue_var( const streng
*name
, int start
, int *stop
)
573 const char *ch1
, *ech0
;
575 if ( ( char_info
[256] & ( RX_ISLOWER
| RX_ISDIGIT
) ) !=
576 ( RX_ISLOWER
| RX_ISDIGIT
) )
579 * The above conditional is the fastest check. Now do the slow
580 * individual check. It speeds up all things.
582 if ( ! ( char_info
[256] & RX_ISLOWER
) )
583 load_info( RX_ISLOWER
);
584 if ( ! ( char_info
[256] & RX_ISDIGIT
) )
585 load_info( RX_ISDIGIT
);
589 ech0
= Str_end( name
);
593 for (; ch1
< ech0
; ch1
++ )
602 if ( char_info
[(unsigned char) *ch1
] & RX_ISDIGIT
)
603 idx
= idx
* 10 + (unsigned) ( *ch1
- '0' );
608 sum
+= u_to_l
[ (unsigned char) *ch1
] + idx
;
612 sum
+= u_to_l
[ (unsigned char) *ch1
];
617 *stop
= ch1
- name
->value
;
623 * Because this modules defines the helper functions for rx_isspace we
624 * don't have access to this defined macro. Just re-define it locally.
626 #define is_expand( c, bit, func ) ( ( char_info[256] & bit ) ? \
627 ( char_info[(unsigned char) c] & bit ) : func( c ) )
628 #define rx_isspace( c ) is_expand( c, RX_ISSPACE , Isspace )
631 * nextarg parses source for the next argument in unix shell terms. If target
632 * is given, it must consist of enough free characters to hold the result +
633 * one byte for the terminator. If len != NULL it will become the length of
634 * the string (which might not been return if target == NULL). The return value
635 * is either NULL or a new start value for nextarg.
636 * escape is the current escape value which should be used, must be set.
638 static const char *nextarg(const char *source
, unsigned *len
, char *target
,
648 l
= 0; /* cached length */
653 while (rx_isspace(*source
)) /* jump over initial spaces */
659 /* There's something to return. Check for delimiters */
662 if ((term
== '\'') || (term
== '\"'))
664 while ((c
= *source
++) != term
) {
667 if (c
== '\0') /* stray \ at EOS is equiv to normal EOS */
669 /* empty string is valid! */
674 return source
- 1; /* next try returns NULL */
681 else /* whitespace delimiters */
684 while (!rx_isspace(c
) && (c
!= '\'') && (c
!= '\"')) {
687 if (c
== '\0') /* stray \ at EOS is equiv to normal EOS */
689 /* at least a stray \ was found, empty string checked in
690 * the very beginning.
696 return source
- 1; /* next try returns NULL */
703 source
--; /* undo the "wrong" character */
705 } while (!rx_isspace(*source
));
715 * makeargs chops string into arguments and returns an array of x+1 strings if
716 * string contains x args. The last argument is NULL. This function usually is
717 * called from the subprocess if fork/exec is used.
718 * Example: "xx y" -> { "xx", "y", NULL }
719 * escape must be the escape character of the command line and is usually ^
722 char **makeargs(const char *string
, char escape
)
729 p
= string
; /* count the number of strings */
730 while ((p
= nextarg(p
, NULL
, NULL
, escape
)) != NULL
)
732 if ((retval
= (char **)malloc((argc
+ 1) * sizeof(char *))) == NULL
)
735 p
= string
; /* count each string length */
736 for (i
= 0; i
< argc
; i
++)
738 p
= nextarg(p
, &size
, NULL
, escape
);
739 if ((retval
[i
] = (char *)malloc(size
+ 1)) == NULL
)
749 p
= string
; /* assign each string */
750 for (i
= 0; i
< argc
; i
++)
751 p
= nextarg(p
, NULL
, retval
[i
], escape
);
757 /* splitoffarg chops string into two different pieces: The first argument and
758 * all other (uninterpreted) arguments. The first argument is returned in a
759 * freshly allocated string. The rest is a pointer somewhere within string
760 * and returned in *trailer. The return value is allocated by malloc().
761 * Example: "xx y" -> returns "xx", *trailer == "xx y"+2
762 * escape must be the escape character of the command line and is usually ^
765 char *splitoffarg(const char *string
, const char **trailer
, char escape
)
772 *trailer
= ""; /* just a default */
773 nextarg(string
, &size
, NULL
, escape
);
774 if ((retval
= malloc(size
+ 1)) == NULL
) /* don't change to internal allocation routine */
777 t
= nextarg(string
, NULL
, retval
, escape
);
784 * nextarg parses source for the next argument as a simple word. If target
785 * is given, it must consist of enough free characters to hold the result +
786 * one byte for the terminator. If len != NULL it will become the length of
787 * the string (which might not been return if target == NULL). The return value
788 * is either NULL or a new start value for nextarg.
790 static const char *nextsimplearg(const char *source
, unsigned *len
,
800 l
= 0; /* cached length */
805 while (rx_isspace(*source
)) /* jump over initial spaces */
812 while (!rx_isspace(c
))
814 if (c
== '\0') /* stray \ at EOS is equiv to normal EOS */
816 /* something's found, therefore we don't have to return NULL */
821 return(source
- 1); /* next try returns NULL */
828 source
--; /* undo the "wrong" character */
838 * makesimpleargs chops string into arguments and returns an array of x+1
839 * strings if string contains x args. The last argument is NULL. This function
840 * usually is called from the subprocess if fork/exec is used.
841 * Example: "xx y" -> { "xx", "y", NULL }
843 char **makesimpleargs(const char *string
)
850 p
= string
; /* count the number of strings */
851 while ((p
= nextsimplearg(p
, NULL
, NULL
)) != NULL
)
853 if ((retval
= malloc((argc
+ 1) * sizeof(char *))) == NULL
)
856 p
= string
; /* count each string length */
857 for (i
= 0; i
< argc
; i
++)
859 p
= nextsimplearg(p
, &size
, NULL
);
860 if ((retval
[i
] = malloc(size
+ 1)) == NULL
)
870 p
= string
; /* assign each string */
871 for (i
= 0; i
< argc
; i
++)
872 p
= nextsimplearg(p
, NULL
, retval
[i
]);
878 * destroyargs destroys the array created by makeargs
880 void destroyargs(char **args
)