home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
minnie.tuhs.org
/
unixen.tar
/
unixen
/
PDP-11
/
Distributions
/
ucb
/
spencer_2bsd.tar.gz
/
2bsd.tar
/
src
/
pi1
/
put.c
< prev
next >
Wrap
C/C++ Source or Header
|
1980-02-17
|
5KB
|
333 lines
/* Copyright (c) 1979 Regents of the University of California */
#
/*
* pi - Pascal interpreter code translator
*
* Charles Haley, Bill Joy UCB
* Version 1.2 January 1979
*/
#include "opcode.h"
#include "0.h"
int *obufp { obuf };
/*
* If DEBUG is defined, include the table
* of the printing opcode names.
*/
#ifdef DEBUG
char *otext[] {
#include "OPnames.h"
};
#endif
/*
* Put is responsible for the interpreter equivalent of code
* generation. Since the interpreter is specifically designed
* for Pascal, little work is required here.
*/
put(a)
{
register int *p, i;
register char *cp;
int n, subop, suboppr, op, oldlc, w;
char *string;
static int casewrd;
/*
* It would be nice to do some more
* optimizations here. The work
* done to collapse offsets in lval
* should be done here, the IFEQ etc
* relational operators could be used
* etc.
*/
oldlc = lc;
if (cgenflg)
/*
* code disabled - do nothing
*/
return (oldlc);
p = &a;
n = *p++;
suboppr = subop = (*p>>8) & 0377;
op = *p & 0377;
string = 0;
#ifdef DEBUG
if ((cp = otext[op]) == NIL) {
printf("op= %o\n", op);
panic("put");
}
#endif
switch (op) {
/*****
case O_LINO:
if (line == codeline)
return (oldlc);
codeline = line;
*****/
case O_PUSH:
case O_POP:
if (p[1] == 0)
return (oldlc);
case O_NEW:
case O_DISPOSE:
case O_AS:
case O_IND:
case O_OFF:
case O_INX2:
case O_INX4:
case O_CARD:
case O_ADDT:
case O_SUBT:
case O_MULT:
case O_IN:
case O_CASE1OP:
case O_CASE2OP:
case O_CASE4OP:
case O_PACK:
case O_UNPACK:
case O_RANG2:
case O_RSNG2:
case O_RANG42:
case O_RSNG42:
if (p[1] == 0)
break;
case O_CON2:
if (p[1] < 128 && p[1] >= -128) {
suboppr = subop = p[1];
p++;
n--;
if (op == O_CON2)
op = O_CON1;
}
break;
default:
if (op >= O_REL2 && op <= O_REL84) {
if ((i = (subop >> 1) * 5 ) >= 30)
i =- 30;
else
i =+ 2;
#ifdef DEBUG
string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
#endif
suboppr = 0;
}
break;
case O_IF:
case O_TRA:
/*****
codeline = 0;
*****/
case O_CALL:
case O_FOR1U:
case O_FOR2U:
case O_FOR4U:
case O_FOR1D:
case O_FOR2D:
case O_FOR4D:
p[1] =- lc + 2;
break;
case O_WRIT82:
#ifdef DEBUG
string = &"22\024\042\044"[subop*3];
#endif
suboppr = 0;
break;
case O_CONG:
i = p[1];
cp = p[2];
#ifdef DEBUG
if (opt('c'))
printf("%5d\tCONG:%d\t%s\n", lc, i, cp);
#endif
if (i <= 127)
word(O_CON | i << 8);
else {
word(O_CON);
word(i);
}
while (i > 0) {
w = *cp ? *cp++ : ' ';
w =| (*cp ? *cp++ : ' ') << 8;
word(w);
i =- 2;
}
return (oldlc);
case O_CONC:
#ifdef DEBUG
(string = "'x'")[1] = p[1];
#endif
suboppr = 0;
op = O_CON1;
subop = p[1];
goto around;
case O_CON1:
suboppr = subop = p[1];
around:
n--;
break;
case O_CASEBEG:
casewrd = 0;
return (oldlc);
case O_CASEEND:
if (lc & 1) {
lc--;
word(casewrd);
}
return (oldlc);
case O_CASE1:
#ifdef DEBUG
if (opt('c'))
printf("%5d\tCASE1\t%d\n", lc, p[2]);
#endif
lc++;
if (lc & 1)
casewrd = p[2];
else {
lc =- 2;
word(casewrd | p[2] << 8);
}
return (oldlc);
case O_CASE2:
#ifdef DEBUG
if (opt('c'))
printf("%5d\tCASE2\t%d\n", lc, p[2]);
#endif
word(p[2]);
return (oldlc);
case O_CASE4:
#ifdef DEBUG
if (opt('c'))
printf("%5d\tCASE4\t%d %d\n", lc, p[1], p[2]);
#endif
word(p[1]);
word(p[2]);
return (oldlc);
}
#ifdef DEBUG
if (opt('c')) {
printf("%5d\t%s", lc, cp);
if (suboppr)
printf(":%d", suboppr);
if (string)
printf("\t%s",string);
if (n > 1)
putchar('\t');
for (i=1; i<n; i++)
printf("%d ", p[i]);
putchar('\n');
}
#endif
if (op != NIL)
word(op | subop << 8);
for (i=1; i<n; i++)
word(p[i]);
return (oldlc);
}
/*
* Putspace puts out a table
* of nothing to leave space
* for the case branch table e.g.
*/
putspace(n)
int n;
{
register i;
#ifdef DEBUG
if (opt('c'))
printf("%5d\t.=.+%d\n", lc, i);
#endif
for (i = even(n); i > 0; i =- 2)
word(0);
}
/*
* Patch repairs the branch
* at location loc to come
* to the current location.
*/
patch(loc)
{
patchfil(loc, lc-loc-2);
}
/*
* Patchfil makes loc+2 have value
* as its contents.
*/
patchfil(loc, value)
char *loc;
int value;
{
register i;
if (cgenflg < 0)
return;
if (loc > lc)
panic("patchfil");
#ifdef DEBUG
if (opt('c'))
printf("\tpatch %u %d\n", loc, value);
#endif
i = (loc + 2 - (lc & ~0777))/2;
if (i >= 0 && i < 512)
obuf[i] = value;
else {
seek(ofil, loc+2, 0);
write(ofil, &value, 2);
seek(ofil, 0, 2);
}
}
/*
* Put the word o into the code
*/
word(o)
int o;
{
*obufp = o;
obufp++;
lc =+ 2;
if (obufp >= obuf+256)
pflush();
}
char *obj;
/*
* Flush the code buffer
*/
pflush()
{
register i;
i = (obufp - obuf) * 2;
if (i != 0 && write(ofil, obuf, i) != i)
perror(obj), pexit(DIED);
obufp = obuf;
}
/*
* Getlab - returns the location counter.
* included here for the eventual code generator.
*/
getlab()
{
return (lc);
}
/*
* Putlab - lay down a label.
*/
putlab(l)
int l;
{
return (l);
}