2
/* Lefteris Koutsofios - AT&T Bell Laboratories */
13
static int lvarn, llvari, flvari;
15
#define LVARSIZE sizeof (lvar_t)
20
int Eerrlevel, Estackdepth, Eshowbody, Eshowcalls, Eoktorun;
22
#define PUSHJMP(op, np, b) op = (volatile jmp_buf *) np, np = (jmp_buf *) &b
23
#define POPJMP(op, np) np = (jmp_buf *) op
25
/* longjmps for normal program execution */
27
PLJ_BREAK, PLJ_CONTINUE, PLJ_RETURN, PLJ_SIZE
29
static jmp_buf *pljbufp1, *pljbufp2;
30
static PLJtype_t pljtype;
32
/* longjmp for error handling */
33
static jmp_buf *eljbufp;
35
/* error levels and types */
37
ERR0, ERR1, ERR2, ERR3, ERR4, ERR5
40
ERRNOLHS, ERRNORHS, ERRNOSUCHFUNC, ERRBADARG, ERRARGMIS, ERRNOTATABLE,
41
ERRIFUNCERR, ERRRECRUN, ERRTABLECHANGED
43
static char *errnam[] = {
48
"argument number mismatch",
50
"internal function call error",
51
"recursive run attempt",
52
"table changed during a forin loop",
57
/* stack information */
58
typedef struct sinfo_t {
63
#define SINFOSIZE sizeof (sinfo_t)
65
static sinfo_t *sinfop;
66
static int sinfoi, sinfon;
71
typedef struct tnk_t {
86
typedef struct num_tt {
98
static Tobj eeval (Tobj, int);
99
static Tobj efcall (Tobj, int);
100
static void ewhilest (Tobj, int);
101
static void eforst (Tobj, int);
102
static void eforinst (Tobj, int);
104
static Tobj getval (Tobj, int);
105
static int getvar (Tobj, int, tnk_t *);
106
static void setvar (tnk_t, Tobj);
107
static int boolop (Tobj);
108
static int orderop (Tobj, Ctype_t, Tobj);
109
static Tobj arithop (num_tt *, Ctype_t, num_tt *);
110
static void err (int, int, Tobj, int);
111
static void printbody (char *, int);
115
rootm = Mpushmark (root);
116
Tinss (root, "null", (null = Ttable (2)));
118
pljbufp1 = pljbufp2 = NULL, pljtype = 0;
120
lvarp = Marrayalloc ((long) LVARINCR * LVARSIZE);
124
sinfop = Marrayalloc ((long) SINFOINCR * SINFOSIZE);
133
Marrayfree (sinfop), sinfop = NULL, sinfon = 0, sinfoi = 0;
134
Marrayfree (lvarp), lvarp = NULL, lvarn = 0, llvari = 0, flvari = 0;
140
Tobj Eunit (Tobj co) {
141
volatile jmp_buf *oeljbufp;
142
volatile int ownsinfoi;
149
if (running && !Eoktorun) {
150
err (ERRRECRUN, ERR2, NULL, 0);
159
if (Tgettype (co) != T_CODE)
160
panic (POS, "Eunit", "argument type is not T_CODE");
163
PUSHJMP (oeljbufp, eljbufp, eljbuf);
164
ownsinfoi = sinfoi++;
165
if (sinfoi == sinfon) {
166
sinfop = Marraygrow (sinfop, (long) (sinfon + SINFOINCR) * SINFOSIZE);
169
sinfop[ownsinfoi].co = co;
170
sinfop[ownsinfoi].ci = TCgetfp (co, 0);
171
sinfop[ownsinfoi].fco = NULL;
172
sinfop[ownsinfoi].flvari = flvari;
173
sinfop[ownsinfoi].llvari = llvari;
175
if (setjmp (*eljbufp))
178
lrtno = eeval (co, TCgetfp (co, 0));
181
flvari = sinfop[ownsinfoi].flvari;
182
llvari = sinfop[ownsinfoi].llvari;
184
POPJMP (oeljbufp, eljbufp);
190
/* shortcut: this function executes a piece of code that corresponds to
191
<internal func name> = function () internal "<internal func name>";
193
Tobj Efunction (Tobj co, char *ifnam) {
197
fi = TCgetnext (co, TCgetfp (co, TCgetfp (co, 0)));
198
v1o = Tcode (TCgetaddr (co, fi), fi,
199
(int) TCgetinteger (co, TCgetfp (co, fi)));
200
Tinss (root, ifnam, v1o);
204
static Tobj eeval (Tobj co, int ci) {
216
ctype = TCgettype (co, ci);
219
i1 = TCgetfp (co, ci);
220
if ((v1o = eeval (co, TCgetnext (co, i1))) == NULL) {
221
err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
224
m1 = Mpushmark (v1o);
225
res = getvar (co, i1, &tnk);
228
err (ERRNOLHS, ERR3, co, i1);
236
i1 = TCgetfp (co, ci);
237
if ((v1o = eeval (co, i1)) == NULL)
238
err (ERRNORHS, ERR4, co, i1);
241
if (boolop (v1o) == TRUE)
243
if ((v1o = eeval (co, TCgetnext (co, i1))) == NULL)
244
err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
245
return (boolop (v1o) == TRUE) ? Ttrue: Tfalse;
247
if (boolop (v1o) == FALSE)
249
if ((v1o = eeval (co, TCgetnext (co, i1))) == NULL)
250
err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
251
return (boolop (v1o) == FALSE) ? Tfalse: Ttrue;
253
return (boolop (v1o) == TRUE) ? Tfalse: Ttrue;
263
i1 = TCgetfp (co, ci);
264
if ((v1o = eeval (co, i1)) == NULL)
265
err (ERRNORHS, ERR4, co, i1);
267
m1 = Mpushmark (v1o);
268
if ((v2o = eeval (co, TCgetnext (co, i1))) == NULL)
269
err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
272
return (orderop (v1o, ctype, v2o) == TRUE) ? Ttrue: Tfalse;
279
i1 = TCgetfp (co, ci);
280
if ((lnum.type = TCgettype (co, i1)) == C_INTEGER)
281
lnum.u.i = TCgetinteger (co, i1);
282
else if (lnum.type == C_REAL)
283
lnum.u.d = TCgetreal (co, i1);
284
else if ((lnum.u.no = eeval (co, i1)) == NULL) {
285
err (ERRNORHS, ERR4, co, i1);
288
if (ctype == C_UMINUS) {
289
if (!(v1o = arithop (&lnum, ctype, NULL)))
290
err (ERRNORHS, ERR4, co, ci);
293
if (lnum.type != C_INTEGER && lnum.type != C_REAL)
294
m1 = Mpushmark (lnum.u.no);
295
i1 = TCgetnext (co, i1);
296
if ((rnum.type = TCgettype (co, i1)) == C_INTEGER)
297
rnum.u.i = TCgetinteger (co, i1);
298
else if (rnum.type == C_REAL)
299
rnum.u.d = TCgetreal (co, i1);
300
else if ((rnum.u.no = eeval (co, i1)) == NULL)
301
err (ERRNORHS, ERR4, co, i1);
302
if (lnum.type != C_INTEGER && lnum.type != C_REAL)
304
if (!(v1o = arithop (&lnum, ctype, &rnum)))
305
err (ERRNORHS, ERR4, co, ci);
308
ci = TCgetfp (co, ci);
311
return efcall (co, ci);
313
return Tinteger (TCgetinteger (co, ci));
315
return Treal (TCgetreal (co, ci));
317
return Tstring (TCgetstring (co, ci));
321
return getval (co, ci);
323
return Tcode (TCgetaddr (co, ci), ci,
324
(int) TCgetinteger (co, TCgetfp (co, ci)));
327
m1 = Mpushmark (v1o);
328
for (i1 = TCgetfp (co, ci); i1 != C_NULL;
329
i1 = TCgetnext (co, TCgetnext (co, i1))) {
330
if (!(v3o = eeval (co, TCgetnext (co, i1)))) {
331
err (ERRNORHS, ERR4, co, TCgetnext (co, i1));
334
m2 = Mpushmark (v3o);
335
if (!(v2o = eeval (co, i1))) {
336
err (ERRNOLHS, ERR3, co, i1);
340
ttype = Tgettype (v2o);
341
if (ttype == T_INTEGER || ttype == T_REAL || ttype == T_STRING)
342
Tinso (v1o, v2o, v3o);
344
err (ERRNOLHS, ERR1, co, i1);
349
for (i1 = TCgetfp (co, ci); i1 != C_NULL; )
350
if ((i2 = TCgetnext (co, i1)) != C_NULL) {
360
i1 = TCgetfp (co, ci);
361
if (!(v1o = eeval (co, i1)))
362
err (ERRNORHS, ERR5, co, i1);
363
if (boolop (v1o) == TRUE) {
364
ci = TCgetnext (co, i1);
366
} else if ((ci = TCgetnext (co, TCgetnext (co, i1))) != C_NULL)
380
longjmp (*pljbufp1, 1);
384
pljtype = PLJ_CONTINUE;
385
longjmp (*pljbufp1, 1);
389
if ((i1 = TCgetfp (co, ci)) != C_NULL)
390
rtno = eeval (co, i1);
391
pljtype = PLJ_RETURN;
392
longjmp (*pljbufp2, 1);
396
panic (POS, "eeval", "unknown program token type %d", ctype);
401
static Tobj efcall (Tobj co, int ci) {
402
volatile jmp_buf *opljbufp1, *opljbufp2;
404
volatile int bi, ownsinfoi, li, ln;
408
int i, fci, ai, di, di1, fid;
410
ownsinfoi = sinfoi++;
411
if (sinfoi == sinfon) {
412
sinfop = Marraygrow (sinfop, (long) (sinfon + SINFOINCR) * SINFOSIZE);
415
sinfop[ownsinfoi].co = co;
416
sinfop[ownsinfoi].ci = ci;
417
sinfop[ownsinfoi].fco = NULL;
418
sinfop[ownsinfoi].flvari = flvari;
419
sinfop[ownsinfoi].llvari = llvari;
420
fci = TCgetfp (co, ci);
421
if (!(fdo = getval (co, fci)) || Tgettype (fdo) != T_CODE) {
422
err (ERRNOSUCHFUNC, ERR2, co, fci);
427
m = Mpushmark ((Tobj) fdo);
428
ai = TCgetfp (co, TCgetnext (co, fci));
429
ln = (int) TCgetinteger (fdo, (li = TCgetnext (fdo, TCgetfp (fdo, 0))));
430
di = TCgetnext (fdo, li);
431
bi = TCgetnext (fdo, di);
432
if (bi != C_NULL && TCgettype (fdo, bi) == C_INTERNAL) {
433
for (i = 0; ai != C_NULL; ai = TCgetnext (co, ai), i++) {
434
if (!(vo = eeval (co, ai))) {
435
err (ERRBADARG, ERR2, co, ai);
437
llvari = sinfop[ownsinfoi].llvari;
441
if (llvari + 1 > lvarn) {
442
lvarp = Marraygrow (lvarp, (long) (llvari + 1) * LVARSIZE);
445
lvarp[llvari].m = Mpushmark ((lvarp[llvari].o = vo));
448
fid = (int) TCgetinteger (fdo, TCgetfp (fdo, bi));
449
if (Ifuncs[fid].min > i || Ifuncs[fid].max < i) {
450
err (ERRARGMIS, ERR2, co, ci);
452
llvari = sinfop[ownsinfoi].llvari;
456
flvari = sinfop[ownsinfoi].llvari;
457
sinfop[ownsinfoi].fco = fdo;
458
sinfop[ownsinfoi].fci = bi;
459
if (fid < 0 || fid >= Ifuncn)
460
panic (POS, "efcall", "no such internal function: %d", fid);
462
if ((*Ifuncs[fid].func) (i, &lvarp[flvari]) == L_FAILURE) {
464
err (ERRIFUNCERR, ERR2, co, ci);
467
if (llvari + ln > lvarn) {
468
lvarp = Marraygrow (lvarp, (long) (llvari + ln) * LVARSIZE);
471
di1 = TCgetfp (fdo, di);
472
for (i = 0; i < ln && di1 != C_NULL && ai != C_NULL;
473
i++, ai = TCgetnext (co, ai)) {
474
if (!(vo = eeval (co, ai))) {
475
err (ERRBADARG, ERR2, co, ai);
477
llvari = sinfop[ownsinfoi].llvari;
481
lvarp[llvari].m = Mpushmark ((lvarp[llvari].o = vo));
483
di1 = TCgetnext (fdo, di1);
485
if (di1 != C_NULL || ai != C_NULL) {
486
err (ERRARGMIS, ERR2, co, ci);
488
llvari = sinfop[ownsinfoi].llvari;
492
for (; i < ln; i++, llvari++)
493
lvarp[llvari].m = Mpushmark ((lvarp[llvari].o = NULL));
494
flvari = sinfop[ownsinfoi].llvari;
495
PUSHJMP (opljbufp2, pljbufp2, pljbuf);
496
opljbufp1 = (volatile jmp_buf *) pljbufp1;
497
if (setjmp (*pljbufp2)) {
500
sinfop[ownsinfoi].fco = fdo;
501
for (; bi != C_NULL; bi = TCgetnext (fdo, bi)) {
502
sinfop[ownsinfoi].fci = bi;
503
if (TCgettype (fdo, bi) != C_DECL)
504
eeval ((Tobj) fdo, bi);
507
POPJMP (opljbufp2, pljbufp2);
508
pljbufp1 = (jmp_buf *) opljbufp1;
510
flvari = sinfop[ownsinfoi].flvari;
511
llvari = sinfop[ownsinfoi].llvari;
514
lrtno = rtno, rtno = NULL;
519
static void ewhilest (Tobj co, int ci) {
520
volatile jmp_buf *opljbufp;
521
volatile jmp_buf pljbuf;
527
c1o = (volatile Tobj) co; /* protect argument from longjmp */
528
ei = TCgetfp (c1o, ci);
529
si = TCgetnext (c1o, ei);
530
PUSHJMP (opljbufp, pljbufp1, pljbuf);
532
if (!(v1o = eeval ((Tobj) c1o, ei)))
533
err (ERRNORHS, ERR5, c1o, ei);
534
if (boolop (v1o) == FALSE)
536
if (setjmp (*pljbufp1)) {
537
if (pljtype == PLJ_CONTINUE)
539
else if (pljtype == PLJ_BREAK)
542
eeval ((Tobj) c1o, si);
544
POPJMP (opljbufp, pljbufp1);
547
static void eforst (Tobj co, int ci) {
548
volatile jmp_buf *opljbufp;
549
volatile jmp_buf pljbuf;
551
volatile int ei1, ei2, ei3, si, eisnop1, eisnop2, eisnop3;
555
c1o = (volatile Tobj) co; /* protect argument from longjmp */
556
ei1 = TCgetfp (c1o, ci);
557
ei2 = TCgetnext (c1o, ei1);
558
ei3 = TCgetnext (c1o, ei2);
559
si = TCgetnext (c1o, ei3);
560
eisnop1 = (TCgettype (c1o, ei1) == C_NOP);
561
eisnop2 = (TCgettype (c1o, ei2) == C_NOP);
562
eisnop3 = (TCgettype (c1o, ei3) == C_NOP);
563
PUSHJMP (opljbufp, pljbufp1, pljbuf);
565
eeval ((Tobj) c1o, ei1);
568
if (!(v1o = eeval ((Tobj) c1o, ei2)))
569
err (ERRNORHS, ERR5, c1o, ei2);
570
if (boolop (v1o) == FALSE)
573
if (setjmp (*pljbufp1) != 0) {
574
if (pljtype == PLJ_CONTINUE)
576
else if (pljtype == PLJ_BREAK)
579
eeval ((Tobj) c1o, si);
582
eeval ((Tobj) c1o, ei3);
584
POPJMP (opljbufp, pljbufp1);
587
static void eforinst (Tobj co, int ci) {
588
volatile jmp_buf *opljbufp;
589
volatile jmp_buf pljbuf;
590
volatile Tobj tblo, c1o;
591
volatile Tkvindex_t tkvi;
594
volatile int ei1, ei2, si;
596
c1o = (volatile Tobj) co; /* protect argument from longjmp */
597
ei1 = TCgetfp (c1o, ci);
598
ei2 = TCgetnext (c1o, ei1);
599
si = TCgetnext (c1o, ei2);
600
if (getvar ((Tobj) c1o, ei1, (tnk_t *) &tnk) == -1) {
601
err (ERRNOLHS, ERR3, c1o, ei1);
604
if (tnk.type == TNK_O)
605
km = Mpushmark (tnk.u.tnko.ko);
606
if (!(tblo = (volatile Tobj) eeval ((Tobj) c1o, ei2))) {
607
if (tnk.type == TNK_O)
609
err (ERRNORHS, ERR4, c1o, ei2);
612
if (Tgettype (tblo) != T_TABLE) {
613
err (ERRNOTATABLE, ERR1, c1o, ei2);
616
PUSHJMP (opljbufp, pljbufp1, pljbuf);
618
for (Tgetfirst ((Tobj) tblo, (Tkvindex_t *) &tkvi); tkvi.kvp;
619
Tgetnext ((Tkvindex_t *) &tkvi)) {
620
setvar (tnk, tkvi.kvp->ko);
621
if (setjmp (*pljbufp1) != 0) {
622
if (pljtype == PLJ_CONTINUE)
624
else if (pljtype == PLJ_BREAK)
627
eeval ((Tobj) c1o, si);
628
if (t != Tgettime (tblo)) {
629
err (ERRTABLECHANGED, ERR1, c1o, ei2);
633
POPJMP (opljbufp, pljbufp1);
634
if (tnk.type == TNK_O)
638
static Tobj getval (Tobj co, int ci) {
643
if ((ct = TCgettype (co, ci)) == C_LVAR) {
644
nn = (int) TCgetinteger (co, (ni = TCgetnext (co, TCgetfp (co, ci))));
645
cto = cvo = lvarp[flvari + nn].o;
648
vi = TCgetnext (co, ni);
649
} else if (ct == C_GVAR) {
651
vi = TCgetfp (co, ci);
652
} else if (ct == C_PVAR)
653
return TCgetobject (co, ci);
657
while (vi != C_NULL) {
658
if (Tgettype (cto) != T_TABLE)
660
if ((vt = TCgettype (co, vi)) == C_STRING) {
661
if (!(cvo = Tfinds (cto, TCgetstring (co, vi))))
663
} else if (vt == C_INTEGER) {
664
if (!(cvo = Tfindi (cto, TCgetinteger (co, vi))))
666
} else if (vt == C_REAL) {
667
if (!(cvo = Tfindr (cto, TCgetreal (co, vi))))
670
if (!(cko = eeval (co, vi)) || !(cvo = Tfindo (cto, cko)))
674
vi = TCgetnext (co, vi);
679
static int getvar (Tobj co, int ci, tnk_t *tnkp) {
685
if ((ct = TCgettype (co, ci)) == C_LVAR) {
686
nn = (int) TCgetinteger (co, (ni = TCgetnext (co, TCgetfp (co, ci))));
687
cvo = cto = lvarp[flvari + nn].o;
688
vi = TCgetnext (co, ni);
689
if (vi != C_NULL && (!cvo || Tgettype (cvo) != T_TABLE))
690
Mresetmark (lvarp[flvari + nn].m,
691
(lvarp[flvari + nn].o = cvo = cto = Ttable (0)));
692
} else if (ct == C_GVAR) { /* else it's a global variable */
694
vi = TCgetfp (co, ci);
700
while (vi != C_NULL) {
702
if ((vt = TCgettype (co, vi)) == C_STRING) {
703
cvo = Tfinds (cto, TCgetstring (co, vi));
704
} else if (vt == C_INTEGER) {
705
cvo = Tfindi (cto, TCgetinteger (co, vi));
706
} else if (vt == C_REAL) {
707
cvo = Tfindr (cto, TCgetreal (co, vi));
709
if (!(cko = eeval (co, vi)) || !(T_ISSTRING (cko) ||
712
cvo = Tfindo (cto, cko);
714
ovi = vi, vi = TCgetnext (co, vi);
715
if (vi != C_NULL && (!cvo || Tgettype (cvo) != T_TABLE)) {
717
Tinss (cto, TCgetstring (co, ovi), (cvo = Ttable (0)));
718
else if (vt == C_INTEGER)
719
Tinsi (cto, TCgetinteger (co, ovi), (cvo = Ttable (0)));
720
else if (vt == C_REAL)
721
Tinsr (cto, TCgetreal (co, ovi), (cvo = Ttable (0)));
723
m = Mpushmark (cko), Tinso (cto, cko, (cvo = Ttable (0))),
727
if (ct == C_LVAR && ovi == -1) {
736
tnkp->u.tnks.kt = vt;
737
tnkp->u.tnks.to = cto;
738
tnkp->u.tnks.co = co;
739
tnkp->u.tnks.vi = ovi;
743
tnkp->u.tnko.to = cto;
744
tnkp->u.tnko.ko = cko;
751
static void setvar (tnk_t tnk, Tobj vo) {
754
Mresetmark (lvarp[flvari + tnk.u.li].m,
755
(lvarp[flvari + tnk.u.li].o = vo));
758
Tinso (tnk.u.tnko.to, tnk.u.tnko.ko, vo);
761
switch (tnk.u.tnks.kt) {
763
Tinss (tnk.u.tnks.to,
764
TCgetstring (tnk.u.tnks.co, tnk.u.tnks.vi), vo);
767
Tinsi (tnk.u.tnks.to,
768
TCgetinteger (tnk.u.tnks.co, tnk.u.tnks.vi), vo);
771
Tinsr (tnk.u.tnks.to, TCgetreal (tnk.u.tnks.co, tnk.u.tnks.vi), vo);
778
static int boolop (Tobj vo) {
785
switch (Tgettype (vo)) {
787
i = Tgetinteger (vo);
788
return (i == 0) ? FALSE : TRUE;
791
return (d == 0.0) ? FALSE : TRUE;
801
static int orderop (Tobj v1o, Ctype_t op, Tobj v2o) {
808
if ((v1o || v2o) && op == C_NE)
812
t1 = Tgettype (v1o), t2 = Tgettype (v2o);
813
if (t1 == T_STRING && t2 == T_STRING) {
814
r = Strcmp (Tgetstring (v1o), Tgetstring (v2o));
815
} else if (t1 == T_INTEGER && t2 == T_INTEGER) {
816
i1 = Tgetinteger (v1o), i2 = Tgetinteger (v2o);
817
r = (i1 == i2) ? 0 : ((i1 < i2) ? -1 : 1);
818
} else if (t1 == T_INTEGER && t2 == T_REAL) {
819
i1 = Tgetinteger (v1o), d2 = Tgetreal (v2o);
820
r = (i1 == d2) ? 0 : ((i1 < d2) ? -1 : 1);
821
} else if (t1 == T_REAL && t2 == T_INTEGER) {
822
d1 = Tgetreal (v1o), i2 = Tgetinteger (v2o);
823
r = (d1 == i2) ? 0 : ((d1 < i2) ? -1 : 1);
824
} else if (t1 == T_REAL && t2 == T_REAL) {
825
d1 = Tgetreal (v1o), d2 = Tgetreal (v2o);
826
r = (d1 == d2) ? 0 : ((d1 < d2) ? -1 : 1);
827
} else if (t1 == t2) {
828
if (op != C_EQ && op != C_NE)
830
r = (v1o == v2o) ? 0 : 1;
835
case C_EQ: return (r == 0) ? TRUE : FALSE;
836
case C_NE: return (r != 0) ? TRUE : FALSE;
837
case C_LT: return (r < 0) ? TRUE : FALSE;
838
case C_LE: return (r <= 0) ? TRUE : FALSE;
839
case C_GT: return (r > 0) ? TRUE : FALSE;
840
case C_GE: return (r >= 0) ? TRUE : FALSE;
842
panic (POS, "orderop", "bad op code");
843
return FALSE; /* NOT REACHED */
846
static Tobj arithop (num_tt *lnum, Ctype_t op, num_tt *rnum) {
849
if (!rnum && op != C_UMINUS)
851
if (lnum->type == C_INTEGER)
853
else if (lnum->type == C_REAL)
855
else if (!lnum->u.no)
857
else if (Tgettype (lnum->u.no) == T_INTEGER)
858
d1 = Tgetinteger (lnum->u.no);
859
else if (Tgettype (lnum->u.no) == T_REAL)
860
d1 = Tgetreal (lnum->u.no);
863
if (op == C_UMINUS) {
867
if (rnum->type == C_INTEGER)
869
else if (rnum->type == C_REAL)
871
else if (!rnum->u.no)
873
else if (Tgettype (rnum->u.no) == T_INTEGER)
874
d2 = Tgetinteger (rnum->u.no);
875
else if (Tgettype (rnum->u.no) == T_REAL)
876
d2 = Tgetreal (rnum->u.no);
880
case C_PLUS: d3 = d1 + d2; break;
881
case C_MINUS: d3 = d1 - d2; break;
882
case C_MUL: d3 = d1 * d2; break;
883
case C_DIV: d3 = d1 / d2; break;
884
case C_MOD: d3 = (long) d1 % (long) d2; break;
887
if (d3 == (double) (long) d3)
888
return Tinteger ((long) d3);
892
static void err (int errnum, int level, Tobj co, int ci) {
896
if (level > Eerrlevel || !errdo)
899
fprintf (stderr, "runtime error: %s\n", errnam[errnum]);
904
if (!sinfop[(si = sinfoi - 1)].fco && si > 0)
907
if (co == sinfop[si].fco)
908
s = Scfull (co, 0, ci);
909
else if (co == sinfop[si].co)
910
s = Scfull (co, TCgetfp (co, 0), ci);
911
printbody (s, Eshowbody), free (s);
912
if (Estackdepth == 1) {
913
fprintf (stderr, "\n");
916
for (i = si; i >= 0; i--) {
918
s = Scfull (sinfop[i].fco, 0, sinfop[i].fci);
919
printbody (s, Eshowbody), free (s);
922
s = Scfull (sinfop[0].co, TCgetfp (sinfop[0].co, 0), sinfop[0].ci);
923
printbody (s, Eshowbody), free (s);
925
fprintf (stderr, "\n");
929
static void printbody (char *s, int mode) {
934
fprintf (stderr, "%s\n", s);
938
for (s1 = s; *s1; s1++)
939
if (*s1 == '>' && *(s1 + 1) && *(s1 + 1) == '>')
943
for (; s1 != s; s1--)
944
if (*(s1 - 1) == '\n')
946
for (s2 = s1; *s2; s2++)
950
c = *s2, *s2 = '\000';
951
fprintf (stderr, "%s\n", s1);