static void compile_atom(labellist *ll, nfa *nf, node *n, int *pa, int *pb) { int i; REQ(n, ATOM); i = n->n_nchildren; (void)i; /* Don't warn about set but unused */ REQN(i, 1); n = n->n_child; if (n->n_type == LPAR) { REQN(i, 3); n++; REQ(n, RHS); compile_rhs(ll, nf, n, pa, pb); n++; REQ(n, RPAR); } else if (n->n_type == NAME || n->n_type == STRING) { *pa = addnfastate(nf); *pb = addnfastate(nf); addnfaarc(nf, *pa, *pb, addlabel(ll, n->n_type, n->n_str)); } else REQ(n, NAME); }
// compilation d'une variable // [name] -> 0 int Compiler::parsevar() { int k; int hasvalue = 0; if (!parser->next(0)) { PRINTF(m)(LOG_COMPILER,"Compiler : ';;' expected (found EOF)\n"); return MTLERR_SN; } if (!strcmp(parser->token,"=")) { if (k=parseval()) return k; hasvalue = 1; } else { parser->giveback(); if (k=STACKPUSH(m,NIL)) return k; if (k=createnodetype(TYPENAME_WEAK)) return k; } // [val type name] if (k=parser->parsekeyword(";;")) return k; int val=INTTOVAL(nblabels(globals)); if (k=addlabel(globals,STRSTART(VALTOPNT(STACKGET(m,2))),val,STACKGET(m,1))) return k; // enregistrement d'une nouvelle globale // on crée le bloc fonction newref=MALLOCCLEAR(m,REF_LENGTH); if (!newref) return MTLERR_OM; TABSET(m,newref,REF_TYPE,STACKPULL(m)); TABSET(m,newref,REF_VAL,STACKPULL(m)); TABSET(m,newref,REF_NAME,STACKPULL(m)); TABSET(m,newref,REF_CODE,INTTOVAL(CODE_VAR)); // la variable vient d'être créé, elle n'est donc ni utilisée ni modifiée encore TABSET(m,newref,REF_USED,INTTOVAL(0)); TABSET(m,newref,REF_SET,INTTOVAL(hasvalue)); TABSET(m,newref,REF_USED_IN_IFDEF,INTTOVAL(0)); TABSET(m,newref,REF_PACKAGE,val); if (k=STACKPUSH(m,PNTTOVAL(newref))) return MTLERR_OM; // [newref] addreftopackage(newref,newpackage); STACKDROP(m); outputbuf->reinit(); outputbuf->printf("Compiler : var %s : ",STRSTART(VALTOPNT(TABGET(newref,REF_NAME)))); echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE))); PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart()); return 0; }
static nfa * addnfa(nfagrammar *gr, char *name) { nfa *nf; nf = newnfa(name); gr->gr_nfa = (nfa **)PyObject_REALLOC(gr->gr_nfa, sizeof(nfa*) * (gr->gr_nnfas + 1)); if (gr->gr_nfa == NULL) Py_FatalError("out of mem"); gr->gr_nfa[gr->gr_nnfas++] = nf; addlabel(&gr->gr_ll, NAME, nf->nf_name); return nf; }
static nfagrammar * newnfagrammar(void) { nfagrammar *gr; gr = (nfagrammar *)PyObject_MALLOC(sizeof(nfagrammar)); if (gr == NULL) Py_FatalError("no mem for new nfa grammar"); gr->gr_nnfas = 0; gr->gr_nfa = NULL; gr->gr_ll.ll_nlabels = 0; gr->gr_ll.ll_label = NULL; addlabel(&gr->gr_ll, ENDMARKER, "EMPTY"); return gr; }
static void dotext(double x, double y, obj *p) /* print text strings of p in proper vertical spacing */ { double h, v, w, dely, *bnd; int i, j, m, n, t; int nt2 = p->o_nt2; bnd = text_bounds(p); v = bnd[3]; /* includes ABOVE/BELOW attributes */ j = text[p->o_nt1].t_line; new_color(p->o_text); for (h = w = 0, i = p->o_nt1; i < nt2; h = w = 0) { /* calculate position of baseline for this line--assumed to be down 3/4 of maximum character height from top of line */ for (m = 0, n = i; n < nt2 && text[n].t_line == j; n++) { w += text[n].t_width*72/pgscale; if (abs(text[n].t_size) > m) m = abs(text[n].t_size); } dely = (double) m / pgscale; /* max size, in inches */ t = text[i].t_type; #if 0 /* Note the adjustments for ABOVE and BELOW are permanent--affect all subsequent strings in this object */ if (t & ABOVE) v += dely / 2; else if (t & BELOW) v -= dely / 2; #endif dely *= .75; if (t & RJUST) h = w; else if (t & CENTER) h = w/2; newlabel(t, text[i].t_val, abs(text[i].t_font), x-h, y + v - dely, text[i].t_size / pgscale, text[i].t_width * 72 / pgscale); v -= (double) abs(text[i].t_space) / pgscale; while (++i < n) addlabel(text[i].t_type, text[i].t_val, text[i].t_font, text[i].t_size / pgscale, text[i].t_width * 72 / pgscale); j = text[i].t_line; /* line numbers not necessarily consecutive! */ } }
// compilation d'une constante (const var = val;;) // [name] -> 0 int Compiler::parseconst() { int k; if (k=parser->parsekeyword("=")) return k; if (k=parseval()) return k; if (k=parser->parsekeyword(";;")) return k; int val=INTTOVAL(nblabels(globals)); if (k=addlabel(globals,STRSTART(VALTOPNT(STACKGET(m,2))),val,STACKGET(m,1))) return k; // enregistrement d'une nouvelle globale // on crée le bloc fonction newref=MALLOCCLEAR(m,REF_LENGTH); if (!newref) return MTLERR_OM; TABSET(m,newref,REF_TYPE,STACKPULL(m)); TABSET(m,newref,REF_VAL,STACKPULL(m)); TABSET(m,newref,REF_NAME,STACKPULL(m)); TABSET(m,newref,REF_CODE,INTTOVAL(CODE_CONST)); // la constante vient d'être créée, elle n'est donc pas utilisée, mais elle a une valeur TABSET(m,newref,REF_USED,INTTOVAL(0)); TABSET(m,newref,REF_SET,INTTOVAL(1)); TABSET(m,newref,REF_USED_IN_IFDEF,INTTOVAL(0)); TABSET(m,newref,REF_PACKAGE,val); if (k=STACKPUSH(m,PNTTOVAL(newref))) return MTLERR_OM; // [newref] addreftopackage(newref,newpackage); STACKDROP(m); outputbuf->reinit(); outputbuf->printf("Compiler : const %s : ",STRSTART(VALTOPNT(TABGET(newref,REF_NAME)))); echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE))); PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart()); return 0; }
// compilation d'un type // [name] -> 0 int Compiler::parsetype() { int k; // PRINTF(m)(LOG_DEVCORE,"type %s\n",STRSTART(VALTOPNT(STACKGET(m,0)))); char* name=STRSTART(VALTOPNT(STACKGET(m,0))); // création des variables de travail if (k=STACKPUSH(m,NIL)) return k; // LOCALS locals=STACKREF(m); newref=searchemptytype(PNTTOVAL(newpackage),name); int mergetype=1; if (newref) { if (k=createnodetypecore(TABGET(VALTOPNT(TABGET(newref,REF_TYPE)),TYPEHEADER_LENGTH+1))) return k; } else { mergetype=0; if (k=createnodetypecore(STACKGET(m,1))) return k; newref=MALLOCCLEAR(m,REF_LENGTH); if (!newref) return MTLERR_OM; TABSET(m,newref,REF_CODE,INTTOVAL(CODE_EMPTYTYPE)); TABSET(m,newref,REF_TYPE,STACKGET(m,0)); if (k=STACKPUSH(m,PNTTOVAL(newref))) return MTLERR_OM; // [newtyp local name] addreftopackage(newref,newpackage); STACKDROP(m); } int narg=0; if (parser->next(0)) { if (strcmp(parser->token,"(")) parser->giveback(); else { do { if (!parser->next(0)) { PRINTF(m)(LOG_COMPILER,"Compiler : parameter or ')' expected (found EOF)\n"); return MTLERR_SN; } if (islabel(parser->token)) { if (k=createnodetype(TYPENAME_UNDEF)) return k; if (k=addlabel(locals,parser->token,STACKGET(m,0),INTTOVAL(narg++))) return k; } else if (strcmp(parser->token,")")) { PRINTF(m)(LOG_COMPILER,"Compiler : parameter or ')' expected (found '%s')\n",parser->token); return MTLERR_SN; } } while(strcmp(parser->token,")")); if (k=DEFTAB(m,narg)) return k; TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH,STACKGET(m,0)); STACKDROP(m); } } if (!mergetype) STACKDROP(m); else if (k=unif(VALTOPNT(STACKPULL(m)),VALTOPNT(TABGET(newref,REF_TYPE)))) return k; if (!parser->next(0)) { PRINTF(m)(LOG_COMPILER,"Compiler : '=' or ';;' expected (found EOF)\n"); return MTLERR_SN; } if (!strcmp(parser->token,"=")) { if (!parser->next(0)) { PRINTF(m)(LOG_COMPILER,"Compiler : uncomplete type definition (found EOF)\n"); return MTLERR_SN; } if (!strcmp(parser->token,"[")) return parsestruct(); parser->giveback(); return parsesum(); } else if (!strcmp(parser->token,";;")) { STACKDROPN(m,2); outputbuf->reinit(); outputbuf->printf("Compiler : uncompleted type : "); echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE))); PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart()); return 0; } PRINTF(m)(LOG_COMPILER,"Compiler : '=' or ';;' expected (found '%s')\n",parser->token); return MTLERR_SN; }
// compilation d'une fonction // [name] -> 0 int Compiler::parsefun() { int k; int* type_result; // PRINTF(m)(LOG_DEVCORE,"fonction %s\n",STRSTART(VALTOPNT(STACKGET(m,0)))); char* name=STRSTART(VALTOPNT(STACKGET(m,0))); // création des variables de travail if (k=STACKPUSH(m,NIL)) return k; // LOCALS locals=STACKREF(m); if (k=createnodetype(TYPENAME_FUN)) return k; // recherche des arguments int narg=0; do { if (!parser->next(0)) { PRINTF(m)(LOG_COMPILER,"Compiler : argument or '=' expected (found EOF)\n"); return MTLERR_SN; } if (islabel(parser->token)) { if (k=createnodetype(TYPENAME_UNDEF)) return k; if (k=addlabel(locals,parser->token,INTTOVAL(narg++),STACKGET(m,0))) return k; } else if (strcmp(parser->token,"=")) { PRINTF(m)(LOG_COMPILER,"Compiler : argument or '=' expected (found '%s')\n",parser->token); return MTLERR_SN; } } while(strcmp(parser->token,"=")); // construction du type initial de la fonction if (k=createnodetuple(narg)) return k; TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH,STACKGET(m,0)); // attachement du noeud tuple au noeud fun STACKDROP(m); if (k=createnodetype(TYPENAME_UNDEF)) return k; // noeud résultat TABSET(m,VALTOPNT(STACKGET(m,1)),TYPEHEADER_LENGTH+1,STACKGET(m,0)); // attachement du noeud resultat au noeud fun type_result=VALTOPNT(STACKPULL(m)); // on garde en mémoire le type du résultat // ici : [type local global name] // on crée le bloc fonction newref=MALLOCCLEAR(m,REF_LENGTH); if (!newref) return MTLERR_OM; TABSET(m,newref,REF_TYPE,STACKPULL(m)); TABSET(m,newref,REF_NAME,STACKGET(m,1)); TABSET(m,newref,REF_CODE,INTTOVAL(narg)); // vient d'être déclarée, pas encore utilisée TABSET(m,newref,REF_USED,INTTOVAL(0)); k=findproto(PNTTOVAL(newpackage),newref); TABSET(m,newref,REF_PACKAGE,(k!=NIL)?k:INTTOVAL(ifuns++)); if (k=STACKPUSH(m,PNTTOVAL(newref))) return MTLERR_OM; // [newref local global name] addreftopackage(newref,newpackage); STACKDROP(m); // [local global name] // on poursuit la compilation vers le corps de la fonction nblocals=narg; bc->reinit(); // initialisation de la production de bytecode // [locals globals] // parsing if (k=parseprogram()) return k; // [type locals globals] // la pile contient le type du résultat de la fonction if (k=parser->parsekeyword(";;")) return k; // unifier le type résultat if (k=unif(type_result,VALTOPNT(STACKGET(m,0)))) return k; STACKDROP(m); // [locals globals name] // créer le bloc programme int* fun=MALLOCCLEAR(m,FUN_LENGTH); if (!fun) return MTLERR_OM; TABSET(m,newref,REF_VAL,PNTTOVAL(fun)); TABSET(m,fun,FUN_NBARGS,INTTOVAL(narg)); TABSET(m,fun,FUN_NBLOCALS,INTTOVAL(nblocals)); // stocker le bytecode bc->addchar(OPret); if (k=STRPUSHBINARY(m,bc->getstart(),bc->getsize())) return k; TABSET(m,fun,FUN_BC,STACKPULL(m)); if (!strcmp(name,"awcConnect")) displaybc(m,STRSTART(VALTOPNT(TABGET(fun,FUN_BC)))); // construire le tuple des références globales // int* globalstuple=tuplefromlabels(globals); // if (!globalstuple) return MTLERR_OM; // TABSET(m,fun,FUN_REF,PNTTOVAL(globalstuple)); TABSET(m,fun,FUN_REFERENCE,PNTTOVAL(newref)); STACKDROPN(m,2); // [] // chercher d'éventuels prototypes if (k=fillproto(PNTTOVAL(newpackage),newref)) return k; outputbuf->reinit(); outputbuf->printf("Compiler : %s : ",STRSTART(VALTOPNT(TABGET(newref,REF_NAME)))); echograph(outputbuf,VALTOPNT(TABGET(newref,REF_TYPE))); PRINTF(m)(LOG_COMPILER,"%s\n",outputbuf->getstart()); return 0; }
// main entry into parser void encode_rpn() { statement *stmt, *tempstmt = gprog->firststmt; struct labelset *label; unsigned int x = 0, y = 0; int channum = 0, lastfnc = 0, lastvar = 0, ifcount = 0; byte display = 0, watchchannel = 0, special = 0; char *cont; symbol *sym; begin: stmt = SafeMalloc(sizeof(statement)); stmtinit(stmt); for (x=0; x<MAX_STMT_METAS; x++) { stmt->metalist[x].operation = 0; stmt->metalist[x].floatarg.mantisa.i = 0; stmt->metalist[x].floatarg.exp = 0; stmt->metalist[x].shortarg = 0; for (y=0; y<MAX_STRING_LENGTH; y++) stmt->metalist[x].stringarg[y] = 0; } special = 0; foundequals = 0; firstvar = 1; numlabels = 0; envinfo.stmttype = 0; tokenpos = 0; token_type = 1; lastopcode = 0; for (x=0; x<32; x++) { numargs[x] = 0; parenstack[x] = 0; } do { get_token(); tokenpos += strlen(token); if(!checkoption(get_cmdindex(get_opname(stmt->opcode)), token, token_type)) lineerror(stmt, __FILE__, __LINE__); // hack to avoid using runtime system // using runtime system would change the last executed line info. // if ((!strcmp(token, "PBSTEP")) && (token_type == TOK_COMMAND)) // dbg_step(); switch (token_type) { case TOK_ERROR: lineerror(stmt, __FILE__, __LINE__); break; case TOK_COMMAND: lastopcode = get_opcode(token); if (cmdtable[get_cmdindex(token)].options & IO_CHANNEL) watchchannel = 1; else watchchannel = 0; stmt->opcode = get_opcode(token); if (stmt->opcode == CMD_LET) goto loop2; else goto loop; case TOK_NUMBER: stmt->opcode = 0; stmt->linenum = atoi(token); break; default: buffermeta(stmt, token_type, token); goto loop2; } buffermeta(stmt, token_type, token); loop: get_token(); if (checkerr == 2) checkerr = 1; else if (checkerr == 1) { if (token[0] == '=') { if (stmt->metalist[stmt->metapos-2].operation == 0xEC) stmt->metapos-=2; else stmt->metapos--; push("ERR", TOK_OPERATOR); } else if (token[0] == '(') { prog--; stmt->metapos--; strcpy(token, "ERR"); token_type = TOK_FUNCTION; } checkerr = 0; } if (lastopcode == CMD_SETERR) { if (!strcmp(token, "ON")) lastopcode = CMD_SETERRON; if (!strcmp(token, "OFF")) lastopcode = CMD_SETERROFF; } if (!strcmp(token, "RECORD")) { if (stmt->opcode == CMD_READ) lastopcode = CMD_READRECORD; if (stmt->opcode == CMD_WRITE) lastopcode = CMD_WRITERECORD; if (stmt->opcode == CMD_EXTRACT) lastopcode = CMD_EXTRACTRECORD; if (stmt->opcode == CMD_FIND) lastopcode = CMD_FINDRECORD; if (stmt->opcode == CMD_PRINT) lastopcode = CMD_PRINTRECORD; token_type = lasttype; goto loop; } if (lastopcode == CMD_REM) { stmt->metalist[1].operation = 0xF5; tokenpos -= 2; if (input[tokenpos] == '\"') x = tokenpos; else x = tokenpos+2; stmt->metalist[1].shortarg = strlen(input) - x; y = 0; for (x=x; x<strlen(input); x++) { stmt->metalist[1].stringarg[y] = input[x]; y++; } stmt->metalist[1].stringarg[y] = '\0'; stmt->metapos++; if (stmt->linenum) insertstmt(gprog, stmt); return; } tokenpos += strlen(token); if(!checkoption(get_cmdindex(get_opname(lastopcode)), token, token_type)) lineerror(stmt, __FILE__, __LINE__); loop2: switch (token_type) { case TOK_SEMICOLON: popstack(stmt, -1); if (!stmt->linenum) { execline(gprog, stmt); stmtinit(stmt); } break; case TOK_COLON: if ((stmt->metalist[stmt->metapos-1].operation == SETVAL_NUMERIC) || (stmt->metalist[stmt->metapos-1].operation == GETVAL_NUMERIC) || (stmt->metalist[stmt->metapos-1].operation == LABELREF)) { label = SafeMalloc(sizeof(struct labelset)); sym = idx2sym(gprog, stmt->metalist[stmt->metapos-1].shortarg); label->labelnum = addlabel(gprog, sym->name, stmt->linenum); for (x=0; x<MAX_STRING_LENGTH; x++) sym->name[x] = '\0'; x = 0; stmt->metapos--; stmt->metalist[stmt->metapos].shortarg = 0; stmt->opcode = 0; stmt->labelset[stmt->numlabels] = label; stmt->numlabels++; firstvar = 1; } else { do { if (stmt->linenum == tempstmt->linenum) { for (x=0; x<strlen(input); x++) if (input[x] == ':') break; y = x; for (x=0; x<=y; x++) input[x] = ' '; cont = SafeMalloc(1024*64); *cont = 0; listline(cont, tempstmt, 1); strcat(cont, input); *prog = 0; prog = cont; display = 1; goto begin; } tempstmt = tempstmt->nextstmt; } while (tempstmt != NULL); numlabels++; } goto loop; case TOK_COMMA: if (parencount > 0) { // comma being delimiter for system functions popstack(stmt, -2); push("(", TOK_OPERATOR); if (chaninfo == 1) { if (!channum) { channum = 1; stmt->metalist[stmt->metapos].operation = 0xE1; stmt->metapos++; } } else { if (special == 1) numargs[parencount-1]+=10; else numargs[parencount-1]++; envinfo.stmttype = 0; } } else { // comma being delimiter for verbs popstack(stmt, -1); buffermeta(stmt, TOK_COMMA, token); for (x=0; x<32; x++) numargs[x] = 0; envinfo.stmttype = 0; foundequals = 0; firstvar = 1; } goto loop; case TOK_ERROR: lineerror(stmt, __FILE__, __LINE__); return; case TOK_COMMAND: lastopcode = get_opcode(token); if (cmdtable[get_cmdindex(token)].options & IO_CHANNEL) watchchannel = 1; else watchchannel = 0; if (!strcmp(token, "IF")) ifcount++; if (!stmt->opcode) { stmt->opcode = get_opcode(token); envinfo.stmttype = 0; goto loop; } else { popstack(stmt, -1); envinfo.stmttype = 0; if (ifcount > 0) { stmt->metalist[stmt->metapos].operation = 0xE7; stmt->metalist[stmt->metapos].shortarg = 0; stmt->metalist[stmt->metapos].intarg = 0; stmt->metapos++; stmt->length++; // watchchannel = 0; chaninfo = 0; channum = 0; ifcount--; } if (lastopcode == CMD_ON) { special = 1; if (!strcmp(token, "GOTO")) stmt->metalist[stmt->metapos].operation = 0x00F4; else stmt->metalist[stmt->metapos].operation = 0x01F4; stmt->length += 2; stmt->metapos++; } else buffermeta(stmt, TOK_COMMAND, token); goto loop; } break; case TOK_RESERVED: popstack(stmt, -1); envinfo.stmttype = 0; lineref = 0; if (!strcmp(token, "ELSE")) { stmt->metalist[stmt->metapos].operation = 0xE7; stmt->metalist[stmt->metapos].intarg = 0; stmt->metalist[stmt->metapos].shortarg = 0; stmt->metapos++; stmt->metalist[stmt->metapos].operation = 0xE2; stmt->metalist[stmt->metapos].intarg = 0; stmt->metalist[stmt->metapos].shortarg = 0; stmt->metapos++; stmt->length+=2; envinfo.stmttype = 0; chaninfo = 0; channum = 0; } goto loop; case TOK_DONE: if ((stmt->linenum) && (!stmt->opcode)) deletestmt(gprog,stmt->linenum); else { popstack(stmt, -1); if (stmt->opcode == CMD_LET && foundequals == 0) lineerror(stmt, __FILE__, __LINE__); if (parencount > 0 || numlabels < 0) lineerror(stmt, __FILE__, __LINE__); if (stmt->linenum) { if (!stmt->errorflag) insertstmt(gprog, stmt); } else if (stmt->opcode) { if (!stmt->errorflag) { execline(gprog, stmt); } } } if (display) { GC_realloc(cont, strlen(cont)); listprog(gprog, stmt->linenum, stmt->linenum); } return; case TOK_USERFUNCTION: if (lastopcode == CMD_DEFFN) addfunction(gprog, token, stmt->linenum, 1); else addfunction(gprog, token, stmt->linenum, 0); if (token[strlen(token)-1] == '$') parenstack[parencount] = 8; else parenstack[parencount] = 7; buffermeta(stmt, TOK_USERFUNCTION, token); break; case TOK_FUNCTION: lastfnc = get_fnc(token); numlabels++; case TOK_OPERATOR: if (token[0] == '[') { special = 1; cont = get_symname(lastvar); if (cont[strlen(cont)-1] == '$') parenstack[parencount] = 2; else parenstack[parencount] = 1; numlabels++; goto openparen; } else if (token[0] == ']') { numargs[parencount-1] += 9; popstack(stmt, -2); envinfo.stmttype = parenstack[parencount]; token_type = TOK_ARRAY; special = 0; goto loop; } else if (token[0] == '-') { // placeholder if ((lasttype == TOK_OPERATOR) || (lasttype == TOK_RESERVED)) token[0] = '_'; evalstack(stmt); goto loop; } else if (token[0] == '(') { openparen: if (lasttype == TOK_COMMAND) { if (watchchannel == 1) chaninfo = 1; } else if (lasttype == TOK_ARRAY) { envinfo.stmttype = 0; numargs[parencount]++; push(token, token_type); goto loop; } else if (lasttype == TOK_SETVAL) { push(get_symname(lastvar), TOK_SETVAL); stmt->metapos--; stmt->metalist[stmt->metapos].shortarg = 0; numlabels++; cont = get_symname(lastvar); if (cont[strlen(cont)-1] == '$') parenstack[parencount] = 2; else parenstack[parencount] = 1; } else if (lasttype == TOK_VARIABLE) { push(get_symname(lastvar), TOK_VARIABLE); numlabels++; stmt->metapos--; stmt->metalist[stmt->metapos].shortarg = 0; cont = get_symname(lastvar); if (cont[strlen(cont)-1] == '$') parenstack[parencount] = 2; else parenstack[parencount] = 1; } else if (lasttype == TOK_USERFUNCTION) { stmt->metapos--; stmt->metalist[stmt->metapos].operation = 0xF5; stmt->metapos++; stmt->length++; } else if (lasttype == TOK_FUNCTION) { if ((envinfo.stmttype != fnctable[lastfnc].returntype) && (envinfo.stmttype != 0)) lineerror(stmt, __FILE__, __LINE__); else parenstack[parencount] = fnctable[lastfnc].returntype; } else parenstack[parencount] = 1; envinfo.stmttype = 0; numargs[parencount] = 1; push(token, token_type); goto loop; } else if (token[0] == ')') { if (parencount == 0) lineerror(stmt, __FILE__, __LINE__); popstack(stmt, -2); if (parenstack[parencount] == 7) { stmt->metalist[stmt->metapos].operation = 0xF8; stmt->metapos++; stmt->length++; envinfo.stmttype = 1; } else if (parenstack[parencount] == 8) { stmt->metalist[stmt->metapos].operation = 0xF8; stmt->metapos++; stmt->length++; envinfo.stmttype = 2; } else envinfo.stmttype = parenstack[parencount]; if (lastopcode == CMD_DEFFN && foundequals == 0) { stmt->metapos--; stmt->metalist[stmt->metapos].operation = 0xF8; stmt->metapos++; } if (chaninfo == 1) { chaninfo = 0; if (!channum) { stmt->metalist[stmt->metapos].operation = 0xE1; stmt->metapos++; } stmt->metalist[stmt->metapos].operation = 0xF4F1; stmt->metapos++; numargs[parencount] = 0; } goto loop; } else { evalstack(stmt); goto loop; } break; case TOK_VARIABLE: if (get_sysvar(token)) { buffermeta(stmt, TOK_SYSVAR, token); numlabels++; goto loop; } else { addsymbol(gprog, token); lastvar = get_symref(token); } case TOK_NUMBER: default: if(!stmt->opcode) { envinfo.stmttype = 0; lastopcode = stmt->opcode = CMD_LET; } if ((firstvar == 1) && (token_type == TOK_VARIABLE) && (lastopcode == CMD_LET || lastopcode == CMD_FOR || lastopcode == CMD_FOR || lastopcode == CMD_NEXT || lastopcode == CMD_DIM || lastopcode == CMD_INPUT)) { buffermeta(stmt, TOK_SETVAL, token); firstvar = 0; token_type = TOK_SETVAL; } else { numlabels++; buffermeta(stmt, token_type, token); } goto loop; } } while (1); }
int main(int argc, char *argv[]) { /* SET UP TABLES ETC */ mktoktbl(); /* END: SET UP TABLES ETC */ /* PARSE ARGUMENTS */ int ninbas=0; char **inbas=NULL; int ninobj=0; char **inobj=NULL; enum {NONE, OBJ, TAPE} outtype=NONE; char *outfile=NULL; bool emu=false; int arg; int state=0; for(arg=1;arg<argc;arg++) { char *varg=argv[arg]; if(strcmp(varg, "-")==0) varg="/dev/stdin"; if(*varg=='-') { if(strcmp(varg, "-V")==0) { printf(VERSION_MSG); return(EXIT_SUCCESS); } else if(strcmp(varg, "--emu")==0) { emu=true; } else if(strcmp(varg, "--no-emu")==0) { emu=false; } else if(strcmp(varg, "--debug")==0) { debug=true; } else if(strcmp(varg, "--no-debug")==0) { debug=false; } else if(strcmp(varg, "-b")==0) state=1; else if(strcmp(varg, "-l")==0) state=7; else if(strcmp(varg, "-t")==0) state=2; else if(strcmp(varg, "-W")==0) state=3; else if(strcmp(varg, "-W-")==0) state=4; else if(strcmp(varg, "-O")==0) state=5; else if(strcmp(varg, "-O-")==0) state=6; else { fprintf(stderr, "bast: No such option %s\n", varg); return(EXIT_FAILURE); } } else { bool flag=false; switch(state) { case 0: case 1: if(addinbas(&ninbas, &inbas, varg)) { fprintf(stderr, "bast: Internal error: Failed to add %s to inbas list\n", varg); return(EXIT_FAILURE); } state=0; break; case 7: if(addinbas(&ninobj, &inobj, varg)) { fprintf(stderr, "bast: Internal error: Failed to add %s to inobj list\n", varg); return(EXIT_FAILURE); } state=0; break; case 2: outtype=TAPE; outfile=strdup(varg); state=0; break; case 3: flag=true; // fallthrough case 4: if(strcmp("all", varg)==0) { Wobjlen=flag; state=0; } else if(strcmp("object-length", varg)==0) { Wobjlen=flag; state=0; } else if(strcmp("object-checksum", varg)==0) { Wobjsum=flag; state=0; } else if(strcmp("se-basic", varg)==0) { Wsebasic=flag; state=0; } else if(strcmp("embedded-newline", varg)==0) { Wembeddednewline=flag; state=0; } break; case 5: flag=true; // fallthrough case 6: if(strcmp("cut-numbers", varg)==0) { Ocutnumbers=flag; state=0; } break; default: fprintf(stderr, "bast: Internal error: Bad state %u in args\n", state); return(EXIT_FAILURE); break; } } } /* END: PARSE ARGUMENTS */ if(!(ninbas||ninobj)) { fprintf(stderr, "bast: No input files specified\n"); return(EXIT_FAILURE); } if((outtype==NONE)||!outfile) { fprintf(stderr, "bast: No output file specified\n"); return(EXIT_FAILURE); } int nsegs=0; segment * data=NULL; /* READ BASIC FILES */ if(ninbas&&!inbas) { fprintf(stderr, "bast: Internal error: ninbas!=0 and inbas is NULL\n"); return(EXIT_FAILURE); } int fbas; for(fbas=0;fbas<ninbas;fbas++) { int fline=0; int dfl=0; FILE *fp=fopen(inbas[fbas], "r"); if(!fp) { fprintf(stderr, "bast: Failed to open input file %s\n", inbas[fbas]); return(EXIT_FAILURE); } segment *curr=addsegment(&nsegs, &data); if(!curr) { fprintf(stderr, "bast: Internal error: failed to add segment for file %s\n", inbas[fbas]); return(EXIT_FAILURE); } curr->name=(char *)malloc(10); sprintf(curr->name, "bas%u", fbas); curr->type=BASIC; curr->data.bas.nlines=0; curr->data.bas.basic=NULL; curr->data.bas.line=0; curr->data.bas.lline=NULL; curr->data.bas.renum=0; curr->data.bas.block=NULL; while(!feof(fp)) { char *line=fgetl(fp); if(line) { fline+=dfl+1; dfl=0; if(*line) { while(line[strlen(line)-1]=='\\') // line splicing { char *second=fgetl(fp); if(!second) continue; dfl++; if(!*second) { free(second); continue; } line[strlen(line)-1]=0; char *splice=(char *)realloc(line, strlen(line)+strlen(second)+2); if(!splice) { free(second); continue; } line=splice; strcat(splice, second); free(second); } if(Wembeddednewline && strchr(line, '\x0D')) // 0x0D is newline in ZX BASIC { fprintf(stderr, "bast: Warning: embedded newline (\\0D) in ZX Basic line\n\t"LOC"\n", LOCARG); } if(addbasline(&curr->data.bas.nlines, &curr->data.bas.basic, line)) { fprintf(stderr, "bast: Internal error: Failed to store line as text\n\t"LOC"\n", LOCARG); return(EXIT_FAILURE); } curr->data.bas.basic[curr->data.bas.nlines-1].sline=fline; if(*line=='#') { char *cmd=strtok(line, " "); if(cmd) { if(strcmp(cmd, "#pragma")==0) { char *prgm=strtok(NULL, " "); if(prgm) { if(strcmp(prgm, "name")==0) { char *basname=strtok(NULL, ""); if(basname) { if(curr->name) free(curr->name); curr->name=strdup(basname); } } else if(strcmp(prgm, "line")==0) { char *pline=strtok(NULL, ""); if(pline) { unsigned int val; if(sscanf(pline, "%u", &val)==1) { curr->data.bas.line=val; } else { curr->data.bas.line=-1; curr->data.bas.lline=strdup(pline); } } else { fprintf(stderr, "bast: Warning: #pragma line missing argument\n\t"LOC"\n", LOCARG); } } else if(strcmp(prgm, "renum")==0) { curr->data.bas.renum=1; curr->data.bas.rnstart=0; curr->data.bas.rnoffset=0; curr->data.bas.rnend=0; char *arg=strtok(NULL, " "); while(arg) { unsigned int val=0; if(*arg) sscanf(arg+1, "%u", &val); switch(*arg) { case '=': curr->data.bas.rnstart=val; break; case '+': curr->data.bas.rnoffset=val; break; case '-': curr->data.bas.rnend=val; break; default: fprintf(stderr, "bast: Warning: #pragma renum bad argument %s\n\t"LOC"\n", arg, LOCARG); break; } arg=strtok(NULL, " "); } } else { fprintf(stderr, "bast: Warning: #pragma %s not recognised (ignoring)\n\t"LOC"\n", prgm, LOCARG); } } else { fprintf(stderr, "bast: #pragma without identifier\n\t"LOC"\n", LOCARG); return(EXIT_FAILURE); } } else if(strcmp(cmd, "##")==0) { // comment, ignore } else { fprintf(stderr, "bast: Unrecognised directive %s\n\t"LOC"\n", cmd, LOCARG); return(EXIT_FAILURE); } } } } free(line); } } fprintf(stderr, "bast: BASIC segment '%s', read %u physical lines\n", curr->name, curr->data.bas.nlines); } /* END: READ BASIC FILES */ /* READ OBJECT FILES */ int fobj; for(fobj=0;fobj<ninobj;fobj++) { FILE *fp=fopen(inobj[fobj], "r"); if(!fp) { fprintf(stderr, "bast: Failed to open input file %s\n", inobj[fobj]); return(EXIT_FAILURE); } segment *curr=addsegment(&nsegs, &data); if(!curr) { fprintf(stderr, "bast: Internal error: failed to add segment for file %s\n", inobj[fobj]); return(EXIT_FAILURE); } curr->name=(char *)malloc(10); sprintf(curr->name, "bin%u", fobj); curr->type=BINARY; err=false; bin_load(inobj[fobj], fp, &curr->data.bin, &curr->name); if(err) { fprintf(stderr, "bast: Failed to load BINARY segment from file %s\n", inobj[fobj]); return(EXIT_FAILURE); } } /* END: READ OBJECT FILES */ /* TODO: fork the assembler for each #[r]asm/#endasm block */ /* TOKENISE BASIC SEGMENTS */ if(ninbas) { int i; for(i=0;i<nsegs;i++) { if(data[i].type==BASIC) { data[i].data.bas.blines=0; fprintf(stderr, "bast: Tokenising BASIC segment %s\n", data[i].name); int j; for(j=0;j<data[i].data.bas.nlines;j++) { err=false; if(debug) fprintf(stderr, "bast: tokenising line %s\n", data[i].data.bas.basic[j].text); tokenise(&data[i].data.bas.basic[j], inbas, i, data[i].data.bas.renum); if(data[i].data.bas.basic[j].ntok) data[i].data.bas.blines++; if(err) return(EXIT_FAILURE); } fprintf(stderr, "bast: Tokenised BASIC segment %s (%u logical lines)\n", data[i].name, data[i].data.bas.blines); } } } /* END: TOKENISE BASIC SEGMENTS */ /* LINKER & LABELS */ // PASS 1: Find labels, renumber labelled BASIC sources, load in !links as attached bin_segs int nlabels=0; label * labels=NULL; int i; for(i=0;i<nsegs;i++) { fprintf(stderr, "bast: Linker (Pass 1): %s\n", data[i].name); switch(data[i].type) { case BASIC:; int num=0,dnum=0; if(data[i].data.bas.renum==1) { dnum=data[i].data.bas.rnoffset?data[i].data.bas.rnoffset:10; int end=data[i].data.bas.rnend?data[i].data.bas.rnend:9999; while(data[i].data.bas.blines*dnum>end) { dnum--; if((dnum==7)||(dnum==9)) dnum--; } if(!dnum) { fprintf(stderr, "bast: Renumber: Couldn't fit %s into available lines\n", data[i].name); return(EXIT_FAILURE); } num=data[i].data.bas.rnstart?data[i].data.bas.rnstart:dnum; fprintf(stderr, "bast: Renumber: BASIC segment %s, start %u, spacing %u, end <=%u\n", data[i].name, num, dnum, end); } int dl; init_char(&data[i].data.bas.block, &dl, (int *)&data[i].data.bas.blen); int last=0; int j; for(j=0;j<data[i].data.bas.nlines;j++) { if(data[i].data.bas.basic[j].ntok) { if(num) { if(data[i].data.bas.renum!=1) { fprintf(stderr, "bast: Linker (Pass 1): Internal error (num!=0 but renum!=1), %s\n", data[i].name); return(EXIT_FAILURE); } data[i].data.bas.basic[j].number=num; num+=dnum; } else { if(data[i].data.bas.renum) { fprintf(stderr, "bast: Linker (Pass 1): Internal error (num==0 but renum!=0), %s\n", data[i].name); return(EXIT_FAILURE); } while(last<nlabels) { labels[last].sline=j; labels[last++].line=data[i].data.bas.basic[j].number; } } int k; for(k=0;k<data[i].data.bas.basic[j].ntok;k++) { if(data[i].data.bas.basic[j].tok[k].tok==TOKEN_RLINK) { if(data[i].data.bas.basic[j].tok[k].data) { FILE *fp=fopen(data[i].data.bas.basic[j].tok[k].data, "rb"); if(fp) { data[i].data.bas.basic[j].tok[k].data2=(char *)malloc(sizeof(bin_seg)); err=false; bin_load(data[i].data.bas.basic[j].tok[k].data, fp, (bin_seg *)data[i].data.bas.basic[j].tok[k].data2, NULL); if(err) { fprintf(stderr, "bast: Linker: failed to attach BINARY segment\n\t%s:%u\n", data[i].name, j); return(EXIT_FAILURE); } } else { fprintf(stderr, "bast: Linker: failed to open rlinked file %s\n\t%s:%u\n", data[i].data.bas.basic[j].tok[k].data, data[i].name, j); return(EXIT_FAILURE); } } else { fprintf(stderr, "bast: Linker: Internal error: TOKEN_RLINK without filename\n\t%s:%u", data[i].name, j); return(EXIT_FAILURE); } } } } else if(*data[i].data.bas.basic[j].text=='.') { if(isvalidlabel(data[i].data.bas.basic[j].text+1)) { label lbl; lbl.text=strdup(data[i].data.bas.basic[j].text+1); lbl.seg=i; lbl.line=num; lbl.sline=j; addlabel(&nlabels, &labels, lbl); } } } buildbas(&data[i].data.bas, false); if(data[i].data.bas.blen==-1) { fprintf(stderr, "bast: Failed to link BASIC segment %s\n", data[i].name); return(EXIT_FAILURE); } if(data[i].data.bas.renum) data[i].data.bas.renum=2; break; case BINARY: // TODO: export symbol table (we don't have symbols in object files yet) // Nothing else on pass 1 break; default: fprintf(stderr, "bast: Linker: Internal error: Bad segment-type %u\n", data[i].type); return(EXIT_FAILURE); break; } } // PASS 2: Replace labels with the linenumbers/addresses to which they point for(i=0;i<nsegs;i++) { fprintf(stderr, "bast: Linker (Pass 2): %s\n", data[i].name); switch(data[i].type) { case BASIC: if(data[i].data.bas.line<0) { if(!data[i].data.bas.lline) { fprintf(stderr, "bast: Linker: Internal error: line<0 but lline=NULL, %s\n", data[i].name); return(EXIT_FAILURE); } int l; for(l=0;l<nlabels;l++) { // TODO limit label scope to this file & the files it has #imported if((data[labels[l].seg].type==BASIC) && (strcmp(data[i].data.bas.lline, labels[l].text)==0)) { data[i].data.bas.line=labels[l].line; break; } } if(l==nlabels) { fprintf(stderr, "bast: Linker: Undefined label %s\n\t%s:#pragma line\n", data[i].data.bas.lline, data[i].name); return(EXIT_FAILURE); } } int j; for(j=0;j<data[i].data.bas.nlines;j++) { int k; for(k=0;k<data[i].data.bas.basic[j].ntok;k++) { if(data[i].data.bas.basic[j].tok[k].tok==TOKEN_LABEL) { int l; for(l=0;l<nlabels;l++) { // TODO limit label scope to this file & the files it has #imported if((data[labels[l].seg].type==BASIC) && (strcmp(data[i].data.bas.basic[j].tok[k].data, labels[l].text)==0)) { if(debug) fprintf(stderr, "bast: Linker: expanded %%%s", data[i].data.bas.basic[j].tok[k].data); if(data[i].data.bas.basic[j].tok[k].index) { if(debug) fprintf(stderr, "%s%02x", data[i].data.bas.basic[j].tok[k].index>0?"+":"-", abs(data[i].data.bas.basic[j].tok[k].index)); } data[i].data.bas.basic[j].tok[k].tok=TOKEN_ZXFLOAT; if(Ocutnumbers) { data[i].data.bas.basic[j].tok[k].data=strdup("."); if(debug) fprintf(stderr, " to %u (cut)\n", labels[l].line+data[i].data.bas.basic[j].tok[k].index); } else { data[i].data.bas.basic[j].tok[k].data=(char *)malloc(6); sprintf(data[i].data.bas.basic[j].tok[k].data, "%05u", labels[l].line+data[i].data.bas.basic[j].tok[k].index); if(debug) fprintf(stderr, " to %s\n", data[i].data.bas.basic[j].tok[k].data); } data[i].data.bas.basic[j].tok[k].data2=(char *)malloc(6); zxfloat(data[i].data.bas.basic[j].tok[k].data2, labels[l].line+data[i].data.bas.basic[j].tok[k].index); break; } } if(l==nlabels) { fprintf(stderr, "bast: Linker: Undefined label %s\n\t"LOC"\n", data[i].data.bas.basic[j].tok[k].data, data[i].name, j); return(EXIT_FAILURE); } } else if(data[i].data.bas.basic[j].tok[k].tok==TOKEN_PTRLBL) { int l; for(l=0;l<nlabels;l++) { // TODO limit label scope to this file & the files it has #imported if((data[labels[l].seg].type==BASIC) && (strcmp(data[i].data.bas.basic[j].tok[k].data, labels[l].text)==0)) { if(debug) fprintf(stderr, "bast: Linker: expanded @%s", data[i].data.bas.basic[j].tok[k].data); if(data[i].data.bas.basic[j].tok[k].index) { if(debug) fprintf(stderr, "%s%02x", data[i].data.bas.basic[j].tok[k].index>0?"+":"-", abs(data[i].data.bas.basic[j].tok[k].index)); } data[i].data.bas.basic[j].tok[k].tok=TOKEN_ZXFLOAT; if(Ocutnumbers) { data[i].data.bas.basic[j].tok[k].data=strdup("."); if(debug) fprintf(stderr, " to %u (cut)\n", (unsigned int)data[labels[l].seg].data.bas.basic[labels[l].sline].offset+data[i].data.bas.basic[j].tok[k].index); } else { data[i].data.bas.basic[j].tok[k].data=(char *)malloc(6); sprintf(data[i].data.bas.basic[j].tok[k].data, "%05u", (unsigned int)data[labels[l].seg].data.bas.basic[labels[l].sline].offset+data[i].data.bas.basic[j].tok[k].index); if(debug) fprintf(stderr, " to %s\n", data[i].data.bas.basic[j].tok[k].data); } data[i].data.bas.basic[j].tok[k].data2=(char *)malloc(6); zxfloat(data[i].data.bas.basic[j].tok[k].data2, data[labels[l].seg].data.bas.basic[labels[l].sline].offset+data[i].data.bas.basic[j].tok[k].index); break; } } if(l==nlabels) { fprintf(stderr, "bast: Linker: Undefined label %s\n\t"LOC"\n", data[i].data.bas.basic[j].tok[k].data, data[i].name, j); return(EXIT_FAILURE); } } } } break; case BINARY: if(data[i].data.bin.nbytes) { int j; for(j=0;j<data[i].data.bin.nbytes;j++) { switch(data[i].data.bin.bytes[j].type) { case BYTE: // do nothing break; // TODO LBL, LBM (labelpointer parsing) default: fprintf(stderr, "bast: Linker: Bad byte-type %u\n\t%s+0x%04X\n", data[i].data.bin.bytes[j].type, data[i].name, j); return(EXIT_FAILURE); break; } } } break; default: fprintf(stderr, "bast: Linker: Internal error: Bad segment-type %u\n", data[i].type); return(EXIT_FAILURE); break; } } fprintf(stderr, "bast: Linker passed all segments\n"); /* END: LINKER & LABELS */ /* CREATE OUTPUT */ switch(outtype) { case TAPE: fprintf(stderr, "bast: Creating TAPE output\n"); if(nsegs) { FILE *fout=fopen(outfile, "wb"); if(!fout) { fprintf(stderr, "bast: Could not open output file %s for writing!\n", outfile); return(EXIT_FAILURE); } int i; for(i=0;i<nsegs;i++) { // write header fputc(0x13, fout); fputc(0x00, fout); unsigned char cksum=0; fputc(0x00, fout); // HEADER int j; char name[10]; switch(data[i].type) { case BASIC: fputc(0, fout); // PROGRAM memset(name, ' ', 10); memcpy(name, data[i].name, min(10, strlen(data[i].name))); for(j=0;j<10;j++) { fputc(name[j], fout); cksum^=name[j]; } buildbas(&data[i].data.bas, true); if(data[i].data.bas.blen==-1) { fprintf(stderr, "bast: Failed to link BASIC segment %s\n", data[i].name); return(EXIT_FAILURE); } fputc(data[i].data.bas.blen, fout); cksum^=data[i].data.bas.blen&0xFF; fputc(data[i].data.bas.blen>>8, fout); cksum^=data[i].data.bas.blen>>8; if(data[i].data.bas.line) // Parameter 1 = autostart line { fputc(data[i].data.bas.line, fout); cksum^=data[i].data.bas.line&0xFF; fputc(data[i].data.bas.line>>8, fout); cksum^=data[i].data.bas.line>>8; } else // Parameter 1 = 0xFFFF { fputc(0xFF, fout); fputc(0xFF, fout); } // Parameter 2 = data[i].data.bas.blen fputc(data[i].data.bas.blen, fout); cksum^=data[i].data.bas.blen&0xFF; fputc(data[i].data.bas.blen>>8, fout); cksum^=data[i].data.bas.blen>>8; fputc(cksum, fout); // write data block fputc((data[i].data.bas.blen+2), fout); fputc((data[i].data.bas.blen+2)>>8, fout); fputc(0xFF, fout); // DATA cksum=0xFF; for(j=0;j<data[i].data.bas.blen;j++) { fputc(data[i].data.bas.block[j], fout); cksum^=data[i].data.bas.block[j]; } fputc(cksum, fout); free(data[i].data.bas.block); break; case BINARY: fputc(3, fout); // CODE cksum^=3; memset(name, ' ', 10); memcpy(name, data[i].name, min(10, strlen(data[i].name))); for(j=0;j<10;j++) { fputc(name[j], fout); cksum^=name[j]; } fputc(data[i].data.bin.nbytes, fout); cksum^=data[i].data.bin.nbytes&0xFF; fputc(data[i].data.bin.nbytes>>8, fout); cksum^=data[i].data.bin.nbytes>>8; // Parameter 1 = address fputc(data[i].data.bin.org, fout); cksum^=data[i].data.bin.org&0xFF; fputc(data[i].data.bin.org>>8, fout); cksum^=data[i].data.bin.org>>8; // Parameter 2 = 0x8000 fputc(0x00, fout); fputc(0x80, fout); cksum^=0x80; fputc(cksum, fout); // write data block fputc((data[i].data.bin.nbytes+2), fout); fputc((data[i].data.bin.nbytes+2)>>8, fout); fputc(0xFF, fout); // DATA cksum=0xFF; for(j=0;j<data[i].data.bin.nbytes;j++) { fputc(data[i].data.bin.bytes[j].byte, fout); cksum^=data[i].data.bin.bytes[j].byte; } fputc(cksum, fout); free(data[i].data.bin.bytes); break; default: fprintf(stderr, "bast: Internal error: Don't know how to make TAPE output of segment type %u\n", data[i].type); return(EXIT_FAILURE); break; } fprintf(stderr, "bast: Wrote segment %s\n", data[i].name); } fclose(fout); }