CodeBlock YpPostfix(CBorLit lhs, int assop)
{
CodeBlock rhs;
int isLiteral= IS_LITERAL(lhs);
if (isLiteral) { /* e.g.- ++x */
Literal name= CBL_VALUE(lhs);
lhs= YpVariable(name);
} else { /* e.g.- ++x(i) */
lhs= CBL_VALUE(lhs);
}
if (CheckCodeSpace(1)) return lhs;
rhs= nextPC;
vmCode[nextPC++].Action= &Push1;
WillPushStack();
if (isLiteral) {
if (CheckCodeSpace(1)) return lhs;
vmCode[nextPC++].Action= previousOp= &DupUnder;
WillPushStack();
rhs= YpIncrement(lhs, assop, rhs);
if (CheckCodeSpace(1)) return rhs;
vmCode[nextPC++].Action= previousOp= &DropTop;
WillPopStack(1L);
} else {
if (CheckCodeSpace(4)) return lhs;
vmCode[nextPC++].Action= previousOp= &EvalUnder;
WillPushStack();
WillPushStack(); /* EvalUnder pushes 2 new stack elements */
vmCode[nextPC++].Action= assop? &Subtract : &Add;
vmCode[nextPC++].Action= previousOp= ≔
vmCode[nextPC++].Action= previousOp= &DropTop;
WillPopStack(3L);
rhs= lhs;
}
return rhs;
}
CodeBlock YpAssign(CBorLit lhs, CodeBlock rhs)
{
long initialPC;
if (IS_LITERAL(lhs)) {
/* this is definition of a variable */
long name= CBL_VALUE(lhs);
int undecided= !(literalTypes[name]&L_REFERENCE);
initialPC= rhs;
if (CheckCodeSpace(2)) return initialPC;
vmCode[nextPC++].Action= previousOp= &Define;
VariableReference(name);
if (undecided) {
literalTypes[name]|= L_LOCAL;
nLocal++;
}
} else {
/* this is assignment to an lvalue */
initialPC= CBL_VALUE(lhs);
if (CheckCodeSpace(1)) return initialPC;
vmCode[nextPC++].Action= previousOp= ≔
WillPopStack(1L);
}
return initialPC;
}
void testSymbol()
{
#if 0 // Operator
int i = 0;
for(; i < KeywordsCount; ++i)
{
printf("%s\n", Operators[i]);
}
#endif
// test: isKeyword isLiteral isVar isSemicolon symbol_construct symbol_deconstruct
#if 0 // not ok
char *symbol[] = {"int", "i", "=", "12", ";"};
for(int i = 0; i < sizeof(symbol) / sizeof(symbol[0]); ++i)
{
// ok
printf("symbol %s : isKeyword:%s isLiteral:%s isVar:%s isSemicolon:%s\n",
symbol[i], TO_BOOL_STR(isKeyword(symbol[i])), TO_BOOL_STR(isLiteral(symbol[i])),
TO_BOOL_STR(isVar(symbol[i])), TO_BOOL_STR(isSemicolon(symbol[i])));
Symbol *sb = symbol_construct(symbol[i]);
if(sb)
{
// not ok
printf("%x %x %x %x \n", IS_KEYWORD(sb->type),
IS_LITERAL(sb->type),
IS_VAR(sb->type),
IS_SEMICOLON(sb->type));
symbol_deconstruct(sb);
}
}
#endif
// test: isCharLiteral isStringLiteral isDecNumber isOctNumber isHexNumber isFloatNumer
// tes: isDoubleNumber
#if 0 // ok
int i = 0;
const char *strArr[] = {"\'c\'", "\"abc\"", "453", "0453", "781", "a90", "0x34", "0X56",
"9.34", "9.4e2", "9.5E5", "9e+2", "9e-3", "9.34f", "9.34F"
};
for(; i < sizeof(strArr) / sizeof(strArr[0]); ++i)
{
printf("%s: isCharLiteral(%s)\n\t", strArr[i], TO_BOOL_STR(isCharLiteral(strArr[i])));
printf("isStringLiteral(%s)\n\t", TO_BOOL_STR(isStringLiteral(strArr[i])));
printf("isDecNumber(%s)\n\t", TO_BOOL_STR(isDecNumber(strArr[i])));
printf("isOctNumber(%s)\n\t", TO_BOOL_STR(isOctNumber(strArr[i])));
printf("isHexNumber(%s)\n\t", TO_BOOL_STR(isHexNumber(strArr[i])));
printf("isFloatNumber(%s)\n\t", TO_BOOL_STR(isFloatNumber(strArr[i])));
printf("isDoubleNumber(%s)\n", TO_BOOL_STR(isDoubleNumber(strArr[i])));
}
/* // I don't know why, but it can't output all strings
for(; i < sizeof(strArr) / sizeof(strArr[0]); ++i)
{
printf("%s: isCharLiteral(%s)\n\t isStringLiteral(%s)\n\t isDecNumber(%s)\n\t isOctNumber(%s)\n\t isHexNumber(%s)\n\t isFloatNumber(%s)\n\t isDoubleNumber(%s)\n",
strArr[i], TO_BOOL_STR(isCharLiteral(strArr[i])), TO_BOOL_STR(isStringLiteral(strArr[i])), TO_BOOL_STR(isDecNumber(strArr[i])), TO_BOOL_STR(isOctNumber(strArr[i])), TO_BOOL_STR(isHexNumber(strArr[i])), TO_BOOL_STR(isFloatNumber(strArr[i])), TO_BOOL_STR(isDoubleNumber(strArr[i])));
}
*/
#endif
}
static bool
_hasNativeMulFor (iCode *ic, sym_link *left, sym_link *right)
{
sym_link *test = NULL;
value *val;
if ( ic->op != '*')
{
return FALSE;
}
if ( IS_LITERAL (left))
{
test = left;
val = OP_VALUE (IC_LEFT (ic));
}
else if ( IS_LITERAL (right))
{
test = right;
val = OP_VALUE (IC_RIGHT (ic));
}
/* 8x8 unsigned multiplication code is shorter than
call overhead for the multiplication routine. */
else if ( IS_CHAR (right) && IS_UNSIGNED (right) &&
IS_CHAR (left) && IS_UNSIGNED(left) && !IS_GB)
{
return TRUE;
}
else
{
return FALSE;
}
if ( getSize (test) <= 2)
{
return TRUE;
}
return FALSE;
}
CodeBlock YpUnop(int which, CodeBlock op)
{
/* which is 0-7:
* & + - ~ ! ++ -- */
if (which==2) return op; /* unary + is no-op */
if (which<6) {
if (which==3 && previousOp==&Eval2) {
/* unary - must be deferred to after matrix multiply */
matrixMarkers[nMatrixMarkers-1].evalled= 2;
return op; /* no-op for now, reinsert in YpMultop */
}
if (IsPushConst(previousOp)) {
long i= vmCode[nextPC-1].index;
if (which<2) YpError("unary * or & cannot be applied to a constant");
else if (constantTable[i].ops==&longScalar) {
SymbolValue value;
if (which==3) value.l= -constantTable[i].value.l;
else if (which==4) value.l= ~constantTable[i].value.l;
else value.l= !constantTable[i].value.l;
vmCode[nextPC-1].index= ReplaceConstant(i, value);
} else if (constantTable[i].ops==&doubleScalar) {
if (which==3) {
SymbolValue value;
value.d= -constantTable[i].value.d;
vmCode[nextPC-1].index= ReplaceConstant(i, value);
} else {
YpError("unary ~ or ! not allowed on float or double constant");
}
} else {
YpError("unary -, ~, or ! not allowed on string constant");
}
} else {
if (CheckCodeSpace(1)) return op;
vmCode[nextPC++].Action= previousOp= Unaries[which];
}
return op;
} else {
CodeBlock rhs;
if (IS_LITERAL(op)) { /* e.g.- ++x */
Literal name= CBL_VALUE(op);
op= YpVariable(name);
} else { /* e.g.- ++x(i) */
op= CBL_VALUE(op);
}
if (CheckCodeSpace(1)) return op;
rhs= nextPC;
vmCode[nextPC++].Action= previousOp= &Push1;
WillPushStack();
return YpIncrement(op, which-6, rhs);
}
}
static bool
_hasNativeMulFor (iCode * ic, sym_link * left, sym_link * right)
{
sym_link *test = NULL;
int result_size = IS_SYMOP(IC_RESULT(ic)) ? getSize(OP_SYM_TYPE(IC_RESULT(ic))) : 4;
if (ic->op != '*')
{
return FALSE;
}
if (IS_LITERAL (left))
test = left;
else if (IS_LITERAL (right))
test = right;
/* 8x8 unsigned multiplication code is shorter than
call overhead for the multiplication routine. */
else if (IS_CHAR (right) && IS_UNSIGNED (right) && IS_CHAR (left) && IS_UNSIGNED (left) && !IS_GB)
{
return TRUE;
}
/* Same for any multiplication with 8 bit result. */
else if (result_size == 1 && !IS_GB)
{
return TRUE;
}
else
{
return FALSE;
}
if (getSize (test) <= 2)
{
return TRUE;
}
return FALSE;
}
static int
_process_expression(struct AstNode *rnode, Visitor *visitor)
{
if (!IS_LITERAL(rnode->kind)) {
if (rnode->kind != IDENTIFIER) {
ast_node_accept(rnode, visitor);
return stack_size;
} else if (rnode->symbol->is_global) {
_print_load(rnode, visitor);
return stack_size;
} else
return rnode->symbol->stack_index;
}
return -1;
}
/*-----------------------------------------------------------------*/
int
allocVariables (symbol * symChain)
{
symbol *sym;
symbol *csym;
int stack = 0;
int saveLevel = 0;
/* go thru the symbol chain */
for (sym = symChain; sym; sym = sym->next)
{
/* if this is a typedef then add it */
/* to the typedef table */
if (IS_TYPEDEF (sym->etype))
{
/* check if the typedef already exists */
csym = findSym (TypedefTab, NULL, sym->name);
if (csym && csym->level == sym->level)
werror (E_DUPLICATE_TYPEDEF, sym->name);
SPEC_EXTR (sym->etype) = 0;
addSym (TypedefTab, sym, sym->name, sym->level, sym->block, 0);
continue; /* go to the next one */
}
/* make sure it already exists */
csym = findSymWithLevel (SymbolTab, sym);
if (!csym || (csym && csym->level != sym->level))
csym = sym;
/* check the declaration */
checkDecl (csym, 0);
/* if this is a function or a pointer to a */
/* function then do args processing */
if (funcInChain (csym->type))
{
processFuncArgs (csym);
}
/* if this is an extern variable then change */
/* the level to zero temporarily */
if (IS_EXTERN (csym->etype) || IS_FUNC (csym->type))
{
saveLevel = csym->level;
csym->level = 0;
}
/* if this is a literal then it is an enumerated */
/* type so need not allocate it space for it */
if (IS_LITERAL (sym->etype))
continue;
/* generate the actual declaration */
if (csym->level)
{
allocLocal (csym);
if (csym->onStack)
stack += getSize (csym->type);
}
else
allocGlobal (csym);
/* restore the level */
if (IS_EXTERN (csym->etype) || IS_FUNC (csym->type))
csym->level = saveLevel;
}
return stack;
}
/*-----------------------------------------------------------------*/
void
allocGlobal (symbol * sym)
{
/* symbol name is internal name */
if (!sym->level) /* local statics can come here */
SNPRINTF (sym->rname, sizeof(sym->rname),
"%s%s", port->fun_prefix, sym->name);
/* add it to the operandKey reset */
if (!isinSet (operKeyReset, sym))
{
addSet(&operKeyReset, sym);
}
/* if this is a literal e.g. enumerated type */
/* put it in the data segment & do nothing */
if (IS_LITERAL (sym->etype))
{
SPEC_OCLS (sym->etype) = data;
return;
}
/* if this is a function then assign code space */
if (IS_FUNC (sym->type))
{
SPEC_OCLS (sym->etype) = code;
/* if this is an interrupt service routine
then put it in the interrupt service array */
if (FUNC_ISISR (sym->type) && !options.noiv &&
(FUNC_INTNO (sym->type) != INTNO_UNSPEC))
{
if (interrupts[FUNC_INTNO (sym->type)])
werror (E_INT_DEFINED,
FUNC_INTNO (sym->type),
interrupts[FUNC_INTNO (sym->type)]->name);
else
interrupts[FUNC_INTNO (sym->type)] = sym;
/* automagically extend the maximum interrupts */
if (FUNC_INTNO (sym->type) >= maxInterrupts)
maxInterrupts = FUNC_INTNO (sym->type) + 1;
}
/* if it is not compiler defined */
if (!sym->cdef)
allocIntoSeg (sym);
return;
}
/* if this is a bit variable and no storage class */
if (bit && IS_SPEC(sym->type) && SPEC_NOUN (sym->type) == V_BIT)
{
SPEC_OCLS (sym->type) = bit;
allocIntoSeg (sym);
return;
}
if (sym->level)
/* register storage class ignored changed to FIXED */
if (SPEC_SCLS (sym->etype) == S_REGISTER)
SPEC_SCLS (sym->etype) = S_FIXED;
/* if it is fixed, then allocate depending on the */
/* current memory model, same for automatics */
if (SPEC_SCLS (sym->etype) == S_FIXED ||
SPEC_SCLS (sym->etype) == S_AUTO)
{
if (port->mem.default_globl_map != xdata)
{
if (sym->ival && SPEC_ABSA (sym->etype))
{
/* absolute initialized global */
SPEC_OCLS (sym->etype) = x_abs;
}
else if (sym->ival && sym->level == 0 && port->mem.initialized_name)
{
SPEC_OCLS (sym->etype) = initialized;
}
else
{
/* set the output class */
SPEC_OCLS (sym->etype) = port->mem.default_globl_map;
}
/* generate the symbol */
allocIntoSeg (sym);
return;
}
else
{
SPEC_SCLS (sym->etype) = S_XDATA;
}
}
allocDefault (sym);
return;
}
void
llvm_codegen_visit_binary_expr (struct _Visitor *visitor, struct AstNode *node)
{
int lindex = -1;
int rindex = -1;
struct AstNode *lnode = node->children;
struct AstNode *op = lnode->sibling;
struct AstNode *rnode = op->sibling;
int __process_binexpr_node(struct AstNode *node) {
if (node->kind == IDENTIFIER) {
if (node->symbol->is_global) {
if (symbol_is_procfunc(node->symbol))
return node->symbol->stack_index;
_print_load(node, visitor);
return stack_size;
}
} else if (!IS_LITERAL(node->kind)) {
ast_node_accept(node, visitor);
return stack_size;
}
return -1;
}
void __print_operand(struct AstNode *node, int index) {
if (index > -1)
printf("%%%d", index);
else if (node->symbol != NULL && symbol_is_procfunc(node->symbol))
printf("0");
else
ast_node_accept(node, visitor);
}
/* Construcao mais simples */
if (IS_LITERAL(lnode->kind) && IS_LITERAL(rnode->kind)) {
ast_node_accept(op, visitor);
printf(" ");
PRINT_TYPE(lnode->type);
printf(" ");
ast_node_accept(lnode, visitor);
printf(", ");
ast_node_accept(rnode, visitor);
printf("\n");
/* Construcoes complexas */
} else {
lindex = __process_binexpr_node(lnode);
rindex = __process_binexpr_node(rnode);
ast_node_accept(op, visitor);
printf(" ");
PRINT_TYPE(lnode->type);
printf(" ");
__print_operand(lnode, lindex);
printf(", ");
__print_operand(rnode, rindex);
printf("\n");
}
stack_size++;
}
void internal_generic_output(FILE* fp, CELL cell, int strict, int tab)
{
switch(GET_TYPE(cell)) {
case T_VOID:
fputs("#<void>", fp);
break;
case T_NULL:
fputs("()", fp);
break;
case T_UNDEFINED:
fputs("#<undefined>", fp);
break;
case T_EMPTY:
fputs("#<empty>", fp);
break;
case T_BOOL:
fputs(GET_BOOL(cell) ? "#t" : "#f", fp);
break;
case T_CHAR:
{
CHAR ch = GET_CHAR(cell);
if (strict) {
switch(ch) {
case ' ': fputs("#\\space", fp); break;
case 0: fputs("#\\nul", fp); break;
case 27: fputs("#\\escape", fp); break;
case 127: fputs("#\\rubout", fp); break;
case '\a': fputs("#\\alarm", fp); break;
case '\b': fputs("#\\backspace", fp); break;
case '\f': fputs("#\\page", fp); break;
case '\n': fputs("#\\newline", fp); break;
case '\r': fputs("#\\return", fp); break;
case '\t': fputs("#\\tab", fp); break;
case '\v': fputs("#\\vtab", fp); break;
default: fprintf(fp, "#\\%c", ch); break;
}
}
else {
fputc(ch, fp);
}
}
break;
case T_INT:
fprintf(fp, "%d", GET_INT(cell));
break;
case T_BIGINT:
fprintf(fp, "%lld", GET_BIGINT(cell));
break;
case T_FLOAT:
fprintf(fp, "%f", GET_FLOAT(cell));
break;
case T_STRING:
{
STRING* p = GET_STRING(cell);
size_t len = p->len;
char* data = p->data;
if (strict) {
// FIXME -- make this more efficient, and escape other special chars?
fputc('"', fp);
while(len--) {
char ch = *data++;
if (ch == '"' || ch == '\\') {
fputc('\\', fp);
}
fputc(ch, fp);
}
fputc('"', fp);
}
else {
fwrite(data, 1, len, fp);
}
}
break;
case T_NAME:
{
NAME* p = GET_NAME(cell);
if (p->gensym) {
fprintf(fp, "#_%d", p->gensym);
}
else {
fwrite(GET_NAME(cell)->data, 1, GET_NAME(cell)->len, fp);
}
}
break;
case T_KEYWORD:
{
KEYWORD* p = GET_KEYWORD(cell);
fwrite(p->data, 1, p->len, fp);
fputc(':', fp);
}
break;
case T_SLOT:
fprintf(fp, "#<slot:%d>", GET_SLOT(cell));
break;
// FIXME - arbitrary recursion
case T_CONS:
fputc('(', fp);
if (tab) ++tab;
int did = 0;
while(1) {
int pair = CONSP(CAR(cell));
if (!did && tab && pair && !CONSP(CAR(CAR(cell)))) { fprintf(fp, "\n%*s", (tab-1)*2, ""); }
internal_generic_output(fp, CAR(cell), strict, tab);
cell = CDR(cell);
if (NULLP(cell)) {
break;
}
did = (tab && pair);
if (did) { fprintf(fp, "\n%*s", (tab-1)*2, ""); }
else fputc(' ', fp);
if (!CONSP(cell)) {
fputs(". ", fp);
internal_generic_output(fp, cell, strict, tab);
break;
}
}
fputc(')', fp);
break;
// FIXME - arbitrary recursion
case T_VECTOR:
{
VECTOR *vec = GET_VECTOR(cell);
fputs("#(", fp);
if (vec->len > 0) {
int i = 0;
internal_generic_output(fp, vec->data[i++], strict, tab);
while(i < vec->len) {
fputc(' ', fp);
internal_generic_output(fp, vec->data[i++], strict, tab);
}
}
fputc(')', fp);
break;
}
case T_FUNC:
fprintf(fp, "#<primitive:%s>", GET_FUNC(cell)->name);
break;
case T_COMPILED_LAMBDA:
fprintf(fp, "#<compiled-lambda:0x%08x>", AS_LITERAL(cell));
break;
{
if (tab) ++tab;
COMPILED_LAMBDA *l = GET_COMPILED_LAMBDA(cell);
fprintf(fp, "#<%s %d%s:%d/%d",
l->is_macro ? "macro" : "lambda",
l->argc, l->rest ? "+" : "",
l->depth,
l->max_slot);
if (tab) { fprintf(fp, "\n%*s", (tab-1)*2, ""); }
else { fputc(' ', fp); }
internal_generic_output(fp, l->body, strict, tab);
fputc('>', fp);
}
break;
case T_CLOSURE:
fprintf(fp, "#<closure:0x%08x>", AS_LITERAL(cell));
break;
{
if (tab) ++tab;
CLOSURE *c = GET_CLOSURE(cell);
fprintf(fp, "#<closure ");
if (tab) { fprintf(fp, "\n%*s", (tab-1)*2, ""); }
internal_print_env(fp, c->env);
if (tab) { fprintf(fp, "\n%*s", (tab-1)*2, ""); }
fputc(' ', fp);
internal_generic_output(fp, c->compiled_lambda, strict, tab);
fputc('>', fp);
}
break;
case T_EXCEPTION:
fputs("#<exception:", fp);
fwrite(GET_EXCEPTION(cell)->data, 1, GET_EXCEPTION(cell)->len, fp);
fputc('>', fp);
break;
case T_REIFIED_CONTINUATION:
fprintf(fp, "#<continuation:0x%08x>", (int)GET_REIFIED_CONTINUATION(cell)->cont);
break;
case T_STACK_FRAME:
{
STACK_FRAME* p = GET_STACK_FRAME(cell);
fputs("#<stack-frame [", fp);
int i;
for(i = 0; i < p->len; ++i) {
if (i) fputc(' ', fp);
fprintf(fp, "0x%08x", (int)p->cells[i]);
}
fputs("]>", fp);
}
break;
case T_ENV:
fprintf(fp, "#<env:count=%d>", GET_ENV(cell)->count);
break;
case T_RELOC:
fprintf(fp, "#<reloc:0x%08x>", (int)GET_RELOC(cell));
break;
case T_PORT:
fprintf(fp, "#<port:%s>", GET_PORT(cell)->data);
break;
case T_DB_CONNECTION:
fprintf(fp, "#<db-connection>");
break;
case T_DB_RESULT:
fprintf(fp, "#<db-result>");
break;
case T_RECORD:
fprintf(fp, "#<record>");
break;
default:
fprintf(fp, "#<%s-%02x:%08x>",
IS_LITERAL(cell) ? "literal" : "pointer",
GET_TYPE(cell),
AS_LITERAL(cell)
);
break;
}
}
