sourcemod-central: sourcepawn/compiler/sc4.c@f3b8bbe17f85 (annotated)

dvander@27	1	/* Pawn compiler - code generation (unoptimized "assembler" code)
dvander@27	2	*
dvander@27	3	* Copyright (c) ITB CompuPhase, 1997-2006
dvander@27	4	*
dvander@27	5	* This software is provided "as-is", without any express or implied warranty.
dvander@27	6	* In no event will the authors be held liable for any damages arising from
dvander@27	7	* the use of this software.
dvander@27	8	*
dvander@27	9	* Permission is granted to anyone to use this software for any purpose,
dvander@27	10	* including commercial applications, and to alter it and redistribute it
dvander@27	11	* freely, subject to the following restrictions:
dvander@27	12	*
dvander@27	13	* 1. The origin of this software must not be misrepresented; you must not
dvander@27	14	* claim that you wrote the original software. If you use this software in
dvander@27	15	* a product, an acknowledgment in the product documentation would be
dvander@27	16	* appreciated but is not required.
dvander@27	17	* 2. Altered source versions must be plainly marked as such, and must not be
dvander@27	18	* misrepresented as being the original software.
dvander@27	19	* 3. This notice may not be removed or altered from any source distribution.
dvander@27	20	*
dvander@365	21	* Version: $Id$
dvander@27	22	*/
dvander@27	23	#include <assert.h>
dvander@27	24	#include <ctype.h>
dvander@27	25	#include <stdio.h>
dvander@27	26	#include <stdlib.h> /* for _MAX_PATH */
dvander@27	27	#include <string.h>
dvander@27	28	#if defined FORTIFY
dvander@27	29	#include <alloc/fortify.h>
dvander@27	30	#endif
dvander@27	31	#include "sc.h"
dvander@27	32
dvander@27	33	static int fcurseg; /* the file number (fcurrent) for the active segment */
dvander@27	34
dvander@27	35
dvander@27	36	/* When a subroutine returns to address 0, the AMX must halt. In earlier
dvander@27	37	* releases, the RET and RETN opcodes checked for the special case 0 address.
dvander@27	38	* Today, the compiler simply generates a HALT instruction at address 0. So
dvander@27	39	* a subroutine can savely return to 0, and then encounter a HALT.
dvander@27	40	*/
dvander@27	41	SC_FUNC void writeleader(symbol *root)
dvander@27	42	{
dvander@27	43	int lbl_nostate,lbl_table;
dvander@27	44	int statecount;
dvander@27	45	symbol *sym;
dvander@27	46	constvalue fsa, state, *stlist;
dvander@27	47	int fsa_id,listid;
dvander@27	48	char lbl_default[sNAMEMAX+1];
dvander@27	49
dvander@27	50	assert(code_idx==0);
dvander@27	51
dvander@27	52	begcseg();
dvander@27	53	stgwrite(";program exit point\n");
dvander@27	54	stgwrite("\thalt 0\n\n");
dvander@27	55	code_idx+=opcodes(1)+opargs(1); /* calculate code length */
dvander@27	56
dvander@27	57	/* check whether there are any functions that have states */
dvander@27	58	for (sym=root->next; sym!=NULL; sym=sym->next)
dvander@27	59	if (sym->ident==iFUNCTN && (sym->usage & (uPUBLIC \| uREAD))!=0 && sym->states!=NULL)
dvander@27	60	break;
dvander@27	61	if (sym==NULL)
dvander@27	62	return; /* no function has states, nothing to do next */
dvander@27	63
dvander@27	64	/* generate an error function that is called for an undefined state */
dvander@27	65	stgwrite("\n;exit point for functions called from the wrong state\n");
dvander@27	66	lbl_nostate=getlabel();
dvander@27	67	setlabel(lbl_nostate);
dvander@27	68	stgwrite("\thalt ");
dvander@27	69	outval(AMX_ERR_INVSTATE,TRUE);
dvander@27	70	code_idx+=opcodes(1)+opargs(1); /* calculate code length */
dvander@27	71
dvander@27	72	/* write the "state-selectors" table with all automatons (update the
dvander@27	73	* automatons structure too, as we are now assigning the address to
dvander@27	74	* each automaton state-selector variable)
dvander@27	75	*/
dvander@27	76	assert(glb_declared==0);
dvander@27	77	begdseg();
dvander@27	78	for (fsa=sc_automaton_tab.next; fsa!=NULL; fsa=fsa->next) {
dvander@27	79	defstorage();
dvander@27	80	stgwrite("0\t; automaton ");
dvander@27	81	if (strlen(fsa->name)==0)
dvander@27	82	stgwrite("(anonymous)");
dvander@27	83	else
dvander@27	84	stgwrite(fsa->name);
dvander@27	85	stgwrite("\n");
dvander@27	86	fsa->value=glb_declared*sizeof(cell);
dvander@27	87	glb_declared++;
dvander@27	88	} /* for */
dvander@27	89
dvander@27	90	/* write stubs and jump tables for all state functions */
dvander@27	91	begcseg();
dvander@27	92	for (sym=root->next; sym!=NULL; sym=sym->next) {
dvander@27	93	if (sym->ident==iFUNCTN && (sym->usage & (uPUBLIC \| uREAD))!=0 && sym->states!=NULL) {
dvander@27	94	stlist=sym->states->next;
dvander@27	95	assert(stlist!=NULL); /* there should be at least one state item */
dvander@27	96	listid=stlist->index;
dvander@27	97	assert(listid==-1 \|\| listid>0);
dvander@27	98	if (listid==-1 && stlist->next!=NULL) {
dvander@27	99	/* first index is the "fallback", take the next one (if available) */
dvander@27	100	stlist=stlist->next;
dvander@27	101	listid=stlist->index;
dvander@27	102	} /* if */
dvander@27	103	if (listid==-1) {
dvander@27	104	/* first index is the fallback, there is no second... */
dvander@27	105	strcpy(stlist->name,"0"); /* insert dummy label number */
dvander@27	106	/* this is an error, but we postpone adding the error message until the
dvander@27	107	* function definition
dvander@27	108	*/
dvander@27	109	continue;
dvander@27	110	} /* if */
dvander@27	111	/* generate label numbers for all statelist ids */
dvander@27	112	for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
dvander@27	113	assert(strlen(stlist->name)==0);
dvander@27	114	strcpy(stlist->name,itoh(getlabel()));
dvander@27	115	} /* for */
dvander@27	116	if (strcmp(sym->name,uENTRYFUNC)==0)
dvander@27	117	continue; /* do not generate stubs for this special function */
dvander@27	118	sym->addr=code_idx; /* fix the function address now */
dvander@27	119	/* get automaton id for this function */
dvander@27	120	assert(listid>0);
dvander@27	121	fsa_id=state_getfsa(listid);
dvander@27	122	assert(fsa_id>=0); /* automaton 0 exists */
dvander@27	123	fsa=automaton_findid(fsa_id);
dvander@27	124	/* count the number of states actually used; at the sane time, check
dvander@27	125	* whether there is a default state function
dvander@27	126	*/
dvander@27	127	statecount=0;
dvander@27	128	strcpy(lbl_default,itoh(lbl_nostate));
dvander@27	129	for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
dvander@27	130	if (stlist->index==-1) {
dvander@27	131	assert(strlen(stlist->name)<sizeof lbl_default);
dvander@27	132	strcpy(lbl_default,stlist->name);
dvander@27	133	} else {
dvander@27	134	statecount+=state_count(stlist->index);
dvander@27	135	} /* if */
dvander@27	136	} /* for */
dvander@27	137	/* generate a stub entry for the functions */
dvander@27	138	stgwrite("\tload.pri ");
dvander@27	139	outval(fsa->value,FALSE);
dvander@27	140	stgwrite("\t; ");
dvander@27	141	stgwrite(sym->name);
dvander@27	142	stgwrite("\n");
dvander@27	143	code_idx+=opcodes(1)+opargs(1); /* calculate code length */
dvander@27	144	lbl_table=getlabel();
dvander@27	145	ffswitch(lbl_table);
dvander@27	146	/* generate the jump table */
dvander@27	147	setlabel(lbl_table);
dvander@27	148	ffcase(statecount,lbl_default,TRUE);
dvander@27	149	for (state=sc_state_tab.next; state!=NULL; state=state->next) {
dvander@27	150	if (state->index==fsa_id) {
dvander@27	151	/* find the label for this list id */
dvander@27	152	for (stlist=sym->states->next; stlist!=NULL; stlist=stlist->next) {
dvander@27	153	if (stlist->index!=-1 && state_inlist(stlist->index,(int)state->value)) {
dvander@27	154	ffcase(state->value,stlist->name,FALSE);
dvander@27	155	break;
dvander@27	156	} /* if */
dvander@27	157	} /* for */
dvander@27	158	if (stlist==NULL && strtol(lbl_default,NULL,16)==lbl_nostate)
dvander@27	159	error(230,state->name,sym->name); /* unimplemented state, no fallback */
dvander@27	160	} /* if (state belongs to automaton of function) */
dvander@27	161	} /* for (state) */
dvander@27	162	stgwrite("\n");
dvander@27	163	} /* if (is function, used & having states) */
dvander@27	164	} /* for (sym) */
dvander@27	165	}
dvander@27	166
dvander@27	167	/* writetrailer
dvander@27	168	* Not much left of this once important function.
dvander@27	169	*
dvander@27	170	* Global references: pc_stksize (referred to only)
dvander@27	171	* sc_dataalign (referred to only)
dvander@27	172	* code_idx (altered)
dvander@27	173	* glb_declared (altered)
dvander@27	174	*/
dvander@27	175	SC_FUNC void writetrailer(void)
dvander@27	176	{
dvander@27	177	assert(sc_dataalign % opcodes(1) == 0); /* alignment must be a multiple of
dvander@27	178	* the opcode size */
dvander@27	179	assert(sc_dataalign!=0);
dvander@27	180
dvander@27	181	/* pad code to align data segment */
dvander@27	182	if ((code_idx % sc_dataalign)!=0) {
dvander@27	183	begcseg();
dvander@27	184	while ((code_idx % sc_dataalign)!=0)
dvander@27	185	nooperation();
dvander@27	186	} /* if */
dvander@27	187
dvander@27	188	/* pad data segment to align the stack and the heap */
dvander@27	189	assert(litidx==0); /* literal queue should have been emptied */
dvander@27	190	assert(sc_dataalign % sizeof(cell) == 0);
dvander@27	191	if (((glb_declared*sizeof(cell)) % sc_dataalign)!=0) {
dvander@27	192	begdseg();
dvander@27	193	defstorage();
dvander@27	194	while (((glb_declared*sizeof(cell)) % sc_dataalign)!=0) {
dvander@27	195	stgwrite("0 ");
dvander@27	196	glb_declared++;
dvander@27	197	} /* while */
dvander@27	198	} /* if */
dvander@27	199
dvander@27	200	stgwrite("\nSTKSIZE "); /* write stack size (align stack top) */
dvander@27	201	outval(pc_stksize - (pc_stksize % sc_dataalign), TRUE);
dvander@27	202	}
dvander@27	203
dvander@27	204	/*
dvander@27	205	* Start (or restart) the CODE segment.
dvander@27	206	*
dvander@27	207	* In fact, the code and data segment specifiers are purely informational;
dvander@27	208	* the "DUMP" instruction itself already specifies that the following values
dvander@27	209	* should go to the data segment. All other instructions go to the code
dvander@27	210	* segment.
dvander@27	211	*
dvander@27	212	* Global references: curseg
dvander@27	213	* fcurrent
dvander@27	214	*/
dvander@27	215	SC_FUNC void begcseg(void)
dvander@27	216	{
faluco@62	217	if (sc_status!=statSKIP && (curseg!=sIN_CSEG \|\| fcurrent!=fcurseg)) {
dvander@27	218	stgwrite("\n");
dvander@27	219	stgwrite("CODE ");
dvander@27	220	outval(fcurrent,FALSE);
dvander@27	221	stgwrite("\t; ");
dvander@27	222	outval(code_idx,TRUE);
dvander@27	223	curseg=sIN_CSEG;
dvander@27	224	fcurseg=fcurrent;
dvander@27	225	} /* endif */
dvander@27	226	}
dvander@27	227
dvander@27	228	/*
dvander@27	229	* Start (or restart) the DATA segment.
dvander@27	230	*
dvander@27	231	* Global references: curseg
dvander@27	232	*/
dvander@27	233	SC_FUNC void begdseg(void)
dvander@27	234	{
faluco@62	235	if (sc_status!=statSKIP && (curseg!=sIN_DSEG \|\| fcurrent!=fcurseg)) {
dvander@27	236	stgwrite("\n");
dvander@27	237	stgwrite("DATA ");
dvander@27	238	outval(fcurrent,FALSE);
dvander@27	239	stgwrite("\t; ");
dvander@27	240	outval((glb_declared-litidx)*sizeof(cell),TRUE);
dvander@27	241	curseg=sIN_DSEG;
dvander@27	242	fcurseg=fcurrent;
dvander@27	243	} /* if */
dvander@27	244	}
dvander@27	245
dvander@27	246	SC_FUNC void setline(int chkbounds)
dvander@27	247	{
faluco@62	248	if (sc_asmfile) {
faluco@62	249	stgwrite("\t; line ");
faluco@62	250	outval(fline,TRUE);
faluco@62	251	} /* if */
dvander@27	252	if ((sc_debug & sSYMBOLIC)!=0 \|\| chkbounds && (sc_debug & sCHKBOUNDS)!=0) {
dvander@27	253	/* generate a "break" (start statement) opcode rather than a "line" opcode
dvander@27	254	* because earlier versions of Small/Pawn have an incompatible version of the
dvander@27	255	* line opcode
dvander@27	256	*/
dvander@27	257	stgwrite("\tbreak\t; ");
dvander@27	258	outval(code_idx,TRUE);
dvander@27	259	code_idx+=opcodes(1);
dvander@27	260	} /* if */
dvander@27	261	}
dvander@27	262
dvander@27	263	SC_FUNC void setfiledirect(char *name)
dvander@27	264	{
dvander@27	265	if (sc_status==statFIRST && sc_listing) {
dvander@27	266	assert(name!=NULL);
dvander@27	267	pc_writeasm(outf,"#file ");
dvander@27	268	pc_writeasm(outf,name);
dvander@27	269	pc_writeasm(outf,"\n");
dvander@27	270	} /* if */
dvander@27	271	}
dvander@27	272
dvander@27	273	SC_FUNC void setlinedirect(int line)
dvander@27	274	{
dvander@27	275	if (sc_status==statFIRST && sc_listing) {
dvander@27	276	char string[40];
dvander@27	277	sprintf(string,"#line %d\n",line);
dvander@27	278	pc_writeasm(outf,string);
dvander@27	279	} /* if */
dvander@27	280	}
dvander@27	281
dvander@27	282	/* setlabel
dvander@27	283	*
dvander@27	284	* Post a code label (specified as a number), on a new line.
dvander@27	285	*/
dvander@27	286	SC_FUNC void setlabel(int number)
dvander@27	287	{
dvander@27	288	assert(number>=0);
dvander@27	289	stgwrite("l.");
dvander@27	290	stgwrite((char *)itoh(number));
dvander@27	291	/* To assist verification of the assembled code, put the address of the
dvander@27	292	* label as a comment. However, labels that occur inside an expression
dvander@27	293	* may move (through optimization or through re-ordering). So write the
dvander@27	294	* address only if it is known to accurate.
dvander@27	295	*/
dvander@27	296	if (!staging) {
dvander@27	297	stgwrite("\t\t; ");
dvander@27	298	outval(code_idx,FALSE);
dvander@27	299	} /* if */
dvander@27	300	stgwrite("\n");
dvander@27	301	}
dvander@27	302
dvander@27	303	/* Write a token that signifies the start or end of an expression or special
dvander@27	304	* statement. This allows several simple optimizations by the peephole
dvander@27	305	* optimizer.
dvander@27	306	*/
dvander@27	307	SC_FUNC void markexpr(optmark type,const char *name,cell offset)
dvander@27	308	{
dvander@27	309	switch (type) {
dvander@27	310	case sEXPR:
dvander@27	311	stgwrite("\t;$exp\n");
dvander@27	312	break;
dvander@27	313	case sPARM:
dvander@27	314	stgwrite("\t;$par\n");
dvander@27	315	break;
dvander@27	316	case sLDECL:
dvander@27	317	assert(name!=NULL);
dvander@27	318	stgwrite("\t;$lcl ");
dvander@27	319	stgwrite(name);
dvander@27	320	stgwrite(" ");
dvander@27	321	outval(offset,TRUE);
dvander@27	322	break;
dvander@27	323	default:
dvander@27	324	assert(0);
dvander@27	325	} /* switch */
dvander@27	326	}
dvander@27	327
dvander@27	328	/* startfunc - declare a CODE entry point (function start)
dvander@27	329	*
dvander@27	330	* Global references: funcstatus (referred to only)
dvander@27	331	*/
dvander@27	332	SC_FUNC void startfunc(char *fname)
dvander@27	333	{
dvander@27	334	stgwrite("\tproc");
dvander@27	335	if (sc_asmfile) {
dvander@27	336	char symname[2*sNAMEMAX+16];
dvander@27	337	funcdisplayname(symname,fname);
dvander@27	338	stgwrite("\t; ");
dvander@27	339	stgwrite(symname);
dvander@27	340	} /* if */
dvander@27	341	stgwrite("\n");
dvander@27	342	code_idx+=opcodes(1);
dvander@27	343	}
dvander@27	344
dvander@27	345	/* endfunc
dvander@27	346	*
dvander@27	347	* Declare a CODE ending point (function end)
dvander@27	348	*/
dvander@27	349	SC_FUNC void endfunc(void)
dvander@27	350	{
dvander@27	351	stgwrite("\n"); /* skip a line */
dvander@27	352	}
dvander@27	353
dvander@27	354	/* alignframe
dvander@27	355	*
dvander@27	356	* Aligns the frame (and the stack) of the current function to a multiple
dvander@27	357	* of the specified byte count. Two caveats: the alignment ("numbytes") should
dvander@27	358	* be a power of 2, and this alignment must be done right after the frame
dvander@27	359	* is set up (before the first variable is declared)
dvander@27	360	*/
dvander@27	361	SC_FUNC void alignframe(int numbytes)
dvander@27	362	{
dvander@27	363	#if !defined NDEBUG
dvander@27	364	/* "numbytes" should be a power of 2 for this code to work */
dvander@27	365	int i,count=0;
dvander@27	366	for (i=0; i<sizeof numbytes*8; i++)
dvander@27	367	if (numbytes & (1 << i))
dvander@27	368	count++;
dvander@27	369	assert(count==1);
dvander@27	370	#endif
dvander@27	371
dvander@27	372	stgwrite("\tlctrl 4\n"); /* get STK in PRI */
dvander@27	373	stgwrite("\tconst.alt "); /* get ~(numbytes-1) in ALT */
dvander@27	374	outval(~(numbytes-1),TRUE);
dvander@27	375	stgwrite("\tand\n"); /* PRI = STK "and" ~(numbytes-1) */
dvander@27	376	stgwrite("\tsctrl 4\n"); /* set the new value of STK ... */
dvander@27	377	stgwrite("\tsctrl 5\n"); /* ... and FRM */
dvander@27	378	code_idx+=opcodes(5)+opargs(4);
dvander@27	379	}
dvander@27	380
dvander@27	381	/* rvalue
dvander@27	382	*
dvander@27	383	* Generate code to get the value of a symbol into "primary".
dvander@27	384	*/
dvander@27	385	SC_FUNC void rvalue(value *lval)
dvander@27	386	{
dvander@27	387	symbol *sym;
dvander@27	388
dvander@27	389	sym=lval->sym;
dvander@27	390	if (lval->ident==iARRAYCELL) {
dvander@27	391	/* indirect fetch, address already in PRI */
dvander@27	392	stgwrite("\tload.i\n");
dvander@27	393	code_idx+=opcodes(1);
dvander@27	394	} else if (lval->ident==iARRAYCHAR) {
dvander@27	395	/* indirect fetch of a character from a pack, address already in PRI */
dvander@27	396	stgwrite("\tlodb.i ");
dvander@27	397	outval(sCHARBITS/8,TRUE); /* read one or two bytes */
dvander@27	398	code_idx+=opcodes(1)+opargs(1);
dvander@27	399	} else if (lval->ident==iREFERENCE) {
dvander@27	400	/* indirect fetch, but address not yet in PRI */
dvander@27	401	assert(sym!=NULL);
dvander@27	402	assert(sym->vclass==sLOCAL);/* global references don't exist in Pawn */
dvander@27	403	if (sym->vclass==sLOCAL)
dvander@27	404	stgwrite("\tlref.s.pri ");
dvander@27	405	else
dvander@27	406	stgwrite("\tlref.pri ");
dvander@27	407	outval(sym->addr,TRUE);
dvander@27	408	markusage(sym,uREAD);
dvander@27	409	code_idx+=opcodes(1)+opargs(1);
dvander@27	410	} else {
dvander@27	411	/* direct or stack relative fetch */
dvander@27	412	assert(sym!=NULL);
dvander@27	413	if (sym->vclass==sLOCAL)
dvander@27	414	stgwrite("\tload.s.pri ");
dvander@27	415	else
dvander@27	416	stgwrite("\tload.pri ");
dvander@27	417	outval(sym->addr,TRUE);
dvander@27	418	markusage(sym,uREAD);
dvander@27	419	code_idx+=opcodes(1)+opargs(1);
dvander@27	420	} /* if */
dvander@27	421	}
dvander@27	422
dvander@27	423	/* Get the address of a symbol into the primary or alternate register (used
dvander@27	424	* for arrays, and for passing arguments by reference).
dvander@27	425	*/
dvander@27	426	SC_FUNC void address(symbol *sym,regid reg)
dvander@27	427	{
dvander@27	428	assert(sym!=NULL);
dvander@27	429	assert(reg==sPRI \|\| reg==sALT);
dvander@27	430	/* the symbol can be a local array, a global array, or an array
dvander@27	431	* that is passed by reference.
dvander@27	432	*/
dvander@27	433	if (sym->ident==iREFARRAY \|\| sym->ident==iREFERENCE) {
dvander@27	434	/* reference to a variable or to an array; currently this is
dvander@27	435	* always a local variable */
dvander@27	436	switch (reg) {
dvander@27	437	case sPRI:
dvander@27	438	stgwrite("\tload.s.pri ");
dvander@27	439	break;
dvander@27	440	case sALT:
dvander@27	441	stgwrite("\tload.s.alt ");
dvander@27	442	break;
dvander@27	443	} /* switch */
dvander@27	444	} else {
dvander@27	445	/* a local array or local variable */
dvander@27	446	switch (reg) {
dvander@27	447	case sPRI:
dvander@27	448	if (sym->vclass==sLOCAL)
dvander@27	449	stgwrite("\taddr.pri ");
dvander@27	450	else
dvander@27	451	stgwrite("\tconst.pri ");
dvander@27	452	break;
dvander@27	453	case sALT:
dvander@27	454	if (sym->vclass==sLOCAL)
dvander@27	455	stgwrite("\taddr.alt ");
dvander@27	456	else
dvander@27	457	stgwrite("\tconst.alt ");
dvander@27	458	break;
dvander@27	459	} /* switch */
dvander@27	460	} /* if */
dvander@27	461	outval(sym->addr,TRUE);
dvander@27	462	markusage(sym,uREAD);
dvander@27	463	code_idx+=opcodes(1)+opargs(1);
dvander@27	464	}
dvander@27	465
dvander@27	466	/* store
dvander@27	467	*
dvander@27	468	* Saves the contents of "primary" into a memory cell, either directly
dvander@27	469	* or indirectly (at the address given in the alternate register).
dvander@27	470	*/
dvander@27	471	SC_FUNC void store(value *lval)
dvander@27	472	{
dvander@27	473	symbol *sym;
dvander@27	474
dvander@27	475	sym=lval->sym;
dvander@27	476	if (lval->ident==iARRAYCELL) {
dvander@27	477	/* store at address in ALT */
dvander@27	478	stgwrite("\tstor.i\n");
dvander@27	479	code_idx+=opcodes(1);
dvander@27	480	} else if (lval->ident==iARRAYCHAR) {
dvander@27	481	/* store at address in ALT */
dvander@27	482	stgwrite("\tstrb.i ");
dvander@27	483	outval(sCHARBITS/8,TRUE); /* write one or two bytes */
dvander@27	484	code_idx+=opcodes(1)+opargs(1);
dvander@27	485	} else if (lval->ident==iREFERENCE) {
dvander@27	486	assert(sym!=NULL);
dvander@27	487	if (sym->vclass==sLOCAL)
dvander@27	488	stgwrite("\tsref.s.pri ");
dvander@27	489	else
dvander@27	490	stgwrite("\tsref.pri ");
dvander@27	491	outval(sym->addr,TRUE);
dvander@27	492	code_idx+=opcodes(1)+opargs(1);
dvander@27	493	} else {
dvander@27	494	assert(sym!=NULL);
dvander@27	495	markusage(sym,uWRITTEN);
dvander@27	496	if (sym->vclass==sLOCAL)
dvander@27	497	stgwrite("\tstor.s.pri ");
dvander@27	498	else
dvander@27	499	stgwrite("\tstor.pri ");
dvander@27	500	outval(sym->addr,TRUE);
dvander@27	501	code_idx+=opcodes(1)+opargs(1);
dvander@27	502	} /* if */
dvander@27	503	}
dvander@27	504
dvander@27	505	/* Get a cell from a fixed address in memory */
dvander@27	506	SC_FUNC void loadreg(cell address,regid reg)
dvander@27	507	{
dvander@27	508	assert(reg==sPRI \|\| reg==sALT);
dvander@27	509	if (reg==sPRI)
dvander@27	510	stgwrite("\tload.pri ");
dvander@27	511	else
dvander@27	512	stgwrite("\tload.alt ");
dvander@27	513	outval(address,TRUE);
dvander@27	514	code_idx+=opcodes(1)+opargs(1);
dvander@27	515	}
dvander@27	516
dvander@27	517	/* Store a cell into a fixed address in memory */
dvander@27	518	SC_FUNC void storereg(cell address,regid reg)
dvander@27	519	{
dvander@27	520	assert(reg==sPRI \|\| reg==sALT);
dvander@27	521	if (reg==sPRI)
dvander@27	522	stgwrite("\tstor.pri ");
dvander@27	523	else
dvander@27	524	stgwrite("\tstor.alt ");
dvander@27	525	outval(address,TRUE);
dvander@27	526	code_idx+=opcodes(1)+opargs(1);
dvander@27	527	}
dvander@27	528
dvander@27	529	/* source must in PRI, destination address in ALT. The "size"
dvander@27	530	* parameter is in bytes, not cells.
dvander@27	531	*/
dvander@27	532	SC_FUNC void memcopy(cell size)
dvander@27	533	{
dvander@27	534	stgwrite("\tmovs ");
dvander@27	535	outval(size,TRUE);
dvander@27	536
dvander@27	537	code_idx+=opcodes(1)+opargs(1);
dvander@27	538	}
dvander@27	539
dvander@27	540	/* Address of the source must already have been loaded in PRI
dvander@27	541	* "size" is the size in bytes (not cells).
dvander@27	542	*/
dvander@27	543	SC_FUNC void copyarray(symbol *sym,cell size)
dvander@27	544	{
dvander@27	545	assert(sym!=NULL);
dvander@27	546	/* the symbol can be a local array, a global array, or an array
dvander@27	547	* that is passed by reference.
dvander@27	548	*/
dvander@27	549	if (sym->ident==iREFARRAY) {
dvander@27	550	/* reference to an array; currently this is always a local variable */
dvander@27	551	assert(sym->vclass==sLOCAL); /* symbol must be stack relative */
dvander@27	552	stgwrite("\tload.s.alt ");
dvander@27	553	} else {
dvander@27	554	/* a local or global array */
dvander@27	555	if (sym->vclass==sLOCAL)
dvander@27	556	stgwrite("\taddr.alt ");
dvander@27	557	else
dvander@27	558	stgwrite("\tconst.alt ");
dvander@27	559	} /* if */
dvander@27	560	outval(sym->addr,TRUE);
dvander@27	561	markusage(sym,uWRITTEN);
dvander@27	562
dvander@27	563	code_idx+=opcodes(1)+opargs(1);
dvander@27	564	memcopy(size);
dvander@27	565	}
dvander@27	566
dvander@27	567	SC_FUNC void fillarray(symbol *sym,cell size,cell value)
dvander@27	568	{
dvander@27	569	ldconst(value,sPRI); /* load value in PRI */
dvander@27	570
dvander@27	571	assert(sym!=NULL);
dvander@27	572	/* the symbol can be a local array, a global array, or an array
dvander@27	573	* that is passed by reference.
dvander@27	574	*/
dvander@27	575	if (sym->ident==iREFARRAY) {
dvander@27	576	/* reference to an array; currently this is always a local variable */
dvander@27	577	assert(sym->vclass==sLOCAL); /* symbol must be stack relative */
dvander@27	578	stgwrite("\tload.s.alt ");
dvander@27	579	} else {
dvander@27	580	/* a local or global array */
dvander@27	581	if (sym->vclass==sLOCAL)
dvander@27	582	stgwrite("\taddr.alt ");
dvander@27	583	else
dvander@27	584	stgwrite("\tconst.alt ");
dvander@27	585	} /* if */
dvander@27	586	outval(sym->addr,TRUE);
dvander@27	587	markusage(sym,uWRITTEN);
dvander@27	588
dvander@27	589	assert(size>0);
dvander@27	590	stgwrite("\tfill ");
dvander@27	591	outval(size,TRUE);
dvander@27	592
dvander@27	593	code_idx+=opcodes(2)+opargs(2);
dvander@27	594	}
dvander@27	595
dvander@200	596	SC_FUNC void stradjust(regid reg)
dvander@200	597	{
dvander@200	598	assert(reg==sPRI);
dvander@200	599	stgwrite("\tstradjust.pri\n");
dvander@200	600	code_idx+=opcodes(1);
dvander@200	601	}
dvander@200	602
dvander@27	603	/* Instruction to get an immediate value into the primary or the alternate
dvander@27	604	* register
dvander@27	605	*/
dvander@27	606	SC_FUNC void ldconst(cell val,regid reg)
dvander@27	607	{
dvander@27	608	assert(reg==sPRI \|\| reg==sALT);
dvander@27	609	switch (reg) {
dvander@27	610	case sPRI:
dvander@27	611	if (val==0) {
dvander@27	612	stgwrite("\tzero.pri\n");
dvander@27	613	code_idx+=opcodes(1);
dvander@27	614	} else {
dvander@27	615	stgwrite("\tconst.pri ");
dvander@27	616	outval(val, TRUE);
dvander@27	617	code_idx+=opcodes(1)+opargs(1);
dvander@27	618	} /* if */
dvander@27	619	break;
dvander@27	620	case sALT:
dvander@27	621	if (val==0) {
dvander@27	622	stgwrite("\tzero.alt\n");
dvander@27	623	code_idx+=opcodes(1);
dvander@27	624	} else {
dvander@27	625	stgwrite("\tconst.alt ");
dvander@27	626	outval(val, TRUE);
dvander@27	627	code_idx+=opcodes(1)+opargs(1);
dvander@27	628	} /* if */
dvander@27	629	break;
dvander@27	630	} /* switch */
dvander@27	631	}
dvander@27	632
dvander@27	633	/* Copy value in alternate register to the primary register */
dvander@27	634	SC_FUNC void moveto1(void)
dvander@27	635	{
dvander@27	636	stgwrite("\tmove.pri\n");
dvander@27	637	code_idx+=opcodes(1)+opargs(0);
dvander@27	638	}
dvander@27	639
dvander@27	640	/* Push primary or the alternate register onto the stack
dvander@27	641	*/
dvander@27	642	SC_FUNC void pushreg(regid reg)
dvander@27	643	{
dvander@27	644	assert(reg==sPRI \|\| reg==sALT);
dvander@27	645	switch (reg) {
dvander@27	646	case sPRI:
dvander@27	647	stgwrite("\tpush.pri\n");
dvander@27	648	break;
dvander@27	649	case sALT:
dvander@27	650	stgwrite("\tpush.alt\n");
dvander@27	651	break;
dvander@27	652	} /* switch */
dvander@27	653	code_idx+=opcodes(1);
dvander@27	654	}
dvander@27	655
dvander@27	656	/*
dvander@27	657	* Push a constant value onto the stack
dvander@27	658	*/
dvander@27	659	SC_FUNC void pushval(cell val)
dvander@27	660	{
dvander@27	661	stgwrite("\tpush.c ");
dvander@27	662	outval(val, TRUE);
dvander@27	663	code_idx+=opcodes(1)+opargs(1);
dvander@27	664	}
dvander@27	665
dvander@27	666	/* Pop stack into the primary or the alternate register
dvander@27	667	*/
dvander@27	668	SC_FUNC void popreg(regid reg)
dvander@27	669	{
dvander@27	670	assert(reg==sPRI \|\| reg==sALT);
dvander@27	671	switch (reg) {
dvander@27	672	case sPRI:
dvander@27	673	stgwrite("\tpop.pri\n");
dvander@27	674	break;
dvander@27	675	case sALT:
dvander@27	676	stgwrite("\tpop.alt\n");
dvander@27	677	break;
dvander@27	678	} /* switch */
dvander@27	679	code_idx+=opcodes(1);
dvander@27	680	}
dvander@27	681
dvander@27	682	/*
dvander@118	683	* Generate an array
dvander@118	684	*/
dvander@123	685	SC_FUNC void genarray(int dims, int _autozero)
dvander@118	686	{
dvander@123	687	if (_autozero) {
dvander@123	688	stgwrite("\tgenarray.z ");
dvander@123	689	} else {
dvander@123	690	stgwrite("\tgenarray ");
dvander@123	691	}
dvander@118	692	outval(dims, TRUE);
dvander@118	693	code_idx+=opcodes(1)+opargs(1);
dvander@118	694	}
dvander@118	695
dvander@118	696	/*
dvander@27	697	* swap the top-of-stack with the value in primary register
dvander@27	698	*/
dvander@27	699	SC_FUNC void swap1(void)
dvander@27	700	{
dvander@27	701	stgwrite("\tswap.pri\n");
dvander@27	702	code_idx+=opcodes(1);
dvander@27	703	}
dvander@27	704
dvander@27	705	/* Switch statements
dvander@27	706	* The "switch" statement generates a "case" table using the "CASE" opcode.
dvander@27	707	* The case table contains a list of records, each record holds a comparison
dvander@27	708	* value and a label to branch to on a match. The very first record is an
dvander@27	709	* exception: it holds the size of the table (excluding the first record) and
dvander@27	710	* the label to branch to when none of the values in the case table match.
dvander@27	711	* The case table is sorted on the comparison value. This allows more advanced
dvander@27	712	* abstract machines to sift the case table with a binary search.
dvander@27	713	*/
dvander@27	714	SC_FUNC void ffswitch(int label)
dvander@27	715	{
dvander@27	716	stgwrite("\tswitch ");
dvander@27	717	outval(label,TRUE); /* the label is the address of the case table */
dvander@27	718	code_idx+=opcodes(1)+opargs(1);
dvander@27	719	}
dvander@27	720
dvander@27	721	SC_FUNC void ffcase(cell value,char *labelname,int newtable)
dvander@27	722	{
dvander@27	723	if (newtable) {
dvander@27	724	stgwrite("\tcasetbl\n");
dvander@27	725	code_idx+=opcodes(1);
dvander@27	726	} /* if */
dvander@27	727	stgwrite("\tcase ");
dvander@27	728	outval(value,FALSE);
dvander@27	729	stgwrite(" ");
dvander@27	730	stgwrite(labelname);
dvander@27	731	stgwrite("\n");
dvander@27	732	code_idx+=opcodes(0)+opargs(2);
dvander@27	733	}
dvander@27	734
dvander@27	735	/*
dvander@27	736	* Call specified function
dvander@27	737	*/
dvander@27	738	SC_FUNC void ffcall(symbol sym,const char label,int numargs)
dvander@27	739	{
dvander@27	740	char symname[2*sNAMEMAX+16];
dvander@798	741	char aliasname[sNAMEMAX+1];
dvander@804	742	int wasAlias = 0;
dvander@27	743
dvander@27	744	assert(sym!=NULL);
dvander@27	745	assert(sym->ident==iFUNCTN);
dvander@27	746	if (sc_asmfile)
dvander@27	747	funcdisplayname(symname,sym->name);
dvander@27	748	if ((sym->usage & uNATIVE)!=0) {
dvander@27	749	/* reserve a SYSREQ id if called for the first time */
dvander@27	750	assert(label==NULL);
dvander@804	751	stgwrite("\tsysreq.c ");
dvander@27	752	if (sc_status==statWRITE && (sym->usage & uREAD)==0 && sym->addr>=0)
dvander@27	753	sym->addr=ntv_funcid++;
dvander@798	754	/* Look for an alias */
dvander@798	755	if (lookup_alias(aliasname, sym->name)) {
dvander@798	756	symbol *asym = findglb(aliasname, sGLOBAL);
dvander@798	757	if (asym && asym->ident==iFUNCTN && ((sym->usage & uNATIVE) != 0)) {
dvander@798	758	sym = asym;
dvander@804	759	if (sc_status==statWRITE && (sym->usage & uREAD)==0 && sym->addr>=0) {
dvander@804	760	sym->addr=ntv_funcid++;
dvander@804	761	markusage(sym, uREAD);
dvander@804	762	}
dvander@798	763	}
dvander@798	764	}
dvander@27	765	outval(sym->addr,FALSE);
dvander@27	766	if (sc_asmfile) {
dvander@27	767	stgwrite("\t; ");
dvander@27	768	stgwrite(symname);
dvander@27	769	} /* if */
dvander@27	770	stgwrite("\n"); /* write on a separate line, to mark a sequence point for the peephole optimizer */
dvander@27	771	stgwrite("\tstack ");
dvander@27	772	outval((numargs+1)*sizeof(cell), TRUE);
dvander@27	773	code_idx+=opcodes(2)+opargs(2);
dvander@27	774	} else {
dvander@27	775	/* normal function */
dvander@27	776	stgwrite("\tcall ");
dvander@27	777	if (label!=NULL) {
dvander@27	778	stgwrite("l.");
dvander@27	779	stgwrite(label);
dvander@27	780	} else {
dvander@27	781	stgwrite(sym->name);
dvander@27	782	} /* if */
dvander@27	783	if (sc_asmfile
dvander@27	784	&& (label!=NULL \|\| !isalpha(sym->name[0]) && sym->name[0]!='_' && sym->name[0]!=sc_ctrlchar))
dvander@27	785	{
dvander@27	786	stgwrite("\t; ");
dvander@27	787	stgwrite(symname);
dvander@27	788	} /* if */
dvander@27	789	stgwrite("\n");
dvander@27	790	code_idx+=opcodes(1)+opargs(1);
dvander@27	791	} /* if */
dvander@27	792	}
dvander@27	793
dvander@27	794	/* Return from function
dvander@27	795	*
dvander@27	796	* Global references: funcstatus (referred to only)
dvander@27	797	*/
dvander@27	798	SC_FUNC void ffret(int remparams)
dvander@27	799	{
dvander@27	800	if (remparams)
dvander@27	801	stgwrite("\tretn\n");
dvander@27	802	else
dvander@27	803	stgwrite("\tret\n");
dvander@27	804	code_idx+=opcodes(1);
dvander@27	805	}
dvander@27	806
dvander@27	807	SC_FUNC void ffabort(int reason)
dvander@27	808	{
dvander@27	809	stgwrite("\thalt ");
dvander@27	810	outval(reason,TRUE);
dvander@27	811	code_idx+=opcodes(1)+opargs(1);
dvander@27	812	}
dvander@27	813
dvander@27	814	SC_FUNC void ffbounds(cell size)
dvander@27	815	{
dvander@27	816	if ((sc_debug & sCHKBOUNDS)!=0) {
dvander@27	817	stgwrite("\tbounds ");
dvander@27	818	outval(size,TRUE);
dvander@27	819	code_idx+=opcodes(1)+opargs(1);
dvander@27	820	} /* if */
dvander@27	821	}
dvander@27	822
dvander@27	823	/*
dvander@27	824	* Jump to local label number (the number is converted to a name)
dvander@27	825	*/
dvander@27	826	SC_FUNC void jumplabel(int number)
dvander@27	827	{
dvander@27	828	stgwrite("\tjump ");
dvander@27	829	outval(number,TRUE);
dvander@27	830	code_idx+=opcodes(1)+opargs(1);
dvander@27	831	}
dvander@27	832
dvander@27	833	/*
dvander@27	834	* Define storage (global and static variables)
dvander@27	835	*/
dvander@27	836	SC_FUNC void defstorage(void)
dvander@27	837	{
dvander@27	838	stgwrite("dump ");
dvander@27	839	}
dvander@27	840
dvander@27	841	/*
dvander@27	842	* Inclrement/decrement stack pointer. Note that this routine does
dvander@27	843	* nothing if the delta is zero.
dvander@27	844	*/
dvander@27	845	SC_FUNC void modstk(int delta)
dvander@27	846	{
dvander@27	847	if (delta) {
dvander@27	848	stgwrite("\tstack ");
dvander@27	849	outval(delta, TRUE);
dvander@27	850	code_idx+=opcodes(1)+opargs(1);
dvander@27	851	} /* if */
dvander@27	852	}
dvander@27	853
dvander@27	854	/* set the stack to a hard offset from the frame */
dvander@27	855	SC_FUNC void setstk(cell value)
dvander@27	856	{
dvander@1931	857	stgwrite("\tstackadjust ");
dvander@27	858	assert(value<=0); /* STK should always become <= FRM */
dvander@1931	859	outval(value, TRUE); /* add (negative) offset */
dvander@1931	860	code_idx+=opcodes(1)+opargs(1);
dvander@27	861	}
dvander@27	862
dvander@27	863	SC_FUNC void modheap(int delta)
dvander@27	864	{
dvander@27	865	if (delta) {
dvander@27	866	stgwrite("\theap ");
dvander@27	867	outval(delta, TRUE);
dvander@27	868	code_idx+=opcodes(1)+opargs(1);
dvander@27	869	} /* if */
dvander@27	870	}
dvander@27	871
dvander@64	872	SC_FUNC void modheap_i()
dvander@64	873	{
dvander@129	874	stgwrite("\ttracker.pop.setheap\n");
dvander@118	875	code_idx+=opcodes(1);
dvander@64	876	}
dvander@64	877
dvander@64	878	SC_FUNC void setheap_save(cell value)
dvander@64	879	{
dvander@65	880	assert(value);
dvander@129	881	stgwrite("\ttracker.push.c ");
dvander@64	882	outval(value, TRUE);
dvander@64	883	code_idx+=opcodes(1)+opargs(1);
dvander@64	884	}
dvander@64	885
dvander@27	886	SC_FUNC void setheap_pri(void)
dvander@27	887	{
dvander@27	888	stgwrite("\theap "); /* ALT = HEA++ */
dvander@27	889	outval(sizeof(cell), TRUE);
dvander@27	890	stgwrite("\tstor.i\n"); /* store PRI (default value) at address ALT */
dvander@27	891	stgwrite("\tmove.pri\n"); /* move ALT to PRI: PRI contains the address */
dvander@27	892	code_idx+=opcodes(3)+opargs(1);
dvander@27	893	}
dvander@27	894
dvander@27	895	SC_FUNC void setheap(cell value)
dvander@27	896	{
dvander@27	897	stgwrite("\tconst.pri "); /* load default value in PRI */
dvander@27	898	outval(value, TRUE);
dvander@27	899	code_idx+=opcodes(1)+opargs(1);
dvander@27	900	setheap_pri();
dvander@27	901	}
dvander@27	902
dvander@27	903	/*
dvander@27	904	* Convert a cell number to a "byte" address; i.e. double or quadruple
dvander@27	905	* the primary register.
dvander@27	906	*/
dvander@27	907	SC_FUNC void cell2addr(void)
dvander@27	908	{
dvander@27	909	#if PAWN_CELL_SIZE==16
dvander@27	910	stgwrite("\tshl.c.pri 1\n");
dvander@27	911	#elif PAWN_CELL_SIZE==32
dvander@27	912	stgwrite("\tshl.c.pri 2\n");
dvander@27	913	#elif PAWN_CELL_SIZE==64
dvander@27	914	stgwrite("\tshl.c.pri 3\n");
dvander@27	915	#else
dvander@27	916	#error Unsupported cell size
dvander@27	917	#endif
dvander@27	918	code_idx+=opcodes(1)+opargs(1);
dvander@27	919	}
dvander@27	920
dvander@27	921	/*
dvander@27	922	* Double or quadruple the alternate register.
dvander@27	923	*/
dvander@27	924	SC_FUNC void cell2addr_alt(void)
dvander@27	925	{
dvander@27	926	#if PAWN_CELL_SIZE==16
dvander@27	927	stgwrite("\tshl.c.alt 1\n");
dvander@27	928	#elif PAWN_CELL_SIZE==32
dvander@27	929	stgwrite("\tshl.c.alt 2\n");
dvander@27	930	#elif PAWN_CELL_SIZE==64
dvander@27	931	stgwrite("\tshl.c.alt 3\n");
dvander@27	932	#else
dvander@27	933	#error Unsupported cell size
dvander@27	934	#endif
dvander@27	935	code_idx+=opcodes(1)+opargs(1);
dvander@27	936	}
dvander@27	937
dvander@27	938	/*
dvander@27	939	* Convert "distance of addresses" to "number of cells" in between.
dvander@27	940	* Or convert a number of packed characters to the number of cells (with
dvander@27	941	* truncation).
dvander@27	942	*/
dvander@27	943	SC_FUNC void addr2cell(void)
dvander@27	944	{
dvander@27	945	#if PAWN_CELL_SIZE==16
dvander@27	946	stgwrite("\tshr.c.pri 1\n");
dvander@27	947	#elif PAWN_CELL_SIZE==32
dvander@27	948	stgwrite("\tshr.c.pri 2\n");
dvander@27	949	#elif PAWN_CELL_SIZE==64
dvander@27	950	stgwrite("\tshr.c.pri 3\n");
dvander@27	951	#else
dvander@27	952	#error Unsupported cell size
dvander@27	953	#endif
dvander@27	954	code_idx+=opcodes(1)+opargs(1);
dvander@27	955	}
dvander@27	956
dvander@27	957	/* Convert from character index to byte address. This routine does
dvander@27	958	* nothing if a character has the size of a byte.
dvander@27	959	*/
dvander@27	960	SC_FUNC void char2addr(void)
dvander@27	961	{
dvander@27	962	#if sCHARBITS==16
dvander@27	963	stgwrite("\tshl.c.pri 1\n");
dvander@27	964	code_idx+=opcodes(1)+opargs(1);
dvander@27	965	#endif
dvander@27	966	}
dvander@27	967
dvander@27	968	/* Align PRI (which should hold a character index) to an address.
dvander@27	969	* The first character in a "pack" occupies the highest bits of
dvander@27	970	* the cell. This is at the lower memory address on Big Endian
dvander@27	971	* computers and on the higher address on Little Endian computers.
dvander@27	972	* The ALIGN.pri/alt instructions must solve this machine dependence;
dvander@27	973	* that is, on Big Endian computers, ALIGN.pri/alt shuold do nothing
dvander@27	974	* and on Little Endian computers they should toggle the address.
dvander@151	975	*
dvander@151	976	* NOTE: For Source Pawn, this is fliped. It will do nothing on Little-Endian.
dvander@27	977	*/
dvander@27	978	SC_FUNC void charalign(void)
dvander@27	979	{
dvander@151	980	#if 0 /* TEMPORARILY DISABLED BECAUSE WE DON'T USE BIG ENDIAN */
dvander@27	981	stgwrite("\talign.pri ");
dvander@27	982	outval(sCHARBITS/8,TRUE);
dvander@27	983	code_idx+=opcodes(1)+opargs(1);
dvander@151	984	#endif
dvander@27	985	}
dvander@27	986
dvander@27	987	/*
dvander@27	988	* Add a constant to the primary register.
dvander@27	989	*/
dvander@27	990	SC_FUNC void addconst(cell value)
dvander@27	991	{
dvander@27	992	if (value!=0) {
dvander@27	993	stgwrite("\tadd.c ");
dvander@27	994	outval(value,TRUE);
dvander@27	995	code_idx+=opcodes(1)+opargs(1);
dvander@27	996	} /* if */
dvander@27	997	}
dvander@27	998
dvander@27	999	/*
dvander@27	1000	* signed multiply of primary and secundairy registers (result in primary)
dvander@27	1001	*/
dvander@27	1002	SC_FUNC void os_mult(void)
dvander@27	1003	{
dvander@27	1004	stgwrite("\tsmul\n");
dvander@27	1005	code_idx+=opcodes(1);
dvander@27	1006	}
dvander@27	1007
dvander@27	1008	/*
dvander@27	1009	* signed divide of alternate register by primary register (quotient in
dvander@27	1010	* primary; remainder in alternate)
dvander@27	1011	*/
dvander@27	1012	SC_FUNC void os_div(void)
dvander@27	1013	{
dvander@27	1014	stgwrite("\tsdiv.alt\n");
dvander@27	1015	code_idx+=opcodes(1);
dvander@27	1016	}
dvander@27	1017
dvander@27	1018	/*
dvander@27	1019	* modulus of (alternate % primary), result in primary (signed)
dvander@27	1020	*/
dvander@27	1021	SC_FUNC void os_mod(void)
dvander@27	1022	{
dvander@27	1023	stgwrite("\tsdiv.alt\n");
dvander@27	1024	stgwrite("\tmove.pri\n"); /* move ALT to PRI */
dvander@27	1025	code_idx+=opcodes(2);
dvander@27	1026	}
dvander@27	1027
dvander@27	1028	/*
dvander@27	1029	* Add primary and alternate registers (result in primary).
dvander@27	1030	*/
dvander@27	1031	SC_FUNC void ob_add(void)
dvander@27	1032	{
dvander@27	1033	stgwrite("\tadd\n");
dvander@27	1034	code_idx+=opcodes(1);
dvander@27	1035	}
dvander@27	1036
dvander@27	1037	/*
dvander@27	1038	* subtract primary register from alternate register (result in primary)
dvander@27	1039	*/
dvander@27	1040	SC_FUNC void ob_sub(void)
dvander@27	1041	{
dvander@27	1042	stgwrite("\tsub.alt\n");
dvander@27	1043	code_idx+=opcodes(1);
dvander@27	1044	}
dvander@27	1045
dvander@27	1046	/*
dvander@27	1047	* arithmic shift left alternate register the number of bits
dvander@27	1048	* given in the primary register (result in primary).
dvander@27	1049	* There is no need for a "logical shift left" routine, since
dvander@27	1050	* logical shift left is identical to arithmic shift left.
dvander@27	1051	*/
dvander@27	1052	SC_FUNC void ob_sal(void)
dvander@27	1053	{
dvander@27	1054	stgwrite("\txchg\n");
dvander@27	1055	stgwrite("\tshl\n");
dvander@27	1056	code_idx+=opcodes(2);
dvander@27	1057	}
dvander@27	1058
dvander@27	1059	/*
dvander@27	1060	* arithmic shift right alternate register the number of bits
dvander@27	1061	* given in the primary register (result in primary).
dvander@27	1062	*/
dvander@27	1063	SC_FUNC void os_sar(void)
dvander@27	1064	{
dvander@27	1065	stgwrite("\txchg\n");
dvander@27	1066	stgwrite("\tsshr\n");
dvander@27	1067	code_idx+=opcodes(2);
dvander@27	1068	}
dvander@27	1069
dvander@27	1070	/*
dvander@27	1071	* logical (unsigned) shift right of the alternate register by the
dvander@27	1072	* number of bits given in the primary register (result in primary).
dvander@27	1073	*/
dvander@27	1074	SC_FUNC void ou_sar(void)
dvander@27	1075	{
dvander@27	1076	stgwrite("\txchg\n");
dvander@27	1077	stgwrite("\tshr\n");
dvander@27	1078	code_idx+=opcodes(2);
dvander@27	1079	}
dvander@27	1080
dvander@27	1081	/*
dvander@27	1082	* inclusive "or" of primary and alternate registers (result in primary)
dvander@27	1083	*/
dvander@27	1084	SC_FUNC void ob_or(void)
dvander@27	1085	{
dvander@27	1086	stgwrite("\tor\n");
dvander@27	1087	code_idx+=opcodes(1);
dvander@27	1088	}
dvander@27	1089
dvander@27	1090	/*
dvander@27	1091	* "exclusive or" of primary and alternate registers (result in primary)
dvander@27	1092	*/
dvander@27	1093	SC_FUNC void ob_xor(void)
dvander@27	1094	{
dvander@27	1095	stgwrite("\txor\n");
dvander@27	1096	code_idx+=opcodes(1);
dvander@27	1097	}
dvander@27	1098
dvander@27	1099	/*
dvander@27	1100	* "and" of primary and secundairy registers (result in primary)
dvander@27	1101	*/
dvander@27	1102	SC_FUNC void ob_and(void)
dvander@27	1103	{
dvander@27	1104	stgwrite("\tand\n");
dvander@27	1105	code_idx+=opcodes(1);
dvander@27	1106	}
dvander@27	1107
dvander@27	1108	/*
dvander@27	1109	* test ALT==PRI; result in primary register (1 or 0).
dvander@27	1110	*/
dvander@27	1111	SC_FUNC void ob_eq(void)
dvander@27	1112	{
dvander@27	1113	stgwrite("\teq\n");
dvander@27	1114	code_idx+=opcodes(1);
dvander@27	1115	}
dvander@27	1116
dvander@27	1117	/*
dvander@27	1118	* test ALT!=PRI
dvander@27	1119	*/
dvander@27	1120	SC_FUNC void ob_ne(void)
dvander@27	1121	{
dvander@27	1122	stgwrite("\tneq\n");
dvander@27	1123	code_idx+=opcodes(1);
dvander@27	1124	}
dvander@27	1125
dvander@27	1126	/* The abstract machine defines the relational instructions so that PRI is
dvander@27	1127	* on the left side and ALT on the right side of the operator. For example,
dvander@27	1128	* SLESS sets PRI to either 1 or 0 depending on whether the expression
dvander@27	1129	* "PRI < ALT" is true.
dvander@27	1130	*
dvander@27	1131	* The compiler generates comparisons with ALT on the left side of the
dvander@27	1132	* relational operator and PRI on the right side. The XCHG instruction
dvander@27	1133	* prefixing the relational operators resets this. We leave it to the
dvander@27	1134	* peephole optimizer to choose more compact instructions where possible.
dvander@27	1135	*/
dvander@27	1136
dvander@27	1137	/* Relational operator prefix for chained relational expressions. The
dvander@27	1138	* "suffix" code restores the stack.
dvander@27	1139	* For chained relational operators, the goal is to keep the comparison
dvander@27	1140	* result "so far" in PRI and the value of the most recent operand in
dvander@27	1141	* ALT, ready for a next comparison.
dvander@27	1142	* The "prefix" instruction pushed the comparison result (PRI) onto the
dvander@27	1143	* stack and moves the value of ALT into PRI. If there is a next comparison,
dvander@27	1144	* PRI can now serve as the "left" operand of the relational operator.
dvander@27	1145	*/
dvander@27	1146	SC_FUNC void relop_prefix(void)
dvander@27	1147	{
dvander@27	1148	stgwrite("\tpush.pri\n");
dvander@27	1149	stgwrite("\tmove.pri\n");
dvander@27	1150	code_idx+=opcodes(2);
dvander@27	1151	}
dvander@27	1152
dvander@27	1153	SC_FUNC void relop_suffix(void)
dvander@27	1154	{
dvander@27	1155	stgwrite("\tswap.alt\n");
dvander@27	1156	stgwrite("\tand\n");
dvander@27	1157	stgwrite("\tpop.alt\n");
dvander@27	1158	code_idx+=opcodes(3);
dvander@27	1159	}
dvander@27	1160
dvander@27	1161	/*
dvander@27	1162	* test ALT<PRI (signed)
dvander@27	1163	*/
dvander@27	1164	SC_FUNC void os_lt(void)
dvander@27	1165	{
dvander@27	1166	stgwrite("\txchg\n");
dvander@27	1167	stgwrite("\tsless\n");
dvander@27	1168	code_idx+=opcodes(2);
dvander@27	1169	}
dvander@27	1170
dvander@27	1171	/*
dvander@27	1172	* test ALT<=PRI (signed)
dvander@27	1173	*/
dvander@27	1174	SC_FUNC void os_le(void)
dvander@27	1175	{
dvander@27	1176	stgwrite("\txchg\n");
dvander@27	1177	stgwrite("\tsleq\n");
dvander@27	1178	code_idx+=opcodes(2);
dvander@27	1179	}
dvander@27	1180
dvander@27	1181	/*
dvander@27	1182	* test ALT>PRI (signed)
dvander@27	1183	*/
dvander@27	1184	SC_FUNC void os_gt(void)
dvander@27	1185	{
dvander@27	1186	stgwrite("\txchg\n");
dvander@27	1187	stgwrite("\tsgrtr\n");
dvander@27	1188	code_idx+=opcodes(2);
dvander@27	1189	}
dvander@27	1190
dvander@27	1191	/*
dvander@27	1192	* test ALT>=PRI (signed)
dvander@27	1193	*/
dvander@27	1194	SC_FUNC void os_ge(void)
dvander@27	1195	{
dvander@27	1196	stgwrite("\txchg\n");
dvander@27	1197	stgwrite("\tsgeq\n");
dvander@27	1198	code_idx+=opcodes(2);
dvander@27	1199	}
dvander@27	1200
dvander@27	1201	/*
dvander@27	1202	* logical negation of primary register
dvander@27	1203	*/
dvander@27	1204	SC_FUNC void lneg(void)
dvander@27	1205	{
dvander@27	1206	stgwrite("\tnot\n");
dvander@27	1207	code_idx+=opcodes(1);
dvander@27	1208	}
dvander@27	1209
dvander@27	1210	/*
dvander@27	1211	* two's complement primary register
dvander@27	1212	*/
dvander@27	1213	SC_FUNC void neg(void)
dvander@27	1214	{
dvander@27	1215	stgwrite("\tneg\n");
dvander@27	1216	code_idx+=opcodes(1);
dvander@27	1217	}
dvander@27	1218
dvander@27	1219	/*
dvander@27	1220	* one's complement of primary register
dvander@27	1221	*/
dvander@27	1222	SC_FUNC void invert(void)
dvander@27	1223	{
dvander@27	1224	stgwrite("\tinvert\n");
dvander@27	1225	code_idx+=opcodes(1);
dvander@27	1226	}
dvander@27	1227
dvander@27	1228	/*
dvander@27	1229	* nop
dvander@27	1230	*/
dvander@27	1231	SC_FUNC void nooperation(void)
dvander@27	1232	{
dvander@27	1233	stgwrite("\tnop\n");
dvander@27	1234	code_idx+=opcodes(1);
dvander@27	1235	}
dvander@27	1236
dvander@27	1237
dvander@27	1238	/* increment symbol
dvander@27	1239	*/
dvander@27	1240	SC_FUNC void inc(value *lval)
dvander@27	1241	{
dvander@27	1242	symbol *sym;
dvander@27	1243
dvander@27	1244	sym=lval->sym;
dvander@27	1245	if (lval->ident==iARRAYCELL) {
dvander@27	1246	/* indirect increment, address already in PRI */
dvander@27	1247	stgwrite("\tinc.i\n");
dvander@27	1248	code_idx+=opcodes(1);
dvander@27	1249	} else if (lval->ident==iARRAYCHAR) {
dvander@27	1250	/* indirect increment of single character, address already in PRI */
dvander@27	1251	stgwrite("\tpush.pri\n");
dvander@27	1252	stgwrite("\tpush.alt\n");
dvander@27	1253	stgwrite("\tmove.alt\n"); /* copy address */
dvander@27	1254	stgwrite("\tlodb.i "); /* read from PRI into PRI */
dvander@27	1255	outval(sCHARBITS/8,TRUE); /* read one or two bytes */
dvander@27	1256	stgwrite("\tinc.pri\n");
dvander@27	1257	stgwrite("\tstrb.i "); /* write PRI to ALT */
dvander@27	1258	outval(sCHARBITS/8,TRUE); /* write one or two bytes */
dvander@27	1259	stgwrite("\tpop.alt\n");
dvander@27	1260	stgwrite("\tpop.pri\n");
dvander@27	1261	code_idx+=opcodes(8)+opargs(2);
dvander@27	1262	} else if (lval->ident==iREFERENCE) {
dvander@27	1263	assert(sym!=NULL);
dvander@27	1264	stgwrite("\tpush.pri\n");
dvander@27	1265	/* load dereferenced value */
dvander@27	1266	assert(sym->vclass==sLOCAL); /* global references don't exist in Pawn */
dvander@27	1267	if (sym->vclass==sLOCAL)
dvander@27	1268	stgwrite("\tlref.s.pri ");
dvander@27	1269	else
dvander@27	1270	stgwrite("\tlref.pri ");
dvander@27	1271	outval(sym->addr,TRUE);
dvander@27	1272	/* increment */
dvander@27	1273	stgwrite("\tinc.pri\n");
dvander@27	1274	/* store dereferenced value */
dvander@27	1275	if (sym->vclass==sLOCAL)
dvander@27	1276	stgwrite("\tsref.s.pri ");
dvander@27	1277	else
dvander@27	1278	stgwrite("\tsref.pri ");
dvander@27	1279	outval(sym->addr,TRUE);
dvander@27	1280	stgwrite("\tpop.pri\n");
dvander@27	1281	code_idx+=opcodes(5)+opargs(2);
dvander@27	1282	} else {
dvander@27	1283	/* local or global variable */
dvander@27	1284	assert(sym!=NULL);
dvander@27	1285	if (sym->vclass==sLOCAL)
dvander@27	1286	stgwrite("\tinc.s ");
dvander@27	1287	else
dvander@27	1288	stgwrite("\tinc ");
dvander@27	1289	outval(sym->addr,TRUE);
dvander@27	1290	code_idx+=opcodes(1)+opargs(1);
dvander@27	1291	} /* if */
dvander@27	1292	}
dvander@27	1293
dvander@27	1294	/* decrement symbol
dvander@27	1295	*
dvander@27	1296	* in case of an integer pointer, the symbol must be incremented by 2.
dvander@27	1297	*/
dvander@27	1298	SC_FUNC void dec(value *lval)
dvander@27	1299	{
dvander@27	1300	symbol *sym;
dvander@27	1301
dvander@27	1302	sym=lval->sym;
dvander@27	1303	if (lval->ident==iARRAYCELL) {
dvander@27	1304	/* indirect decrement, address already in PRI */
dvander@27	1305	stgwrite("\tdec.i\n");
dvander@27	1306	code_idx+=opcodes(1);
dvander@27	1307	} else if (lval->ident==iARRAYCHAR) {
dvander@27	1308	/* indirect decrement of single character, address already in PRI */
dvander@27	1309	stgwrite("\tpush.pri\n");
dvander@27	1310	stgwrite("\tpush.alt\n");
dvander@27	1311	stgwrite("\tmove.alt\n"); /* copy address */
dvander@27	1312	stgwrite("\tlodb.i "); /* read from PRI into PRI */
dvander@27	1313	outval(sCHARBITS/8,TRUE); /* read one or two bytes */
dvander@27	1314	stgwrite("\tdec.pri\n");
dvander@27	1315	stgwrite("\tstrb.i "); /* write PRI to ALT */
dvander@27	1316	outval(sCHARBITS/8,TRUE); /* write one or two bytes */
dvander@27	1317	stgwrite("\tpop.alt\n");
dvander@27	1318	stgwrite("\tpop.pri\n");
dvander@27	1319	code_idx+=opcodes(8)+opargs(2);
dvander@27	1320	} else if (lval->ident==iREFERENCE) {
dvander@27	1321	assert(sym!=NULL);
dvander@27	1322	stgwrite("\tpush.pri\n");
dvander@27	1323	/* load dereferenced value */
dvander@27	1324	assert(sym->vclass==sLOCAL); /* global references don't exist in Pawn */
dvander@27	1325	if (sym->vclass==sLOCAL)
dvander@27	1326	stgwrite("\tlref.s.pri ");
dvander@27	1327	else
dvander@27	1328	stgwrite("\tlref.pri ");
dvander@27	1329	outval(sym->addr,TRUE);
dvander@27	1330	/* decrement */
dvander@27	1331	stgwrite("\tdec.pri\n");
dvander@27	1332	/* store dereferenced value */
dvander@27	1333	if (sym->vclass==sLOCAL)
dvander@27	1334	stgwrite("\tsref.s.pri ");
dvander@27	1335	else
dvander@27	1336	stgwrite("\tsref.pri ");
dvander@27	1337	outval(sym->addr,TRUE);
dvander@27	1338	stgwrite("\tpop.pri\n");
dvander@27	1339	code_idx+=opcodes(5)+opargs(2);
dvander@27	1340	} else {
dvander@27	1341	/* local or global variable */
dvander@27	1342	assert(sym!=NULL);
dvander@27	1343	if (sym->vclass==sLOCAL)
dvander@27	1344	stgwrite("\tdec.s ");
dvander@27	1345	else
dvander@27	1346	stgwrite("\tdec ");
dvander@27	1347	outval(sym->addr,TRUE);
dvander@27	1348	code_idx+=opcodes(1)+opargs(1);
dvander@27	1349	} /* if */
dvander@27	1350	}
dvander@27	1351
dvander@27	1352	/*
dvander@27	1353	* Jumps to "label" if PRI != 0
dvander@27	1354	*/
dvander@27	1355	SC_FUNC void jmp_ne0(int number)
dvander@27	1356	{
dvander@27	1357	stgwrite("\tjnz ");
dvander@27	1358	outval(number,TRUE);
dvander@27	1359	code_idx+=opcodes(1)+opargs(1);
dvander@27	1360	}
dvander@27	1361
dvander@27	1362	/*
dvander@27	1363	* Jumps to "label" if PRI == 0
dvander@27	1364	*/
dvander@27	1365	SC_FUNC void jmp_eq0(int number)
dvander@27	1366	{
dvander@27	1367	stgwrite("\tjzer ");
dvander@27	1368	outval(number,TRUE);
dvander@27	1369	code_idx+=opcodes(1)+opargs(1);
dvander@27	1370	}
dvander@27	1371
dvander@27	1372	/* write a value in hexadecimal; optionally adds a newline */
dvander@27	1373	SC_FUNC void outval(cell val,int newline)
dvander@27	1374	{
dvander@27	1375	stgwrite(itoh(val));
dvander@27	1376	if (newline)
dvander@27	1377	stgwrite("\n");
dvander@27	1378	}

author	David Anderson <dvander@alliedmods.net>
	Wed Feb 25 20:07:12 2009 -0500 (2009-02-25)
changeset 2607	f3b8bbe17f85
parent 2289	44045ead61cd
child 3951	c3f26df2183f
permissions	-rw-r--r--