/* rvalue
*
* Generate code to get the value of a symbol into "primary".
*/
SC_FUNC void rvalue(value *lval)
{
symbol *sym;
sym=lval->sym;
if (lval->ident==iARRAYCELL) {
/* indirect fetch, address already in PRI */
stgwrite("\tload.i\n");
code_idx+=opcodes(1);
} else if (lval->ident==iARRAYCHAR) {
/* indirect fetch of a character from a pack, address already in PRI */
stgwrite("\tlodb.i ");
outval(sCHARBITS/8,TRUE); /* read one or two bytes */
code_idx+=opcodes(1)+opargs(1);
} else if (lval->ident==iREFERENCE) {
/* indirect fetch, but address not yet in PRI */
assert(sym!=NULL);
assert(sym->vclass==sLOCAL);/* global references don't exist in Pawn */
if (sym->vclass==sLOCAL)
stgwrite("\tlref.s.pri ");
else
stgwrite("\tlref.pri ");
outval(sym->addr,TRUE);
markusage(sym,uREAD);
code_idx+=opcodes(1)+opargs(1);
} else {
/* direct or stack relative fetch */
assert(sym!=NULL);
if (sym->vclass==sLOCAL)
stgwrite("\tload.s.pri ");
else
stgwrite("\tload.pri ");
outval(sym->addr,TRUE);
markusage(sym,uREAD);
code_idx+=opcodes(1)+opargs(1);
} /* if */
}
void
setfile(char *name, int fileno)
{
if ((sc_debug & sSYMBOLIC) != 0)
{
begcseg();
stgwrite("file ");
outval(fileno, FALSE);
stgwrite(" ");
stgwrite(name);
stgwrite("\n");
/* calculate code length */
code_idx += opcodes(1) + opargs(2) + nameincells(name);
} /* if */
}
/*
* Inclrement/decrement stack pointer. Note that this routine does
* nothing if the delta is zero.
*/
SC_FUNC void modstk(int delta)
{
if (delta) {
cell crit=((cell)1<<pc_cellsize*4);
if (!staging && pc_optimize>=sOPTIMIZE_FULL && delta>=-crit && delta<crit) {
stgwrite("\tstack.p ");
outval(delta,FALSE,TRUE);
code_idx+=opcodes(1);
} else {
stgwrite("\tstack ");
outval(delta,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
} /* if */
} /* if */
}
static cell parmx(FILE *fbin,const char *params,cell opcode,cell cip)
{
int idx;
ucell count=getparamvalue(params,¶ms);
(void)cip;
if (fbin!=NULL) {
write_cell(fbin,opcode);
write_cell(fbin,(ucell)count);
} /* if */
for (idx=0; idx<count; idx++) {
ucell p=getparamvalue(params,¶ms);
if (fbin!=NULL)
write_cell(fbin,p);
} /* for */
return opcodes(1)+opargs(count+1);
}
static cell do_switch(FILE *fbin,const char *params,cell opcode,cell cip)
{
int i;
ucell p;
i=(int)hex2ucell(params,NULL);
assert(i>=0 && i<sc_labnum);
if (fbin!=NULL) {
assert(lbltab!=NULL);
p=lbltab[i]-cip;
write_cell(fbin,opcode);
write_cell(fbin,p);
} /* if */
return opcodes(1)+opargs(1);
}
/*
* Inclrement/decrement stack pointer. Note that this routine does
* nothing if the delta is zero.
*/
SC_FUNC void modstk(int delta)
{
if (delta) {
#if !defined AMX_NO_PACKED_OPC
if (!staging && pc_optimize>sOPTIMIZE_NOMACRO && delta>=-(1<<sizeof(cell)*4) && delta<(1<<sizeof(cell)*4)) {
stgwrite("\tstack.p ");
outval(delta,FALSE,TRUE);
code_idx+=opcodes(1);
} else {
#endif
stgwrite("\tstack ");
outval(delta,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
#if !defined AMX_NO_PACKED_OPC
} /* if */
#endif
} /* if */
}
static cell do_case(FILE *fbin,const char *params,cell opcode,cell cip)
{
int i;
ucell p,v;
(void)opcode;
v=hex2ucell(params,¶ms);
i=(int)hex2ucell(params,NULL);
assert(i>=0 && i<sc_labnum);
if (fbin!=NULL) {
assert(lbltab!=NULL);
p=lbltab[i]-cip;
write_cell(fbin,v);
write_cell(fbin,p);
} /* if */
return opcodes(0)+opargs(2);
}
SC_FUNC void setheap_pri(void)
{
#if !defined AMX_NO_PACKED_OPC
if (!staging && pc_optimize>sOPTIMIZE_NOMACRO) {
stgwrite("\theap.p ");
outval(sizeof(cell),FALSE,TRUE);
code_idx+=opcodes(3); /* the other 2 opcodes follow below */
} else {
#endif
stgwrite("\theap "); /* ALT = HEA++ */
outval(sizeof(cell),TRUE,TRUE);
code_idx+=opcodes(3)+opargs(1); /* the other 2 opcodes follow below */
#if !defined AMX_NO_PACKED_OPC
} /* if */
#endif
stgwrite("\tstor.i\n"); /* store PRI (default value) at address ALT */
stgwrite("\tmove.pri\n"); /* move ALT to PRI: PRI contains the address */
}
SC_FUNC void ffcase(cell value,int label,int newtable,int icase)
{
if (newtable) {
if (icase)
stgwrite("\ticasetbl\n");
else
stgwrite("\tcasetbl\n");
code_idx+=opcodes(1);
} /* if */
if (icase)
stgwrite("\ticase ");
else
stgwrite("\tcase ");
outval(value,TRUE,FALSE);
stgwrite(" ");
outval(label,TRUE,TRUE);
code_idx+=opcodes(0)+opargs(2);
}
/* alignframe
*
* Aligns the frame (and the stack) of the current function to a multiple
* of the specified byte count. Two caveats: the alignment ("numbytes") should
* be a power of 2, and this alignment must be done right after the frame
* is set up (before the first variable is declared)
*/
SC_FUNC void alignframe(int numbytes)
{
#if !defined NDEBUG
/* "numbytes" should be a power of 2 for this code to work */
int i,count=0;
for (i=0; i<sizeof numbytes*8; i++)
if (numbytes & (1 << i))
count++;
assert(count==1);
#endif
stgwrite("\tlctrl 4\n"); /* get STK in PRI */
stgwrite("\tconst.alt "); /* get ~(numbytes-1) in ALT */
outval(~(numbytes-1),TRUE,TRUE);
stgwrite("\tand\n"); /* PRI = STK "and" ~(numbytes-1) */
stgwrite("\tsctrl 4\n"); /* set the new value of STK ... */
stgwrite("\tsctrl 5\n"); /* ... and FRM */
code_idx+=opcodes(5)+opargs(4);
}
static cell parmx_p(FILE *fbin,const char *params,cell opcode,cell cip)
{
int idx;
ucell p;
ucell count=getparamvalue(params,¶ms);
(void)cip;
assert(count<((ucell)1<<(pc_cellsize*4)));
assert(opcode>=0 && opcode<=255);
/* write the instruction (optionally) */
if (fbin!=NULL) {
p=(count<<pc_cellsize*4) | opcode;
write_cell(fbin,p);
} /* if */
for (idx=0; idx<count; idx++) {
p=getparamvalue(params,¶ms);
if (fbin!=NULL)
write_cell(fbin,p);
} /* for */
return opcodes(1)+opargs(count);
}
/* Get the address of a symbol into the primary or alternate register (used
* for arrays, and for passing arguments by reference).
*/
SC_FUNC void address(symbol *sym,regid reg)
{
assert(sym!=NULL);
assert(reg==sPRI || reg==sALT);
/* the symbol can be a local array, a global array, or an array
* that is passed by reference.
*/
if (sym->ident==iREFARRAY || sym->ident==iREFERENCE) {
/* reference to a variable or to an array; currently this is
* always a local variable */
switch (reg) {
case sPRI:
stgwrite("\tload.s.pri ");
break;
case sALT:
stgwrite("\tload.s.alt ");
break;
} /* switch */
} else {
/* a local array or local variable */
switch (reg) {
case sPRI:
if (sym->vclass==sLOCAL)
stgwrite("\taddr.pri ");
else
stgwrite("\tconst.pri ");
break;
case sALT:
if (sym->vclass==sLOCAL)
stgwrite("\taddr.alt ");
else
stgwrite("\tconst.alt ");
break;
} /* switch */
} /* if */
outval(sym->addr,TRUE,TRUE);
markusage(sym,uREAD);
code_idx+=opcodes(1)+opargs(1);
}
static cell do_call(FILE *fbin,const char *params,cell opcode,cell cip)
{
char name[sNAMEMAX+1];
int i;
symbol *sym;
ucell p;
for (i=0; !isspace(*params); i++,params++) {
assert(*params!='\0');
assert(i<sNAMEMAX);
name[i]=*params;
} /* for */
name[i]='\0';
if (name[0]=='l' && name[1]=='.') {
/* this is a label, not a function symbol */
i=(int)hex2ucell(name+2,NULL);
assert(i>=0 && i<sc_labnum);
if (fbin!=NULL) {
assert(lbltab!=NULL);
p=lbltab[i]-cip; /* make relative address */
} /* if */
} else {
/* look up the function address; note that the correct file number must
* already have been set (in order for static globals to be found).
*/
sym=findglb(name,sGLOBAL);
assert(sym!=NULL);
assert(sym->ident==iFUNCTN || sym->ident==iREFFUNC);
assert(sym->vclass==sGLOBAL);
p=sym->addr-cip; /* make relative address */
} /* if */
if (fbin!=NULL) {
write_cell(fbin,opcode);
write_cell(fbin,p);
} /* if */
return opcodes(1)+opargs(1);
}
/* Address of the source must already have been loaded in PRI
* "size" is the size in bytes (not cells).
*/
SC_FUNC void copyarray(symbol *sym,cell size)
{
assert(sym!=NULL);
/* the symbol can be a local array, a global array, or an array
* that is passed by reference.
*/
if (sym->ident==iREFARRAY) {
/* reference to an array; currently this is always a local variable */
assert(sym->vclass==sLOCAL); /* symbol must be stack relative */
stgwrite("\tload.s.alt ");
} else {
/* a local or global array */
if (sym->vclass==sLOCAL)
stgwrite("\taddr.alt ");
else
stgwrite("\tconst.alt ");
} /* if */
outval(sym->addr,TRUE);
markusage(sym,uWRITTEN);
code_idx+=opcodes(1)+opargs(1);
memcopy(size);
}
/* When a subroutine returns to address 0, the AMX must halt. In earlier
* releases, the RET and RETN opcodes checked for the special case 0 address.
* Today, the compiler simply generates a HALT instruction at address 0. So
* a subroutine can savely return to 0, and then encounter a HALT.
*/
SC_FUNC void writeleader(symbol *root,int *lbl_nostate,int *lbl_ignorestate)
{
symbol *sym;
assert(code_idx==0);
assert(lbl_nostate!=NULL);
assert(lbl_ignorestate!=NULL);
*lbl_nostate=0;
*lbl_ignorestate=0;
begcseg();
pc_ovl0size[ovlEXIT][0]=code_idx; /* store offset to the special overlay */
stgwrite(";program exit point\n");
#if !defined AMX_NO_PACKED_OPC
if (pc_optimize>sOPTIMIZE_NOMACRO) {
stgwrite("\thalt.p 0\n\n");
code_idx+=opcodes(1);
} else {
#endif
stgwrite("\thalt 0\n\n");
code_idx+=opcodes(1)+opargs(1); /* calculate code length */
#if !defined AMX_NO_PACKED_OPC
} /* if */
#endif
pc_ovl0size[ovlEXIT][1]=code_idx-pc_ovl0size[ovlEXIT][0]; /* store overlay code size */
/* check whether there are any functions that have states */
for (sym=root->next; sym!=NULL; sym=sym->next)
if (sym->ident==iFUNCTN && (sym->usage & (uPUBLIC | uREAD))!=0 && sym->states!=NULL)
break;
if (sym==NULL)
return; /* no function has states, nothing to do next */
/* generate an error function that is called for an undefined state */
pc_ovl0size[ovlNO_STATE][0]=code_idx;
stgwrite(";exit point for functions called from the wrong state\n");
assert(lbl_nostate!=NULL);
*lbl_nostate=getlabel();
setlabel(*lbl_nostate);
#if !defined AMX_NO_PACKED_OPC
if (pc_optimize>sOPTIMIZE_NOMACRO) {
assert(AMX_ERR_INVSTATE<(1<<sizeof(cell)*4));
stgwrite("\thalt.p ");
outval(AMX_ERR_INVSTATE,TRUE,TRUE);
code_idx+=opcodes(1);
} else {
#endif
stgwrite("\thalt ");
outval(AMX_ERR_INVSTATE,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1); /* calculate code length */
#if !defined AMX_NO_PACKED_OPC
} /* if */
#endif
stgwrite("\n");
pc_ovl0size[ovlNO_STATE][1]=code_idx-pc_ovl0size[ovlNO_STATE][0];
/* check whether there are "exit state" functions */
for (sym=root->next; sym!=NULL; sym=sym->next)
if (strcmp(sym->name,uEXITFUNC)==0)
break;
if (sym!=NULL) {
/* generate a stub function that is called for an undefined exit state and
* that returns immediately to the caller (no error)
*/
pc_ovl0size[ovlEXITSTATE][0]=code_idx;
stgwrite(";catch-all for undefined exit states\n");
assert(lbl_ignorestate!=NULL);
*lbl_ignorestate=getlabel();
setlabel(*lbl_ignorestate);
/* the RET and IRETN instructions pop off the FRM register from the stack,
* because they assume that a stack frame was set up; for this catch-all
* routine (for exit states) we therefore need to set up a stack frame
*/
stgwrite("\tproc\n");
if (pc_overlays>0)
stgwrite("\tiretn\n");
else
stgwrite("\tret\n");
code_idx+=opcodes(2);
pc_ovl0size[ovlEXITSTATE][1]=code_idx-pc_ovl0size[ovlEXITSTATE][0];
} /* if */
}
/* writestatetables
* Creates and dumps the state tables. Every function with states has a state
* table that contains jump addresses (or overlay indices) the branch to the
* appropriate function using the (hidden) state variable as the criterion.
* Technically, this happens in a "switch" (or an "iswitch") instruction.
* This function also creates the hidden state variables (one for each
* automaton) in the data segment.
*/
SC_FUNC void writestatetables(symbol *root,int lbl_nostate,int lbl_ignorestate)
{
int lbl_default,lbl_table,lbl_defnostate;
int statecount;
symbol *sym;
constvalue *fsa, *state;
statelist *stlist;
int fsa_id,listid;
assert(code_idx>0); /* leader must already have been written */
/* check whether there are any functions that have states */
for (sym=root->next; sym!=NULL; sym=sym->next)
if (sym->ident==iFUNCTN && (sym->usage & (uPUBLIC | uREAD))!=0 && sym->states!=NULL)
break;
if (sym==NULL)
return; /* no function has states, nothing to do next */
assert(pc_ovl0size[ovlNO_STATE][0]>0); /* state exit point must already have been created */
assert(pc_ovl0size[ovlNO_STATE][1]>0);
/* write the "state-selectors" table with all automatons (update the
* automatons structure too, as we are now assigning the address to
* each automaton state-selector variable)
*/
assert(glb_declared==0);
begdseg();
for (fsa=sc_automaton_tab.next; fsa!=NULL; fsa=fsa->next) {
defstorage();
stgwrite("0\t; automaton ");
if (strlen(fsa->name)==0)
stgwrite("(anonymous)");
else
stgwrite(fsa->name);
stgwrite("\n");
fsa->value=glb_declared*sizeof(cell);
glb_declared++;
} /* for */
/* write stubs and jump tables for all state functions */
begcseg();
for (sym=root->next; sym!=NULL; sym=sym->next) {
if (sym->ident==iFUNCTN && (sym->usage & (uPUBLIC | uREAD))!=0 && sym->states!=NULL) {
stlist=sym->states->next;
assert(stlist!=NULL); /* there should be at least one state item */
listid=stlist->id;
assert(listid==-1 || listid>0);
if (listid==-1 && stlist->next!=NULL) {
/* first index is the "fallback", take the next one (if available) */
stlist=stlist->next;
listid=stlist->id;
} /* if */
if (listid==-1) {
/* first index is the fallback, there is no second... */
stlist->label=0; /* insert dummy label number */
/* this is an error, but we postpone adding the error message until the
* function definition
*/
continue;
} /* if */
/* generate label numbers for all statelist ids */
for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
if (pc_overlays>0) {
/* code overlay indices should already be set, see gen_ovlinfo() */
assert(stlist->label>0);
} else {
assert(stlist->label==0);
stlist->label=getlabel();
} /* if */
} /* for */
if (strcmp(sym->name,uENTRYFUNC)==0)
continue; /* do not generate stubs for this special function */
sym->addr=code_idx; /* fix the function address now */
/* get automaton id for this function */
assert(listid>0);
fsa_id=state_getfsa(listid);
assert(fsa_id>=0); /* automaton 0 exists */
fsa=automaton_findid(fsa_id);
/* count the number of states actually used; at the same time, check
* whether there is a default (i.e. "fallback") state function
*/
statecount=0;
if (strcmp(sym->name,uEXITFUNC)==0) {
lbl_default= (pc_overlays>0) ? ovlEXITSTATE : lbl_ignorestate;
} else {
lbl_defnostate= (pc_overlays>0) ? ovlNO_STATE : lbl_nostate;
lbl_default=lbl_defnostate;
} /* if */
for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
if (stlist->id==-1) {
lbl_default=stlist->label;
} else {
statecount+=state_count(stlist->id);
} /* if */
} /* for */
/* generate a stub entry for the functions */
stgwrite("\tload.pri ");
outval(fsa->value,TRUE,FALSE);
stgwrite("\t; ");
stgwrite(sym->name);
if (pc_overlays>0) {
/* add overlay index */
stgwrite("/");
outval(sym->index,FALSE,FALSE);
} /* if */
stgwrite("\n");
code_idx+=opcodes(1)+opargs(1); /* calculate code length */
lbl_table=getlabel();
ffswitch(lbl_table,(pc_overlays>0));
/* generate the jump table */
setlabel(lbl_table);
ffcase(statecount,lbl_default,TRUE,(pc_overlays>0));
for (state=sc_state_tab.next; state!=NULL; state=state->next) {
if (state->index==fsa_id) {
/* find the label for this list id */
for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
if (stlist->id!=-1 && state_inlist(stlist->id,(int)state->value)) {
/* when overlays are used, the jump-label for the case statement
* are overlay indices instead of code labels
*/
ffcase(state->value,stlist->label,FALSE,(pc_overlays>0));
break;
} /* if */
} /* for */
if (stlist==NULL && lbl_default==lbl_defnostate)
error(230,state->name,sym->name); /* unimplemented state, no fallback */
} /* if (state belongs to automaton of function) */
} /* for (state) */
stgwrite("\n");
/* the jump table gets its own overlay index, and the size of the jump
* table must therefore be known (i.e. update the codeaddr field of the
* function with the address where the jump table ends)
*/
sym->codeaddr=code_idx;
} /* if (is function, used & having states) */
} /* for (sym) */
}
/*
* Jumps to "label" if PRI == 0
*/
SC_FUNC void jmp_eq0(int number)
{
stgwrite("\tjzer ");
outval(number,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
}
/* When a subroutine returns to address 0, the AMX must halt. In earlier
* releases, the RET and RETN opcodes checked for the special case 0 address.
* Today, the compiler simply generates a HALT instruction at address 0. So
* a subroutine can savely return to 0, and then encounter a HALT.
*/
SC_FUNC void writeleader(symbol *root)
{
int lbl_nostate,lbl_table;
int statecount;
symbol *sym;
constvalue *fsa, *state, *stlist;
int fsa_id,listid;
char lbl_default[sNAMEMAX+1];
assert(code_idx==0);
begcseg();
stgwrite(";program exit point\n");
stgwrite("\thalt 0\n\n");
code_idx+=opcodes(1)+opargs(1); /* calculate code length */
/* check whether there are any functions that have states */
for (sym=root->next; sym!=NULL; sym=sym->next)
if (sym->ident==iFUNCTN && (sym->usage & (uPUBLIC | uREAD))!=0 && sym->states!=NULL)
break;
if (sym==NULL)
return; /* no function has states, nothing to do next */
/* generate an error function that is called for an undefined state */
stgwrite("\n;exit point for functions called from the wrong state\n");
lbl_nostate=getlabel();
setlabel(lbl_nostate);
stgwrite("\thalt ");
outval(AMX_ERR_INVSTATE,TRUE);
code_idx+=opcodes(1)+opargs(1); /* calculate code length */
/* write the "state-selectors" table with all automatons (update the
* automatons structure too, as we are now assigning the address to
* each automaton state-selector variable)
*/
assert(glb_declared==0);
begdseg();
for (fsa=sc_automaton_tab.next; fsa!=NULL; fsa=fsa->next) {
defstorage();
stgwrite("0\t; automaton ");
if (strlen(fsa->name)==0)
stgwrite("(anonymous)");
else
stgwrite(fsa->name);
stgwrite("\n");
fsa->value=glb_declared*sizeof(cell);
glb_declared++;
} /* for */
/* write stubs and jump tables for all state functions */
begcseg();
for (sym=root->next; sym!=NULL; sym=sym->next) {
if (sym->ident==iFUNCTN && (sym->usage & (uPUBLIC | uREAD))!=0 && sym->states!=NULL) {
stlist=sym->states->next;
assert(stlist!=NULL); /* there should be at least one state item */
listid=stlist->index;
assert(listid==-1 || listid>0);
if (listid==-1 && stlist->next!=NULL) {
/* first index is the "fallback", take the next one (if available) */
stlist=stlist->next;
listid=stlist->index;
} /* if */
if (listid==-1) {
/* first index is the fallback, there is no second... */
strcpy(stlist->name,"0"); /* insert dummy label number */
/* this is an error, but we postpone adding the error message until the
* function definition
*/
continue;
} /* if */
/* generate label numbers for all statelist ids */
for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
assert(strlen(stlist->name)==0);
strcpy(stlist->name,itoh(getlabel()));
} /* for */
if (strcmp(sym->name,uENTRYFUNC)==0)
continue; /* do not generate stubs for this special function */
sym->addr=code_idx; /* fix the function address now */
/* get automaton id for this function */
assert(listid>0);
fsa_id=state_getfsa(listid);
assert(fsa_id>=0); /* automaton 0 exists */
fsa=automaton_findid(fsa_id);
/* count the number of states actually used; at the sane time, check
* whether there is a default state function
*/
statecount=0;
strcpy(lbl_default,itoh(lbl_nostate));
for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
if (stlist->index==-1) {
assert(strlen(stlist->name)<sizeof lbl_default);
strcpy(lbl_default,stlist->name);
} else {
statecount+=state_count(stlist->index);
} /* if */
} /* for */
/* generate a stub entry for the functions */
stgwrite("\tload.pri ");
outval(fsa->value,FALSE);
stgwrite("\t; ");
stgwrite(sym->name);
stgwrite("\n");
code_idx+=opcodes(1)+opargs(1); /* calculate code length */
lbl_table=getlabel();
ffswitch(lbl_table);
/* generate the jump table */
setlabel(lbl_table);
ffcase(statecount,lbl_default,TRUE);
for (state=sc_state_tab.next; state!=NULL; state=state->next) {
if (state->index==fsa_id) {
/* find the label for this list id */
for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
if (stlist->index!=-1 && state_inlist(stlist->index,(int)state->value)) {
ffcase(state->value,stlist->name,FALSE);
break;
} /* if */
} /* for */
if (stlist==NULL && strtol(lbl_default,NULL,16)==lbl_nostate)
error(230,state->name,sym->name); /* unimplemented state, no fallback */
} /* if (state belongs to automaton of function) */
} /* for (state) */
stgwrite("\n");
} /* if (is function, used & having states) */
} /* for (sym) */
}
/* Switch statements
* The "switch" statement generates a "case" table using the "CASE" opcode.
* The case table contains a list of records, each record holds a comparison
* value and a label to branch to on a match. The very first record is an
* exception: it holds the size of the table (excluding the first record) and
* the label to branch to when none of the values in the case table match.
* The case table is sorted on the comparison value. This allows more advanced
* abstract machines to sift the case table with a binary search.
*/
SC_FUNC void ffswitch(int label)
{
stgwrite("\tswitch ");
outval(label,TRUE); /* the label is the address of the case table */
code_idx+=opcodes(1)+opargs(1);
}
/* Copy value in alternate register to the primary register */
SC_FUNC void swapregs(void)
{
stgwrite("\txchg\n");
code_idx+=opcodes(1)+opargs(0);
}
/*
* Jumps to "label" if PRI != 0
*/
void jmp_ne0(int number)
{
stgwrite("\tjnz ");
outval(number,TRUE);
code_idx+=opcodes(1)+opargs(1);
}
SC_FUNC void getfrm(void)
{
stgwrite("\tlctrl 5\n");
code_idx+=opcodes(1)+opargs(1);
}
/* Copy value in alternate register to the primary register */
SC_FUNC void moveto1(void)
{
stgwrite("\tmove.pri\n");
code_idx+=opcodes(1)+opargs(0);
}
/*
* Push a constant value onto the stack
*/
SC_FUNC void pushval(cell val)
{
stgwrite("\tpush.c ");
outval(val,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
}
/*
* Jump to local label number (the number is converted to a name)
*/
SC_FUNC void jumplabel(int number)
{
stgwrite("\tjump ");
outval(number,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
}
SC_FUNC void ffabort(int reason)
{
stgwrite("\thalt ");
outval(reason,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
}
/* Align PRI (which should hold a character index) to an address.
* The first character in a "pack" occupies the highest bits of
* the cell. This is at the lower memory address on Big Endian
* computers and on the higher address on Little Endian computers.
* The ALIGN.pri/alt instructions must solve this machine dependence;
* that is, on Big Endian computers, ALIGN.pri/alt shuold do nothing
* and on Little Endian computers they should toggle the address.
*/
SC_FUNC void charalign(void)
{
stgwrite("\talign.pri ");
outval(sCHARBITS/8,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
}
/* Address of the source must already have been loaded in PRI, the
* destination address in ALT.
* This routine makes a loop that copies the minor dimension vector
* by vector.
*/
SC_FUNC void copyarray2d(int majordim,int minordim)
{
int cellshift=(pc_cellsize==8) ? 3 : (pc_cellsize==4) ? 2 : 1;
int looplbl=getlabel();
stgwrite("\tpush.alt\n");
stgwrite("\tpush.pri\n");
code_idx+=opcodes(2);
if (pc_optimize>=sOPTIMIZE_MACRO) {
stgwrite("\tzero.alt\n");/* ALT = index = 0 */
code_idx+=opcodes(1);
} else {
stgwrite("\tconst.alt 0\n");/* ALT = index = 0 */
code_idx+=opcodes(1)+opargs(1);
} /* if */
setlabel(looplbl);
stgwrite("\tpush.alt\n"); /* save index */
stgwrite("\tpick 8\n"); /* PRI = dest */
code_idx+=opcodes(2)+opargs(1);
if (pc_optimize>=sOPTIMIZE_MACRO) {
stgwrite("\txchg\n"); /* ALT = dest, PRI = index */
stgwrite("\tidxaddr\n");/* PRI = dest + index * sizeof(cell) */
code_idx+=opcodes(2);
} else {
stgwrite("\tshl.c.alt "); outval(cellshift,TRUE,TRUE); /* ALT = index * sizeof(cell) */
stgwrite("\tadd\n"); /* PRI = dest + index * sizeof(cell) */
code_idx+=opcodes(2)+opargs(1);
} /* if */
stgwrite("\tpush.pri\n");
stgwrite("\tload.i\n"); /* PRI = dest[index * sizeof(cell)] */
stgwrite("\tpop.alt\n"); /* ALT = dest + index * sizeof(cell) */
stgwrite("\tadd\n"); /* PRI = dest + index * sizeof(cell) + dest[index * sizeof(cell)] */
stgwrite("\tpush.pri\n");
code_idx+=opcodes(5);
if (pc_optimize>=sOPTIMIZE_MACRO) {
stgwrite("\tpick 8\n"); /* PRI = source */
stgwrite("\txchg\n"); /* ALT = source */
stgwrite("\tpick 4\n"); /* PRI = index */
stgwrite("\tidxaddr\n");/* PRI = source + index * sizeof(cell) */
code_idx+=opcodes(4)+opargs(2);
} else {
stgwrite("\tpick 4\n"); /* PRI = index */
stgwrite("\txchg\n"); /* ALT = index */
stgwrite("\tshl.c.alt "); outval(cellshift,TRUE,TRUE); /* ALT = index * sizeof(cell) */
stgwrite("\tpick 8\n"); /* PRI = source */
stgwrite("\tadd\n"); /* PRI = source + index * sizeof(cell) */
code_idx+=opcodes(5)+opargs(3);
} /* if */
stgwrite("\tpush.pri\n");
stgwrite("\tload.i\n"); /* PRI = source[index * sizeof(cell)] */
stgwrite("\tpop.alt\n"); /* ALT = source + index * sizeof(cell) */
stgwrite("\tadd\n"); /* PRI = source + index * sizeof(cell) + source[index * sizeof(cell)] */
stgwrite("\tpop.alt\n"); /* ALT = dest + index * sizeof(cell) + dest[index * sizeof(cell)] */
stgwrite("\tmovs "); outval(minordim*pc_cellsize,TRUE,TRUE);
stgwrite("\tpop.alt\n"); /* ALT = saved index */
stgwrite("\tinc.alt\n"); /* ALT = index + 1 */
code_idx+=opcodes(8)+opargs(1);
if (pc_optimize>=sOPTIMIZE_MACRO) {
stgwrite("\teq.c.alt "); outval(majordim,TRUE,TRUE);
code_idx+=opcodes(1)+opargs(1);
} else {
stgwrite("\tconst.pri "); outval(majordim,TRUE,TRUE);
stgwrite("\teq\n"); /* compare ALT with majordim */
code_idx+=opcodes(2)+opargs(1);
} /* if */
stgwrite("\tjzer "); outval(looplbl,TRUE,TRUE);
stgwrite("\tpop.pri\n"); /* restore stack & registers */
stgwrite("\tpop.alt\n");
code_idx+=opcodes(3)+opargs(1);
}
void move_alt(void)
{
stgwrite("\tmove.alt\n");
code_idx+=opcodes(1)+opargs(0);
}
