This commit is contained in:
Oliver Lehmann 1989-09-19 13:58:23 +00:00
parent 77b7be5aca
commit 5265abcaca
3 changed files with 880 additions and 0 deletions

View File

@ -0,0 +1,112 @@
/*
** --- RG_CODE.C ------- PRINT R_CODE MAME ----------------------------------
**
** FOR TEST PURPOSES ONLY
**
** Version: @(#)rg_code.c 4.0 02/05/89
**
*/
# include "rg.h"
# ifdef RG_TRACE
# ifdef ENUM_INT
char *Code[H_3_BYTES];
# else
char *Code[(int) H_3_BYTES];
# endif
rg_code()
{
/* INITIALIZE R_CODE NAMES */
Code[(int) bdLT] = "bdLT";
Code[(int) bdEQ] = "bdEQ";
Code[(int) bdLE] = "bdLE";
Code[(int) bdGT] = "bdGT";
Code[(int) bdNE] = "bdNE";
Code[(int) bdGE] = "bdGE";
Code[(int) pushFALSE] = "pushFALSE";
Code[(int) pushTRUE] = "pushTRUE";
Code[(int) pushNULL] = "pushNULL";
Code[(int) push1INT] = "push1INT";
Code[(int) push2INT] = "push2INT";
Code[(int) push4INT] = "push4INT";
Code[(int) pushREAL] = "pushREAL";
Code[(int) pushSTRING] = "pushSTRING";
Code[(int) pushCONST] = "pushCONST";
Code[(int) pushCOL] = "pushCOL";
Code[(int) pushLINE] = "pushLINE";
Code[(int) pushALLINES] = "pushALLINES";
Code[(int) pushPAGE] = "pushPAGE";
Code[(int) pushTUPLE] = "pushTUPLE";
Code[(int) pushLAST] = "pushLAST";
Code[(int) pushVALUE] = "pushVALUE";
Code[(int) pushNEXT] = "pushNEXT";
Code[(int) pushVAR] = "pushVAR";
Code[(int) pushSWITCH] = "pushSWITCH";
Code[(int) rcNOT] = "rcNOT";
Code[(int) rcOR] = "rcOR";
Code[(int) rcAND] = "rcAND";
Code[(int) rcEND_SET] = "rcEND_SET";
Code[(int) rcMIN] = "rcMIN";
Code[(int) rcADD] = "rcADD";
Code[(int) rcSUB] = "rcSUB";
Code[(int) rcMUL] = "rcMUL";
Code[(int) rcDIV] = "rcDIV";
Code[(int) rcDIV_R] = "rcDIV_R";
Code[(int) rcMOD] = "rcMOD";
Code[(int) rcRC_END] = "rcRC_END";
Code[(int) rcRETURN] = "rcRETURN";
Code[(int) rcRTTS] = "rcRTTS";
Code[(int) rcEOTUP] = "rcEOTUP";
Code[(int) rcALL] = "rcALL";
Code[(int) rcONE] = "rcONE";
Code[(int) rcDATE] = "rcDATE";
Code[(int) rcTIME] = "rcTIME";
Code[(int) prCOL] = "prCOL";
Code[(int) prLINE] = "prLINE";
Code[(int) prALLINES] = "prALLINES";
Code[(int) prNEWPAGE] = "prNEWPAGE";
Code[(int) prPAGE] = "prPAGE";
Code[(int) prTUPLE] = "prTUPLE";
Code[(int) prVAR] = "prVAR";
Code[(int) prCONST] = "prCONST";
Code[(int) prSPACE] = "prSPACE";
Code[(int) prNEWLINE] = "prNEWLINE";
Code[(int) prNEWCOL] = "prNEWCOL";
Code[(int) prLAST] = "prLAST";
Code[(int) prVALUE] = "prVALUE";
Code[(int) prNEXT] = "prNEXT";
Code[(int) fmtB_BIT] = "fmtB_BIT";
Code[(int) fmtW_BIT] = "fmtW_BIT";
Code[(int) fmtB_OCT] = "fmtB_OCT";
Code[(int) fmtW_OCT] = "fmtW_OCT";
Code[(int) fmtB_DEC] = "fmtB_DEC";
Code[(int) fmtW_DEC] = "fmtW_DEC";
Code[(int) fmtB_HEX] = "fmtB_HEX";
Code[(int) fmtW_HEX] = "fmtW_HEX";
Code[(int) prSTRING] = "prSTRING";
Code[(int) prINPUT] = "prINPUT";
Code[(int) fmtINT] = "fmtINT";
Code[(int) fmtREAL] = "fmtREAL";
Code[(int) fmtCHAR] = "fmtCHAR";
Code[(int) fmtGRAPH] = "fmtGRAPH";
Code[(int) rcCASE] = "rcCASE";
Code[(int) rcREPEAT] = "rcREPEAT";
Code[(int) onBATCH] = "onBATCH";
Code[(int) onB_LINE] = "onB_LINE";
Code[(int) onE_LINE] = "onE_LINE";
Code[(int) onB_PAGE] = "onB_PAGE";
Code[(int) onE_PAGE] = "onE_PAGE";
Code[(int) rcJUMP] = "rcJUMP";
Code[(int) rcCALL] = "rcCALL";
Code[(int) setVAR] = "setVAR";
Code[(int) setSWITCH] = "setSWITCH";
Code[(int) rcIF] = "rcIF";
Code[(int) rcTHEN] = "rcTHEN";
}
# endif

