static void
set_main_to_stdin(void)
{
cell_destroy(FILENAME);
FILENAME->type = C_STRING;
FILENAME->ptr = (PTR) new_STRING("-");
cell_destroy(FNR);
FNR->type = C_DOUBLE;
FNR->dval = 0.0;
rt_fnr = 0;
main_fin = FINdopen(0, 1);
}
void
slow_cell_assign(CELL * target, CELL * source)
{
if (
#ifdef MSDOS /* the dreaded segment nonsense */
SAMESEG(target, field) &&
#endif
target >= field && target <= LAST_PFIELD)
field_assign(target, source);
else {
CELL **p = fbank + 1;
while (*p) {
if (
#ifdef MSDOS
SAMESEG(target, *p) &&
#endif
target >= *p && target < *p + FBANK_SZ) {
field_assign(target, source);
return;
}
p++;
}
/* its not a field */
cell_destroy(target);
cellcpy(target, source);
}
}
static void
load_field_ov(void)
{
register SPLIT_OV *p; /* walks split_ov_list */
register CELL *cp; /* target of copy */
int j; /* current fbank[] */
CELL *cp_limit; /* change fbank[] */
SPLIT_OV *q; /* trails p */
/* make sure the fields are allocated */
slow_field_ptr(nf);
p = split_ov_list;
split_ov_list = (SPLIT_OV *) 0;
j = 1;
cp = fbank[j];
cp_limit = cp + FBANK_SZ;
while (p) {
cell_destroy(cp);
cp->type = C_MBSTRN;
cp->ptr = (PTR) p->sval;
if (++cp == cp_limit) {
cp = fbank[++j];
cp_limit = cp + FBANK_SZ;
}
q = p;
p = p->link;
ZFREE(q);
}
}
CELL *
bi_printf(CELL *sp)
{
register int k;
register CELL *p;
FILE *fp;
TRACE_FUNC("bi_printf", sp);
k = sp->type;
if (k < 0) {
/* k has redirection */
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
fp = (FILE *) file_find(string(sp), k);
free_STRING(string(sp));
k = (--sp)->type;
/* k is now number of args including format */
} else
fp = stdout;
sp -= k; /* sp points at the format string */
k--;
if (sp->type < C_STRING)
cast1_to_s(sp);
do_printf(fp, string(sp)->str, (unsigned) k, sp + 1);
free_STRING(string(sp));
/* cleanup arguments on eval stack */
for (p = sp + 1; k; k--, p++)
cell_destroy(p);
return --sp;
}
void
free_cell_data(CELL * cp)
{
switch (cp->type) {
case C_RE:
TRACE(("\t... C_RE\n"));
re_destroy(cp->ptr);
zfree(cp, sizeof(CELL));
break;
case C_REPL:
TRACE(("\t... C_REPL\n"));
repl_destroy(cp);
zfree(cp, sizeof(CELL));
break;
case C_REPLV:
TRACE(("\t... C_REPLV\n"));
repl_destroy(cp);
zfree(cp, sizeof(CELL));
break;
case C_MBSTRN:
case C_STRING:
case C_STRNUM:
if (cp >= (field + (nf < 1 ? 1 : nf)) || (cp < field)) {
cell_destroy(cp);
}
break;
}
}
CELL *
bi_print(
CELL *sp) /* stack ptr passed in */
{
register CELL *p;
register int k;
FILE *fp;
k = sp->type;
if (k < 0) {
/* k holds redirection */
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
fp = (FILE *) file_find(string(sp), k);
free_STRING(string(sp));
k = (--sp)->type;
/* k now has number of arguments */
} else
fp = stdout;
if (k) {
p = sp - k; /* clear k variables off the stack */
sp = p - 1;
k--;
while (k > 0) {
print_cell(p, fp);
print_cell(OFS, fp);
cell_destroy(p);
p++;
k--;
}
print_cell(p, fp);
cell_destroy(p);
} else { /* print $0 */
sp--;
print_cell(&field[0], fp);
}
print_cell(ORS, fp);
if (ferror(fp))
write_error();
return sp;
}
CELL *
bi_srand(CELL * sp)
{
CELL c;
if (sp->type == 0) /* seed off clock */
{
time_t secs = time((time_t *) 0);
cellcpy(sp, &cseed);
cell_destroy(&cseed);
cseed.type = C_DOUBLE;
cseed.dval = (double) secs;
} else { /* user seed */
sp--;
/* swap cseed and *sp ; don't need to adjust ref_cnts */
c = *sp;
*sp = cseed;
cseed = c;
}
/* The old seed is now in *sp ; move the value in cseed to
seed in range [1,M) */
cellcpy(&c, &cseed);
if (c.type == C_NOINIT)
cast1_to_d(&c);
seed = ((c.type == C_DOUBLE)
? (long) (d_to_i(c.dval) & M) % M + 1
: (long) hash(string(&c)->str) % M + 1);
if (seed == M)
seed = M - 1;
cell_destroy(&c);
/* crank it once so close seeds don't give a close
first result */
crank(seed);
return sp;
}
struct cell *
cell_new(lua_State *L, const char * mainfile) {
hive_getenv(L, "cell_map");
int cell_map = lua_absindex(L,-1); // cell_map
luaL_requiref(L, "cell.c", cell_lib, 0); // cell_map cell_lib
struct cell * c = cell_create();
c->L = L;
cell_touserdata(L, cell_map, c); // cell_map cell_lib cell_ud
lua_setfield(L, -2, "self"); // cell_map cell_lib
hive_getenv(L, "system_pointer");
struct cell * sys = lua_touserdata(L, -1); // cell_map cell_lib system_cell
lua_pop(L, 1);
if (sys) {
cell_touserdata(L, cell_map, sys);
lua_setfield(L, -2, "system");
}
lua_pop(L,2);
lua_pushlightuserdata(L, c);
hive_setenv(L, "cell_pointer");
int err = luaL_loadfile(L, mainfile);
if (err) {
printf("%d : %s\n", err, lua_tostring(L,-1));
lua_pop(L,1);
goto _error;
}
err = lua_pcall(L, 0, 0, 0);
if (err) {
printf("%d : %s\n", err, lua_tostring(L,-1));
lua_pop(L,1);
goto _error;
}
lua_pushcfunction(L, traceback); // upvalue 1
lua_pushcfunction(L, data_unpack); // upvalue 2
hive_getenv(L, "dispatcher"); // upvalue 3
if (!lua_isfunction(L, -1)) {
printf("set dispatcher first\n");
goto _error;
}
hive_getenv(L, "cell_map"); // upvalue 4
lua_pushcclosure(L, lcallback, 4);
return c;
_error:
scheduler_deletetask(L);
c->L = NULL;
cell_destroy(c);
return NULL;
}
void
set_binmode(int x)
{
CELL c;
int change = ((x & 4) == 0);
/* set RS */
c.type = C_STRING;
c.ptr = (PTR) new_STRING((change && (x & 1)) ? "\r\n" : "\n");
field_assign(RS, &c);
free_STRING(string(&c));
/* set ORS */
cell_destroy(ORS);
ORS->type = C_STRING;
ORS->ptr = (PTR) new_STRING((change && (x & 2)) ? "\r\n" : "\n");
cell_destroy(BINMODE);
BINMODE->type = C_DOUBLE;
BINMODE->dval = (double) x;
}
CELL *
bi_match(CELL *sp)
{
char *p;
size_t length;
TRACE_FUNC("bi_match", sp);
if (sp->type != C_RE)
cast_to_RE(sp);
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
cell_destroy(RSTART);
cell_destroy(RLENGTH);
RSTART->type = C_DOUBLE;
RLENGTH->type = C_DOUBLE;
p = REmatch(string(sp)->str,
string(sp)->len,
cast_to_re((sp + 1)->ptr),
&length,
0);
if (p) {
sp->dval = (double) (p - string(sp)->str + 1);
RLENGTH->dval = (double) length;
} else {
sp->dval = 0.0;
RLENGTH->dval = -1.0; /* posix */
}
free_STRING(string(sp));
sp->type = C_DOUBLE;
RSTART->dval = sp->dval;
return_CELL("bi_match", sp);
}
void array_clear(ARRAY A)
{
unsigned i ;
ANODE *p, *q ;
if (A->type == AY_SPLIT) {
for(i = 0; i < A->size; i++)
cell_destroy((CELL*)A->ptr+i) ;
zfree(A->ptr, A->limit * sizeof(CELL)) ;
}
else if (A->type & AY_STR) {
DUAL_LINK *table = (DUAL_LINK*) A->ptr ;
for(i=0; (unsigned) i <= A->hmask; i++) {
p = table[i].slink ;
while(p) {
q = p ;
p = q->slink ;
free_STRING(q->sval) ;
cell_destroy(&q->cell) ;
ZFREE(q) ;
}
}
zfree(A->ptr, (A->hmask+1)*sizeof(DUAL_LINK)) ;
}
else if (A->type & AY_INT) {
DUAL_LINK *table = (DUAL_LINK*) A->ptr ;
for(i=0; (unsigned) i <= A->hmask; i++) {
p = table[i].ilink ;
while(p) {
q = p ;
p = q->ilink ;
cell_destroy(&q->cell) ;
ZFREE(q) ;
}
}
zfree(A->ptr, (A->hmask+1)*sizeof(DUAL_LINK)) ;
}
memset(A, 0, sizeof(*A)) ;
}
void
field_leaks(void)
{
int n;
free_STRING(string(CONVFMT));
free_STRING(string(FS));
free_STRING(string(OFMT));
free_STRING(string(RS));
cell_destroy(&field[0]);
for (n = 1; n <= nf; ++n) {
cell_destroy(&field[n]);
}
switch (fs_shadow.type) {
case C_RE:
re_destroy(fs_shadow.ptr);
break;
case C_STRING:
case C_STRNUM:
case C_MBSTRN:
cell_destroy(&fs_shadow);
break;
default:
break;
}
switch (rs_shadow.type) {
case SEP_STR:
free_STRING(((STRING *) (&rs_shadow.ptr)));
break;
case SEP_RE:
re_destroy(rs_shadow.ptr);
break;
}
}
void
set_field0(char *s, size_t len)
{
cell_destroy(&field[0]);
nf = -1;
if (len) {
field[0].type = C_MBSTRN;
field[0].ptr = (PTR) new_STRING0(len);
memcpy(string(&field[0])->str, s, len);
} else {
field[0].type = C_STRING;
field[0].ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
}
void cell_list_destroy(void)
{
struct likewise_cell *p = _lw_cell_list;
while (p) {
struct likewise_cell *q = p->next;
cell_destroy(p);
p = q;
}
_lw_cell_list = NULL;
return;
}
/* Destroys 'table' and frees all associated storage. (However, the client
* owns the 'type' members pointed to by cells, so these are not destroyed.) */
void
table_destroy(struct table *table)
{
if (table) {
size_t i;
for (i = 0; i < table->n_columns; i++) {
free(table->columns[i].heading);
}
free(table->columns);
for (i = 0; i < table->n_columns * table->n_rows; i++) {
cell_destroy(&table->cells[i]);
}
free(table->cells);
free(table->caption);
}
}
/* mktime(datespec)
Turns datespec into a time stamp of the same form as returned by systime().
The datespec is a string of the form
YYYY MM DD HH MM SS [DST].
*/
CELL *
bi_mktime(CELL *sp)
{
time_t result;
struct tm my_tm;
STRING *sval = string(sp);
int error = 0;
TRACE_FUNC("bi_mktime", sp);
memset(&my_tm, 0, sizeof(my_tm));
switch (sscanf(sval->str, "%d %d %d %d %d %d %d",
&my_tm.tm_year,
&my_tm.tm_mon,
&my_tm.tm_mday,
&my_tm.tm_hour,
&my_tm.tm_min,
&my_tm.tm_sec,
&my_tm.tm_isdst)) {
case 7:
break;
case 6:
my_tm.tm_isdst = -1; /* ask mktime to get timezone */
break;
default:
error = 1; /* not enough data */
break;
}
if (error) {
result = -1;
} else {
my_tm.tm_year -= 1900;
my_tm.tm_mon -= 1;
result = mktime(&my_tm);
}
TRACE(("...bi_mktime(%s) ->%s", sval->str, ctime(&result)));
cell_destroy(sp);
sp->type = C_DOUBLE;
sp->dval = (double) result;
return_CELL("bi_mktime", sp);
}
static int cell_management(int argc, char *argv[])
{
int err;
if (argc < 3) {
help(argv[0]);
exit(1);
}
if (strcmp(argv[2], "create") == 0)
err = cell_create(argc, argv);
else if (strcmp(argv[2], "destroy") == 0)
err = cell_destroy(argc, argv);
else {
help(argv[0]);
exit(1);
}
return err;
}
void array_load(
ARRAY A,
size_t cnt)
{
CELL *cells ; /* storage for A[1..cnt] */
size_t i ; /* index into cells[] */
if (A->type != AY_SPLIT || A->limit < (unsigned) cnt) {
array_clear(A) ;
A->limit = (unsigned) ( (cnt & (size_t) ~3) + 4 ) ;
A->ptr = zmalloc(A->limit*sizeof(CELL)) ;
A->type = AY_SPLIT ;
}
else
{
for(i=0; (unsigned) i < A->size; i++)
cell_destroy((CELL*)A->ptr + i) ;
}
cells = (CELL*) A->ptr ;
A->size = cnt ;
if (cnt > MAX_SPLIT) {
SPLIT_OV *p = split_ov_list ;
SPLIT_OV *q ;
split_ov_list = (SPLIT_OV*) 0 ;
i = MAX_SPLIT ;
while( p ) {
cells[i].type = C_MBSTRN ;
cells[i].ptr = (PTR) p->sval ;
q = p ;
p = q->link ;
ZFREE(q) ;
i++ ;
}
cnt = MAX_SPLIT ;
}
for(i=0; i < cnt; i++) {
cells[i].type = C_MBSTRN ;
cells[i].ptr = split_buff[i] ;
}
}
int
cell_dispatch_message(struct cell *c) {
cell_lock(c);
if (c->quit) {
cell_destroy(c);
return CELL_QUIT;
}
struct message m;
int empty = mq_pop(&c->mq, &m);
if (empty || c->L == NULL) {
cell_unlock(c);
return CELL_EMPTY;
}
cell_grab(c);
cell_unlock(c);
lua_pushvalue(c->L, 1); // dup callback
lua_pushinteger(c->L, m.port);
lua_pushlightuserdata(c->L, m.buffer);
lua_call(c->L, 2, 0);
cell_release(c);
return CELL_MESSAGE;
}
CELL *
bi_sprintf(CELL *sp)
{
CELL *p;
int argcnt = sp->type;
STRING *sval;
TRACE_FUNC("bi_sprintf", sp);
sp -= argcnt; /* sp points at the format string */
argcnt--;
if (sp->type != C_STRING)
cast1_to_s(sp);
sval = do_printf((FILE *) 0, string(sp)->str, (unsigned) argcnt, sp + 1);
free_STRING(string(sp));
sp->ptr = (PTR) sval;
/* cleanup */
for (p = sp + 1; argcnt; argcnt--, p++)
cell_destroy(p);
return sp;
}
void
execute(INST * cdp, /* code ptr, start execution here */
CELL *sp, /* eval_stack pointer */
CELL *fp) /* frame ptr into eval_stack for
user defined functions */
{
/* some useful temporaries */
CELL *cp;
int t;
unsigned tu;
/* save state for array loops via a stack */
ALOOP_STATE *aloop_state = (ALOOP_STATE *) 0;
/* for moving the eval stack on deep recursion */
CELL *old_stack_base = 0;
CELL *old_sp = 0;
#ifdef DEBUG
CELL *entry_sp = sp;
#endif
int force_exit = (end_start == 0);
if (fp) {
/* we are a function call, check for deep recursion */
if (sp > stack_danger) { /* change stacks */
old_stack_base = stack_base;
old_sp = sp;
stack_base = (CELL *) zmalloc(sizeof(CELL) * EVAL_STACK_SIZE);
stack_danger = stack_base + DANGER;
sp = stack_base;
/* waste 1 slot for ANSI, actually large model msdos breaks in
RET if we don't */
#ifdef DEBUG
entry_sp = sp;
#endif
} else
old_stack_base = (CELL *) 0;
}
while (1) {
TRACE(("execute %s sp(%ld:%s)\n",
da_op_name(cdp),
(long) (sp - stack_base),
da_type_name(sp)));
switch ((cdp++)->op) {
/* HALT only used by the disassemble now ; this remains
so compilers don't offset the jump table */
case _HALT:
case _STOP: /* only for range patterns */
#ifdef DEBUG
if (sp != entry_sp + 1)
bozo("stop0");
#endif
return;
case _PUSHC:
inc_sp();
cellcpy(sp, (cdp++)->ptr);
break;
case _PUSHD:
inc_sp();
sp->type = C_DOUBLE;
sp->dval = *(double *) (cdp++)->ptr;
break;
case _PUSHS:
inc_sp();
sp->type = C_STRING;
sp->ptr = (cdp++)->ptr;
string(sp)->ref_cnt++;
break;
case F_PUSHA:
cp = (CELL *) cdp->ptr;
if (cp != field) {
if (nf < 0)
split_field0();
if (!(cp >= NF && cp <= LAST_PFIELD)) {
/* it is a real field $1, $2 ...
If it is greater than $NF, we have to
make sure it is set to "" so that
(++|--) and g?sub() work right
*/
t = field_addr_to_index(cp);
if (t > nf) {
cp->type = C_STRING;
cp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
}
}
/* fall thru */
case _PUSHA:
case A_PUSHA:
inc_sp();
sp->ptr = (cdp++)->ptr;
break;
case _PUSHI:
/* put contents of next address on stack */
inc_sp();
cellcpy(sp, (cdp++)->ptr);
break;
case L_PUSHI:
/* put the contents of a local var on stack,
cdp->op holds the offset from the frame pointer */
inc_sp();
cellcpy(sp, fp + (cdp++)->op);
break;
case L_PUSHA:
/* put a local address on eval stack */
inc_sp();
sp->ptr = (PTR) (fp + (cdp++)->op);
break;
case F_PUSHI:
/* push contents of $i
cdp[0] holds & $i , cdp[1] holds i */
inc_sp();
if (nf < 0)
split_field0();
cp = (CELL *) cdp->ptr;
t = (cdp + 1)->op;
cdp += 2;
if (t <= nf)
cellcpy(sp, cp);
else { /* an unset field */
sp->type = C_STRING;
sp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
break;
case NF_PUSHI:
inc_sp();
if (nf < 0)
split_field0();
cellcpy(sp, NF);
break;
case FE_PUSHA:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
tu = d_to_index(sp->dval);
if (tu && nf < 0)
split_field0();
sp->ptr = (PTR) field_ptr((int) tu);
if ((int) tu > nf) {
/* make sure it is set to "" */
cp = (CELL *) sp->ptr;
cell_destroy(cp);
cp->type = C_STRING;
cp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
break;
case FE_PUSHI:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
tu = d_to_index(sp->dval);
if (nf < 0)
split_field0();
if ((int) tu <= nf) {
cellcpy(sp, field_ptr((int) tu));
} else {
sp->type = C_STRING;
sp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
break;
case AE_PUSHA:
/* top of stack has an expr, cdp->ptr points at an
array, replace the expr with the cell address inside
the array */
cp = array_find((ARRAY) (cdp++)->ptr, sp, CREATE);
cell_destroy(sp);
sp->ptr = (PTR) cp;
break;
case AE_PUSHI:
/* top of stack has an expr, cdp->ptr points at an
array, replace the expr with the contents of the
cell inside the array */
cp = array_find((ARRAY) (cdp++)->ptr, sp, CREATE);
cell_destroy(sp);
cellcpy(sp, cp);
break;
case LAE_PUSHI:
/* sp[0] is an expression
cdp->op is offset from frame pointer of a CELL which
has an ARRAY in the ptr field, replace expr
with array[expr]
*/
if (fp != 0) {
cp = array_find((ARRAY) fp[(cdp++)->op].ptr, sp, CREATE);
cell_destroy(sp);
cellcpy(sp, cp);
}
break;
case LAE_PUSHA:
/* sp[0] is an expression
cdp->op is offset from frame pointer of a CELL which
has an ARRAY in the ptr field, replace expr
with & array[expr]
*/
if (fp != 0) {
cp = array_find((ARRAY) fp[(cdp++)->op].ptr, sp, CREATE);
cell_destroy(sp);
sp->ptr = (PTR) cp;
}
break;
case LA_PUSHA:
/* cdp->op is offset from frame pointer of a CELL which
has an ARRAY in the ptr field. Push this ARRAY
on the eval stack
*/
if (fp != 0) {
inc_sp();
sp->ptr = fp[(cdp++)->op].ptr;
}
break;
case SET_ALOOP:
{
ALOOP_STATE *ap = ZMALLOC(ALOOP_STATE);
size_t vector_size;
ap->var = (CELL *) sp[-1].ptr;
ap->base = ap->ptr = array_loop_vector((ARRAY) sp->ptr, &vector_size);
ap->limit = ap->base + vector_size;
sp -= 2;
/* push onto aloop stack */
ap->link = aloop_state;
aloop_state = ap;
cdp += cdp->op;
}
break;
case ALOOP:
{
ALOOP_STATE *ap = aloop_state;
if (ap != 0 && (ap->ptr < ap->limit)) {
cell_destroy(ap->var);
ap->var->type = C_STRING;
ap->var->ptr = (PTR) * ap->ptr++;
cdp += cdp->op;
} else {
cdp++;
}
}
break;
case POP_AL:
{
/* finish up an array loop */
ALOOP_STATE *ap = aloop_state;
if (ap != 0) {
aloop_state = ap->link;
while (ap->ptr < ap->limit) {
free_STRING(*ap->ptr);
ap->ptr++;
}
if (ap->base < ap->limit) {
zfree(ap->base,
((unsigned) (ap->limit - ap->base)
* sizeof(STRING *)));
}
ZFREE(ap);
}
}
break;
case _POP:
cell_destroy(sp);
sp--;
break;
case _ASSIGN:
/* top of stack has an expr, next down is an
address, put the expression in *address and
replace the address with the expression */
/* don't propagate type C_MBSTRN */
if (sp->type == C_MBSTRN)
check_strnum(sp);
sp--;
cell_destroy(((CELL *) sp->ptr));
cellcpy(sp, cellcpy(sp->ptr, sp + 1));
cell_destroy(sp + 1);
break;
case F_ASSIGN:
/* assign to a field */
if (sp->type == C_MBSTRN)
check_strnum(sp);
sp--;
field_assign((CELL *) sp->ptr, sp + 1);
cell_destroy(sp + 1);
cellcpy(sp, (CELL *) sp->ptr);
break;
case _ADD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef SW_FP_CHECK /* specific to V7 and XNX23A */
clrerr();
#endif
cp->dval += (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _SUB_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef SW_FP_CHECK
clrerr();
#endif
cp->dval -= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _MUL_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef SW_FP_CHECK
clrerr();
#endif
cp->dval *= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _DIV_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
#ifdef SW_FP_CHECK
clrerr();
#endif
cp->dval /= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _MOD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
cp->dval = fmod(cp->dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
case _POW_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
cp->dval = pow(cp->dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
break;
/* will anyone ever use these ? */
case F_ADD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval += (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_SUB_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval -= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_MUL_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval *= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_DIV_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
#ifdef SW_FP_CHECK
clrerr();
#endif
tc.dval /= (sp--)->dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_MOD_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp->dval);
#endif
tc.dval = fmod(tc.dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case F_POW_ASG:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
cp = (CELL *) (sp - 1)->ptr;
cast1_to_d(cellcpy(&tc, cp));
tc.dval = pow(tc.dval, (sp--)->dval);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
field_assign(cp, &tc);
break;
case _ADD:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval += sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _SUB:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval -= sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _MUL:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval *= sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _DIV:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp[1].dval);
#endif
#ifdef SW_FP_CHECK
clrerr();
#endif
sp[0].dval /= sp[1].dval;
#ifdef SW_FP_CHECK
fpcheck();
#endif
break;
case _MOD:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
#ifdef NOINFO_SIGFPE
CHECK_DIVZERO(sp[1].dval);
#endif
sp[0].dval = fmod(sp[0].dval, sp[1].dval);
break;
case _POW:
sp--;
if (TEST2(sp) != TWO_DOUBLES)
cast2_to_d(sp);
sp[0].dval = pow(sp[0].dval, sp[1].dval);
break;
case _NOT:
/* evaluates to 0.0 or 1.0 */
reswitch_1:
switch (sp->type) {
case C_NOINIT:
sp->dval = 1.0;
break;
case C_DOUBLE:
sp->dval = sp->dval != 0.0 ? 0.0 : 1.0;
break;
case C_FIELDWIDTHS:
case C_STRING:
sp->dval = string(sp)->len ? 0.0 : 1.0;
free_STRING(string(sp));
break;
case C_STRNUM: /* test as a number */
sp->dval = sp->dval != 0.0 ? 0.0 : 1.0;
free_STRING(string(sp));
break;
case C_MBSTRN:
check_strnum(sp);
goto reswitch_1;
default:
bozo("bad type on eval stack");
}
sp->type = C_DOUBLE;
break;
case _TEST:
/* evaluates to 0.0 or 1.0 */
reswitch_2:
switch (sp->type) {
case C_NOINIT:
sp->dval = 0.0;
break;
case C_DOUBLE:
sp->dval = sp->dval != 0.0 ? 1.0 : 0.0;
break;
case C_FIELDWIDTHS:
case C_STRING:
sp->dval = string(sp)->len ? 1.0 : 0.0;
free_STRING(string(sp));
break;
case C_STRNUM: /* test as a number */
sp->dval = sp->dval != 0.0 ? 1.0 : 0.0;
free_STRING(string(sp));
break;
case C_MBSTRN:
check_strnum(sp);
goto reswitch_2;
default:
bozo("bad type on eval stack");
}
sp->type = C_DOUBLE;
break;
case _UMINUS:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
sp->dval = -sp->dval;
break;
case _UPLUS:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
break;
case _CAT:
{
size_t len1, len2;
char *str1, *str2;
STRING *b;
sp--;
if (TEST2(sp) != TWO_STRINGS)
cast2_to_s(sp);
str1 = string(sp)->str;
len1 = string(sp)->len;
str2 = string(sp + 1)->str;
len2 = string(sp + 1)->len;
b = new_STRING0(len1 + len2);
memcpy(b->str, str1, len1);
memcpy(b->str + len1, str2, len2);
free_STRING(string(sp));
free_STRING(string(sp + 1));
sp->ptr = (PTR) b;
break;
}
case _PUSHINT:
inc_sp();
sp->type = (short) (cdp++)->op;
break;
case _BUILTIN:
case _PRINT:
sp = (*(PF_CP) (cdp++)->ptr) (sp);
break;
case _POST_INC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
cp->dval += 1.0;
break;
case _POST_DEC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->type = C_DOUBLE;
sp->dval = cp->dval;
cp->dval -= 1.0;
break;
case _PRE_INC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->dval = cp->dval += 1.0;
sp->type = C_DOUBLE;
break;
case _PRE_DEC:
cp = (CELL *) sp->ptr;
if (cp->type != C_DOUBLE)
cast1_to_d(cp);
sp->dval = cp->dval -= 1.0;
sp->type = C_DOUBLE;
break;
case F_POST_INC:
cp = (CELL *) sp->ptr;
cellcpy(&tc, cp);
cast1_to_d(&tc);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
tc.dval += 1.0;
field_assign(cp, &tc);
break;
case F_POST_DEC:
cp = (CELL *) sp->ptr;
cellcpy(&tc, cp);
cast1_to_d(&tc);
sp->type = C_DOUBLE;
sp->dval = tc.dval;
tc.dval -= 1.0;
field_assign(cp, &tc);
break;
case F_PRE_INC:
cp = (CELL *) sp->ptr;
cast1_to_d(cellcpy(sp, cp));
sp->dval += 1.0;
field_assign(cp, sp);
break;
case F_PRE_DEC:
cp = (CELL *) sp->ptr;
cast1_to_d(cellcpy(sp, cp));
sp->dval -= 1.0;
field_assign(cp, sp);
break;
case _JMP:
cdp += cdp->op;
break;
case _JNZ:
/* jmp if top of stack is non-zero and pop stack */
if (test(sp))
cdp += cdp->op;
else
cdp++;
cell_destroy(sp);
sp--;
break;
case _JZ:
/* jmp if top of stack is zero and pop stack */
if (!test(sp))
cdp += cdp->op;
else
cdp++;
cell_destroy(sp);
sp--;
break;
case _LJZ:
/* special jump for logical and */
/* this is always preceded by _TEST */
if (sp->dval == 0.0) {
/* take jump, but don't pop stack */
cdp += cdp->op;
} else {
/* pop and don't jump */
sp--;
cdp++;
}
break;
case _LJNZ:
/* special jump for logical or */
/* this is always preceded by _TEST */
if (sp->dval != 0.0) {
/* take jump, but don't pop stack */
cdp += cdp->op;
} else {
/* pop and don't jump */
sp--;
cdp++;
}
break;
/* the relation operations */
/* compare() makes sure string ref counts are OK */
case _EQ:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t == 0 ? 1.0 : 0.0;
break;
case _NEQ:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t ? 1.0 : 0.0;
break;
case _LT:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t < 0 ? 1.0 : 0.0;
break;
case _LTE:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t <= 0 ? 1.0 : 0.0;
break;
case _GT:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t > 0 ? 1.0 : 0.0;
break;
case _GTE:
t = compare(--sp);
sp->type = C_DOUBLE;
sp->dval = t >= 0 ? 1.0 : 0.0;
break;
case _MATCH0:
/* does $0 match, the RE at cdp? */
inc_sp();
if (field->type >= C_STRING) {
sp->type = C_DOUBLE;
sp->dval = (REtest(string(field)->str,
string(field)->len,
cast_to_re((cdp++)->ptr))
? 1.0
: 0.0);
break /* the case */ ;
} else {
cellcpy(sp, field);
/* and FALL THRU */
}
case _MATCH1:
/* does expr at sp[0] match RE at cdp */
if (sp->type < C_STRING)
cast1_to_s(sp);
t = REtest(string(sp)->str,
string(sp)->len,
cast_to_re((cdp++)->ptr));
free_STRING(string(sp));
sp->type = C_DOUBLE;
sp->dval = t ? 1.0 : 0.0;
break;
case _MATCH2:
/* does sp[-1] match sp[0] as re */
cast_to_RE(sp);
if ((--sp)->type < C_STRING)
cast1_to_s(sp);
t = REtest(string(sp)->str,
string(sp)->len,
cast_to_re((sp + 1)->ptr));
free_STRING(string(sp));
no_leaks_re_ptr((sp + 1)->ptr);
sp->type = C_DOUBLE;
sp->dval = t ? 1.0 : 0.0;
break;
case A_LENGTH:
sp--;
sp->type = C_DOUBLE;
sp->dval = (double) (((ARRAY) ((sp + 0)->ptr))->size);
break;
case A_TEST:
/* entry : sp[0].ptr-> an array
sp[-1] is an expression
we compute (expression in array) */
sp--;
cp = array_find((sp + 1)->ptr, sp, NO_CREATE);
cell_destroy(sp);
sp->type = C_DOUBLE;
sp->dval = (cp != (CELL *) 0) ? 1.0 : 0.0;
break;
case A_DEL:
/* sp[0].ptr -> array
sp[-1] is an expr
delete array[expr] */
array_delete(sp->ptr, sp - 1);
cell_destroy(sp - 1);
sp -= 2;
break;
case DEL_A:
/* free all the array at once */
array_clear(sp->ptr);
sp--;
break;
/* form a multiple array index */
case A_CAT:
sp = array_cat(sp, (cdp++)->op);
break;
case _EXIT:
if (sp->type != C_DOUBLE)
cast1_to_d(sp);
exit_code = d_to_i(sp->dval);
sp--;
/* fall thru */
case _EXIT0:
if (force_exit)
mawk_exit(exit_code);
cdp = end_start;
force_exit = 1; /* makes sure next exit exits */
if (begin_start) {
free_codes("BEGIN", begin_start, begin_size);
begin_start = 0;
begin_size = 0;
}
if (main_start) {
free_codes("MAIN", main_start, main_size);
main_start = 0;
main_size = 0;
}
sp = eval_stack - 1; /* might be in user function */
CLEAR_ALOOP_STACK(); /* ditto */
break;
case _JMAIN: /* go from BEGIN code to MAIN code */
free_codes("BEGIN", begin_start, begin_size);
begin_start = 0;
begin_size = 0;
cdp = main_start;
break;
case _OMAIN:
if (!main_fin)
open_main();
restart_label = cdp;
cdp = next_label;
break;
case _NEXT:
/* next might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
cdp = next_label;
break;
case _NEXTFILE:
/* nextfile might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
FINsemi_close(main_fin);
cdp = next_label;
break;
case OL_GL:
{
char *p;
size_t len;
if (!(p = FINgets(main_fin, &len))) {
if (force_exit)
mawk_exit(0);
cdp = end_start;
zfree(main_start, main_size);
main_start = (INST *) 0;
force_exit = 1;
} else {
set_field0(p, len);
cdp = restart_label;
rt_nr++;
rt_fnr++;
}
}
break;
/* two kinds of OL_GL is a historical stupidity from working on
a machine with very slow floating point emulation */
case OL_GL_NR:
{
char *p;
size_t len;
if (!(p = FINgets(main_fin, &len))) {
if (force_exit)
mawk_exit(0);
cdp = end_start;
zfree(main_start, main_size);
main_start = (INST *) 0;
force_exit = 1;
} else {
set_field0(p, len);
cdp = restart_label;
if (TEST2(NR) != TWO_DOUBLES)
cast2_to_d(NR);
NR->dval += 1.0;
rt_nr++;
FNR->dval += 1.0;
rt_fnr++;
}
}
break;
case _RANGE:
/* test a range pattern: pat1, pat2 { action }
entry :
cdp[0].op -- a flag, test pat1 if on else pat2
cdp[1].op -- offset of pat2 code from cdp
cdp[2].op -- offset of action code from cdp
cdp[3].op -- offset of code after the action from cdp
cdp[4] -- start of pat1 code
*/
#define FLAG cdp[0].op
#define PAT2 cdp[1].op
#define ACTION cdp[2].op
#define FOLLOW cdp[3].op
#define PAT1 4
if (FLAG) /* test against pat1 */
{
execute(cdp + PAT1, sp, fp);
t = test(sp + 1);
cell_destroy(sp + 1);
if (t)
FLAG = 0;
else {
cdp += FOLLOW;
break; /* break the switch */
}
}
/* test against pat2 and then perform the action */
execute(cdp + PAT2, sp, fp);
FLAG = test(sp + 1);
cell_destroy(sp + 1);
cdp += ACTION;
break;
/* function calls */
case _RET0:
inc_sp();
sp->type = C_NOINIT;
/* fall thru */
case _RET:
#ifdef DEBUG
if (sp != entry_sp + 1)
bozo("ret");
#endif
if (old_stack_base) /* reset stack */
{
/* move the return value */
cellcpy(old_sp + 1, sp);
cell_destroy(sp);
zfree(stack_base, sizeof(CELL) * EVAL_STACK_SIZE);
stack_base = old_stack_base;
stack_danger = old_stack_base + DANGER;
}
/* return might be inside an aloop -- clear stack */
CLEAR_ALOOP_STACK();
return;
case _CALL:
/* cdp[0] holds ptr to "function block"
cdp[1] holds number of input arguments
*/
{
FBLOCK *fbp = (FBLOCK *) (cdp++)->ptr;
int a_args = (cdp++)->op; /* actual number of args */
CELL *nfp = sp - a_args + 1; /* new fp for callee */
CELL *local_p = sp + 1; /* first local argument on stack */
char *type_p = 0; /* pts to type of an argument */
if (fbp->nargs)
type_p = fbp->typev + a_args - 1;
/* create space for locals */
t = fbp->nargs - a_args; /* t is number of locals */
while (t > 0) {
t--;
sp++;
type_p++;
sp->type = C_NOINIT;
if ((type_p) != 0 && (*type_p == ST_LOCAL_ARRAY))
sp->ptr = (PTR) new_ARRAY();
}
execute(fbp->code, sp, nfp);
/* cleanup the callee's arguments */
/* putting return value at top of eval stack */
if ((type_p != 0) && (sp >= nfp)) {
cp = sp + 1; /* cp -> the function return */
do {
if (*type_p == ST_LOCAL_ARRAY) {
if (sp >= local_p) {
array_clear(sp->ptr);
ZFREE((ARRAY) sp->ptr);
}
} else {
cell_destroy(sp);
}
type_p--;
sp--;
}
while (sp >= nfp);
cellcpy(++sp, cp);
cell_destroy(cp);
} else
sp++; /* no arguments passed */
}
break;
default:
bozo("bad opcode");
}
}
}
void array_delete(
ARRAY A,
CELL *cp)
{
ANODE *ap ;
int redid ;
if (A->size == 0) return ;
switch(cp->type) {
case C_DOUBLE :
{
double d = cp->dval ;
Int ival = d_to_I(d) ;
if ((double)ival == d) {
if (A->type == AY_SPLIT)
{
if (ival >=1 && ival <= (int) A->size)
convert_split_array_to_table(A) ;
else return ; /* ival not in range */
}
ap = find_by_ival(A, ival, NO_CREATE, &redid) ;
if (ap) { /* remove from the front of the ilist */
DUAL_LINK *table = (DUAL_LINK*) A->ptr ;
table[(unsigned) ap->ival & A->hmask].ilink = ap->ilink ;
if (ap->sval) {
ANODE *p, *q = 0 ;
unsigned indx = (unsigned) ap->hval & A->hmask ;
p = table[indx].slink ;
while(p != ap) {
q = p ;
p = q->slink ;
}
if (q) q->slink = p->slink ;
else table[indx].slink = p->slink ;
free_STRING(ap->sval) ;
}
cell_destroy(&ap->cell) ;
ZFREE(ap) ;
if (--A->size == 0) array_clear(A) ;
}
return ;
}
else { /* get the string value */
char buff[260] ;
STRING *sval ;
sprintf(buff, string(CONVFMT)->str, d) ;
sval = new_STRING(buff) ;
ap = find_by_sval(A, sval, NO_CREATE, &redid) ;
free_STRING(sval) ;
}
}
break ;
case C_NOINIT :
ap = find_by_sval(A, &null_str, NO_CREATE, &redid) ;
break ;
default :
ap = find_by_sval(A, string(cp), NO_CREATE, &redid) ;
break ;
}
if (ap) { /* remove from the front of the slist */
DUAL_LINK *table = (DUAL_LINK*) A->ptr ;
table[ap->hval & A->hmask].slink = ap->slink ;
if (ap->ival != NOT_AN_IVALUE) {
ANODE *p, *q = 0 ;
unsigned indx = (unsigned) ap->ival & A->hmask ;
p = table[indx].ilink ;
while(p != ap) {
q = p ;
p = q->ilink ;
}
if (q) q->ilink = p->ilink ;
else table[indx].ilink = p->ilink ;
}
free_STRING(ap->sval) ;
cell_destroy(&ap->cell) ;
ZFREE(ap) ;
if (--A->size == 0) array_clear(A) ;
}
}
void
field_assign(CELL * fp, CELL * cp)
{
CELL c;
int i, j;
/* the most common case first */
if (fp == field) {
cell_destroy(field);
cellcpy(fp, cp);
nf = -1;
return;
}
/* its not important to do any of this fast */
if (nf < 0)
split_field0();
#ifdef MSDOS
if (!SAMESEG(fp, field)) {
i = -1;
goto lm_dos_label;
}
#endif
switch (i = (int) (fp - field)) {
case NF_field:
cell_destroy(NF);
cellcpy(NF, cellcpy(&c, cp));
if (c.type != C_DOUBLE)
cast1_to_d(&c);
if ((j = d_to_i(c.dval)) < 0)
rt_error("negative value assigned to NF");
if (j > nf)
for (i = nf + 1; i <= j; i++) {
cp = field_ptr(i);
cell_destroy(cp);
cp->type = C_STRING;
cp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
nf = j;
build_field0();
break;
case RS_field:
cell_destroy(RS);
cellcpy(RS, cp);
set_rs_shadow();
break;
case FS_field:
cell_destroy(FS);
cast_for_split(cellcpy(&fs_shadow, cellcpy(FS, cp)));
break;
case OFMT_field:
case CONVFMT_field:
/* If the user does something stupid with OFMT or CONVFMT,
we could crash.
We'll make an attempt to protect ourselves here. This is
why OFMT and CONVFMT are pseudo fields.
The ptrs of OFMT and CONVFMT always have a valid STRING,
even if assigned a DOUBLE or NOINIT
*/
free_STRING(string(fp));
cellcpy(fp, cp);
if (fp->type < C_STRING) /* !! */
fp->ptr = (PTR) new_STRING("%.6g");
else if (fp == CONVFMT) {
/* It's a string, but if it's really goofy and CONVFMT,
it could still damage us. Test it .
*/
char xbuff[512];
xbuff[256] = 0;
sprintf(xbuff, string(fp)->str, 3.1459);
if (xbuff[256])
rt_error("CONVFMT assigned unusable value");
}
break;
#ifdef MSDOS
lm_dos_label:
#endif
default: /* $1 or $2 or ... */
cell_destroy(fp);
cellcpy(fp, cp);
if (i < 0 || i > MAX_SPLIT)
i = field_addr_to_index(fp);
if (i > nf) {
for (j = nf + 1; j < i; j++) {
cp = field_ptr(j);
cell_destroy(cp);
cp->type = C_STRING;
cp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
}
nf = i;
cell_destroy(NF);
NF->type = C_DOUBLE;
NF->dval = (double) i;
}
build_field0();
}
}
static void
build_field0(void)
{
#ifdef DEBUG
if (nf < 0)
bozo("nf <0 in build_field0");
#endif
cell_destroy(field + 0);
if (nf == 0) {
field[0].type = C_STRING;
field[0].ptr = (PTR) & null_str;
null_str.ref_cnt++;
} else if (nf == 1) {
cellcpy(field, field + 1);
} else {
CELL c;
STRING *ofs, *tail;
size_t len;
register CELL *cp;
register char *p, *q;
int cnt;
CELL **fbp, *cp_limit;
cast1_to_s(cellcpy(&c, OFS));
ofs = (STRING *) c.ptr;
cast1_to_s(cellcpy(&c, field_ptr(nf)));
tail = (STRING *) c.ptr;
cnt = nf - 1;
len = ((size_t) cnt) * ofs->len + tail->len;
fbp = fbank;
cp_limit = field + FBANK_SZ;
cp = field + 1;
while (cnt-- > 0) {
if (cp->type < C_STRING) { /* use the string field temporarily */
if (cp->type == C_NOINIT) {
cp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
} else { /* its a double */
Int ival;
char xbuff[260];
ival = d_to_I(cp->dval);
if (ival == cp->dval)
sprintf(xbuff, INT_FMT, ival);
else
sprintf(xbuff, string(CONVFMT)->str, cp->dval);
cp->ptr = (PTR) new_STRING(xbuff);
}
}
len += string(cp)->len;
if (++cp == cp_limit) {
cp = *++fbp;
cp_limit = cp + FBANK_SZ;
}
}
field[0].type = C_STRING;
field[0].ptr = (PTR) new_STRING0(len);
p = string(field)->str;
/* walk it again , putting things together */
cnt = nf - 1;
fbp = fbank;
cp = field + 1;
cp_limit = field + FBANK_SZ;
while (cnt-- > 0) {
memcpy(p, string(cp)->str, string(cp)->len);
p += string(cp)->len;
/* if not really string, free temp use of ptr */
if (cp->type < C_STRING) {
free_STRING(string(cp));
}
if (++cp == cp_limit) {
cp = *++fbp;
cp_limit = cp + FBANK_SZ;
}
/* add the separator */
q = ofs->str;
while (*q)
*p++ = *q++;
}
/* tack tail on the end */
memcpy(p, tail->str, tail->len);
/* cleanup */
free_STRING(tail);
free_STRING(ofs);
}
}
CELL *
bi_substr(CELL *sp)
{
int n_args, len;
register int i, n;
STRING *sval; /* substr(sval->str, i, n) */
TRACE_FUNC("bi_substr", sp);
n_args = sp->type;
sp -= n_args;
if (sp->type != C_STRING)
cast1_to_s(sp);
/* don't use < C_STRING shortcut */
sval = string(sp);
if ((len = (int) sval->len) == 0) /* substr on null string */
{
if (n_args == 3) {
cell_destroy(sp + 2);
}
cell_destroy(sp + 1);
return_CELL("bi_substr", sp);
}
if (n_args == 2) {
n = len;
if (sp[1].type != C_DOUBLE) {
cast1_to_d(sp + 1);
}
} else {
if (TEST2(sp + 1) != TWO_DOUBLES)
cast2_to_d(sp + 1);
n = d_to_i(sp[2].dval);
}
i = d_to_i(sp[1].dval) - 1; /* i now indexes into string */
/*
* If the starting index is past the end of the string, there is nothing
* to extract other than an empty string.
*/
if (i > len) {
n = 0;
}
/*
* Workaround in case someone's written a script that does substr(0,last-1)
* by transforming it into substr(1,last).
*/
if (i < 0) {
n -= i + 1;
i = 0;
}
/*
* Keep 'n' from extending past the end of the string.
*/
if (n > len - i) {
n = len - i;
}
if (n <= 0) /* the null string */
{
sp->ptr = (PTR) & null_str;
null_str.ref_cnt++;
} else { /* got something */
sp->ptr = (PTR) new_STRING0((size_t) n);
memcpy(string(sp)->str, sval->str + i, (size_t) n);
}
free_STRING(sval);
return_CELL("bi_substr", sp);
}
static void
process_cmdline(int argc, char **argv)
{
int i, j, nextarg;
char *optArg;
char *optNext;
PFILE dummy; /* starts linked list of filenames */
PFILE *tail = &dummy;
size_t length;
if (argc <= 1)
usage();
for (i = 1; i < argc && argv[i][0] == '-'; i = nextarg) {
if (argv[i][1] == 0) /* - alone */
{
if (!pfile_name)
no_program();
break; /* the for loop */
}
/* safe to look at argv[i][2] */
/*
* Check for "long" options and decide how to handle them.
*/
if (strlen(argv[i]) > 2 && !strncmp(argv[i], "--", (size_t) 2)) {
if (!allow_long_options(argv[i])) {
nextarg = i + 1;
continue;
}
}
if (argv[i][2] == 0) {
if (i == argc - 1 && argv[i][1] != '-') {
if (strchr("WFvf", argv[i][1])) {
errmsg(0, "option %s lacks argument", argv[i]);
mawk_exit(2);
}
bad_option(argv[i]);
}
optArg = argv[i + 1];
nextarg = i + 2;
} else { /* argument glued to option */
optArg = &argv[i][2];
nextarg = i + 1;
}
switch (argv[i][1]) {
case 'W':
for (j = 0; j < (int) strlen(optArg); j = (int) (optNext - optArg)) {
switch (parse_w_opt(optArg + j, &optNext)) {
case W_VERSION:
print_version();
break;
#if USE_BINMODE
case W_BINMODE:
if (haveValue(optNext)) {
set_binmode(atoi(optNext + 1));
optNext = skipValue(optNext);
} else {
errmsg(0, "missing value for -W binmode");
mawk_exit(2);
}
break;
#endif
case W_DUMP:
dump_code_flag = 1;
break;
case W_EXEC:
if (pfile_name) {
errmsg(0, "-W exec is incompatible with -f");
mawk_exit(2);
} else if (nextarg == argc) {
no_program();
}
if (haveValue(optNext)) {
pfile_name = optNext + 1;
i = nextarg;
} else {
pfile_name = argv[nextarg];
i = nextarg + 1;
}
goto no_more_opts;
case W_INTERACTIVE:
interactive_flag = 1;
setbuf(stdout, (char *) 0);
break;
case W_POSIX_SPACE:
posix_space_flag = 1;
break;
case W_RANDOM:
if (haveValue(optNext)) {
int x = atoi(optNext + 1);
CELL c[2];
memset(c, 0, sizeof(c));
c[1].type = C_DOUBLE;
c[1].dval = (double) x;
/* c[1] is input, c[0] is output */
bi_srand(c + 1);
optNext = skipValue(optNext);
} else {
errmsg(0, "missing value for -W random");
mawk_exit(2);
}
break;
case W_SPRINTF:
if (haveValue(optNext)) {
int x = atoi(optNext + 1);
if (x > (int) sizeof(string_buff)) {
if (sprintf_buff != string_buff &&
sprintf_buff != 0) {
zfree(sprintf_buff,
(size_t) (sprintf_limit - sprintf_buff));
}
sprintf_buff = (char *) zmalloc((size_t) x);
sprintf_limit = sprintf_buff + x;
}
optNext = skipValue(optNext);
} else {
errmsg(0, "missing value for -W sprintf");
mawk_exit(2);
}
break;
case W_HELP:
/* FALLTHRU */
case W_USAGE:
usage();
/* NOTREACHED */
break;
case W_UNKNOWN:
errmsg(0, "vacuous option: -W %s", optArg + j);
break;
}
while (*optNext == '=') {
errmsg(0, "unexpected option value %s", optArg + j);
optNext = skipValue(optNext);
}
}
break;
case 'v':
if (!is_cmdline_assign(optArg)) {
errmsg(0, "improper assignment: -v %s", optArg);
mawk_exit(2);
}
break;
case 'F':
rm_escape(optArg, &length); /* recognize escape sequences */
cell_destroy(FS);
FS->type = C_STRING;
FS->ptr = (PTR) new_STRING1(optArg, length);
cast_for_split(cellcpy(&fs_shadow, FS));
break;
case '-':
if (argv[i][2] != 0) {
bad_option(argv[i]);
}
i++;
goto no_more_opts;
case 'f':
/* first file goes in pfile_name ; any more go
on a list */
if (!pfile_name)
pfile_name = optArg;
else {
tail = tail->link = ZMALLOC(PFILE);
tail->fname = optArg;
}
break;
default:
bad_option(argv[i]);
}
}
no_more_opts:
tail->link = (PFILE *) 0;
pfile_list = dummy.link;
if (pfile_name) {
set_ARGV(argc, argv, i);
scan_init((char *) 0);
} else { /* program on command line */
if (i == argc)
no_program();
set_ARGV(argc, argv, i + 1);
#if defined(MSDOS) && ! HAVE_REARGV /* reversed quotes */
{
char *p;
for (p = argv[i]; *p; p++)
if (*p == '\'')
*p = '\"';
}
#endif
scan_init(argv[i]);
/* #endif */
}
}
CELL *
bi_strftime(CELL *sp)
{
const char *format = "%c";
time_t rawtime;
struct tm *ptm;
int n_args;
int utc;
STRING *sval = 0; /* strftime(sval->str, timestamp, utc) */
char buff[128];
size_t result;
TRACE_FUNC("bi_strftime", sp);
n_args = sp->type;
sp -= n_args;
if (n_args > 0) {
if (sp->type != C_STRING)
cast1_to_s(sp);
/* don't use < C_STRING shortcut */
sval = string(sp);
if ((int) sval->len != 0) /* strftime on valid format */
format = sval->str;
} else {
sp->type = C_STRING;
}
if (n_args > 1) {
if (sp[1].type != C_DOUBLE)
cast1_to_d(sp + 1);
rawtime = d_to_i(sp[1].dval);
} else {
time(&rawtime);
}
if (n_args > 2) {
if (sp[2].type != C_DOUBLE)
cast1_to_d(sp + 2);
utc = d_to_i(sp[2].dval);
} else {
utc = 0;
}
if (utc != 0)
ptm = gmtime(&rawtime);
else
ptm = localtime(&rawtime);
result = strftime(buff, sizeof(buff) / sizeof(buff[0]), format, ptm);
TRACE(("...bi_strftime (%s, \"%d.%d.%d %d.%d.%d %d\", %d) ->%s\n",
format,
ptm->tm_year,
ptm->tm_mon,
ptm->tm_mday,
ptm->tm_hour,
ptm->tm_min,
ptm->tm_sec,
ptm->tm_isdst,
utc,
buff));
if (sval)
free_STRING(sval);
sp->ptr = (PTR) new_STRING1(buff, result);
while (n_args > 1) {
n_args--;
cell_destroy(sp + n_args);
}
return_CELL("bi_strftime", sp);
}
int
is_cmdline_assign(char *s)
{
register char *p;
int c;
SYMTAB *stp;
CELL *cp = 0;
size_t len;
CELL cell; /* used if command line assign to pseudo field */
CELL *fp = (CELL *) 0; /* ditto */
size_t length;
if (scan_code[*(unsigned char *) s] != SC_IDCHAR)
return 0;
p = s + 1;
while ((c = scan_code[*(unsigned char *) p]) == SC_IDCHAR
|| c == SC_DIGIT)
p++;
if (*p != '=')
return 0;
*p = 0;
stp = find(s);
switch (stp->type) {
case ST_NONE:
stp->type = ST_VAR;
stp->stval.cp = cp = ZMALLOC(CELL);
break;
case ST_VAR:
case ST_NR: /* !! no one will do this */
cp = stp->stval.cp;
cell_destroy(cp);
break;
case ST_FIELD:
/* must be pseudo field */
fp = stp->stval.cp;
cp = &cell;
break;
default:
rt_error(
"cannot command line assign to %s\n\ttype clash or keyword"
,s);
}
/* we need to keep ARGV[i] intact */
*p++ = '=';
len = strlen(p) + 1;
/* posix says escape sequences are on from command line */
p = rm_escape(strcpy((char *) zmalloc(len), p), &length);
cp->ptr = (PTR) new_STRING1(p, length);
zfree(p, len);
check_strnum(cp); /* sets cp->type */
if (fp) /* move it from cell to pfield[] */
{
field_assign(fp, cp);
free_STRING(string(cp));
}
return 1;
}
/* get the next command line file open */
static FIN *
next_main(int open_flag) /* called by open_main() if on */
{
register CELL *cp;
CELL *cp0;
CELL argc; /* copy of ARGC */
CELL c_argi; /* cell copy of argi */
CELL argval; /* copy of ARGV[c_argi] */
int failed = 1;
argval.type = C_NOINIT;
c_argi.type = C_DOUBLE;
if (main_fin) {
FINclose(main_fin);
main_fin = 0;
}
/* FILENAME and FNR don't change unless we really open
a new file */
/* make a copy of ARGC to avoid side effect */
if (cellcpy(&argc, ARGC)->type != C_DOUBLE)
cast1_to_d(&argc);
while (argi < argc.dval) {
c_argi.dval = argi;
argi += 1.0;
if (!(cp0 = array_find(Argv, &c_argi, NO_CREATE)))
continue; /* its deleted */
/* make a copy so we can cast w/o side effect */
cell_destroy(&argval);
cp = cellcpy(&argval, cp0);
#ifndef NO_LEAKS
cell_destroy(cp0);
#endif
if (cp->type < C_STRING)
cast1_to_s(cp);
if (string(cp)->len == 0) {
/* file argument is "" */
cell_destroy(cp);
continue;
}
/* it might be a command line assignment */
if (is_cmdline_assign(string(cp)->str)) {
continue;
}
/* try to open it -- we used to continue on failure,
but posix says we should quit */
if (!(main_fin = FINopen(string(cp)->str, 1))) {
errmsg(errno, "cannot open %s", string(cp)->str);
mawk_exit(2);
}
/* success -- set FILENAME and FNR */
cell_destroy(FILENAME);
cellcpy(FILENAME, cp);
cell_destroy(cp);
cell_destroy(FNR);
FNR->type = C_DOUBLE;
FNR->dval = 0.0;
rt_fnr = 0;
failed = 0;
break;
}
if (failed) {
cell_destroy(&argval);
if (open_flag) {
/* all arguments were null or assignment */
set_main_to_stdin();
} else {
main_fin = &dead_main;
/* since MAIN_FLAG is not set, FINgets won't call next_main() */
}
}
return main_fin;
}