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);
}