View File

@ -0,0 +1,413 @@
/*
** --- RG_EXPR.C ------- EXPRESSION INTERPRETER -----------------------------
**
** R_EXPR_CODE (soft) Co-processor
**
** Version: @(#)rg_expr.c 4.0 02/05/89
**
*/
# include "rg_int.h"
# define SYM_NULL ((SYMBOL *) 0)
# define EXPR (tos = rg_expr(rc, rcEXPR))
# define EXPR_END return (tos)
# define EXPR_EXIT return (SYM_NULL)
# define DOUBLE sizeof (double)
# define ROUND 0.5
# define FRMT sy_frmt
# define FRML sy_frml
static int Frmt = FLOAT; /* expected */
static int Frml = DOUBLE; /* result */
SYMBOL *rg_expr(rc, code)
register char *rc;
int code; /* the reason why to interpret expression, */
/* (rcIF, setVAR, setSWITCH or rcEXPR) */
{
register SYMBOL *tos;
register SYMBOL *s;
register int c; /* the atual R-EXPR-CODE */
register int i;
register char *p;
register union anytype *any;
register union anytype *a;
BOOL set_flag; /* var assign flag */
extern char *push_rc();
extern char *AAbmove();
extern double floor();
extern char *print_type();
# ifdef RG_TRACE
extern char *Code[];
# endif
R_expr = set_flag = FALSE; /* assume interpreter dies */
tos = &Stack[MAX_STACK];
switch (code)
{
case setSWITCH:
set_flag = TRUE;
/* fall through */
case rcIF:
Frmt = BIN;
Frml = sizeof (BOOL);
break;
case setVAR:
set_flag = TRUE;
Frmt = FLOAT;
Frml = DOUBLE;
/* fall through */
case rcEXPR:
break;
default:
rg_error("INVALID start of expression (`%u')", code);
goto abo_expr;
}
# ifdef RG_TRACE
if (TR_EXPR)
printf("+>+\tset_flag=%d Frmt=%d Frml=%d\n",
set_flag, Frmt, Frml);
# endif
while (c = RC_BYTE)
{
# ifdef RG_TRACE
if (TR_EXPR)
printf("+ +\t%4d %s\n", rc - R_code - 1, Code[c]);
# endif
if (tos == Stack && RANGE(L_PUSH, c, H_PUSH))
{
rg_error("EXRESSION STACK OVERFLOW");
abo_expr:
rg_exit(EXIT_R_CODE);
}
a = any = &tos->sy_val;
switch (c)
{
case bdLT:
case bdEQ:
case bdLE:
case bdGT:
case bdNE:
case bdGE:
s = tos++;
i = rg_compare(c, tos++, s);
# ifdef RG_TRACE
if (TR_INTERP)
printf("COMPARE\twant 0%o ret 0%o\n", c, i);
# endif
if (i < 0)
EXPR_EXIT;
push_bin(--tos, bitset(i, c));
continue;
case pushFALSE:
case pushTRUE:
push_bin(--tos, c == (int) pushTRUE);
continue;
case pushNULL:
push_dbl(--tos, (double) 0);
continue;
case push1INT:
if ((i = RC_BYTE) > MAX_I1)
i -= BYTE_MASK + 1;
push_dbl(--tos, (double) i);
continue;
case push2INT:
RC_WORD;
push_dbl(--tos, (double) R_word);
continue;
case push4INT:
push_dbl(--tos, (double) 0); /* empty initialization */
any = &tos->sy_val;
AAbmove(rc, any->c0type, sizeof (long));
rc += sizeof (long);
any->f8type = any->i4type;
continue;
case pushREAL:
push_dbl(--tos, (double) 0); /* empty initialization */
any = &tos->sy_val;
AAbmove(rc, any->c0type, tos->FRML);
rc += tos->FRML;
continue;
case pushSTRING:
RC_WORD;
rc = push_rc(--tos, rc, R_word);
continue;
case pushCONST:
i = rg_getime(RC_BYTE);
push_dbl(--tos, (double) i);
continue;
case pushCOL:
if (set_flag)
{
if (EXPR)
{
any = &tos->sy_val;
set_col(i = any->f8type);
}
EXPR_END;
}
i = SYS_col - Col_begin + 1;
push_dbl(--tos, (double) i);
continue;
case pushLINE:
if (set_flag)
{
if (EXPR)
{
any = &tos->sy_val;
set_line(i = any->f8type);
}
EXPR_END;
}
i = SYS_line - Line_begin + 1;
push_dbl(--tos, (double) i);
continue;
case pushALLINES:
if (set_flag)
rg_error("ALL LINES is read only");
else
{
i = SYS_line - Line_begin + 1;
if (!i)
i = 1;
i = R_lines - i + 1;
push_dbl(--tos, (double) i);
}
continue;
case pushPAGE:
if (set_flag)
{
if (EXPR)
{
any = &tos->sy_val;
if ((i = any->f8type) > 0)
SYS_page = i;
}
EXPR_END;
}
push_dbl(--tos, (double) SYS_page);
continue;
case pushTUPLE:
if (set_flag)
{
if (EXPR)
{
any = &tos->sy_val;
if ((i = any->f8type) >= 0)
SYS_tuple = i;
}
EXPR_END;
}
push_dbl(--tos, (double) SYS_tuple);
continue;
case pushLAST:
p = Last;
goto push_dom;
case pushVALUE:
p = Value;
goto push_dom;
case pushNEXT:
p = Next;
push_dom:
RC_WORD; /* dom */
R_val = var_to_int();
RC_WORD; /* from */
i = var_to_int();
RC_WORD; /* to */
rg_push_dom(--tos, p, i, var_to_int());
continue;
case pushVAR:
RC_WORD;
i = ck_var();
if (set_flag)
{
if (EXPR)
{
any = &tos->sy_val;
Var[i].f8type = any->f8type;
}
EXPR_END;
}
push_dbl(--tos, Var[i].f8type);
continue;
case pushSWITCH:
RC_WORD;
i = ck_bvar();
if (set_flag)
{
if (EXPR)
{
any = &tos->sy_val;
Bvar[i] = any->booltype;
}
EXPR_END;
}
push_bin(--tos, Bvar[i]);
continue;
case rcNOT: /* double check ? */
s = tos;
if ( ck_2_frm (s, tos, BIN, sizeof (BOOL), "NOT"))
EXPR_EXIT;
a->booltype = !any->booltype;
continue;
case rcOR:
s = tos++;
if (ck_2_frm(s, tos, BIN, sizeof (BOOL), "OR"))
EXPR_EXIT;
a = &tos->sy_val;
a->booltype = a->booltype || any->booltype;
continue;
case rcAND:
s = tos++;
if (ck_2_frm(s, tos, BIN, sizeof (BOOL), "AND"))
EXPR_EXIT;
a = &tos->sy_val;
a->booltype = a->booltype && any->booltype;
continue;
case rcEND_SET:
case rcTHEN:
if (tos != &Stack[MAX_STACK - 1])
{
rg_error("LEAVING %d SYMBOLS in EXPR-STACK",
&Stack[MAX_STACK - 1] - tos);
goto expr_error;
}
if (Frmt == FLOAT && Frml == DOUBLE)
convert(tos);
if (ck_frm(tos, Frmt, Frml))
{
rg_error("WRONG EXPR-TYPE %s%d, expected %s%d",
print_type(tos->FRMT), tos->FRML,
print_type(Frmt), Frml);
expr_error:
rg_error("Expression not assigned");
EXPR_EXIT;
}
if (c == (int) rcTHEN)
R_expr = a->booltype;
# ifdef RG_TRACE
if (TR_EXPR)
{
printf("+<+\t");
if (Frmt == BIN)
printf("bool(%d)\n", a->booltype);
else
printf("%10.3f\n", a->f8type);
}
# endif
EXPR_END;
case rcMIN: /* double check ? */
s = tos;
if (ck_2_frm(s, tos, FLOAT, DOUBLE, "-"))
EXPR_EXIT;
a->f8type = - any->f8type;
continue;
case rcADD:
s = tos++;
if (ck_2_frm(s, tos, FLOAT, DOUBLE, "+"))
EXPR_EXIT;
a = &tos->sy_val;
a->f8type += any->f8type;
continue;
case rcSUB:
s = tos++;
if (ck_2_frm(s, tos, FLOAT, DOUBLE, "-"))
EXPR_EXIT;
a = &tos->sy_val;
a->f8type -= any->f8type;
continue;
case rcMUL:
s = tos++;
if (ck_2_frm(s, tos, FLOAT, DOUBLE, "*"))
EXPR_EXIT;
a = &tos->sy_val;
a->f8type *= any->f8type;
continue;
case rcDIV:
s = tos++;
if (ck_2_frm(s, tos, FLOAT, DOUBLE, ":"))
EXPR_EXIT;
a = &tos->sy_val;
if (any->f8type == 0.0)
{
rg_error("ILLEGAL division: %10.3f : 0", a->f8type);
EXPR_EXIT;
}
a->f8type /= any->f8type;
continue;
case rcDIV_R:
s = tos++;
if (ck_2_frm(s, tos, FLOAT, DOUBLE, "/"))
EXPR_EXIT;
a = &tos->sy_val;
if (any->f8type == 0.0)
{
rg_error("ILLEGAL division: %10.3f / 0", a->f8type);
EXPR_EXIT;
}
a->f8type = floor(a->f8type / any->f8type);
continue;
case rcMOD:
s = tos++;
if (ck_2_frm(s, tos, FLOAT, DOUBLE, "%"))
EXPR_EXIT;
a = &tos->sy_val;
a->f8type = (long) a->f8type % (long) any->f8type;
continue;
default:
rg_error("ILLEGAL EXPRESSION R-CODE `%u'", c);
rg_exit(EXIT_R_CODE);
/*NOTREACHED*/
} /* switch */
} /* while */
EXPR_EXIT;
}

