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