/* Copyright (c) 1979 Regents of the University of California */
static char sccsid
[] = "@(#)interp.c 1.30 2/9/83";
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
] = {
union progcntr pc
; /* interpreted program cntr */
register char *vpc
; /* register used for "pc" */
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
;
register struct formalrtn
*tfp
;
* Setup sets up any hardware specific parameters before
* starting the interpreter. Typically this is inline replaced
* by interp.sed to utilize specific machine instructions.
* 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
_display
.frame
[0].locvars
= pushsp((long)(2 * sizeof(struct iorec
*)));
_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
;
stp
= (struct blockmark
*)pushsp((long)(sizeof(struct blockmark
)));
_dp
= &_display
.frame
[0];
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(tl1
); /* 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
;
popsp(stp
->entry
->framesze
+ /* pop local vars */
sizeof(struct blockmark
) + /* pop stack frame */
stp
->entry
->nargs
); /* pop parms */
tcp
= base
+ *pc
.lp
++;/* calc new entry point */
tcp
= base
+ *(long *)tcp
;
stp
= (struct blockmark
*)
pushsp((long)(sizeof(struct blockmark
)));
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();
stp
= (struct blockmark
*)
pushsp((long)(sizeof(struct blockmark
)));
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
+ *pc
.lp
++; /* calc new entry point */
tfp
->fentryaddr
= (long (*)())(base
+ *(long *)tcp
);
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 */
tl1
= (tl
+ 1) & ~1; /* 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 */
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
++];
tcp1
= pushsp((tl
+ 1) & ~1);
tcp
= _display
.raw
[*pc
.ucp
++];
pushaddr(tcp
+ *pc
.sp
++);
tcp
= _display
.raw
[*pc
.ucp
++];
push2((short)(*(tcp
+ *pc
.lp
++)));
tcp
= _display
.raw
[*pc
.ucp
++];
push4((long)(*(tcp
+ *pc
.lp
++)));
tcp
= _display
.raw
[*pc
.ucp
++];
push2(*(short *)(tcp
+ *pc
.lp
++));
tcp
= _display
.raw
[*pc
.ucp
++];
push4((long)(*(short *)(tcp
+ *pc
.lp
++)));
tcp
= _display
.raw
[*pc
.ucp
++];
push4(*(long *)(tcp
+ *pc
.lp
++));
tcp
= _display
.raw
[*pc
.ucp
++];
pushsze8(*(struct sze8
*)(tcp
+ *pc
.lp
++));
tcp
= _display
.raw
[*pc
.ucp
++];
tcp1
= pushsp((tl
+ 1) & ~1);
tcp
= _display
.raw
[*pc
.ucp
++];
pushaddr(tcp
+ *pc
.lp
++);
push2((short)(*popaddr()));
push4((long)(*popaddr()));
push2(*(short *)(popaddr()));
push4((long)(*(short *)(popaddr())));
push4(*(long *)(popaddr()));
pushsze8(*(struct sze8
*)(popaddr()));
tcp1
= pushsp((tl
+ 1) & ~1);
push2((short)(*pc
.cp
++));
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
, *pc
.lp
++));
push2((short)(RANG4(tl1
, tl
, *pc
.lp
++)));
push2((short)(RSNG4(tl1
, tl
)));
popsp((long)(sizeof(long)));
popsp((long)(sizeof(char *)+sizeof(long)));
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 */
tsp
= pc
.sp
+ tl
; /* ptr to end of jump table */
tlp
= (long *)tsp
; /* 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 */
tcp
= pushsp((long)(0)) + tl1
; /* tcp pts to result */
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
);
popsp((long)(sizeof(long)+sizeof(char *)));
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
+ *pc
.lp
++)));
push2((short)(READC(curfile
)));
push2((short)(TEOF(popaddr())));
push2((short)(TEOLN(popaddr())));
fputc('\n', ACTFILE(curfile
));
fputc('\f', ACTFILE(curfile
));
pushaddr(NAM(tl
, base
+ *pc
.lp
++));
push4(MAX(tl1
, tl
, (long)(*pc
.usp
++)));
push4(tl1
> tl
? tl1
: tl
);
push4(tl1
< tl
? tl1
: tl
);
curfile
= UNIT(popaddr());
pushaddr(FNIL(popaddr()));
popsp((long)(2*sizeof(char *)+2*sizeof(long)));
popsp((long)(2*sizeof(char *)+2*sizeof(long)));
popsp((long)(2*sizeof(char *)+2*sizeof(long)));
pushaddr(ACTFILE(curfile
));
popsp((long)(sizeof(char *)+sizeof(long)));
popsp((long)(sizeof(char *)));
popsp((long)(5*sizeof(long)+2*sizeof(char*)));
popsp((long)(5*sizeof(long)+2*sizeof(char*)));
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)(CHR(pop4())));
push2((short)(SUCC(tl1
, tl
, (long)(*pc
.sp
++))));
push4(SUCC(tl1
, tl
, (long)(*pc
.sp
++)));
push4(SUCC(tl1
, tl
, (long)(*pc
.lp
++)));
push2((short)(PRED(tl1
, tl
, (long)(*pc
.sp
++))));
push4(PRED(tl1
, tl
, (long)(*pc
.sp
++)));
push4(PRED(tl1
, tl
, (long)(*pc
.lp
++)));
ERROR("Panic: bad op code\n");