View File

@ -0,0 +1,355 @@
/*
** --- RG_INT.C -------- R-CODE-INTERPRETER ---------------------------------
**
** R_CODE (soft) Processor
**
** Version: @(#)rg_int.c 4.0 02/05/89
**
*/
# include <stdio.h>
# include "rg_int.h"
SYMBOL Stack[MAX_STACK + 1];
SYMBOL *Print = &Stack[MAX_STACK];
# ifdef RG_TRACE
static int I_level;
# endif
rg_interp()
{
register char *rc; /* R-CODE pointer */
register int c; /* the actual R-CODE */
register int i;
register char *push_rc; /* pushed R_CODE ptr */
short no;
char *inp;
extern char *fmt_graph();
extern char *rg_case();
extern char *AApad();
# ifdef RG_TRACE
extern char *Code[];
# endif
RUN = 0;
rc = R_rc;
# ifdef RG_TRACE
if (TR_INTERP)
{
I_level++;
printf("*>*\n");
}
# endif
while (c = RC_BYTE)
{
# ifdef RG_TRACE
if (TR_INTERP)
printf("*%d*\t%4d %s",
I_level, rc - R_code - 1, Code[c]);
# endif
i = 0;
/* get the first argument of the TWO BYTES CODES */
if (RANGE(L_2_BYTES, c, H_2_BYTES))
{
/* it may be a var, get the value */
RC_WORD;
R_val = var_to_int();
# ifdef RG_TRACE
if (TR_INTERP)
printf(" %d", R_val);
# endif
}
/* get the first (or the second for rcCASE and */
/* rcREPEAT) argument of the THREE BYTES CODES, */
/* it's a relative R-CODE address */
if (RANGE(L_3_BYTES, c, H_3_BYTES))
{
/* first read the offset, then update !! */
RC_WORD;
push_rc = R_rc = rc + R_word;
# ifdef RG_TRACE
if (TR_INTERP)
printf(" -->%d", push_rc - R_code);
# endif
}
# ifdef RG_TRACE
if (TR_INTERP)
putchar('\n');
# endif
/* most CODES have their arguments, */
/* START to interpret R-CODE */
switch (c)
{
/* ONE BYTE CODE */
case rcRC_END:
new_page();
RUN++;
break;
case rcRETURN:
# ifdef RG_TRACE
if (TR_INTERP)
{
--I_level;
printf("*<*\n");
}
# endif
R_rc = rc;
return;
case rcRTTS:
case rcEOTUP:
case rcALL:
RUN++;
break;
case rcONE:
continue;
case rcDATE:
case rcTIME:
rg_prtime(c == (int) rcTIME);
break;
case prCOL:
i = SYS_col - Col_begin + 1;
goto push;
case prLINE:
i = SYS_line - Line_begin + 1;
if (!i)
i = 1;
goto push;
case prALLINES:
i = SYS_line - Line_begin + 1;
if (!i)
i = 1;
i = R_lines - i + 1;
goto push;
case prNEWPAGE:
if (RUNline || RUNpage)
RUN++;
else
new_page();
break;
case prPAGE:
i = SYS_page;
goto push;
case prTUPLE:
i = SYS_tuple;
push:
push_int(Print, i);
continue;
/* THE ANACHRONISM CODE */
case prVAR:
RC_WORD;
i = ck_var();
push_dbl(Print, Var[i].f8type);
continue;
/* TWO Bytes CODES */
case prCONST:
i = rg_getime(R_val);
goto push;
case prSPACE:
SYS_col = AApad(SYS_col, ck_val1(A_SPACE));
break;
case prNEWLINE:
if (RUNline)
RUN++;
else
{
if ((i = R_val) < 1 || i > H_NEWLINE)
i = A_NEWLINE;
for ( ; i; --i)
new_line();
}
break;
case prNEWCOL:
set_col(ck_val1(A_COL));
break;
case prLAST:
rg_pr_dom(Last);
continue;
case prVALUE:
rg_pr_dom(Value);
continue;
case prNEXT:
rg_pr_dom(Next);
continue;
case fmtB_BIT:
fmt_byte(BIT);
break;
case fmtW_BIT:
fmt_word(BIT);
break;
case fmtB_OCT:
fmt_byte(OCT);
break;
case fmtW_OCT:
fmt_word(OCT);
break;
case fmtB_DEC:
fmt_byte(DEC);
break;
case fmtW_DEC:
fmt_word(DEC);
break;
case fmtB_HEX:
fmt_byte(HEX);
break;
case fmtW_HEX:
fmt_word(HEX);
break;
/* THE ANACHRONISM CODE */
case prSTRING:
i = R_val; /* !! */
RC_WORD; /* batch length */
rg_batch(i, var_to_int(), i, rc);
rc += i; /* update */
break;
case prINPUT:
RC_WORD; /* batch length */
i = rg_input(rc, &inp); /* prompt */
rg_batch(i, var_to_int(), i, inp);
rc += R_val; /* update */
break;
case fmtINT:
fmt_int(rc);
adjust:
rc += sizeof (double); /* skip scale */
RC_WORD; /* pic length */
rc += R_word; /* skip picture string */
break;
case fmtREAL:
fmt_real(rc);
rc += 8; /* skip before, point, ignore, norm */
goto adjust;
case fmtCHAR: /* R_val == output length */
RC_WORD; /* == from */
i = var_to_int();
RC_WORD; /* == to */
no = var_to_int();
RC_WORD; /* == batch length */
fmt_char(i, no, var_to_int());
break;
case fmtGRAPH:
rc = fmt_graph(rc);
break;
/* THE ANACHRONISM CODE */
case rcCASE:
/* get address of case == R_rc */
/* and return address == rc */
rc = rg_case();
rg_interp();
continue;
case rcREPEAT:
if (rg_repeat(rc))
goto jump;
continue;
/* THREE BYTES CODES */
case onBATCH:
ONbatch = rc;
/* jump over exception */
goto jump;
case onB_LINE:
ONb_line = rc;
/* jump over exception */
goto jump;
case onE_LINE:
ONe_line = rc;
/* jump over exception */
goto jump;
case onB_PAGE:
ONb_page = rc;
/* jump over exception */
goto jump;
case onE_PAGE:
ONe_page = rc;
/* jump over exception */
/* fall through */
case rcJUMP:
jump:
rc = push_rc;
continue;
case rcCALL:
rg_interp();
continue;
case setVAR:
case setSWITCH:
case rcIF:
rg_expr(rc, c);
goto jump; /* goto THEN */
case rcTHEN:
if (!R_expr)
goto jump; /* goto ELSE */
continue;
default:
rg_error("ILLEGAL R-CODE `%u'", c);
rg_exit(EXIT_R_CODE);
}
check_line();
if (RUN)
{
# ifdef RG_TRACE
if (TR_INTERP)
{
--I_level;
printf("*<*\n");
}
# endif
R_rc = rc;
return;
}
}
}