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