* Copyright (c) 1991, 1993
* The Regents of the University of California. All rights reserved.
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
static char sccsid
[] = "@(#)interp.c 8.1 (Berkeley) 6/6/93";
long _runtst
= (long)TRUE
;
char *_minptr
= (char *)0x7fffffff;
char *_minptr
= (char *)0xffff;
char *_maxptr
= (char *)0;
long *_pcpcount
= (long *)0;
char _inwin
, _outwin
, _errwin
;
"Message file", /* pfname */
FTEXT
| FWRITE
| EOFF
, /* funit */
struct iorechd output
= {
"standard output", /* pfname */
FTEXT
| FWRITE
| EOFF
, /* funit */
"standard input", /* pfname */
FTEXT
|FREAD
|SYNC
|EOLN
, /* funit */
struct iorechd _fchain
= {
0, 0, 0, 0, /* only use fchain field */
struct iorec
*_actfile
[MAXFILES
] = {
* stuff for pdx to watch what the interpreter is doing.
* The .globl is #ifndef DBX since it breaks DBX to have a global
* asm label in the middle of a function (see _loopaddr: below).
/* register */ union progcntr pc
; /* interpreted program cntr */
struct iorec
*curfile
; /* active file */
register struct blockmark
*stp
; /* active stack frame ptr */
* the following variables are used as scratch
register long tl
, tl1
, tl2
, tl3
;
register struct formalrtn
*tfp
;
/* register */ union progcntr stack
; /* Interpreted stack */
* Setup sets up any hardware specific parameters before
* starting the interpreter. Typically this is macro- or inline-
* replaced by "machdep.h" or interp.sed.
* necessary only on systems which do not initialize
for (ip
= &_actfile
[3]; ip
< &_actfile
[MAXFILES
]; *ip
++ = FILNIL
)
* set up global environment, then ``call'' the main program
STACKALIGN(tl
, 2 * sizeof(struct iorec
*));
_display
.frame
[0].locvars
= pushsp(tl
);
_display
.frame
[0].locvars
+= 2 * sizeof(struct iorec
*);
*(struct iorec
**)(_display
.frame
[0].locvars
+ OUTPUT_OFF
) = OUTPUT
;
*(struct iorec
**)(_display
.frame
[0].locvars
+ INPUT_OFF
) = INPUT
;
STACKALIGN(tl
, sizeof(struct blockmark
));
stp
= (struct blockmark
*)pushsp(tl
);
_dp
= &_display
.frame
[0];
* Save away the program counter to a fixed location for pdx.
* Having the label below makes dbx not work
* to debug this interpreter,
* since it thinks a new function called loopaddr()
* has started here, and it won't display the local
* variables of interpreter(). You have to compile
* -DDBX to avoid this problem...
case O_BPT
: /* breakpoint trap */
_dp
+= 1; /* enter local scope */
stp
->odisp
= *_dp
; /* save old display value */
tl
= *pc
.ucp
++; /* tl = name size */
stp
->entry
= pc
.hdrp
; /* pointer to entry info */
tl1
= pc
.hdrp
->framesze
;/* tl1 = size of frame */
_runtst
= pc
.hdrp
->tests
;
pc
.cp
+= (int)tl
; /* skip over proc hdr info */
stp
->file
= curfile
; /* save active file */
tcp
= pushsp(tl2
); /* tcp = new top of stack */
if (_runtst
) /* zero stack frame */
tcp
+= (int)tl1
; /* offsets of locals are neg */
_dp
->locvars
= tcp
; /* set new display pointer */
stp
->tos
= pushsp((long)0); /* set tos pointer */
PCLOSE(_dp
->locvars
); /* flush & close local files */
curfile
= stp
->file
; /* restore old active file */
*_dp
= stp
->odisp
; /* restore old display entry */
if (_dp
== &_display
.frame
[1])
return; /* exiting main proc ??? */
_lino
= stp
->lino
; /* restore lino, pc, dp */
_runtst
= stp
->entry
->tests
;
STACKALIGN(tl
, stp
->entry
->framesze
);
STACKALIGN(tl1
, sizeof(struct blockmark
));
popsp(tl
+ /* pop local vars */
tl1
+ /* pop stack frame */
stp
->entry
->nargs
);/* pop parms */
tcp
= base
+ tl1
+ sizeof(short);/* new entry point */
STACKALIGN(tl1
, sizeof(struct blockmark
));
stp
= (struct blockmark
*)pushsp(tl1
);
stp
->lino
= _lino
; /* save lino, pc, dp */
_dp
= &_display
.frame
[tl
]; /* set up new display ptr */
tcp
= popaddr(); /* ptr to display save area */
tfp
= (struct formalrtn
*)popaddr();
STACKALIGN(tl
, sizeof(struct blockmark
));
stp
= (struct blockmark
*)pushsp(tl
);
stp
->lino
= _lino
; /* save lino, pc, dp */
pc
.cp
= (char *)(tfp
->fentryaddr
);/* new entry point */
_dp
= &_display
.frame
[tfp
->fbn
];/* new display ptr */
blkcpy(&_display
.frame
[1], tcp
,
tfp
->fbn
* sizeof(struct dispsave
));
blkcpy(&tfp
->fdisp
[0], &_display
.frame
[1],
tfp
->fbn
* sizeof(struct dispsave
));
tl
= *pc
.cp
++; /* tl = size of return obj */
tfp
= *(struct formalrtn
**)(tcp
+ tl
);
(tcp
+ tl
+ sizeof(struct formalrtn
*));
blkcpy(tcp
, tcp
+ sizeof(struct formalrtn
*)
sizeof(struct formalrtn
*) + sizeof (char *));
blkcpy(tcp1
, &_display
.frame
[1],
tfp
->fbn
* sizeof(struct dispsave
));
tfp
= (struct formalrtn
*)popaddr();
tfp
->fbn
= *pc
.cp
++; /* blk number of routine */
tcp
= base
+ tl
+ sizeof(short);/* new entry point */
tfp
->fentryaddr
= (long (*)())(base
+ tl
);
blkcpy(&_display
.frame
[1], &tfp
->fdisp
[0],
tfp
->fbn
* sizeof(struct dispsave
));
tstp
= _display
.frame
[*pc
.cp
++].stp
; /* ptr to
if (_dp
== &_display
.frame
[1])
ERROR("Active frame not found in non-local goto\n", 0); /* exiting prog ??? */
PCLOSE(_dp
->locvars
); /* close local files */
curfile
= stp
->file
; /* restore active file */
*_dp
= stp
->odisp
; /* old display entry */
_dp
= stp
->dp
; /* restore dp */
/* pop locals, stack frame, parms, and return values */
popsp((long)(stp
->tos
- pushsp((long)(0))));
if (_dp
->stp
->tos
!= pushsp((long)(0)))
ERROR("Panic: stack not empty between statements\n");
_lino
= *pc
.cp
++; /* set line number */
LINO(); /* inc statement count */
ERROR("Panic: bad relation %d to REL4*\n",
tl2
= *pc
.cp
++; /* tc has jump opcode */
tl
= *pc
.usp
++; /* tl has comparison length */
STACKALIGN(tl1
, tl
); /* tl1 has arg stack length */
tcp
= pushsp((long)(0));/* tcp pts to first arg */
tb
= RELEQ(tl
, tcp
+ tl1
, tcp
);
tb
= RELNE(tl
, tcp
+ tl1
, tcp
);
tb
= RELSLT(tl
, tcp
+ tl1
, tcp
);
tb
= RELSGT(tl
, tcp
+ tl1
, tcp
);
tb
= RELSLE(tl
, tcp
+ tl1
, tcp
);
tb
= RELSGE(tl
, tcp
+ tl1
, tcp
);
ERROR("Panic: bad relation %d to RELG*\n", tl2
);
tl2
= *pc
.cp
++; /* tc has jump opcode */
tl1
= *pc
.usp
++; /* tl1 has comparison length */
tcp
= pushsp((long)(0));/* tcp pts to first arg */
tb
= RELEQ(tl1
, tcp
+ tl1
, tcp
);
tb
= RELNE(tl1
, tcp
+ tl1
, tcp
);
tb
= RELTLT(tl1
, tcp
+ tl1
, tcp
);
tb
= RELTGT(tl1
, tcp
+ tl1
, tcp
);
tb
= RELTLE(tl1
, tcp
+ tl1
, tcp
);
tb
= RELTGE(tl1
, tcp
+ tl1
, tcp
);
ERROR("Panic: bad relation %d to RELT*\n", tl2
);
ERROR("Panic: bad relation %d to REL8*\n",
*(short *)popaddr() = tl
;
*(short *)popaddr() = tl
;
*(double *)popaddr() = tl
;
*(double *)popaddr() = tl
;
*(struct sze8
*)popaddr() = t8
;
blkcpy(tcp
, *(char **)(tcp
+ tl1
), tl
);
popsp(tl1
+ sizeof(char *));
tl
= *pc
.cp
++; /* tl has shift amount */
tl1
= (tl1
- *pc
.sp
++) << tl
;
tl
= *pc
.cp
++; /* tl has shift amount */
tl1
= (tl1
- *pc
.sp
++) << tl
;
tl
= *pc
.cp
++; /* tl has element size */
tl1
= pop2(); /* index */
pushaddr(tcp
+ (tl1
- tl2
) * tl
);
SUBSC(tl1
, tl2
, tl
); /* range check */
tl
= *pc
.cp
++; /* tl has element size */
tl1
= pop4(); /* index */
pushaddr(tcp
+ (tl1
- tl2
) * tl
);
SUBSC(tl1
, tl2
, tl
); /* range check */
tl
= pop2(); /* tl has element size */
tl1
= pop2(); /* upper bound */
tl2
= pop2(); /* lower bound */
tl3
= pop2(); /* index */
pushaddr(tcp
+ (tl3
- tl2
) * tl
);
SUBSC(tl3
, tl2
, tl1
); /* range check */
tl
= pop2(); /* tl has element size */
tl1
= pop2(); /* upper bound */
tl2
= pop2(); /* lower bound */
tl3
= pop4(); /* index */
pushaddr(tcp
+ (tl3
- tl2
) * tl
);
SUBSC(tl3
, tl2
, tl1
); /* range check */
tl
= pop4(); /* tl has element size */
tl1
= pop4(); /* upper bound */
tl2
= pop4(); /* lower bound */
tl3
= pop2(); /* index */
pushaddr(tcp
+ (tl3
- tl2
) * tl
);
SUBSC(tl3
, tl2
, tl1
); /* range check */
tl
= pop4(); /* tl has element size */
tl1
= pop4(); /* upper bound */
tl2
= pop4(); /* lower bound */
tl3
= pop4(); /* index */
pushaddr(tcp
+ (tl3
- tl2
) * tl
);
SUBSC(tl3
, tl2
, tl1
); /* range check */
push4(tl
>= 0 ? tl
: -tl
);
push8(td
>= 0.0 ? td
: -td
);
tcp
= _display
.raw
[*pc
.ucp
++];
push2((short)(*(tcp
+ *pc
.sp
++)));
tcp
= _display
.raw
[*pc
.ucp
++];
push4((long)(*(tcp
+ *pc
.sp
++)));
tcp
= _display
.raw
[*pc
.ucp
++];
push2(*(short *)(tcp
+ *pc
.sp
++));
tcp
= _display
.raw
[*pc
.ucp
++];
push4((long)(*(short *)(tcp
+ *pc
.sp
++)));
tcp
= _display
.raw
[*pc
.ucp
++];
push4(*(long *)(tcp
+ *pc
.sp
++));
tcp
= _display
.raw
[*pc
.ucp
++];
pushsze8(*(struct sze8
*)(tcp
+ *pc
.sp
++));
tcp
= _display
.raw
[*pc
.ucp
++];
tcp
= _display
.raw
[*pc
.ucp
++];
pushaddr(tcp
+ *pc
.sp
++);
tcp
= _display
.raw
[*pc
.ucp
++];
push2((short)(*(tcp
+ tl
)));
tcp
= _display
.raw
[*pc
.ucp
++];
push4((long)(*(tcp
+ tl
)));
tcp
= _display
.raw
[*pc
.ucp
++];
push2(*(short *)(tcp
+ tl
));
tcp
= _display
.raw
[*pc
.ucp
++];
push4((long)(*(short *)(tcp
+ tl
)));
tcp
= _display
.raw
[*pc
.ucp
++];
push4(*(long *)(tcp
+ tl
));
tcp
= _display
.raw
[*pc
.ucp
++];
pushsze8(*(struct sze8
*)(tcp
+ tl
));
tcp
= _display
.raw
[*pc
.ucp
++];
tcp
= _display
.raw
[*pc
.ucp
++];
ts
= *(short *)(popaddr());
ts
= *(short *)(popaddr());
tl
= *(long *)(popaddr());
t8
= *(struct sze8
*)(popaddr());
push2((short)(*pc
.cp
++));
tcp
= pushsp(sizeof(double));
blkcpy(pc
.cp
, tcp
, sizeof(double));
pc
.cp
+= (int)((tl
+ 2) & ~1);
push2((short)(RANG4(tl1
, tl
, (long)(*pc
.sp
++))));
push4(RANG4(tl1
, tl
, (long)(*pc
.sp
++)));
push2((short)(RSNG4(tl1
, tl
)));
push4(RANG4(tl1
, tl
, tl2
));
push2((short)(RANG4(tl1
, tl
, tl2
)));
push2((short)(RSNG4(tl1
, tl
)));
fputs("\nCall to procedure halt\n", stderr
);
NEW(&_pcpcount
, (_cntrs
+ 1) * sizeof(long));
blkclr(_pcpcount
, (_cntrs
+ 1) * sizeof(long));
tl
= *pc
.cp
++; /* tl = number of cases */
tsp
= pc
.sp
+ tl
; /* ptr to end of jump table */
tcp
= (char *)tsp
; /* tcp = ptr to case values */
tl1
= pop2(); /* tl1 = element to find */
for(; tl
> 0; tl
--) /* look for element */
if (tl
== 0) /* default case => error */
tl
= *pc
.cp
++; /* tl = number of cases */
tsp
= pc
.sp
+ tl
; /* ptr to end of jump table */
tsp1
= tsp
; /* tsp1 = ptr to case values */
tl1
= (unsigned short)pop2();/* tl1 = element to find */
for(; tl
> 0; tl
--) /* look for element */
if (tl
== 0) /* default case => error */
tl
= *pc
.cp
++; /* tl = number of cases */
tsp1
= pc
.sp
+ tl
; /* ptr to end of jump table */
tlp
= (long *)tsp1
; /* tlp = ptr to case values */
tl1
= pop4(); /* tl1 = element to find */
for(; tl
> 0; tl
--) { /* look for element */
if (tl
== 0) /* default case => error */
tl
= *pc
.cp
++; /* tl has comparison length */
tcp
= pushsp((long)(0));/* tcp pts to first arg */
ADDT(tcp
+ tl
, tcp
+ tl
, tcp
, tl
>> 2);
tl
= *pc
.cp
++; /* tl has comparison length */
tcp
= pushsp((long)(0));/* tcp pts to first arg */
SUBT(tcp
+ tl
, tcp
+ tl
, tcp
, tl
>> 2);
tl
= *pc
.cp
++; /* tl has comparison length */
tcp
= pushsp((long)(0));/* tcp pts to first arg */
MULT(tcp
+ tl
, tcp
+ tl
, tcp
, tl
>> 2);
tl
= *pc
.cp
++; /* tl has number of args */
tl
= *pc
.cp
++; /* tl has number of args */
tl1
= tl
* sizeof(long); /* Size of all args */
tcp
= pushsp((long)(0)) + tl1
; /* tcp pts to result */
tl1
= pop4(); /* Pop the 4 fixed args */
tcp2
= pushsp((long)0); /* tcp2 -> data values */
CTTOTA(tcp
, tl1
, tl2
, tl3
, tl4
, tcp2
);
popsp(tl
*sizeof(long) - 4*sizeof(long)); /* Pop data */
tl
= *pc
.cp
++; /* tl has comparison length */
tcp
= pushsp((long)(0));/* tcp pts to set */
tl
= *pc
.cp
++; /* tl has comparison length */
tl1
= pop4(); /* tl1 is the element */
tcp
= pushsp((long)(0));/* tcp pts to set */
tl2
= *pc
.sp
++; /* lower bound */
tb
= IN(tl1
, tl2
, (long)(*pc
.usp
++), tcp
);
tl1
= *pc
.cp
++; /* tl1 loop branch */
tcp
= popaddr(); /* tcp = ptr to index var */
tl
= pop4(); /* tl upper bound */
if (*tcp
== tl
) /* loop is done, fall through */
*tcp
+= 1; /* inc index var */
pc
.cp
+= tl1
; /* return to top of loop */
tl1
= *pc
.cp
++; /* tl1 loop branch */
tsp
= (short *)popaddr(); /* tsp = ptr to index var */
tl
= pop4(); /* tl upper bound */
if (*tsp
== tl
) /* loop is done, fall through */
*tsp
+= 1; /* inc index var */
pc
.cp
+= tl1
; /* return to top of loop */
tl1
= *pc
.cp
++; /* tl1 loop branch */
tlp
= (long *)popaddr(); /* tlp = ptr to index var */
tl
= pop4(); /* tl upper bound */
if (*tlp
== tl
) /* loop is done, fall through */
*tlp
+= 1; /* inc index var */
pc
.cp
+= tl1
; /* return to top of loop */
tl1
= *pc
.cp
++; /* tl1 loop branch */
tcp
= popaddr(); /* tcp = ptr to index var */
tl
= pop4(); /* tl upper bound */
if (*tcp
== tl
) /* loop is done, fall through */
*tcp
-= 1; /* dec index var */
pc
.cp
+= tl1
; /* return to top of loop */
tl1
= *pc
.cp
++; /* tl1 loop branch */
tsp
= (short *)popaddr(); /* tsp = ptr to index var */
tl
= pop4(); /* tl upper bound */
if (*tsp
== tl
) /* loop is done, fall through */
*tsp
-= 1; /* dec index var */
pc
.cp
+= tl1
; /* return to top of loop */
tl1
= *pc
.cp
++; /* tl1 loop branch */
tlp
= (long *)popaddr(); /* tlp = ptr to index var */
tl
= pop4(); /* tl upper bound */
if (*tlp
== tl
) /* loop is done, fall through */
*tlp
-= 1; /* dec index var */
pc
.cp
+= tl1
; /* return to top of loop */
push2((short)(READE(curfile
, base
+ tl
)));
push2((short)(READC(curfile
)));
push2((short)(TEOF(tcp
)));
push2((short)(TEOLN(tcp
)));
pc
.cp
++; /* Skip arg size */
WRITES(curfile
, tf
, ti
, ti2
, tcp2
);
fwrite(tf
, ti
, ti2
, tcp2
);
tcp2
= pushsp((long)0); /* Addr of printf's args */
VWRITEF(curfile
, tf
, tcp
, tcp2
);
(*pc
.cp
++) - (sizeof (FILE *)) - sizeof (char *));
fputc('\n', ACTFILE(curfile
));
fputc('\f', ACTFILE(curfile
));
pushaddr(NAM(tl
, base
+ tl1
));
push4(MAX(tl1
, tl
, (long)(*pc
.usp
++)));
push4(tl1
> tl
? tl1
: tl
);
push4(tl1
< tl
? tl1
: tl
);
curfile
= UNIT(popaddr());
DEFNAME((struct iorec
*)tcp2
, tcp
, tl
, tl2
);
RESET((struct iorec
*)tcp2
, tcp
, tl
, tl2
);
REWRITE((struct iorec
*)tcp2
, tcp
, tl
, tl2
);
pushaddr(ACTFILE(curfile
));
FLUSH((struct iorec
*)tcp
);
PACK(tl
, tcp
, tcp2
, tl1
, tl2
, tl3
, tl4
);
UNPACK(tl
, tcp
, tcp2
, tl1
, tl2
, tl3
, tl4
);
tl
= *pc
.cp
++; /* tl = size of char array */
tcp
= popaddr(); /* tcp = addr of char array */
tl1
= pop4(); /* tl1 = argv subscript */
tl
= *pc
.cp
++; /* tl = size being new'ed */
tcp
= popaddr(); /* ptr to ptr being new'ed */
blkclr(*((char **)(tcp
)), tl
);
tl
= *pc
.cp
++; /* tl = size being disposed */
tcp
= popaddr(); /* ptr to ptr being disposed */
*(char **)tcp
= (char *)0;
tl
= *pc
.cp
++; /* tl = size being disposed */
tcp
= popaddr(); /* ptr to ptr being disposed */
*(char **)tcp
= (char *)0;
push2((short)(SUCC(tl1
, tl
, (long)(*pc
.sp
++))));
push4(SUCC(tl1
, tl
, (long)(*pc
.sp
++)));
push4(SUCC(tl1
, tl
, (long)(tl2
)));
push2((short)(PRED(tl1
, tl
, (long)(*pc
.sp
++))));
push4(PRED(tl1
, tl
, (long)(*pc
.sp
++)));
push4(PRED(tl1
, tl
, (long)(tl2
)));
td
= pop8(); /* Argument is ignored */
ERROR("Panic: bad op code\n");