ack/lang/m2/comp/code.c

1048 lines
19 KiB
C
Raw Normal View History

1986-05-21 18:32:20 +00:00
/* C O D E G E N E R A T I O N R O U T I N E S */
#ifndef NORCSID
static char *RcsId = "$Header$";
#endif
/* Code generation for expressions and coercions
*/
#include "debug.h"
#include <em_arith.h>
#include <em_label.h>
#include <assert.h>
#include "type.h"
#include "def.h"
#include "scope.h"
#include "desig.h"
#include "LLlex.h"
#include "node.h"
#include "Lpars.h"
1986-05-30 18:48:00 +00:00
#include "standards.h"
1986-06-20 14:36:49 +00:00
#include "walk.h"
1986-05-21 18:32:20 +00:00
extern char *long2str();
extern char *symbol2str();
extern int proclevel;
1986-06-06 02:22:09 +00:00
int fp_used;
1986-05-21 18:32:20 +00:00
CodeConst(cst, size)
arith cst, size;
{
/* Generate code to push constant "cst" with size "size"
*/
label dlab;
if (size <= word_size) {
C_loc(cst);
}
else if (size == dword_size) {
C_ldc(cst);
}
else {
1986-06-20 14:36:49 +00:00
C_df_dlb(dlab = ++data_label);
1986-06-06 02:22:09 +00:00
C_rom_icon(long2str((long) cst), size);
1986-05-23 09:46:31 +00:00
C_lae_dlb(dlab, (arith) 0);
1986-05-21 18:32:20 +00:00
C_loi(size);
}
}
CodeString(nd)
1986-06-04 09:01:48 +00:00
register struct node *nd;
1986-05-21 18:32:20 +00:00
{
label lab;
1986-05-28 18:36:51 +00:00
1986-06-04 09:01:48 +00:00
if (nd->nd_type == char_type) {
1986-05-23 09:46:31 +00:00
C_loc(nd->nd_INT);
}
1986-06-04 09:01:48 +00:00
else {
1986-06-20 14:36:49 +00:00
C_df_dlb(lab = ++data_label);
1986-06-10 13:18:52 +00:00
C_rom_scon(nd->nd_STR, WA(nd->nd_SLE + 1));
1986-06-04 09:01:48 +00:00
C_lae_dlb(lab, (arith) 0);
}
}
CodePadString(nd, sz)
register struct node *nd;
arith sz;
{
/* Generate code to push the string indicated by "nd".
Make it null-padded to "sz" bytes
*/
1986-06-10 13:18:52 +00:00
register arith sizearg = WA(nd->nd_type->tp_size);
1986-06-04 09:01:48 +00:00
assert(nd->nd_type->tp_fund == T_STRING);
if (sizearg != sz) {
/* null padding required */
assert(sizearg < sz);
C_zer(sz - sizearg);
}
CodeString(nd); /* push address of string */
1986-06-06 02:22:09 +00:00
C_loi(sizearg);
1986-05-21 18:32:20 +00:00
}
CodeReal(nd)
1986-06-04 09:01:48 +00:00
register struct node *nd;
1986-05-21 18:32:20 +00:00
{
1986-06-20 14:36:49 +00:00
label lab = ++data_label;
1986-06-04 09:01:48 +00:00
C_df_dlb(lab);
1986-05-21 18:32:20 +00:00
C_rom_fcon(nd->nd_REL, nd->nd_type->tp_size);
1986-05-28 18:36:51 +00:00
C_lae_dlb(lab, (arith) 0);
1986-05-21 18:32:20 +00:00
C_loi(nd->nd_type->tp_size);
}
CodeExpr(nd, ds, true_label, false_label)
1986-05-23 19:25:21 +00:00
register struct node *nd;
register struct desig *ds;
1986-05-21 18:32:20 +00:00
label true_label, false_label;
{
1986-06-06 02:22:09 +00:00
register struct type *tp = nd->nd_type;
1986-05-21 18:32:20 +00:00
1986-06-06 02:22:09 +00:00
if (tp->tp_fund == T_REAL) fp_used = 1;
1986-05-21 18:32:20 +00:00
switch(nd->nd_class) {
case Def:
1986-05-30 18:48:00 +00:00
if (nd->nd_def->df_kind == D_PROCEDURE) {
1986-06-04 09:01:48 +00:00
C_lpi(NameOfProc(nd->nd_def));
1986-05-30 18:48:00 +00:00
ds->dsg_kind = DSG_LOADED;
break;
}
1986-06-04 09:01:48 +00:00
/* Fall through */
case Link:
1986-06-20 14:36:49 +00:00
case LinkDef:
1986-06-10 13:18:52 +00:00
case Arrsel:
case Arrow:
1986-05-21 18:32:20 +00:00
CodeDesig(nd, ds);
break;
case Oper:
CodeOper(nd, true_label, false_label);
if (true_label == 0) ds->dsg_kind = DSG_LOADED;
1986-06-10 13:18:52 +00:00
else {
ds->dsg_kind = DSG_INIT;
true_label = 0;
}
1986-05-21 18:32:20 +00:00
break;
case Uoper:
CodeUoper(nd);
ds->dsg_kind = DSG_LOADED;
break;
case Value:
switch(nd->nd_symb) {
case REAL:
CodeReal(nd);
break;
case STRING:
CodeString(nd);
break;
case INTEGER:
1986-06-06 02:22:09 +00:00
CodeConst(nd->nd_INT, tp->tp_size);
1986-05-21 18:32:20 +00:00
break;
default:
crash("Value error");
}
ds->dsg_kind = DSG_LOADED;
break;
case Call:
CodeCall(nd);
ds->dsg_kind = DSG_LOADED;
break;
1986-05-23 19:25:21 +00:00
case Set: {
arith *st;
int i;
st = nd->nd_set;
1986-05-28 18:36:51 +00:00
ds->dsg_kind = DSG_LOADED;
if (!st) {
1986-06-06 02:22:09 +00:00
C_zer(tp->tp_size);
1986-05-28 18:36:51 +00:00
break;
}
1986-06-06 02:22:09 +00:00
for (i = tp->tp_size / word_size, st += i; i > 0; i--) {
1986-05-23 19:25:21 +00:00
C_loc(*--st);
}
}
break;
1986-05-21 18:32:20 +00:00
case Xset:
1986-05-23 19:25:21 +00:00
CodeSet(nd);
1986-05-21 18:32:20 +00:00
ds->dsg_kind = DSG_LOADED;
break;
default:
crash("(CodeExpr) bad node type");
}
if (true_label != 0) {
1986-06-06 02:22:09 +00:00
CodeValue(ds, tp->tp_size);
1986-05-21 18:32:20 +00:00
*ds = InitDesig;
C_zne(true_label);
C_bra(false_label);
}
}
CodeCoercion(t1, t2)
1986-05-28 18:36:51 +00:00
register struct type *t1, *t2;
1986-05-21 18:32:20 +00:00
{
1986-06-04 09:01:48 +00:00
register int fund1, fund2;
1986-05-28 18:36:51 +00:00
if (t1->tp_fund == T_SUBRANGE) t1 = t1->next;
if (t2->tp_fund == T_SUBRANGE) t2 = t2->next;
1986-06-17 12:04:05 +00:00
if (t1 == t2) return;
1986-05-28 18:36:51 +00:00
if ((fund1 = t1->tp_fund) == T_WORD) fund1 = T_INTEGER;
if ((fund2 = t2->tp_fund) == T_WORD) fund2 = T_INTEGER;
switch(fund1) {
case T_INTEGER:
1986-05-30 18:48:00 +00:00
case T_INTORCARD:
1986-05-28 18:36:51 +00:00
switch(fund2) {
case T_INTEGER:
if (t2->tp_size != t1->tp_size) {
C_loc(t1->tp_size);
C_loc(t2->tp_size);
C_cii();
}
break;
case T_ENUMERATION:
case T_CHAR:
case T_CARDINAL:
if (t1->tp_size != word_size) {
C_loc(t1->tp_size);
C_loc(word_size);
C_ciu();
}
break;
case T_REAL:
C_loc(t1->tp_size);
C_loc(t2->tp_size);
C_cif();
break;
default:
crash("Funny integer conversion");
}
break;
case T_CHAR:
case T_ENUMERATION:
case T_CARDINAL:
switch(fund2) {
case T_ENUMERATION:
case T_CHAR:
case T_CARDINAL:
case T_POINTER:
if (t2->tp_size > word_size) {
C_loc(word_size);
C_loc(t2->tp_size);
C_cuu();
}
break;
case T_INTEGER:
1986-06-06 02:22:09 +00:00
C_loc(word_size);
1986-05-28 18:36:51 +00:00
C_loc(t2->tp_size);
C_cui();
break;
case T_REAL:
1986-06-06 02:22:09 +00:00
C_loc(word_size);
1986-05-28 18:36:51 +00:00
C_loc(t2->tp_size);
C_cuf();
break;
default:
crash("Funny cardinal conversion");
}
break;
case T_REAL:
switch(fund2) {
case T_REAL:
if (t2->tp_size != t1->tp_size) {
C_loc(t1->tp_size);
C_loc(t2->tp_size);
C_cff();
}
break;
case T_INTEGER:
C_loc(t1->tp_size);
C_loc(t2->tp_size);
C_cfi();
break;
case T_CARDINAL:
C_loc(t1->tp_size);
C_loc(t2->tp_size);
C_cfu();
break;
default:
crash("Funny REAL conversion");
}
break;
}
1986-05-21 18:32:20 +00:00
}
CodeCall(nd)
1986-05-23 19:25:21 +00:00
register struct node *nd;
1986-05-21 18:32:20 +00:00
{
/* Generate code for a procedure call. Checking of parameters
and result is already done.
*/
register struct node *left = nd->nd_left;
1986-06-20 14:36:49 +00:00
register struct type *result_tp;
1986-05-21 18:32:20 +00:00
if (left->nd_type == std_type) {
CodeStd(nd);
return;
}
1986-05-30 18:48:00 +00:00
if (IsCast(left)) {
1986-05-23 09:46:31 +00:00
/* it was just a cast. Simply ignore it
*/
1986-05-30 18:48:00 +00:00
CodePExpr(nd->nd_right->nd_left);
1986-05-23 09:46:31 +00:00
*nd = *(nd->nd_right->nd_left);
nd->nd_type = left->nd_def->df_type;
return;
}
1986-05-30 18:48:00 +00:00
assert(IsProcCall(left));
1986-05-21 18:32:20 +00:00
1986-06-17 12:04:05 +00:00
if (nd->nd_right) {
1986-06-20 14:36:49 +00:00
CodeParameters(ParamList(left->nd_type), nd->nd_right);
1986-05-21 18:32:20 +00:00
}
if (left->nd_class == Def && left->nd_def->df_kind == D_PROCEDURE) {
if (left->nd_def->df_scope->sc_level > 0) {
C_lxl((arith) proclevel - left->nd_def->df_scope->sc_level);
}
1986-06-04 09:01:48 +00:00
C_cal(NameOfProc(left->nd_def));
1986-05-21 18:32:20 +00:00
}
else if (left->nd_class == Def && left->nd_def->df_kind == D_PROCHEAD) {
C_cal(left->nd_def->for_name);
}
else {
1986-05-30 18:48:00 +00:00
CodePExpr(left);
1986-05-21 18:32:20 +00:00
C_cai();
}
1986-06-10 13:18:52 +00:00
if (left->nd_type->prc_nbpar) C_asp(left->nd_type->prc_nbpar);
1986-06-20 14:36:49 +00:00
if (result_tp = ResultType(left->nd_type)) {
if (IsConstructed(result_tp)) {
C_lfr(pointer_size);
C_loi(result_tp->tp_size);
}
else C_lfr(WA(result_tp->tp_size));
1986-05-21 18:32:20 +00:00
}
}
1986-06-17 12:04:05 +00:00
CodeParameters(param, arg)
struct paramlist *param;
struct node *arg;
{
register struct type *tp;
register struct node *left;
assert(param != 0 && arg != 0);
if (param->next) {
CodeParameters(param->next, arg->nd_right);
}
tp = TypeOfParam(param);
left = arg->nd_left;
if (IsConformantArray(tp)) {
C_loc(tp->arr_elsize);
if (IsConformantArray(left->nd_type)) {
DoHIGH(left);
if (tp->arr_elem->tp_size != left->nd_type->arr_elem->tp_size) {
/* This can only happen if the formal type is
ARRAY OF WORD
*/
/* ??? */
}
}
else if (left->nd_symb == STRING) {
C_loc(left->nd_SLE);
}
else if (tp->arr_elem == word_type) {
C_loc(left->nd_type->tp_size / word_size - 1);
}
else {
tp = left->nd_type->next;
if (tp->tp_fund == T_SUBRANGE) {
C_loc(tp->sub_ub - tp->sub_lb);
}
else C_loc((arith) (tp->enm_ncst - 1));
}
C_loc((arith) 0);
if (left->nd_symb == STRING) {
CodeString(left);
}
else CodeDAddress(left);
}
else if (IsVarParam(param)) {
CodeDAddress(left);
}
else {
if (left->nd_type->tp_fund == T_STRING) {
CodePadString(left, tp->tp_size);
}
else CodePExpr(left);
CheckAssign(left->nd_type, tp);
}
}
1986-05-21 18:32:20 +00:00
CodeStd(nd)
struct node *nd;
{
1986-05-30 18:48:00 +00:00
register struct node *arg = nd->nd_right;
register struct node *left = 0;
register struct type *tp = 0;
int std;
if (arg) {
left = arg->nd_left;
tp = left->nd_type;
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
arg = arg->nd_right;
}
switch(std = nd->nd_left->nd_def->df_value.df_stdname) {
case S_ABS:
CodePExpr(left);
if (tp->tp_fund == T_INTEGER) {
if (tp->tp_size == int_size) {
C_cal("_absi");
}
else C_cal("_absl");
}
else if (tp->tp_fund == T_REAL) {
if (tp->tp_size == float_size) {
C_cal("_absf");
}
else C_cal("_absd");
}
C_lfr(tp->tp_size);
break;
case S_CAP:
CodePExpr(left);
C_loc((arith) 0137);
C_and(word_size);
break;
case S_CHR:
CodePExpr(left);
CheckAssign(char_type, tp);
break;
case S_FLOAT:
CodePExpr(left);
CodeCoercion(tp, real_type);
break;
case S_HIGH:
assert(IsConformantArray(tp));
1986-06-04 09:01:48 +00:00
DoHIGH(left);
1986-05-30 18:48:00 +00:00
break;
case S_ODD:
if (tp->tp_size == word_size) {
C_loc((arith) 1);
C_and(word_size);
}
else {
assert(tp->tp_size == dword_size);
C_ldc((arith) 1);
C_and(dword_size);
C_ior(word_size);
}
break;
case S_ORD:
CodePExpr(left);
break;
case S_TRUNC:
CodePExpr(left);
CodeCoercion(tp, card_type);
break;
case S_VAL:
CodePExpr(left);
CheckAssign(nd->nd_type, tp);
break;
case S_ADR:
CodeDAddress(left);
break;
case S_DEC:
case S_INC:
CodePExpr(left);
if (arg) CodePExpr(arg->nd_left);
else C_loc((arith) 1);
if (tp->tp_size <= word_size) {
if (std == S_DEC) {
if (tp->tp_fund == T_INTEGER) C_sbi(word_size);
else C_sbu(word_size);
}
else {
if (tp->tp_fund == T_INTEGER) C_adi(word_size);
else C_adu(word_size);
}
CheckAssign(tp, int_type);
}
else {
CodeCoercion(int_type, tp);
if (std == S_DEC) {
if (tp->tp_fund==T_INTEGER) C_sbi(tp->tp_size);
else C_sbu(tp->tp_size);
}
else {
if (tp->tp_fund==T_INTEGER) C_adi(tp->tp_size);
else C_adu(tp->tp_size);
}
}
CodeDStore(left);
break;
case S_HALT:
C_cal("_halt");
break;
case S_INCL:
case S_EXCL:
CodePExpr(left);
CodePExpr(arg->nd_left);
C_set(tp->tp_size);
if (std == S_INCL) {
C_ior(tp->tp_size);
}
else {
C_com(tp->tp_size);
C_and(tp->tp_size);
}
CodeDStore(left);
break;
default:
crash("(CodeStd)");
}
1986-05-21 18:32:20 +00:00
}
1986-05-28 18:36:51 +00:00
CodeAssign(nd, dss, dst)
1986-05-21 18:32:20 +00:00
struct node *nd;
1986-05-23 09:46:31 +00:00
struct desig *dst, *dss;
1986-05-21 18:32:20 +00:00
{
/* Generate code for an assignment. Testing of type
compatibility and the like is already done.
*/
1986-06-04 09:01:48 +00:00
register struct type *tp = nd->nd_right->nd_type;
1986-05-28 18:36:51 +00:00
if (dss->dsg_kind == DSG_LOADED) {
1986-06-04 09:01:48 +00:00
if (tp->tp_fund == T_STRING) {
CodeAddress(dst);
C_loc(tp->tp_size);
C_loc(nd->nd_left->nd_type->tp_size);
C_cal("_StringAssign");
C_asp((int_size << 1) + (pointer_size << 1));
return;
}
1986-05-28 18:36:51 +00:00
CodeStore(dst, nd->nd_left->nd_type->tp_size);
1986-06-04 09:01:48 +00:00
return;
1986-05-28 18:36:51 +00:00
}
1986-06-04 09:01:48 +00:00
CodeAddress(dss);
CodeAddress(dst);
C_blm(nd->nd_left->nd_type->tp_size);
1986-05-28 18:36:51 +00:00
}
CheckAssign(tpl, tpr)
register struct type *tpl, *tpr;
{
/* Generate a range check if neccessary
*/
arith llo, lhi, rlo, rhi;
if (bounded(tpl)) {
/* in this case we might need a range check */
if (!bounded(tpr)) {
/* yes, we need one */
1986-06-17 12:04:05 +00:00
genrck(tpl);
1986-05-28 18:36:51 +00:00
}
else {
/* both types are restricted. check the bounds
to see wether we need a range check
*/
getbounds(tpl, &llo, &lhi);
getbounds(tpr, &rlo, &rhi);
if (llo > rlo || lhi < rhi) {
1986-06-17 12:04:05 +00:00
genrck(tpl);
1986-05-28 18:36:51 +00:00
}
}
}
1986-05-21 18:32:20 +00:00
}
Operands(leftop, rightop)
1986-05-23 19:25:21 +00:00
register struct node *leftop, *rightop;
1986-05-21 18:32:20 +00:00
{
1986-05-30 18:48:00 +00:00
CodePExpr(leftop);
1986-05-21 18:32:20 +00:00
if (rightop->nd_type->tp_fund == T_POINTER &&
leftop->nd_type->tp_size != pointer_size) {
CodeCoercion(leftop->nd_type, rightop->nd_type);
leftop->nd_type = rightop->nd_type;
}
1986-05-30 18:48:00 +00:00
CodePExpr(rightop);
1986-05-21 18:32:20 +00:00
}
CodeOper(expr, true_label, false_label)
struct node *expr; /* the expression tree itself */
label true_label;
label false_label; /* labels to jump to in logical expr's */
{
register int oper = expr->nd_symb;
register struct node *leftop = expr->nd_left;
register struct node *rightop = expr->nd_right;
register struct type *tp = expr->nd_type;
switch (oper) {
case '+':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_INTEGER:
C_adi(tp->tp_size);
break;
case T_POINTER:
C_ads(rightop->nd_type->tp_size);
break;
case T_REAL:
C_adf(tp->tp_size);
break;
case T_CARDINAL:
C_adu(tp->tp_size);
break;
case T_SET:
C_ior(tp->tp_size);
break;
default:
crash("bad type +");
}
break;
case '-':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_INTEGER:
C_sbi(tp->tp_size);
break;
case T_POINTER:
if (rightop->nd_type->tp_fund == T_POINTER) {
C_sbs(pointer_size);
}
else {
C_ngi(rightop->nd_type->tp_size);
C_ads(rightop->nd_type->tp_size);
}
break;
case T_REAL:
C_sbf(tp->tp_size);
break;
case T_CARDINAL:
C_sbu(tp->tp_size);
break;
case T_SET:
C_com(tp->tp_size);
C_and(tp->tp_size);
break;
default:
crash("bad type -");
}
break;
case '*':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_INTEGER:
C_mli(tp->tp_size);
break;
case T_POINTER:
CodeCoercion(rightop->nd_type, tp);
/* Fall through */
case T_CARDINAL:
C_mlu(tp->tp_size);
break;
case T_REAL:
C_mlf(tp->tp_size);
break;
case T_SET:
C_and(tp->tp_size);
break;
default:
crash("bad type *");
}
break;
case '/':
Operands(leftop, rightop);
switch (tp->tp_fund) {
case T_REAL:
C_dvf(tp->tp_size);
break;
case T_SET:
C_xor(tp->tp_size);
break;
default:
crash("bad type /");
}
break;
case DIV:
Operands(leftop, rightop);
switch(tp->tp_fund) {
case T_INTEGER:
C_dvi(tp->tp_size);
break;
case T_POINTER:
CodeCoercion(rightop->nd_type, tp);
/* Fall through */
case T_CARDINAL:
C_dvu(tp->tp_size);
break;
default:
crash("bad type DIV");
}
break;
case MOD:
Operands(leftop, rightop);
switch(tp->tp_fund) {
case T_INTEGER:
C_rmi(tp->tp_size);
break;
case T_POINTER:
CodeCoercion(rightop->nd_type, tp);
/* Fall through */
case T_CARDINAL:
C_rmu(tp->tp_size);
break;
default:
crash("bad type MOD");
}
break;
case '<':
case LESSEQUAL:
case '>':
case GREATEREQUAL:
case '=':
case '#':
Operands(leftop, rightop);
CodeCoercion(rightop->nd_type, leftop->nd_type);
1986-05-28 18:36:51 +00:00
tp = leftop->nd_type; /* Not the result type! */
if (tp->tp_fund == T_SUBRANGE) tp = tp->next;
1986-05-21 18:32:20 +00:00
switch (tp->tp_fund) {
case T_INTEGER:
1986-05-28 18:36:51 +00:00
C_cmi(tp->tp_size);
1986-05-21 18:32:20 +00:00
break;
1986-06-04 09:01:48 +00:00
case T_HIDDEN:
1986-05-21 18:32:20 +00:00
case T_POINTER:
C_cmp();
break;
case T_CARDINAL:
1986-05-28 18:36:51 +00:00
C_cmu(tp->tp_size);
1986-05-21 18:32:20 +00:00
break;
case T_ENUMERATION:
case T_CHAR:
C_cmu(word_size);
break;
case T_REAL:
1986-05-28 18:36:51 +00:00
C_cmf(tp->tp_size);
1986-05-21 18:32:20 +00:00
break;
case T_SET:
1986-05-28 18:36:51 +00:00
if (oper == GREATEREQUAL) {
/* A >= B is the same as A equals A + B
*/
C_dup(2*tp->tp_size);
C_asp(tp->tp_size);
C_zer(tp->tp_size);
}
else if (oper == LESSEQUAL) {
/* A <= B is the same as A - B = {}
*/
C_com(tp->tp_size);
C_and(tp->tp_size);
C_ior(tp->tp_size);
1986-06-20 14:36:49 +00:00
C_zer(tp->tp_size);
1986-05-28 18:36:51 +00:00
}
C_cms(tp->tp_size);
1986-05-21 18:32:20 +00:00
break;
default:
crash("bad type COMPARE");
}
if (true_label != 0) {
compare(oper, true_label);
C_bra(false_label);
}
else {
truthvalue(oper);
}
break;
case IN:
1986-05-28 18:36:51 +00:00
/* In this case, evaluate right hand side first! The
INN instruction expects the bit number on top of the
stack
*/
Operands(rightop, leftop);
CodeCoercion(leftop->nd_type, word_type);
C_inn(rightop->nd_type->tp_size);
1986-06-10 13:18:52 +00:00
if (true_label != 0) {
C_zne(true_label);
C_bra(false_label);
}
1986-05-21 18:32:20 +00:00
break;
case AND:
case '&':
if (true_label == 0) {
1986-06-20 14:36:49 +00:00
label l_true = ++text_label;
label l_false = ++text_label;
label l_maybe = ++text_label;
label l_end = ++text_label;
1986-05-21 18:32:20 +00:00
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, l_maybe, l_false);
C_df_ilb(l_maybe);
Des = InitDesig;
CodeExpr(rightop, &Des, l_true, l_false);
C_df_ilb(l_true);
C_loc((arith)1);
C_bra(l_end);
C_df_ilb(l_false);
C_loc((arith)0);
C_df_ilb(l_end);
}
else {
1986-06-20 14:36:49 +00:00
label l_maybe = ++text_label;
1986-05-21 18:32:20 +00:00
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, l_maybe, false_label);
Des = InitDesig;
C_df_ilb(l_maybe);
CodeExpr(rightop, &Des, true_label, false_label);
}
break;
case OR:
if (true_label == 0) {
1986-06-20 14:36:49 +00:00
label l_true = ++text_label;
label l_false = ++text_label;
label l_maybe = ++text_label;
label l_end = ++text_label;
1986-05-21 18:32:20 +00:00
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, l_true, l_maybe);
C_df_ilb(l_maybe);
Des = InitDesig;
CodeExpr(rightop, &Des, l_true, l_false);
C_df_ilb(l_false);
C_loc((arith)0);
C_bra(l_end);
C_df_ilb(l_true);
C_loc((arith)1);
C_df_ilb(l_end);
}
else {
1986-06-20 14:36:49 +00:00
label l_maybe = ++text_label;
1986-05-21 18:32:20 +00:00
struct desig Des;
Des = InitDesig;
CodeExpr(leftop, &Des, true_label, l_maybe);
C_df_ilb(l_maybe);
Des = InitDesig;
CodeExpr(rightop, &Des, true_label, false_label);
}
break;
default:
crash("(CodeOper) Bad operator %s\n", symbol2str(oper));
}
}
/* compare() serves as an auxiliary function of CodeOper */
compare(relop, lbl)
int relop;
1986-05-23 19:25:21 +00:00
register label lbl;
1986-05-21 18:32:20 +00:00
{
switch (relop) {
case '<':
C_zlt(lbl);
break;
case LESSEQUAL:
C_zle(lbl);
break;
case '>':
C_zgt(lbl);
break;
case GREATEREQUAL:
C_zge(lbl);
break;
case '=':
C_zeq(lbl);
break;
case '#':
C_zne(lbl);
break;
default:
crash("(compare)");
}
}
/* truthvalue() serves as an auxiliary function of CodeOper */
truthvalue(relop)
int relop;
{
switch (relop) {
case '<':
C_tlt();
break;
case LESSEQUAL:
C_tle();
break;
case '>':
C_tgt();
break;
case GREATEREQUAL:
C_tge();
break;
case '=':
C_teq();
break;
case '#':
C_tne();
break;
default:
crash("(truthvalue)");
}
}
CodeUoper(nd)
register struct node *nd;
{
register struct type *tp = nd->nd_type;
1986-06-17 12:04:05 +00:00
CodePExpr(nd->nd_right);
1986-05-21 18:32:20 +00:00
switch(nd->nd_symb) {
case '~':
case NOT:
C_teq();
break;
case '-':
switch(tp->tp_fund) {
case T_INTEGER:
C_ngi(tp->tp_size);
break;
case T_REAL:
C_ngf(tp->tp_size);
break;
default:
crash("Bad operand to unary -");
}
break;
default:
crash("Bad unary operator");
}
}
1986-05-23 19:25:21 +00:00
CodeSet(nd)
register struct node *nd;
{
struct type *tp = nd->nd_type;
1986-06-06 02:22:09 +00:00
C_zer(nd->nd_type->tp_size); /* empty set */
1986-05-23 19:25:21 +00:00
nd = nd->nd_right;
while (nd) {
assert(nd->nd_class == Link && nd->nd_symb == ',');
CodeEl(nd->nd_left, tp);
nd = nd->nd_right;
}
}
CodeEl(nd, tp)
register struct node *nd;
1986-06-04 09:01:48 +00:00
register struct type *tp;
1986-05-23 19:25:21 +00:00
{
if (nd->nd_class == Link && nd->nd_symb == UPTO) {
1986-06-06 02:22:09 +00:00
C_loc(tp->tp_size); /* push size */
1986-06-04 09:01:48 +00:00
if (tp->next->tp_fund == T_SUBRANGE) {
C_loc(tp->next->sub_ub);
}
1986-06-06 02:22:09 +00:00
else C_loc((arith) (tp->next->enm_ncst - 1));
1986-05-23 19:25:21 +00:00
Operands(nd->nd_left, nd->nd_right);
C_cal("_LtoUset"); /* library routine to fill set */
1986-06-06 02:22:09 +00:00
C_asp(4 * word_size);
1986-05-23 19:25:21 +00:00
}
else {
1986-05-30 18:48:00 +00:00
CodePExpr(nd);
1986-05-23 19:25:21 +00:00
C_set(tp->tp_size);
1986-06-06 02:22:09 +00:00
C_ior(tp->tp_size);
1986-05-23 19:25:21 +00:00
}
}
1986-05-30 18:48:00 +00:00
CodePExpr(nd)
struct node *nd;
{
/* Generate code to push the value of the expression "nd"
on the stack.
*/
struct desig designator;
designator = InitDesig;
CodeExpr(nd, &designator, NO_LABEL, NO_LABEL);
CodeValue(&designator, nd->nd_type->tp_size);
}
CodeDAddress(nd)
struct node *nd;
{
/* Generate code to push the address of the designator "nd"
on the stack.
*/
struct desig designator;
designator = InitDesig;
CodeDesig(nd, &designator);
CodeAddress(&designator);
}
CodeDStore(nd)
register struct node *nd;
{
/* Generate code to store the expression on the stack into the
designator "nd".
*/
struct desig designator;
designator = InitDesig;
CodeDesig(nd, &designator);
CodeStore(&designator, nd->nd_type->tp_size);
}
1986-06-04 09:01:48 +00:00
DoHIGH(nd)
struct node *nd;
{
1986-06-20 14:36:49 +00:00
register struct def *df = nd->nd_def;
register arith highoff;
1986-06-04 09:01:48 +00:00
assert(nd->nd_class == Def);
assert(df->df_kind == D_VARIABLE);
highoff = df->var_off + pointer_size + word_size;
if (df->df_scope->sc_level < proclevel) {
1986-06-10 13:18:52 +00:00
C_lxa((arith) (proclevel - df->df_scope->sc_level));
1986-06-04 09:01:48 +00:00
C_lof(highoff);
}
else C_lol(highoff);
}