/*
* $Id: symtab_bltin.c,v 1.7 2025/03/26 15:17:12 snw Exp $
* FreeM local system table and user-defined special variable table
*
*
* Author: Serena Willis <snw@coherent-logic.com>
* Copyright (C) 1998 MUG Deutschland
* Copyright (C) 2020, 2025 Coherent Logic Development LLC
*
*
* This file is part of FreeM.
*
* FreeM is free software: you can redistribute it and/or modify
* it under the terms of the GNU Affero Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* FreeM is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Affero Public License for more details.
*
* You should have received a copy of the GNU Affero Public License
* along with FreeM. If not, see <https://www.gnu.org/licenses/>.
*
* $Log: symtab_bltin.c,v $
* Revision 1.7 2025/03/26 15:17:12 snw
* Fall back to global-backed SSVNs when memory-backed globals fail in attempt to fix Tru64
*
* Revision 1.6 2025/03/24 04:13:11 snw
* Replace action macro dat with fra_dat to avoid symbol conflict on OS/2
*
* Revision 1.5 2025/03/24 02:01:41 snw
* Work around some OS/2 incompatibilities in symbol table code
*
* Revision 1.4 2025/03/09 19:50:47 snw
* Second phase of REUSE compliance and header reformat
*
*
* SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC
* SPDX-License-Identifier: AGPL-3.0-or-later
**/
#include <stdlib.h>
#define ZNEW 'N'
#include "mpsdef.h"
#include <string.h>
#include <sys/ipc.h>
#include <sys/shm.h>
#include <sys/sem.h>
#include <unistd.h>
#include "mdebug.h"
#include "merr.h"
#include "consttbl.h"
#include "shmmgr.h"
/* Turn this on to get tons of lovely debugging messages about
symbol-table calls */
/* #define DEBUG_SYM */
short st_use_shm = FALSE;
short restoring_consts = FALSE;
int semid_symtab;
#if !defined(__OpenBSD__) && !defined(__APPLE__) && !defined(__OS2__)
union semun {
int val; /* Value for SETVAL */
struct semid_ds *buf; /* Buffer for IPC_STAT, IPC_SET */
unsigned short *array; /* Array for GETALL, SETALL */
struct seminfo *__buf; /* Buffer for IPC_INFO
(Linux-specific) */
};
#endif
long str2long(char *string)
{
int loop = 0;
int mult = 1;
int exp = 1;
long value = 0;
if (string[0] == '-') {
mult = -1;
string++;
}
while(string[loop] != EOL && string[loop] >= '0' && string[loop] <= '9') loop++;
loop--;
while(loop > -1) {
value += (string[loop] - '0') * exp;
exp *= 10; loop--;
}
value *= mult;
return value;
}
void symtab_init (void)
{
register int i;
union semun arg;
key_t symtab_sk;
symtab_sk = ftok (config_file, 6);
if (first_process) {
for (i = 0; i < 128; i++) {
shm_config->hdr->alphptr[i] = 0L;
}
shm_config->hdr->symlen = PSIZE;
shm_config->hdr->s = &mbpartition[PSIZE] - 256;
shm_config->hdr->PSIZE = DEFPSIZE;
shm_config->hdr->argptr = mbpartition;
fprintf (stderr, "symtab_init: initializing memory-backed globals\r\n");
semid_symtab = semget (symtab_sk, 1, 0666 | IPC_CREAT);
if (semid_symtab == -1) {
fprintf (stderr, "symtab_init: failed to create symbol table semaphore\r\n");
exit (1);
}
else {
fprintf (stderr, "symtab_init: symbol table semaphore created with semid %d\r\n", semid_symtab);
}
arg.val = 1;
if (semctl (semid_symtab, 0, SETVAL, arg) == -1) {
fprintf (stderr, "symtab_init: failed to initialize symbol table semaphore\r\n");
exit (1);
}
else {
fprintf (stderr, "symtab_init: symbol table semaphore initialized\r\n");
}
fprintf (stderr, "symtab_init: allocating partition for memory-backed globals\r\n");
mbpartition = (char *) shm_alloc ((size_t) PSIZE + 2);
if (mbpartition != NULL) {
shm_config->hdr->use_mb_globals = TRUE;
}
else {
fprintf (stderr, "symtab_init: falling back to global-backed structured system variables\r\n");
shm_config->hdr->use_mb_globals = FALSE;
}
shm_config->hdr->partition = mbpartition;
if (symtab_get_sem ()) {
for (i = 0; i < 128; i++) shm_config->hdr->alphptr[i] = 0L;
symtab_release_sem ();
}
}
else {
semid_symtab = semget (symtab_sk, 1, 0);
if (semid_symtab == -1) {
fprintf (stderr, "symtab_init: could not attach to symbol table semaphore\r\n");
exit (1);
}
mbpartition = shm_config->hdr->partition;
}
}
short have_symtab_sem = FALSE;
short symtab_get_sem(void)
{
int tries;
struct sembuf s = {0, -1, IPC_NOWAIT};
if (have_symtab_sem) {
return TRUE;
}
for (tries = 0; tries < 5; tries++) {
if (semop (semid_symtab, &s, 1) != -1) {
have_symtab_sem = TRUE;
return TRUE;
}
sleep (1);
}
fprintf (stderr, "symtab_get_sem: fail\r\n");
have_symtab_sem = FALSE;
return FALSE;
}
void symtab_release_sem(void)
{
struct sembuf s = {0, 1, 0};
semop (semid_symtab, &s, 1);
have_symtab_sem = FALSE;
}
void symtab_shm (short action, char *key, char *data) /* symbol table functions */
{
char *old_s;
char *old_argptr;
long old_psize;
long old_symlen;
unsigned long stptrs[128];
register int i;
char *old_partition = partition;
if (shm_config->hdr->use_mb_globals == FALSE) {
symtab_bltin (action, key, data);
return;
}
partition = mbpartition;
writing_mb = TRUE;
if (symtab_get_sem ()) {
/* save off current non-shared symtab state */
old_s = s;
old_argptr = argptr;
old_psize = PSIZE;
old_symlen = symlen;
for (i = 0; i < 128; i++) {
stptrs[i] = alphptr[i];
}
/* replace symtab state with the values from the shared symtab */
s = shm_config->hdr->s;
argptr = shm_config->hdr->argptr;
PSIZE = shm_config->hdr->PSIZE;
symlen = shm_config->hdr->symlen;
for (i = 0; i < 128; i++) {
alphptr[i] = shm_config->hdr->alphptr[i];
}
/* execute the action (symtab_bltin will now be working with the shared symbol table) */
symtab_bltin (action, key, data);
/* copy new alphptr state back to shared memory */
for (i = 0; i < 128; i++) {
shm_config->hdr->alphptr[i] = alphptr[i];
}
/* restore non-shared symtab alphptr state */
for (i = 0; i < 128; i++) {
alphptr[i] = stptrs[i];
}
/* write the new shared symtab state back to shared memory */
shm_config->hdr->s = s;
shm_config->hdr->argptr = argptr;
shm_config->hdr->PSIZE = PSIZE;
shm_config->hdr->symlen = symlen;
/* restore the non-shared symtab state */
s = old_s;
argptr = old_argptr;
PSIZE = old_psize;
symlen = old_symlen;
symtab_release_sem ();
}
else {
fprintf (stderr, "symtab_shm: failed to acquire symbol table sempahore\r\n");
}
writing_mb = FALSE;
partition = old_partition;
}
/* local symbol table management */
/* (+)functions are now re-implemented */
/* (!)functions are new */
/* (?)re-implemented, with issues */
/* +set_sym +get_sym */
/* +kill_sym +$data */
/* +kill_all +$fra_order */
/* +killexcl +fra_query */
/* +new_sym +bigquery */
/* +new_all +getinc */
/* +newexcl */
/* +killone +m_alias */
/* !merge_sym +zdata */
/* !pop_sym */
/* The symbol table is placed at the high end of 'partition'. It begins at
* 'symlen' and ends at 'PSIZE'. The layout is
* (keylength)(key...)(<EOL>)(datalength)(data...[<EOL>])
* The keys are sorted in $order sequence.
*
* ****possible future layout with less space requirements****
* (keylength)(statusbyte)(key...)[(datalength)(data...[<EOL>])]
* 'keylength' is the length of 'key' overhead bytes not included.
* 'statusbyte' is an indicator with the following bits:
* 0 (LSB) 1=data information is missing 0=there is a data field
* 1 1=key is numeric 0=key is alphabetic
* 2..7 0..number of previous key_pieces
* note, that the status byte of a defined unsubscripted variable
* is zero.
* If a subscripted variable is stored, the variablename and each
* subscript are separate entries in the symbol table.
* E.g. S USA("CA",6789)="California" ; with $D(ABC)=0 before the set
* then the following format is used:
* (3)( 1)ABC
* (2)(1*4+1)CA
* (4)(2*4+2)6789(10)California
* ****end of "possible future layout"****
* To have the same fast access regardless of the position in the
* alphabet for each character a pointer to the first variable beginning
* with that letter is maintained. (0 indicates there's no such var.)
*/
void symtab_bltin (short action, char *key, char *data) /* symbol table functions */
{
/* must be static: */
static unsigned long tryfast = 0L; /* last $order reference */
/* the following variables may */
/* be static or not */
static unsigned short nocompact = TRUE; /* flag: do not compact symtab if */
/* value becomes shorter */
/* be static or dynamic: */
static long keyl, datal; /* length of key and data */
static long kill_from;
static char tmp1[256], tmp2[256], tmp3[256];
register long i, j, k, k1;
char tt_with[STRLEN];
char tt_key[STRLEN];
#ifdef DEBUG_SYM
int i0, i1;
char *start;
#endif
if (restoring_consts == FALSE) {
if (((action % 2) == 0) && const_is_defined (key)) {
merr_raise (CMODIFY);
return;
}
}
if (action == kill_all) goto no_with;
if ((stlen (key) >= 5) && (strncmp (key, "%INT.", 5) == 0)) goto no_with;
if (strncmp (key, "^$", 2) == 0) goto no_with;
if (strncmp (key, "$", 1) == 0) goto no_with;
stcpy (tt_with, i_with);
stcpy (tt_key, key);
stcnv_m2c (tt_with);
stcnv_m2c (tt_key);
snprintf (key, 100, "%s%s\201\201", tt_with, tt_key);
no_with:
if (dbg_enable_watch && ((action % 2) == 0)) dbg_fire_watch (key);
if (key && key[1] != '$') stcpy (zloc, key);
if (v22ptr) {
procv22 (key);
if (key[0] == '^') {
char zrsav[256];
int naksav;
char gosav[256];
stcpy (zrsav, zref);
naksav = nakoffs;
stcpy (gosav, g_o_val);
global (action, key, data);
stcpy (zref, zrsav);
nakoffs = naksav;
stcpy (l_o_val, g_o_val);
stcpy (g_o_val, gosav);
return;
}
}
/* process optional limitations */
if (glvnflag.all && key[0] >= '%' && key[0] <= 'z') {
if ((i = glvnflag.one[0])) { /* number of significant chars */
j = 0;
while ((k1 = key[j]) != DELIM && k1 != EOL) {
if (j >= i) {
while ((k1 = key[++j]) != DELIM && k1 != EOL) ;
stcpy (&key[i], &key[j]);
break;
}
j++;
}
}
if (glvnflag.one[1]) { /* upper/lower sensitivity */
j = 0;
while ((k1 = key[j]) != DELIM && k1 != EOL) {
if (k1 >= 'a' && k1 <= 'z') key[j] = k1 - 32;
j++;
}
}
if ((i = glvnflag.one[2])) {
/* IMPACT: x11-94-28 */
if (stlen (key) > i) {
merr_raise (M75);
return;
} /* key length limit */
}
if ((i = glvnflag.one[3])) { /* subscript length limit */
j = 0;
while ((k1 = key[j++]) != DELIM && k1 != EOL) ;
if (k1 == DELIM) {
k = 0;
for (;;) {
k1 = key[j++];
if (k1 == DELIM || k1 == EOL) {
if (k > i) {
merr_raise (M75);
return;
}
k = 0;
}
if (k1 == EOL) break;
k++;
}
}
}
}
if (aliases && (action != m_alias)) { /* there are aliases */
i = 0;
j = 0;
while (i < aliases) {
k1 = i + UNSIGN (ali[i]) + 1;
/* is current reference an alias ??? */
j = 0;
while (ali[++i] == key[j]) {
if (ali[i] == EOL) break;
j++;
}
/* yes, it is, so resolve it now! */
if (ali[i] == EOL && (key[j] == EOL || key[j] == DELIM)) {
stcpy (tmp1, key);
stcpy (key, &ali[i + 1]);
stcat (key, &tmp1[j]);
i = 0;
continue; /* try again, it might be a double alias! */
}
i = k1;
}
}
#ifdef DEBUG_SYM
printf("DEBUG (%d): ",action);
if(key) {
printf("[key] is [");
for(loop=0; key[loop] != EOL; loop++) printf("%c",(key[loop] == DELIM) ? '!' : key[loop]);
printf("]\r\n");
}
else {
printf("No key passed in.\r\n");
}
if(data) {
printf("[data] (datalen) is [");
for(loop=0; data[loop] != EOL; loop++) printf("%c", data[loop]);
printf("] (%d)\r\n",stlen(data));
printf("[Numeric?] is [%d]\r\n",is_numeric(data));
}
else {
printf("No data passed in.\r\n");
}
#endif
switch (action) {
case get_sym: /* retrieve */
/* OLD get_sym routine */
if ((i = alphptr[(int) key[0]])) {
// printf ("alphptr match; writing_mb = %d\r\n", writing_mb);
k = 1;
j = i + 1; /* first char always matches! */
do {
while (key[k] == partition[++j]) { /* compare keys */
if (key[k] == EOL) {
/* IMPACT: x11-94-28 */
i = UNSIGN (partition[++j]);
if (i < 4) {
k = 0;
while (k < i) data[k++] = partition[++j];
}
else {
stcpy0 (data, &partition[j + 1], i);
}
data[i] = EOL;
return;
}
k++;
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
k = 0;
j = i;
} while (i < PSIZE);
}
merr_raise (M6);
data[0] = EOL;
return;
case set_sym: /* store/create variable */
/* HANDLE ISVs FROM unnew() */
if (key[0] == '$') {
switch (key[1]) {
case 't': /* $TEST */
test = data[0];
break;
case 'z': /* $Z ISVs */
if (key[2] == 'r') { /* $ZREFERENCE / $REFERENCE */
stcpy (zref, data);
}
break;
}
}
datal = stlen (data); /* data length */
/* Old set_sym routine */
/* check whether the key has subscripts or not */
if ((keyl = stlen (key) + 2) > STRLEN) {
merr_raise (M75);
return;
}
k1 = 0;
i = 1;
while (key[i] != EOL) {
if (key[i++] == DELIM) {
k1 = i;
break;
}
}
if ((i = alphptr[(int) key[0]])) { /* previous entry */
j = i + 1;
k = 1;
}
else {
i = symlen;
j = i;
k = 0;
}
if (k1 == 0) /* key was unsubscripted */
/* compare keys */
while (i < PSIZE) {
while (key[k] == partition[++j]) {
if (key[k] == EOL) goto old;
k++;
}
if (key[k] < partition[j]) break;
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
j = i;
k = 0;
}
else { /* key was subscripted */
/* compare keys */
while (i < PSIZE) {
while (key[k] == partition[++j]) {
if (key[k] == EOL) goto old;
k++;
}
if (k < k1) {
if (key[k] < partition[j]) break;
}
else {
long m, n, o, ch;
/* get complete subscripts */
n = k;
while (key[--n] != DELIM) ;
n++;
m = j + n - k;
o = 0;
while ((ch = tmp3[o++] = partition[m++]) != EOL && ch != DELIM) ;
if (ch == DELIM) tmp3[--o] = EOL;
o = 0;
while ((ch = tmp2[o++] = key[n++]) != EOL && ch != DELIM) ;
if (ch == DELIM) tmp2[--o] = EOL;
if (collate (tmp3, tmp2) == FALSE) {
if (stcmp (tmp2, tmp3) || ch == EOL) break;
}
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
j = i;
k = 0;
}
}
/* if entry found, i pointer to searched entry
* else entry not found, i pointer to alphabetically next entry */
/* new entry */
if (setop) {
tmp1[0] = EOL;
m_op (tmp1, data, setop);
setop = 0;
if (merr () > OK) return;
datal = stcpy (data, tmp1);
}
k = i;
j = key[0];
i = keyl + datal + 1;
if (alphptr['%']) alphptr['%'] -= i;
for (k1 = 'A'; k1 <= j; k1++) {
if (alphptr[k1]) alphptr[k1] -= i;
}
i = k - i;
if (alphptr[j] == 0 || alphptr[j] > i) alphptr[j] = i;
j = keyl + datal + 1;
i = symlen - j;
if (i <= 256) { /* more space needed. try to get it */
long dif = 0L;
dif = getpmore ();
if (dif == 0) {
merr_raise (STORE);
return;
}
data = argptr;
i += dif;
k += dif;
}
symlen = i;
s = &partition[i] - 256;
stcpy0 (&partition[i], &partition[j + i], k - i);
i = k - (keyl + datal + 1);
partition[i++] = (char) (keyl);
stcpy (&partition[i], key); /* store new key */
i += keyl - 1;
/* IMPACT: x11-94-28 */
partition[i++] = (char) (datal);
stcpy0 (&partition[i], data, datal); /* store new data */
return;
/* there is a previous value */
old:
i += UNSIGN (partition[i]);
if (setop) {
j = UNSIGN (partition[i]);
stcpy0 (tmp1, &partition[i + 1], j);
tmp1[j] = EOL;
m_op (tmp1, data, setop);
setop = 0;
if (merr () > OK) return;
datal = stcpy (data, tmp1);
}
old0: /* entry from getinc */
/* IMPACT: x11-94-28 */
j = UNSIGN (partition[i]) - datal;
if (j < 0) { /* more space needed */
if ((symlen + j) <= 256) {
long dif = 0L;
dif = getpmore ();
if (dif == 0L) {
merr_raise (STORE);
return;
}
data = argptr;
i += dif;
}
for (k = 36; k < key[0]; k++) {
if (alphptr[k])
alphptr[k] += j;
}
if (alphptr[k] && alphptr[k] < i) alphptr[k] += j;
stcpy0 (&partition[symlen + j], &partition[symlen], i - symlen);
i += j;
symlen += j;
s = &partition[symlen] - 256;
tryfast = 0;
}
else if (j > 0) { /* surplus space */
if (nocompact) {
/* in a dynamic environment it is sufficient to */
/* set newdatalength=olddatalength */
datal += j;
}
else {
/* instead of compression of the local symbol table, */
/* which the following piece of code does */
symlen += j;
s = &partition[symlen] - 256;
for (k = 36; k < key[0]; k++) {
if (alphptr[k]) alphptr[k] += j;
}
if (alphptr[k] && alphptr[k] < i) alphptr[k] += j;
i += j;
k = i;
j = i - j;
while (i >= symlen) {
partition[i--] = partition[j--];
}
i = k;
tryfast = 0;
nocompact = TRUE;
}
}
/* IMPACT: x11-94-28 */
partition[i++] = (char) (datal);
j = datal;
if (j < 4) {
k = 0;
while (k < j) partition[i++] = data[k++];
return;
}
stcpy0 (&partition[i], data, j); /* store new data */
return;
/* end of set_sym section */
case fra_dat:
/* note: we assume EOL<DELIM<ASCII */
data[0] = '0';
data[1] = EOL;
if ((i = alphptr[(int) key[0]])) {
data[2] = EOL;
j = i + 1;
k = 1;
do {
while ((k1 = key[k] - partition[++j]) == 0) { /* compare keys */
if (key[k] == EOL) break;
k++;
}
if (k1 == 0) {
data[0] = '1';
}
else {
if (partition[j] == DELIM && key[k] == EOL) {
data[1] = data[0];
data[0] = '1';
return;
}
if (k1 < 0 && k < 2) return;
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
j = i;
k = 0;
} while (i < PSIZE);
}
return;
/* end of $data section */
case getinc: /* increment by one and retrieve */
#ifdef DEBUG_SYM
printf ("DEBUG GETINC: ");
printf ("[key] is [");
for (loop = 0; key[loop] != EOL; loop++) printf ("%c", (key[loop] == DELIM) ? '!' : key[loop]);
printf("]\r\n");
#endif
if ((i = alphptr[(int) key[0]])) {
j = i + 1;
k = 1;
do {
while (key[k] == partition[++j]) { /* compare keys */
if (key[k] == EOL) {
i = UNSIGN (partition[++j]);
stcpy0 (data, &partition[j + 1], i);
data[i] = EOL; /* data retrieved ... now increment */
/****************increment by one*******************/
if (i == 0) i++; /* if data was empty use EOL as dummy value */
if (i > 1 && data[0] == '0') i++; /* leading zero use EOL as dummy value */
k = 0;
while (k < i) {
if ((k1 = data[k++]) < '0' || k1 > '9') { /* no positive integer */
numlit (data);
tmp1[0] = '1';
tmp1[1] = EOL;
add (data, tmp1);
datal = stlen (data);
i = j;
nocompact = FALSE; /* getinc needs compacted symtab */
goto old0;
}
}
k1 = k--; /* length of string */
while ((partition[j + 1 + k] = ++data[k]) > '9') {
partition[j + 1 + k] = '0';
data[k--] = '0';
if (k < 0) {
k = k1;
while (k >= 0) {
data[k + 1] = data[k];
k--;
}
data[0] = '1';
s = &partition[--symlen] - 256;
if (alphptr['%']) alphptr['%']--;
for (k = 'A'; k <= key[0]; k++) {
if (alphptr[k]) alphptr[k]--;
}
k = j - 1;
j = symlen;
stcpy0 (&partition[j], &partition[j + 1], k - j);
partition[k] = (char) ++i;
partition[++k] = '1';
return;
}
}
return;
/************end increment by one*******************/
}
k++;
}
/** if (key[k]<partition[j]) break; **/
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
j = i;
k = 0;
} while (i < PSIZE);
}
data[0] = EOL;
merr_raise (UNDEF);
return;
case fra_order: /* next one please */
if (ordercnt < 0) goto zinv;
k1 = (j = stcpy (tmp1, key) - 1);
while (tmp1[k1] != DELIM) {
if ((--k1) <= 0) goto unsubscr;
}
tmp1[++k1] = EOL;
stcpy (tmp2, &key[k1]);
if (ordercnt == 0) {
stcpy (data, tmp2);
l_o_val[0] = EOL;
return;
}
data[0] = EOL;
if ((i = alphptr[(int) key[0]]) == 0) {
l_o_val[0] = EOL;
return;
}
/***************************/
/* frequent special case: the key of which we search the next
* entry is defined ! */
if (tmp2[0] != EOL) {
if (tryfast && stcmp (key, &partition[tryfast + 1]) == 0) {
j = tryfast;
j += UNSIGN (partition[j]); /* skip key */
j += UNSIGN (partition[j]) + 1; /* skip data */
goto begorder;
}
k = 1;
j = i + 1; /* first char always matches! */
do {
while (key[k] == partition[++j]) { /* compare keys */
if (key[k++] == EOL) {
j = i;
goto begorder;
}
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
k = 0;
j = i;
} while (i < PSIZE);
}
/* the key was not defined */
/***************************/
j = alphptr[(int) key[0]];
begorder:
do {
if (key[0] != partition[j + 1]) {
l_o_val[0] = EOL;
data[0] = EOL;
return;
}
stcpy0 (data, &partition[j + 1], k1);
data[k1] = EOL;
if (stcmp (tmp1, data) == 0) {
stcpy (data, &partition[j + 1 + k1]); /* index on same level */
k = 0;
while (data[k] != EOL && data[k] != DELIM) k++;
data[k] = EOL;
if (collate (tmp2, data)) {
if (--ordercnt <= 0) {
tryfast = j;
/* save data value for inspection with $V(110) */
j += UNSIGN (partition[j]); /* skip key */
k = UNSIGN (partition[j++]);
stcpy0 (l_o_val, &partition[j], k);
l_o_val[k] = EOL;
return;
}
ordercounter++;
}
}
j += UNSIGN (partition[j]); /* skip key */
j += UNSIGN (partition[j]) + 1; /* skip data */
} while (j < PSIZE);
data[0] = EOL;
tryfast = 0;
l_o_val[0] = EOL;
return;
/* end of $order section */
case kill_all:
genocid:
/* Old genocide routine */
alphptr['%'] = 0;
for (i = 'A'; i <= 'z'; alphptr[i++] = 0) ;
symlen = PSIZE;
s = &partition[symlen] - 256;
tryfast = 0;
ssvn_system_update ();
ssvn_job_update ();
ssvn_routine_update ();
#if defined(HAVE_MWAPI_MOTIF)
ssvn_display_update ();
#endif
const_restore ();
return;
case kill_sym: /* kill them dirty bloody variables */
/* Old Kill Routine */
if ((i = alphptr[(int) key[0]]) == 0) return; /* damn - nothing to kill */
kill_from = 0;
while (i < PSIZE) {
j = i;
k = 0;
while ((k1 = key[k]) == partition[++j]) { /* compare keys */
if (k1 == EOL) break;
k++;
}
if (k1 == EOL && (partition[j] == DELIM || partition[j] == EOL)) {
if (kill_from == 0) kill_from = i;
}
else {
if (kill_from) break;
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
}
k_entry: /* entry from killone section */
if (kill_from) {
j = i - kill_from;
symlen += j;
s = &partition[symlen] - 256;
for (k = 36; k < key[0]; k++) {
if (alphptr[k]) alphptr[k] += j;
}
if (alphptr[k] == kill_from) {
alphptr[k] = i;
if (partition[i + 1] != key[0]) alphptr[k] = 0;
}
else {
alphptr[k] += j;
}
/* j=i-j; while(i>symlen) partition[--i]=partition[--j]; */
stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
}
tryfast = 0;
return;
/* end of kill_sym section */
case killone: /* kill one variable, not descendants */
if ((i = alphptr[(int) key[0]]) == 0) return; /* nothing to kill */
kill_from = 0;
while (i < PSIZE) {
j = i;
k = 0;
while ((k1 = key[k]) == partition[++j]) { /* compare keys */
if (k1 == EOL) break;
k++;
}
k = i;
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
if (k1 == EOL) {
if (partition[j] == DELIM) return; /* descendant */
kill_from = k;
goto k_entry;
}
}
tryfast = 0;
return;
/* end of killone section */
case killexcl: /* exclusive kill */
i = symlen;
while (i < PSIZE) {
tmp2[0] = SP;
kill_from = i;
stcpy (tmp3, &partition[i + 1]);
stcpy (&tmp2[1], tmp3);
stcat (tmp2, " \201");
i += UNSIGN (partition[i]);
i += UNSIGN (partition[i]) + 1;
if (kill_ok (key, tmp2) == 0) continue; /* don't kill */
while (i < PSIZE) {
j = i;
k = 0;
while ((k1 = tmp3[k]) == partition[++j]) { /* compare keys */
if (k1 == EOL) break;
k++;
}
if (k1 != EOL || (partition[j] != DELIM && partition[j] != EOL)) break;
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
}
j = i - kill_from;
symlen += j;
s = &partition[symlen] - 256;
for (k = 36; k < tmp3[0]; k++) {
if (alphptr[k]) alphptr[k] += j;
}
if (alphptr[k] == kill_from) {
alphptr[k] = i;
if (partition[i + 1] != tmp3[0]) alphptr[k] = 0;
}
else {
alphptr[k] += j;
}
stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
i = kill_from + j;
}
tryfast = 0;
return;
/* end of killexcl section */
case fra_query: /* next entry */
case bigquery:
if (ordercnt == 0) {
l_o_val[0] = EOL;
zname (data, key + stlen (i_with));
return;
}
/***************************/
/* frequent special case: the key which we search for is the next
* entry */
if ((i = alphptr[(int) key[0]])) {
if (stcmp (key, &partition[tryfast + 1]) == 0) {
i = tryfast;
}
else {
j = i;
do {
if (stcmp (key, &partition[j + 1]) == 0) {
i = j;
break;
}
j += UNSIGN (partition[j]); /* skip key */
j += UNSIGN (partition[j]) + 1; /* skip data */
} while (j < PSIZE);
}
}
else {
i = symlen; /* no previous entry */
}
/***************************/
/* check whether the key has subscripts or not */
k1 = 0;
k = 1;
while (key[k] != EOL) {
if (key[k++] == DELIM) {
k1 = k;
break;
}
}
while (i < PSIZE) {
j = i;
k = 0;
while (key[k] == partition[++j]) { /* compare keys */
if (key[k] == EOL) break;
k++;
}
if (key[k] == EOL) {
if (partition[j] == EOL) {
i += UNSIGN (partition[i]);
i += UNSIGN (partition[i]) + 1;
}
break;
}
if (k < k1 || k1 == 0) {
if (key[k] < partition[j]) break;
}
else {
long m, n, o, ch;
/* get complete subscripts */
n = k;
while (key[--n] != DELIM) ;
n++;
m = j + n - k;
o = 0;
while ((ch = tmp2[o++] = key[n++]) != EOL && ch != DELIM) ;
if (ch == DELIM) tmp2[--o] = EOL;
o = 0;
while ((ch = tmp3[o++] = partition[m++]) != EOL && ch != DELIM) ;
if (ch == DELIM) tmp3[--o] = EOL;
if (collate (tmp2, tmp3)) break;
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
}
/* multiple backward query */
if (ordercnt < 0) {
j = symlen;
k = ordercnt - 1;
while (j < i) { /* count entries */
j += UNSIGN (partition[j]); /* skip key */
j += UNSIGN (partition[j]) + 1; /* skip data */
k++;
}
if (k < 0) {
data[0] = EOL;
l_o_val[0] = EOL;
return;
}
i = symlen;
while (--k >= 0) {
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
}
}
/* end: multiple backward query */
while (--ordercnt > 0) { /* multiple forward $query */
if (i >= PSIZE) break;
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
}
/* now 'i' is pointer to 'next' entry */
tryfast = i;
/* save data value for inspection with $V(110) */
j = i;
j += UNSIGN (partition[j]);
k = UNSIGN (partition[j]);
stcpy0 (l_o_val, &partition[j + 1], k);
l_o_val[k] = EOL;
keyl = i;
keyl += UNSIGN (partition[i++]) - 2;
/* action==bigquery may return a result in a different lvn */
/* which is illegal with $query() */
if (action == fra_query) {
k = 0; /* is result same lvn? */
while (partition[i+k] == key[k]) {
if (key[k] == DELIM) break;
k++;
}
if (partition[i+k] != DELIM) i = keyl + 1; /* discard result! */
}
if (i <= keyl) {
zname (data, &partition[i + stlen (i_with)]);
}
else {
data[0] = EOL;
}
return;
/* end of $query section */
zinv: /* previous one please */
data[0] = EOL;
l_o_val[0] = EOL;
k1 = (j = stcpy (tmp1, key) - 1);
while (tmp1[k1] != DELIM) {
if ((--k1) <= 0) {
merr_raise (NEXTER);
return;
}
}
tmp1[++k1] = EOL;
stcpy (tmp2, &key[k1]);
if (tmp2[0] == EOL) {
tmp2[0] = DEL;
tmp2[1] = DEL;
tmp2[2] = EOL;
}
k = (int) (key[0]);
if (alphptr[k] == 0) return;
j = alphptr[k];
do {
if (key[0] != partition[j + 1]) goto zinvend;
stcpy0 (tmp3, &partition[j + 1], k1);
tmp3[k1] = EOL;
if (stcmp (tmp1, tmp3) == 0) {
stcpy (tmp3, &partition[j + 1 + k1]); /* index on same level */
k = 0;
while (tmp3[k] != EOL && tmp3[k] != DELIM) k++;
tmp3[k] = EOL;
if (collate (tmp3, tmp2) == FALSE) goto zinvend;
stcpy (data, tmp3);
/* save data value for inspection with $V(110) */
i = j;
i += UNSIGN (partition[i]);
k = UNSIGN (partition[i]);
stcpy0 (l_o_val, &partition[i + 1], k);
l_o_val[k] = EOL;
}
j += UNSIGN (partition[j]); /* skip key */
j += UNSIGN (partition[j]) + 1; /* skip data */
} while (j < PSIZE);
zinvend:
if (data[0] == EOL) return;
ordercounter++;
if (++ordercnt >= 0) return;
stcpy (&key[k1], data);
goto zinv;
/* end of $zinverse section */
case new_sym: /* new one symbol */
if (key[0] == '$') { /* $svn: save current value on new stack */
if (newptr > newlimit && getnewmore ()) return;
if ((key[1] | 0140) == 't') { /* NEW $TEST */
*newptr++ = test;
*newptr++ = EOL;
*newptr++ = 1;
k1 = stcpy (newptr, "$t\201");
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
//if (mcmnd != ZNEW) test = FALSE;
return;
}
if ((key[1] | 0140) == 'j') { /* NEW $JOB */
*newptr++ = pid / 256;
*newptr++ = pid % 256;
*newptr++ = EOL;
*newptr++ = 2;
k1 = stcpy (newptr, "$j\201");
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
return;
}
if (((key[1] | 0140) == 'z') && ((key[2] | 0140) == 'i')) { /* NEW $ZINRPT */
*newptr++ = breakon;
*newptr++ = EOL;
*newptr++ = 1;
k1 = stcpy (newptr, "$zi\201");
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
return;
}
/* NEW $ETRAP added 10 Oct 2020, JPW */
if (((key[1] | 0140) == 'e') && ((key[2] | 0140) == 't')) { /* NEW $ETRAP */
j = stcpy (newptr, etrap);
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
k1 = stcpy (newptr, "$et\201");
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
return;
}
/* NEW $ESTACK added 12 Oct 2020, JPW */
if (((key[1] | 0140) == 'e') && ((key[2] | 0140) == 's')) { /* NEW $ESTACK */
char esbuf[256];
snprintf (esbuf, 255, "%d\201", estack);
j = stcpy (newptr, esbuf);
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
k1 = stcpy (newptr, "$es\201");
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
estack = 0;
return;
}
j = stcpy (newptr, zref); /* NEW $ZREFERENCE */
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
k1 = stcpy (newptr, "$zr\201");
newptr += k1;
*newptr++ = EOL;
*newptr++ = nakoffs;
k1++;
*newptr++ = k1;
*newptr++ = set_sym;
if (mcmnd != ZNEW) zref[0] = EOL;
return;
}
if ((i = alphptr[(int) key[0]])) { /* is there something to be saved?/killed */
/* always FALSE with special variables */
kill_from = 0;
while (i < PSIZE) {
j = i;
k = 0;
while ((k1 = key[k]) == partition[++j]) { /* compare keys */
if (k1 == EOL) break;
k++;
}
if (k1 == EOL && (partition[j] == DELIM || partition[j] == EOL)) {
if (kill_from == 0) kill_from = i;
}
else {
if (kill_from) break;
}
if (kill_from) { /* save current values on new stack */
j = UNSIGN (partition[i]);
k = i + 1;
k1 = j;
i += j;
j = UNSIGN (partition[i]);
if (newptr > newlimit && getnewmore ()) return;
#ifdef DEBUG_SYM
start = newptr;
#endif
stcpy0 (newptr, &partition[i + 1], j);
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
i += (j + 1);
stcpy0 (newptr, &partition[k], k1);
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
#ifdef DEBUG_SYM
printf ("SAVING [newptr] newptr became [");
while (start < newptr) {
printf ("%c(%d)", (*start==EOL) ? ('!') : *start, *start);
start++;
}
printf("{%d}]\r\n", *(newptr - 1));
#endif
}
else {
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
}
}
if (kill_from && mcmnd != ZNEW) {
j = i - kill_from;
symlen += j;
s = &partition[symlen] - 256;
for (k = 36; k < key[0]; k++) {
if (alphptr[k]) alphptr[k] += j;
}
if (alphptr[k] == kill_from) {
alphptr[k] = i;
if (partition[i + 1] != key[0]) alphptr[k] = 0;
}
else {
alphptr[k] += j;
}
stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
}
tryfast = 0;
}
if (newptr > newlimit && getnewmore ()) return;
#ifdef DEBUG_SYM
start = newptr;
#endif
j = stcpy (newptr, key);
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
*newptr++ = kill_sym;
#ifdef DEBUG_SYM
printf ("KILLING [newptr] newptr became [");
while (start < newptr) {
printf ("%c(%d)", (*start == EOL) ? ('!') : *start,*start );
start++;
}
printf ("{%d}]\r\n", *(newptr - 1));
#endif
return;
/* end of new_sym section */
case new_all: /* new all symbols */
i = symlen;
while (i < PSIZE) {
j = UNSIGN (partition[i]);
k = i + 1;
k1 = j;
i += j;
j = UNSIGN (partition[i]);
if (newptr > newlimit && getnewmore ()) return;
stcpy0 (newptr, &partition[i + 1], j);
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
i += (j + 1);
stcpy0 (newptr, &partition[k], k1);
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
}
*newptr++ = kill_all;
if (mcmnd == ZNEW) return;
goto genocid; /* ... and now kill them all */
/* end of new_all section */
case newexcl: /* new all except specified */
i = symlen;
while (i < PSIZE) {
tmp2[0] = SP;
kill_from = i;
stcpy (tmp3, &partition[i + 1]);
stcpy (&tmp2[1], tmp3);
stcat (tmp2, " \201");
if (kill_ok (key, tmp2) == 0) { /* don't new */
i += UNSIGN (partition[i]);
i += UNSIGN (partition[i]) + 1;
continue;
}
j = UNSIGN (partition[i]);
k = i + 1;
k1 = j;
i += j;
j = UNSIGN (partition[i]);
if (newptr > newlimit && getnewmore ()) return;
stcpy0 (newptr, &partition[i + 1], j);
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
i += (j + 1);
stcpy0 (newptr, &partition[k], k1);
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
while (i < PSIZE) {
j = i;
k = 0;
while ((k1 = tmp3[k]) == partition[++j]) { /* compare keys */
if (k1 == EOL) break;
k++;
}
if (k1 != EOL || (partition[j] != DELIM && partition[j] != EOL)) break;
j = UNSIGN (partition[i]);
k = i + 1;
k1 = j;
i += j;
j = UNSIGN (partition[i]);
if (newptr > newlimit && getnewmore ()) return;
stcpy0 (newptr, &partition[i + 1], j);
newptr += j;
*newptr++ = EOL;
*newptr++ = j;
i += (j + 1);
stcpy0 (newptr, &partition[k], k1);
newptr += k1;
*newptr++ = EOL;
*newptr++ = k1;
*newptr++ = set_sym;
}
if (mcmnd == ZNEW) continue;
j = i - kill_from;
symlen += j;
s = &partition[symlen] - 256;
for (k = 36; k < tmp3[0]; k++) {
if (alphptr[k]) alphptr[k] += j;
}
if (alphptr[k] == kill_from) {
alphptr[k] = i;
if (partition[i + 1] != tmp3[0]) alphptr[k] = 0;
}
else {
alphptr[k] += j;
}
stcpy1 (&partition[i - 1], &partition[i - j - 1], i - symlen);
i = kill_from + j;
}
tryfast = 0;
if (newptr > newlimit && getnewmore ()) return;
j = stcpy (newptr, key);
newptr += (j + 1);
*newptr++ = j;
*newptr++ = killexcl;
return;
/* end of newexcl section */
case m_alias: /* define an alias of a variable */
/* process stuff */
if (stcmp (key, data) == 0) return; /* sorry, that's no alias */
if (data[0] == EOL) { /* delete an alias from the table */
if (aliases) { /* there are aliases */
i = 0;
while (i < aliases) {
k = i;
k1 = i + UNSIGN (ali[i]) + 1;
j = 0; /* is current reference an alias ??? */
while (ali[++i] == key[j]) {
if (ali[i] == EOL) break;
j++;
}
/* yes, it is, so resolve it now! */
if (ali[i] == EOL && key[j] == EOL) {
if (aliases > k1) stcpy0 (&ali[k], &ali[k1], aliases - k1);
aliases -= (k1 - k);
return;
}
i = k1;
}
}
return;
}
/* new entry to alias table. there is no check agains duplicate entries */
i = stlen (key);
j = stlen (data);
ali[aliases++] = (char) (i + j + 2); /* byte for fast skipping */
stcpy (&ali[aliases], key);
aliases += (i + 1);
stcpy (&ali[aliases], data);
aliases += (j + 1);
/* write note to unmake the alias */
j = stcpy (newptr, key);
newptr += (j + 1);
*newptr++ = j;
*newptr++ = m_alias;
return;
case zdata: /* nonstandard data function */
{
long counties[128];
int icnt, icnt0;
i = 0;
while (i < 128) counties[i++] = 0L; /* init count; */
/* note: we assume EOL<DELIM<ASCII */
icnt = 0;
i = 0;
while ((j = key[i++]) != EOL) {
if (j == DELIM) {
icnt++;
}
}
if ((i = alphptr[(int) key[0]])) {
data[2] = EOL;
j = i + 1;
k = 1;
do {
icnt0 = j + 1;
while ((k1 = key[k] - partition[++j]) == 0) { /* compare keys */
if (key[k] == EOL) break;
k++;
}
if (k1 == 0) {
counties[0] = 1;
}
else {
if (partition[j] == DELIM && key[k] == EOL) {
int ch;
j = icnt0;
icnt0 = 0;
while ((ch = partition[j++]) != EOL) {
if (ch == DELIM) {
icnt0++;
}
}
if (icnt0 <= icnt) break;
counties[icnt0 - icnt]++;
}
/* if (k1<0 && k<2) break; */
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
j = i;
k = 0;
} while (i < PSIZE);
}
i = 128;
while (counties[--i] == 0L) ;
lintstr (data, counties[0]);
j = 1;
tmp1[0] = ',';
while (j <= i) {
lintstr (&tmp1[1], counties[j++]);
stcat (data, tmp1);
}
return;
} /* end of $zdata section */
} /* end of action switch */
/* return next variable or array name - non standard */
unsubscr:
if (standard) {
merr_raise (NEXTER);
return;
}
j = key[0];
data[0] = EOL;
while (alphptr[j] == 0) {
if (++j >= DEL) return;
}
i = alphptr[j];
while (i < PSIZE) {
j = i;
k = 0;
while ((k1 = key[k] - partition[++j]) == 0) { /* compare keys */
if (key[k] == EOL) break;
k++;
}
if (k1 < 0 && (partition[j] != DELIM || key[k] != EOL)) {
j = i;
i = 0;
while ((data[i] = partition[++j]) != EOL) {
if (data[i] == DELIM) {
data[i] = EOL;
break;
}
i++;
}
return;
}
i += UNSIGN (partition[i]); /* skip key */
i += UNSIGN (partition[i]) + 1; /* skip data */
}
return;
} /* end of symtab() */
/******************************************************************************/
/* if 't' follows 's' in MUMPS collating sequence a 1 is returned
* otherwise 0
*/
short int collate (char *s, char *t)
{
short dif;
if (s[0] == EOL) return (t[0] != EOL); /* the empty one is the leader! */
if (t[0] == EOL) return FALSE;
if ((dif = stcmp (t, s)) == 0) return FALSE;
if (numeric (s)) { /* then come numerics */
if (numeric (t) == FALSE) return TRUE;
return comp (s, t);
}
if (numeric (t)) return FALSE;
return dif > 0;
} /* end of collate() */
/******************************************************************************/
short int numeric (char *str)
/**
* boolean function that tests
* whether str is a canonical
* numeric
*/
{
register int ptr = 0, ch;
register int point;
if (str[0] == '-') {
ptr = 1;
}
if (str[ptr] == EOL) {
return FALSE;
}
if (str[ptr] == '0') return str[1] == EOL; /* leading zero */
point = FALSE;
while ((ch = str[ptr++]) != EOL) {
if (ch > '9') {
return FALSE;
}
if (ch < '0') {
if (ch != '.') return FALSE;
if (point) return FALSE; /* multiple points */
point = TRUE;
}
}
if (point) {
if ((ch = str[ptr - 2]) == '0') return FALSE; /* trailing zero */
if (ch == '.') return FALSE; /* trailing point */
}
return TRUE;
} /* end of numeric() */
/******************************************************************************/
/* s and t are strings representing */
/* MUMPS numbers. comp returns t>s */
short int comp (char *s, char *t)
{
register int s1 = s[0], t1 = t[0], point = '.';
#if !defined(_AIX)
if (fp_mode) {
double fp_s;
double fp_t;
stcnv_m2c (s);
stcnv_m2c (t);
fp_s = atof (s);
fp_t = atof (t);
return fp_t > fp_s;
}
#endif
if (s1 != t1) {
if (s1 == '-') return TRUE; /* s<0<t */
if (t1 == '-') return FALSE; /* t<0<s */
if (s1 == point && t1 == '0') return FALSE; /* s>0; t==0 */
if (t1 == point && s1 == '0') return TRUE; /* t>0; s==0 */
}
if (t1 == '-') {
char *a;
a = &t[1];
t = &s[1];
s = a;
}
s1 = 0;
while (s[s1] > point) s1++; /* Note: EOL<'.' */
t1 = 0;
while (t[t1] > point) t1++;
if (t1 > s1) return TRUE;
if (t1 < s1) return FALSE;
while (*t == *s) {
if (*t == EOL) return FALSE;
t++;
s++;
}
if (*t > *s) return TRUE;
return FALSE;
} /* end of comp() */
/******************************************************************************/
void intstr (char *str, short integ) /* converts integer to string */
{
if (integ < 0) {
integ = (-integ);
*str++ = '-';
}
if (integ < 10) {
*str++ = integ + '0';
*str = EOL;
return;
}
else if (integ < 100) {
str += 2;
}
else if (integ < 1000) {
str += 3;
}
else if (integ < 10000) {
str += 4;
}
else {
str += 5;
}
*str = EOL;
do {
*(--str) = integ % 10 + '0';
} while (integ /= 10);
return;
} /* end of intstr() */
/******************************************************************************/
void lintstr (char *str, long integ) /* converts long integer to string */
{
char result[11]; /* 32 bit = 10 digits+sign */
register int i = 0;
if (integ < 0) {
integ = (-integ);
*str++ = '-';
}
do {
result[i++] = integ % 10 + '0';
} while (integ /= 10);
do {
*str++ = result[--i];
} while (i > 0);
*str = EOL;
return;
} /* end of lintstr() */
/****************************************************************/
/* user defined special variable table management */
/* The symbol table is placed at the high end of 'svntable'. It begins at
* 'svnlen' and ends at 'UDFSVSIZ'. The layout is
* (keylength)(key...)(<EOL>)(datalength)(data...[<EOL>])
* The keys are sorted in alphabetic sequence.
*
* To have the same fast access regardless of the position in the
* alphabet for each character a pointer to the first variable beginning
* with that letter is maintained. (0 indicates there's no such var.)
*/
void udfsvn (short action, char *key, char *data) /* symbol table functions */
{
long keyl; /* length of key */
long datal; /* length of data */
register long int i, j, k, k1;
#ifdef DEBUG_SYM
char *start;
#endif
switch (action) {
case get_sym: /* retrieve */
if ((i = svnaptr[(int) key[0]])) {
k = 1;
j = i + 1; /* first char always matches! */
do {
while (key[k] == svntable[++j]) { /* compare keys */
if (key[k++] == EOL) {
i = UNSIGN (svntable[++j]);
stcpy0 (data, &svntable[j + 1], i);
data[i] = EOL;
return;
}
}
i += UNSIGN (svntable[i]); /* skip key */
i += UNSIGN (svntable[i]) + 1; /* skip data */
k = 0;
j = i;
} while (i < UDFSVSIZ);
}
merr_raise (ILLFUN);
return;
case set_sym: /* store/create variable; */
if ((keyl = stlen (key) + 2) > STRLEN) {
merr_raise (M75);
return;
} /* key length +2 */
datal = stlen (data); /* data length */
if ((i = svnaptr[(int) key[0]])) { /* previous entry */
j = i + 1;
k = 1;
}
else {
i = svnlen;
j = i;
k = 0;
}
while (i < UDFSVSIZ) { /* compare keys */
while (key[k] == svntable[++j]) {
if (key[k] == EOL) goto old;
k++;
}
if (key[k] < svntable[j]) break;
i += UNSIGN (svntable[i]); /* skip key */
i += UNSIGN (svntable[i]) + 1; /* skip data */
j = i;
k = 0;
}
/* if entry found, i pointer to searched entry
* else entry not found, i pointer to alphabetically next entry */
/* new entry */
k = i;
j = key[0];
i = keyl + datal + 1;
if (svnlen <= i) {
long dif;
dif = getumore ();
if (dif == 0L) return;
k += dif;
}
for (k1 = 'a'; k1 <= j; k1++) {
if (svnaptr[k1]) svnaptr[k1] -= i;
}
i = k - i;
if (svnaptr[j] == 0 || svnaptr[j] > i) svnaptr[j] = i;
i = (svnlen -= (j = keyl + datal + 1));
stcpy0 (&svntable[i], &svntable[j + i], k - i);
i = k - (keyl + datal + 1);
svntable[i++] = (char) (keyl);
stcpy (&svntable[i], key); /* store new key */
i += keyl - 1;
svntable[i++] = (char) (datal);
stcpy0 (&svntable[i], data, datal); /* store new data */
return;
/* there is a previous value */
old:
i += UNSIGN (svntable[i]);
j = UNSIGN (svntable[i]) - datal;
if (j < 0) { /* more space needed */
if (svnlen <= (-j)) {
long dif;
dif = getumore ();
if (dif == 0L) return;
i += dif;
}
svnlen += j;
for (k = 'a'; k < key[0]; k++) {
if (svnaptr[k]) svnaptr[k] += j;
}
if (svnaptr[k] && svnaptr[k] < i) svnaptr[k] += j;
k = i + j;
i = svnlen;
stcpy0 (&svntable[i], &svntable[i - j], k - i);
i = k;
}
else if (j > 0) { /* surplus space */
svnlen += j;
for (k = 'a'; k < key[0]; k++) {
if (svnaptr[k]) svnaptr[k] += j;
}
if (svnaptr[k] && svnaptr[k] < i) svnaptr[k] += j;
i += j;
k = i;
j = i - j;
while (i >= svnlen) {
svntable[i--] = svntable[j--];
}
i = k;
}
svntable[i++] = (char) (datal);
stcpy0 (&svntable[i], data, datal); /* store new data */
return;
/* end of set_sym section */
}
} /* end user defined special variable table */
/******************************************************************************/
long getpmore (void)
{ /* try to get more 'partition' space. returns size increment */
long siz;
long dif;
if (autopsize == FALSE) return 0L;
siz = PSIZE;
if (siz % 1024) siz = (siz & ~01777) + 02000; /* round for full kB; */
siz += 01777;
dif = siz - PSIZE;
if (newpsize (siz)) return 0L;
return dif;
} /* end getpmore */
/******************************************************************************/
long getumore (void)
{ /* try to get more udfsvntab space. returns size increment */
long siz, dif;
if (autousize == FALSE) {
merr_raise (STORE);
return 0L;
}
siz = UDFSVSIZ;
if (siz % 1024) siz = (siz & ~01777) + 02000; /* round for full kB; */
siz += 01777;
dif = siz - UDFSVSIZ;
if (newusize (siz)) {
merr_raise (STORE);
return 0L;
}
return dif;
} /* end getumore */
/******************************************************************************/
long getrmore (void)
{ /* try to get more routine space. returns size increment */
long siz, dif;
short i;
if (autorsize == FALSE) {
merr_raise (PGMOV);
return 0L;
}
siz = PSIZE0;
if (siz % 1024) siz = (siz & ~01777) + 02000; /* round for full kB; */
siz += 01777;
dif = siz - PSIZE0;
for (i = 0; i < NO_OF_RBUF; i++) { /* empty routine buffer */
pgms[i][0] = EOL;
ages[i] = 0L;
}
if (newrsize (siz, NO_OF_RBUF)) {
merr_raise (PGMOV);
return 0L;
}
return dif;
} /* end getrmore */
/******************************************************************************/
short int getnewmore (void)
{ /* enlarge new_buffers */
char *newbuf;
int i;
long dif;
newbuf = calloc ((unsigned) (NSIZE + 4096), 1); /* new_buffer */
if (newbuf == NULL) { /* could not allocate stuff... */
merr_raise (STKOV);
return 1;
}
stcpy0 (newbuf, newstack, (long) NSIZE);
dif = newbuf - newstack;
free (newstack); /* free previously allocated space */
newstack = newbuf;
NSIZE += 4096;
newptr += dif;
newlimit = newstack + NSIZE - 1024;
i = 0;
while (i <= nstx) {
if (nestnew[i]) nestnew[i] += dif;
i++;
}
return 0;
} /* end getnewmore() */
/******************************************************************************/
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to symtab_bltin.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem / src