1 /*---------------------------------------------------------------------
2 Copyright (c) 2008 - 2021, Charles Childers
3
4 Portions are based on Ngaro, which was additionally copyrighted by
5 the following:
6
7 Copyright (c) 2009 - 2010, Luke Parrish
8 Copyright (c) 2010, Marc Simpson
9 Copyright (c) 2010, Jay Skeer
10 Copyright (c) 2011, Kenneth Keating
11 ---------------------------------------------------------------------*/
12
13 #include <ctype.h>
14 #include <errno.h>
15 #include <fcntl.h>
16 #include <limits.h>
17 #include <signal.h>
18 #include <stdio.h>
19 #include <stdlib.h>
20 #include <string.h>
21 #include <sys/stat.h>
22 #include <sys/types.h>
23 #include <time.h>
24
25 #ifdef ENABLE_FLOATS
26 #include <math.h>
27 #endif
28
29 #ifdef ENABLE_SOCKETS
30 #include <arpa/inet.h>
31 #include <netdb.h>
32 #include <netinet/in.h>
33 #include <sys/socket.h>
34 #endif
35
36 #ifdef ENABLE_UNIX
37 #include <sys/wait.h>
38 #include <unistd.h>
39 #endif
40
41 #ifdef _WIN32
42 #define NEEDS_STRL
43 #endif
44
45 #ifdef _WIN64
46 #define NEEDS_STRL
47 #endif
48
49 #if defined(__APPLE__) && defined(__MACH__)
50 #ifdef NEEDS_STRL
51 #undef NEEDS_STRL
52 #endif
53 #endif
54
55 /* Configuration ----------------------------------------------------- */
56 #ifndef BIT64
57 #define CELL int32_t
58 #define CELL_MIN INT_MIN + 1
59 #define CELL_MAX INT_MAX - 1
60 #else
61 #define CELL int64_t
62 #define CELL_MIN LLONG_MIN + 1
63 #define CELL_MAX LLONG_MAX - 1
64 #endif
65
66 #ifndef IMAGE_SIZE
67 #define IMAGE_SIZE 524288 /* Amount of RAM, in cells */
68 #endif
69
70 #ifndef ADDRESSES
71 #define ADDRESSES 256 /* Depth of address stack */
72 #endif
73
74 #ifndef STACK_DEPTH
75 #define STACK_DEPTH 256 /* Depth of data stack */
76 #endif
77
78 #define TIB 1025 /* Location of TIB */
79
80 #define D_OFFSET_LINK 0 /* Dictionary Format Info. Update if */
81 #define D_OFFSET_XT 1 /* you change the dictionary fields. */
82 #define D_OFFSET_CLASS 2
83 #define D_OFFSET_NAME 3
84
85 #define MAX_DEVICES 32
86 #define MAX_OPEN_FILES 32
87
88 #include "image.c"
89
90 /* Function Prototypes ----------------------------------------------- */
91 CELL stack_pop();
92 void stack_push(CELL value);
93 CELL string_inject(char *str, CELL buffer);
94 char *string_extract(CELL at);
95 CELL d_xt_for(char *Name, CELL Dictionary);
96 void update_rx();
97 void include_file(char *fname, int run_tests);
98
99 void register_device(void *handler, void *query);
100
101 void io_output(); void query_output();
102 void io_keyboard(); void query_keyboard();
103 void query_filesystem(); void io_filesystem();
104 void io_clock(); void query_clock();
105 void io_scripting(); void query_scripting();
106 void io_rng(); void query_rng();
107
108 #ifdef ENABLE_UNIX
109 void query_unix(); void io_unix();
110 #endif
111
112 #ifdef ENABLE_FLOATS
113 void io_floatingpoint(); void query_floatingpoint();
114 #endif
115
116 #ifdef ENABLE_SOCKETS
117 void io_socket(); void query_socket();
118 #endif
119
120 void io_image(); void query_image();
121
122 void load_embedded_image();
123 CELL load_image();
124 void prepare_vm();
125 void process_opcode_bundle(CELL opcode);
126 int validate_opcode_bundle(CELL opcode);
127
128 #ifdef NEEDS_STRL
129 size_t strlcat(char *dst, const char *src, size_t dsize);
130 size_t strlcpy(char *dst, const char *src, size_t dsize);
131 #endif
132
133 void prepare_vm();
134
135 void inst_no(); void inst_li(); void inst_du();
136 void inst_dr(); void inst_sw(); void inst_pu();
137 void inst_po(); void inst_ju(); void inst_ca();
138 void inst_cc(); void inst_re(); void inst_eq();
139 void inst_ne(); void inst_lt(); void inst_gt();
140 void inst_fe(); void inst_st(); void inst_ad();
141 void inst_su(); void inst_mu(); void inst_di();
142 void inst_an(); void inst_or(); void inst_xo();
143 void inst_sh(); void inst_zr(); void inst_ha();
144 void inst_ie(); void inst_iq(); void inst_ii();
145
146
147 /* Image, Stack, and VM variables ------------------------------------ */
148 CELL memory[IMAGE_SIZE + 1]; /* The memory for the image */
149
150 #define TOS cpu.data[cpu.sp] /* Top item on stack */
151 #define NOS cpu.data[cpu.sp-1] /* Second item on stack */
152 #define TORS cpu.address[cpu.rp] /* Top item on address stack */
153
154 struct NgaCore {
155 CELL sp, rp, ip; /* Stack & instruction pointers */
156 CELL data[STACK_DEPTH]; /* The data stack */
157 CELL address[ADDRESSES]; /* The address stack */
158 } cpu;
159
160 int devices; /* The number of I/O devices */
161
162
163 /* Markers for code & test blocks ------------------------------------ */
164 char code_start[33], code_end[33], test_start[33], test_end[33];
165
166 /* Populate The I/O Device Tables ------------------------------------ */
167 typedef void (*Handler)(void);
168 Handler IO_deviceHandlers[MAX_DEVICES];
169 Handler IO_queryHandlers[MAX_DEVICES];
170
171 /* Global Variables -------------------------------------------------- */
172 CELL Compiler, Dictionary, NotFound, interpret;
173
174 char string_data[8192];
175 char **sys_argv;
176 int sys_argc;
177 char scripting_sources[64][8192];
178 int current_source;
179 int perform_abort;
180
181
182 /* Floating Point ---------------------------------------------------- */
183 #ifdef ENABLE_FLOATS
184 double Floats[256], AFloats[256];
185 CELL fsp, afsp;
186
float_guard()187 void float_guard() {
188 if (fsp < 0 || fsp > 255) {
189 printf("\nERROR (nga/float_guard): Float Stack Limits Exceeded!\n");
190 printf("At %lld, fsp = %lld\n", (long long)cpu.ip, (long long)fsp);
191 exit(1);
192 }
193 if (afsp < 0 || afsp > 255) {
194 printf("\nERROR (nga/float_guard): Alternate Float Stack Limits Exceeded!\n");
195 printf("At %lld, afsp = %lld\n", (long long)cpu.ip, (long long)afsp);
196 exit(1);
197 }
198 }
199
200 /*---------------------------------------------------------------------
201 The first two functions push a float to the stack and pop a value off
202 the stack.
203 ---------------------------------------------------------------------*/
204
float_push(double value)205 void float_push(double value) {
206 fsp++;
207 float_guard();
208 Floats[fsp] = value;
209 }
210
float_pop()211 double float_pop() {
212 fsp--;
213 float_guard();
214 return Floats[fsp + 1];
215 }
216
float_to_alt()217 void float_to_alt() {
218 afsp++;
219 float_guard();
220 AFloats[afsp] = float_pop();
221 }
222
float_from_alt()223 void float_from_alt() {
224 float_push(AFloats[afsp]);
225 afsp--;
226 float_guard();
227 }
228
229
230 /*---------------------------------------------------------------------
231 RETRO operates on 32-bit signed integer values. This function just
232 pops a number from the data stack, casts it to a float, and pushes it
233 to the float stack.
234 ---------------------------------------------------------------------*/
float_from_number()235 void float_from_number() {
236 float_push((double)stack_pop());
237 }
238
239
240 /*---------------------------------------------------------------------
241 To get a float from a string in the image, I provide this function.
242 I cheat: using `atof()` takes care of the details, so I don't have
243 to.
244 ---------------------------------------------------------------------*/
float_from_string()245 void float_from_string() {
246 float_push(atof(string_extract(stack_pop())));
247 }
248
249
250 /*---------------------------------------------------------------------
251 Converting a floating point into a string is slightly more work. Here
252 I pass it off to `snprintf()` to deal with.
253 ---------------------------------------------------------------------*/
float_to_string()254 void float_to_string() {
255 snprintf(string_data, 8192, "%f", float_pop());
256 string_inject(string_data, stack_pop());
257 }
258
259
260 /*---------------------------------------------------------------------
261 Converting a floating point back into a standard number requires a
262 little care due to the signed nature. This makes adjustments for the
263 max & min value, and then casts (rounding) the float back to a normal
264 number.
265 ---------------------------------------------------------------------*/
266
float_to_number()267 void float_to_number() {
268 double a = float_pop();
269 if (a > 2147483647)
270 a = 2147483647;
271 if (a < -2147483648)
272 a = -2147483648;
273 stack_push((CELL)round(a));
274 }
275
float_add()276 void float_add() {
277 double a = float_pop();
278 double b = float_pop();
279 float_push(a+b);
280 }
281
float_sub()282 void float_sub() {
283 double a = float_pop();
284 double b = float_pop();
285 float_push(b-a);
286 }
287
float_mul()288 void float_mul() {
289 double a = float_pop();
290 double b = float_pop();
291 float_push(a*b);
292 }
293
float_div()294 void float_div() {
295 double a = float_pop();
296 double b = float_pop();
297 float_push(b/a);
298 }
299
float_floor()300 void float_floor() {
301 float_push(floor(float_pop()));
302 }
303
float_ceil()304 void float_ceil() {
305 float_push(ceil(float_pop()));
306 }
307
float_eq()308 void float_eq() {
309 double a = float_pop();
310 double b = float_pop();
311 if (a == b)
312 stack_push(-1);
313 else
314 stack_push(0);
315 }
316
float_neq()317 void float_neq() {
318 double a = float_pop();
319 double b = float_pop();
320 if (a != b)
321 stack_push(-1);
322 else
323 stack_push(0);
324 }
325
float_lt()326 void float_lt() {
327 double a = float_pop();
328 double b = float_pop();
329 if (b < a)
330 stack_push(-1);
331 else
332 stack_push(0);
333 }
334
float_gt()335 void float_gt() {
336 double a = float_pop();
337 double b = float_pop();
338 if (b > a)
339 stack_push(-1);
340 else
341 stack_push(0);
342 }
343
float_depth()344 void float_depth() {
345 stack_push(fsp);
346 }
347
float_adepth()348 void float_adepth() {
349 stack_push(afsp);
350 }
351
float_dup()352 void float_dup() {
353 double a = float_pop();
354 float_push(a);
355 float_push(a);
356 }
357
float_drop()358 void float_drop() {
359 float_pop();
360 }
361
float_swap()362 void float_swap() {
363 double a = float_pop();
364 double b = float_pop();
365 float_push(a);
366 float_push(b);
367 }
368
float_log()369 void float_log() {
370 double a = float_pop();
371 double b = float_pop();
372 float_push(log(b) / log(a));
373 }
374
float_sqrt()375 void float_sqrt() {
376 float_push(sqrt(float_pop()));
377 }
378
float_pow()379 void float_pow() {
380 double a = float_pop();
381 double b = float_pop();
382 float_push(pow(b, a));
383 }
384
float_sin()385 void float_sin() {
386 float_push(sin(float_pop()));
387 }
388
float_cos()389 void float_cos() {
390 float_push(cos(float_pop()));
391 }
392
float_tan()393 void float_tan() {
394 float_push(tan(float_pop()));
395 }
396
float_asin()397 void float_asin() {
398 float_push(asin(float_pop()));
399 }
400
float_acos()401 void float_acos() {
402 float_push(acos(float_pop()));
403 }
404
float_atan()405 void float_atan() {
406 float_push(atan(float_pop()));
407 }
408
409
410 /*---------------------------------------------------------------------
411 With this finally done, I implement the FPU instructions.
412 ---------------------------------------------------------------------*/
413 Handler FloatHandlers[] = {
414 float_from_number, float_from_string,
415 float_to_number, float_to_string,
416 float_add, float_sub, float_mul, float_div,
417 float_floor, float_ceil, float_sqrt, float_eq,
418 float_neq, float_lt, float_gt, float_depth,
419 float_dup, float_drop, float_swap, float_log,
420 float_pow, float_sin, float_tan, float_cos,
421 float_asin, float_acos, float_atan, float_to_alt,
422 float_from_alt, float_adepth,
423 };
424
query_floatingpoint()425 void query_floatingpoint() {
426 stack_push(1);
427 stack_push(2);
428 }
429
io_floatingpoint()430 void io_floatingpoint() {
431 FloatHandlers[stack_pop()]();
432 }
433 #endif
434
435
436 /* FileSystem Device ------------------------------------------------- */
437
438 /*---------------------------------------------------------------------
439 I keep an array of file handles. RETRO will use the index number as
440 its representation of the file.
441 ---------------------------------------------------------------------*/
442
443 FILE *OpenFileHandles[MAX_OPEN_FILES];
444
445 /*---------------------------------------------------------------------
446 `files_get_handle()` returns a file handle, or 0 if there are no
447 available handle slots in the array.
448 ---------------------------------------------------------------------*/
449
files_get_handle()450 CELL files_get_handle() {
451 CELL i;
452 for(i = 1; i < MAX_OPEN_FILES; i++)
453 if (OpenFileHandles[i] == 0)
454 return i;
455 return 0;
456 }
457
458
459 /*---------------------------------------------------------------------
460 `file_open()` opens a file. This pulls from the RETRO data stack:
461
462 - mode (number, TOS)
463 - filename (string, NOS)
464
465 Modes are:
466
467 | Mode | Corresponds To | Description |
468 | ---- | -------------- | -------------------- |
469 | 0 | rb | Open for reading |
470 | 1 | w | Open for writing |
471 | 2 | a | Open for append |
472 | 3 | rb+ | Open for read/update |
473
474 The file name should be a NULL terminated string. This will attempt
475 to open the requested file and will return a handle (index number
476 into the `OpenFileHandles` array).
477 ---------------------------------------------------------------------*/
478
file_open()479 void file_open() {
480 CELL slot, mode, name;
481 char *request;
482 slot = files_get_handle();
483 mode = stack_pop();
484 name = stack_pop();
485 request = string_extract(name);
486 if (slot > 0) {
487 if (mode == 0) OpenFileHandles[slot] = fopen(request, "rb");
488 if (mode == 1) OpenFileHandles[slot] = fopen(request, "w");
489 if (mode == 2) OpenFileHandles[slot] = fopen(request, "a");
490 if (mode == 3) OpenFileHandles[slot] = fopen(request, "rb+");
491 }
492 if (OpenFileHandles[slot] == NULL) {
493 OpenFileHandles[slot] = 0;
494 slot = 0;
495 }
496 stack_push(slot);
497 }
498
499
500 /*---------------------------------------------------------------------
501 `file_read()` reads a byte from a file. This takes a file pointer
502 from the stack and pushes the character that was read to the stack.
503 ---------------------------------------------------------------------*/
504
file_read()505 void file_read() {
506 CELL c;
507 CELL slot = stack_pop();
508 if (slot <= 0 || slot > MAX_OPEN_FILES || OpenFileHandles[slot] == 0) {
509 printf("\nERROR (nga/file_read): Invalid file handle\n");
510 exit(1);
511 }
512 c = fgetc(OpenFileHandles[slot]);
513 stack_push(feof(OpenFileHandles[slot]) ? 0 : c);
514 }
515
516
517 /*---------------------------------------------------------------------
518 `file_write()` writes a byte to a file. This takes a file pointer
519 (TOS) and a byte (NOS) from the stack. It does not return any values
520 on the stack.
521 ---------------------------------------------------------------------*/
522
file_write()523 void file_write() {
524 CELL slot, c, r;
525 slot = stack_pop();
526 if (slot <= 0 || slot > MAX_OPEN_FILES || OpenFileHandles[slot] == 0) {
527 printf("\nERROR (nga/file_write): Invalid file handle\n");
528 exit(1);
529 }
530 c = stack_pop();
531 r = fputc(c, OpenFileHandles[slot]);
532 }
533
534
535 /*---------------------------------------------------------------------
536 `file_close()` closes a file. This takes a file handle from the
537 stack and does not return anything on the stack.
538 ---------------------------------------------------------------------*/
539
file_close()540 void file_close() {
541 CELL slot = stack_pop();
542 if (slot <= 0 || slot > MAX_OPEN_FILES || OpenFileHandles[slot] == 0) {
543 printf("\nERROR (nga/file_close): Invalid file handle\n");
544 exit(1);
545 }
546 fclose(OpenFileHandles[slot]);
547 OpenFileHandles[slot] = 0;
548 }
549
550
551 /*---------------------------------------------------------------------
552 `file_get_position()` provides the current index into a file. This
553 takes the file handle from the stack and returns the offset.
554 ---------------------------------------------------------------------*/
555
file_get_position()556 void file_get_position() {
557 CELL slot = stack_pop();
558 if (slot <= 0 || slot > MAX_OPEN_FILES || OpenFileHandles[slot] == 0) {
559 printf("\nERROR (nga/file_get_position): Invalid file handle\n");
560 exit(1);
561 }
562 stack_push((CELL) ftell(OpenFileHandles[slot]));
563 }
564
565
566 /*---------------------------------------------------------------------
567 `file_set_position()` changes the current index into a file to the
568 specified one. This takes a file handle (TOS) and new offset (NOS)
569 from the stack.
570 ---------------------------------------------------------------------*/
571
file_set_position()572 void file_set_position() {
573 CELL slot, pos;
574 slot = stack_pop();
575 pos = stack_pop();
576 if (slot <= 0 || slot > MAX_OPEN_FILES || OpenFileHandles[slot] == 0) {
577 printf("\nERROR (nga/file_set_position): Invalid file handle\n");
578 exit(1);
579 }
580 fseek(OpenFileHandles[slot], pos, SEEK_SET);
581 }
582
583
584 /*---------------------------------------------------------------------
585 `file_get_size()` returns the size of a file, or 0 if empty. If the
586 file is a directory, it returns -1. It takes a file handle from the
587 stack.
588 ---------------------------------------------------------------------*/
589
file_get_size()590 void file_get_size() {
591 CELL slot, current, r, size;
592 struct stat buffer;
593 slot = stack_pop();
594 if (slot <= 0 || slot > MAX_OPEN_FILES || OpenFileHandles[slot] == 0) {
595 printf("\nERROR (nga/file_get_size): Invalid file handle\n");
596 exit(1);
597 }
598 fstat(fileno(OpenFileHandles[slot]), &buffer);
599 if (!S_ISDIR(buffer.st_mode)) {
600 current = ftell(OpenFileHandles[slot]);
601 r = fseek(OpenFileHandles[slot], 0, SEEK_END);
602 size = ftell(OpenFileHandles[slot]);
603 fseek(OpenFileHandles[slot], current, SEEK_SET);
604 } else {
605 r = -1;
606 size = 0;
607 }
608 stack_push((r == 0) ? size : 0);
609 }
610
611
612 /*---------------------------------------------------------------------
613 `file_delete()` removes a file. This takes a file name (as a string)
614 from the stack.
615 ---------------------------------------------------------------------*/
616
file_delete()617 void file_delete() {
618 char *request;
619 CELL name = stack_pop();
620 request = string_extract(name);
621 unlink(request);
622 }
623
624
625 /*---------------------------------------------------------------------
626 `file_flush()` flushes any pending writes to disk. This takes a
627 file handle from the stack.
628 ---------------------------------------------------------------------*/
629
file_flush()630 void file_flush() {
631 CELL slot;
632 slot = stack_pop();
633 if (slot <= 0 || slot > MAX_OPEN_FILES || OpenFileHandles[slot] == 0) {
634 printf("\nERROR (nga/file_flush): Invalid file handle\n");
635 exit(1);
636 }
637 fflush(OpenFileHandles[slot]);
638 }
639
640 Handler FileActions[10] = {
641 file_open, file_close,
642 file_read, file_write,
643 file_get_position, file_set_position,
644 file_get_size, file_delete,
645 file_flush
646 };
647
query_filesystem()648 void query_filesystem() {
649 stack_push(0);
650 stack_push(4);
651 }
652
io_filesystem()653 void io_filesystem() {
654 FileActions[stack_pop()]();
655 }
656
657
658 #ifdef ENABLE_UNIX
659 /*---------------------------------------------------------------------
660 `unix_open_pipe()` is like `file_open()`, but for pipes. This pulls
661 from the data stack:
662
663 - mode (number, TOS)
664 - executable (string, NOS)
665
666 Modes are:
667
668 | Mode | Corresponds To | Description |
669 | ---- | -------------- | -------------------- |
670 | 0 | r | Open for reading |
671 | 1 | w | Open for writing |
672 | 3 | r+ | Open for read/update |
673
674 The file name should be a NULL terminated string. This will attempt
675 to open the requested file and will return a handle (index number
676 into the `OpenFileHandles` array).
677
678 Once opened, you can use the standard file words to read/write to the
679 process.
680 ---------------------------------------------------------------------*/
681
unix_open_pipe()682 void unix_open_pipe() {
683 CELL slot, mode, name;
684 char *request;
685 slot = files_get_handle();
686 mode = stack_pop();
687 name = stack_pop();
688 request = string_extract(name);
689 if (slot > 0) {
690 if (mode == 0) OpenFileHandles[slot] = popen(request, "r");
691 if (mode == 1) OpenFileHandles[slot] = popen(request, "w");
692 if (mode == 3) OpenFileHandles[slot] = popen(request, "r+");
693 }
694 if (OpenFileHandles[slot] == NULL) {
695 OpenFileHandles[slot] = 0;
696 slot = 0;
697 }
698 stack_push(slot);
699 }
700
unix_close_pipe()701 void unix_close_pipe() {
702 pclose(OpenFileHandles[TOS]);
703 OpenFileHandles[TOS] = 0;
704 stack_pop();
705 }
706
unix_system()707 void unix_system() {
708 int ignore = 0;
709 ignore = system(string_extract(stack_pop()));
710 }
711
unix_fork()712 void unix_fork() {
713 stack_push(fork());
714 }
715
716 /*---------------------------------------------------------------------
717 UNIX provides `execl` to execute a file, with various forms for
718 arguments provided.
719
720 RRE wraps this in several functions, one for each number of passed
721 arguments. See the Glossary for details on what each takes from the
722 stack. Each of these will return the error code if the execution
723 fails.
724 ---------------------------------------------------------------------*/
725
unix_exec0()726 void unix_exec0() {
727 char path[1025];
728 strlcpy(path, string_extract(stack_pop()), 1024);
729 execl(path, path, (char *)0);
730 stack_push(errno);
731 }
732
unix_exec1()733 void unix_exec1() {
734 char path[1025];
735 char arg0[1025];
736 strlcpy(arg0, string_extract(stack_pop()), 1024);
737 strlcpy(path, string_extract(stack_pop()), 1024);
738 execl(path, path, arg0, (char *)0);
739 stack_push(errno);
740 }
741
unix_exec2()742 void unix_exec2() {
743 char path[1025];
744 char arg0[1025], arg1[1025];
745 strlcpy(arg1, string_extract(stack_pop()), 1024);
746 strlcpy(arg0, string_extract(stack_pop()), 1024);
747 strlcpy(path, string_extract(stack_pop()), 1024);
748 execl(path, path, arg0, arg1, (char *)0);
749 stack_push(errno);
750 }
751
unix_exec3()752 void unix_exec3() {
753 char path[1025];
754 char arg0[1025], arg1[1025], arg2[1025];
755 strlcpy(arg2, string_extract(stack_pop()), 1024);
756 strlcpy(arg1, string_extract(stack_pop()), 1024);
757 strlcpy(arg0, string_extract(stack_pop()), 1024);
758 strlcpy(path, string_extract(stack_pop()), 1024);
759 execl(path, path, arg0, arg1, arg2, (char *)0);
760 stack_push(errno);
761 }
762
unix_exit()763 void unix_exit() {
764 exit(stack_pop());
765 }
766
unix_getpid()767 void unix_getpid() {
768 stack_push(getpid());
769 }
770
unix_wait()771 void unix_wait() {
772 int a;
773 stack_push(wait(&a));
774 }
775
unix_kill()776 void unix_kill() {
777 CELL a;
778 a = stack_pop();
779 kill(stack_pop(), a);
780 }
781
unix_write()782 void unix_write() {
783 CELL a, b, c;
784 ssize_t ignore;
785 c = stack_pop();
786 b = stack_pop();
787 a = stack_pop();
788 ignore = write(fileno(OpenFileHandles[c]), string_extract(a), b);
789 }
790
unix_chdir()791 void unix_chdir() {
792 int ignore;
793 ignore = chdir(string_extract(stack_pop()));
794 }
795
unix_getenv()796 void unix_getenv() {
797 CELL a, b;
798 a = stack_pop();
799 b = stack_pop();
800 string_inject(getenv(string_extract(b)), a);
801 }
802
unix_putenv()803 void unix_putenv() {
804 putenv(string_extract(stack_pop()));
805 }
806
unix_sleep()807 void unix_sleep() {
808 sleep(stack_pop());
809 }
810
811 Handler UnixActions[] = {
812 unix_system, unix_fork, unix_exec0, unix_exec1, unix_exec2,
813 unix_exec3, unix_exit, unix_getpid, unix_wait, unix_kill,
814 unix_open_pipe, unix_close_pipe, unix_write, unix_chdir, unix_getenv,
815 unix_putenv, unix_sleep
816 };
817
query_unix()818 void query_unix() {
819 stack_push(2);
820 stack_push(8);
821 }
822
io_unix()823 void io_unix() {
824 UnixActions[stack_pop()]();
825 }
826 #endif
827
828
829 /* Time and Date Functions --------------------------------------------*/
830 #ifdef ENABLE_CLOCK
clock_time()831 void clock_time() {
832 stack_push((CELL)time(NULL));
833 }
834
clock_day()835 void clock_day() {
836 time_t t = time(NULL);
837 stack_push((CELL)localtime(&t)->tm_mday);
838 }
839
clock_month()840 void clock_month() {
841 time_t t = time(NULL);
842 stack_push((CELL)localtime(&t)->tm_mon + 1);
843 }
844
clock_year()845 void clock_year() {
846 time_t t = time(NULL);
847 stack_push((CELL)localtime(&t)->tm_year + 1900);
848 }
849
clock_hour()850 void clock_hour() {
851 time_t t = time(NULL);
852 stack_push((CELL)localtime(&t)->tm_hour);
853 }
854
clock_minute()855 void clock_minute() {
856 time_t t = time(NULL);
857 stack_push((CELL)localtime(&t)->tm_min);
858 }
859
clock_second()860 void clock_second() {
861 time_t t = time(NULL);
862 stack_push((CELL)localtime(&t)->tm_sec);
863 }
864
clock_day_utc()865 void clock_day_utc() {
866 time_t t = time(NULL);
867 stack_push((CELL)gmtime(&t)->tm_mday);
868 }
869
clock_month_utc()870 void clock_month_utc() {
871 time_t t = time(NULL);
872 stack_push((CELL)gmtime(&t)->tm_mon + 1);
873 }
874
clock_year_utc()875 void clock_year_utc() {
876 time_t t = time(NULL);
877 stack_push((CELL)gmtime(&t)->tm_year + 1900);
878 }
879
clock_hour_utc()880 void clock_hour_utc() {
881 time_t t = time(NULL);
882 stack_push((CELL)gmtime(&t)->tm_hour);
883 }
884
clock_minute_utc()885 void clock_minute_utc() {
886 time_t t = time(NULL);
887 stack_push((CELL)gmtime(&t)->tm_min);
888 }
889
clock_second_utc()890 void clock_second_utc() {
891 time_t t = time(NULL);
892 stack_push((CELL)gmtime(&t)->tm_sec);
893 }
894
895 Handler ClockActions[] = {
896 clock_time,
897 clock_day, clock_month, clock_year,
898 clock_hour, clock_minute, clock_second,
899 clock_day_utc, clock_month_utc, clock_year_utc,
900 clock_hour_utc, clock_minute_utc, clock_second_utc
901 };
902
query_clock()903 void query_clock() {
904 stack_push(0);
905 stack_push(5);
906 }
907
io_clock()908 void io_clock() {
909 ClockActions[stack_pop()]();
910 }
911 #endif
912
913
914 /* Random Number Generator --------------------------------------------*/
915 #ifdef ENABLE_RNG
io_rng()916 void io_rng() {
917 int64_t r = 0;
918 char buffer[8];
919 int i;
920 ssize_t ignore;
921 int fd = open("/dev/urandom", O_RDONLY);
922 ignore = read(fd, buffer, 8);
923 close(fd);
924 for(i = 0; i < 8; ++i) {
925 r = r << 8;
926 r += ((int64_t)buffer[i] & 0xFF);
927 }
928 #ifndef BIT64
929 stack_push((CELL)abs((CELL)r));
930 #else
931 stack_push((CELL)llabs((CELL)r));
932 #endif
933 }
934
query_rng()935 void query_rng() {
936 stack_push(0);
937 stack_push(10);
938 }
939 #endif
940
941
942 #ifdef ENABLE_SOCKETS
943 /*---------------------------------------------------------------------
944 BSD Sockets
945 ---------------------------------------------------------------------*/
946
947 int SocketID[16];
948 struct sockaddr_in Sockets[16];
949
950 struct addrinfo hints, *res;
951
socket_getaddrinfo()952 void socket_getaddrinfo() {
953 char host[1025], port[6];
954 strlcpy(port, string_extract(stack_pop()), 5);
955 strlcpy(host, string_extract(stack_pop()), 1024);
956 getaddrinfo(host, port, &hints, &res);
957 }
958
socket_get_host()959 void socket_get_host() {
960 struct hostent *hp;
961 struct in_addr **addr_list;
962
963 hp = gethostbyname(string_extract(stack_pop()));
964 if (hp == NULL) {
965 memory[stack_pop()] = 0;
966 return;
967 }
968
969 addr_list = (struct in_addr **)hp->h_addr_list;
970 string_inject(inet_ntoa(*addr_list[0]), stack_pop());
971 }
972
socket_create()973 void socket_create() {
974 int i;
975 int sock = socket(PF_INET, SOCK_STREAM, 0);
976 for (i = 0; i < 16; i++) {
977 if (SocketID[i] == 0 && sock != 0) {
978 SocketID[i] = sock;
979 stack_push((CELL)i);
980 sock = 0;
981 }
982 }
983 }
984
socket_bind()985 void socket_bind() {
986 int sock, port;
987 memset(&hints, 0, sizeof hints);
988 hints.ai_family = AF_UNSPEC;
989 hints.ai_socktype = SOCK_STREAM;
990 hints.ai_flags = AI_PASSIVE;
991
992 sock = stack_pop();
993 port = stack_pop();
994
995 getaddrinfo(NULL, string_extract(port), &hints, &res);
996 stack_push((CELL) bind(SocketID[sock], res->ai_addr, res->ai_addrlen));
997 stack_push(errno);
998 }
999
socket_listen()1000 void socket_listen() {
1001 int sock = stack_pop();
1002 int backlog = stack_pop();
1003 stack_push(listen(SocketID[sock], backlog));
1004 stack_push(errno);
1005 }
1006
socket_accept()1007 void socket_accept() {
1008 int i;
1009 int sock = stack_pop();
1010 struct sockaddr_storage their_addr;
1011 socklen_t addr_size = sizeof their_addr;
1012 int new_fd = accept(SocketID[sock], (struct sockaddr *)&their_addr, &addr_size);
1013
1014 for (i = 0; i < 16; i++) {
1015 if (SocketID[i] == 0 && new_fd != 0) {
1016 SocketID[i] = new_fd;
1017 stack_push((CELL)i);
1018 new_fd = 0;
1019 }
1020 }
1021 stack_push(errno);
1022 }
1023
socket_connect()1024 void socket_connect() {
1025 stack_push((CELL)connect(SocketID[stack_pop()], res->ai_addr, res->ai_addrlen));
1026 stack_push(errno);
1027 }
1028
socket_send()1029 void socket_send() {
1030 int sock = stack_pop();
1031 char *buf = string_extract(stack_pop());
1032 stack_push(send(SocketID[sock], buf, strlen(buf), 0));
1033 stack_push(errno);
1034 }
1035
socket_sendto()1036 void socket_sendto() {
1037 }
1038
socket_recv()1039 void socket_recv() {
1040 char buf[8193];
1041 int sock = stack_pop();
1042 int limit = stack_pop();
1043 int dest = stack_pop();
1044 int len = recv(SocketID[sock], buf, limit, 0);
1045 if (len > 0) buf[len] = '\0';
1046 if (len > 0) string_inject(buf, dest);
1047 stack_push(len);
1048 stack_push(errno);
1049 }
1050
socket_recvfrom()1051 void socket_recvfrom() {
1052 }
1053
socket_close()1054 void socket_close() {
1055 int sock = stack_pop();
1056 close(SocketID[sock]);
1057 SocketID[sock] = 0;
1058 }
1059
1060 Handler SocketActions[] = {
1061 socket_get_host,
1062 socket_create, socket_bind, socket_listen,
1063 socket_accept, socket_connect, socket_send,
1064 socket_sendto, socket_recv, socket_recvfrom,
1065 socket_close, socket_getaddrinfo
1066 };
1067
io_socket()1068 void io_socket() {
1069 SocketActions[stack_pop()]();
1070 }
1071
query_socket()1072 void query_socket() {
1073 stack_push(0);
1074 stack_push(7);
1075 }
1076 #endif
1077
1078
1079 /*---------------------------------------------------------------------
1080 Now on to I/O and extensions!
1081 ---------------------------------------------------------------------*/
1082
io_output()1083 void io_output() {
1084 putc(stack_pop(), stdout);
1085 fflush(stdout);
1086 }
1087
query_output()1088 void query_output() {
1089 stack_push(0);
1090 stack_push(0);
1091 }
1092
1093
1094 /*=====================================================================*/
1095
io_keyboard()1096 void io_keyboard() {
1097 stack_push(getc(stdin));
1098 if (TOS == 127) TOS = 8;
1099 }
1100
query_keyboard()1101 void query_keyboard() {
1102 stack_push(0);
1103 stack_push(1);
1104 }
1105
1106 /*=====================================================================*/
1107
io_image()1108 void io_image() {
1109 FILE *fp;
1110 char *f = string_extract(stack_pop());
1111 if ((fp = fopen(f, "wb")) == NULL) {
1112 printf("\nERROR (nga/io_image): Unable to save the image: %s!\n", f);
1113 exit(2);
1114 }
1115 fwrite(&memory, sizeof(CELL), memory[3] + 1, fp);
1116 fclose(fp);
1117 }
1118
query_image()1119 void query_image() {
1120 stack_push(0);
1121 stack_push(1000);
1122 }
1123
1124
1125 /*=====================================================================*/
1126
1127
1128 /*---------------------------------------------------------------------
1129 Scripting Support
1130 ---------------------------------------------------------------------*/
1131
1132 CELL currentLine;
1133 CELL ignoreToEOL;
1134 CELL ignoreToEOF;
1135
scripting_arg()1136 void scripting_arg() {
1137 CELL a, b;
1138 a = stack_pop();
1139 b = stack_pop();
1140 stack_push(string_inject(sys_argv[a + 2], b));
1141 }
1142
scripting_arg_count()1143 void scripting_arg_count() {
1144 stack_push(sys_argc - 2);
1145 }
1146
scripting_include()1147 void scripting_include() {
1148 include_file(string_extract(stack_pop()), 0);
1149 }
1150
scripting_name()1151 void scripting_name() {
1152 stack_push(string_inject(sys_argv[1], stack_pop()));
1153 }
1154
1155 /* addeded in scripting i/o device, revision 1 */
scripting_source()1156 void scripting_source() {
1157 stack_push(string_inject(scripting_sources[current_source], stack_pop()));
1158 }
1159
scripting_line()1160 void scripting_line() {
1161 stack_push(currentLine + 1);
1162 }
1163
scripting_ignore_to_eol()1164 void scripting_ignore_to_eol() {
1165 ignoreToEOL = -1;
1166 }
1167
scripting_ignore_to_eof()1168 void scripting_ignore_to_eof() {
1169 ignoreToEOF = -1;
1170 }
1171
scripting_abort()1172 void scripting_abort() {
1173 scripting_ignore_to_eol();
1174 scripting_ignore_to_eof();
1175 perform_abort = -1;
1176 }
1177
carry_out_abort()1178 void carry_out_abort() {
1179 cpu.ip = IMAGE_SIZE + 1;
1180 cpu.rp = 0;
1181 cpu.sp = 0;
1182 #ifdef ENABLE_FLOATS
1183 fsp = 0;
1184 afsp = 0;
1185 #endif
1186
1187 if (current_source > 0) {
1188 scripting_abort();
1189 return;
1190 }
1191
1192 perform_abort = 0;
1193 current_source = 0;
1194 }
1195
1196 Handler ScriptingActions[] = {
1197 scripting_arg_count, scripting_arg,
1198 scripting_include, scripting_name,
1199 scripting_source, scripting_line,
1200 scripting_ignore_to_eol, scripting_ignore_to_eof,
1201 scripting_abort
1202 };
1203
query_scripting()1204 void query_scripting() {
1205 stack_push(2);
1206 stack_push(9);
1207 }
1208
io_scripting()1209 void io_scripting() {
1210 ScriptingActions[stack_pop()]();
1211 }
1212
1213
1214 /*=====================================================================*/
1215
1216 /*---------------------------------------------------------------------
1217 With these out of the way, I implement `execute`, which takes an
1218 address and runs the code at it. This has a couple of interesting
1219 bits.
1220
1221 This will also exit if the address stack depth is zero (meaning that
1222 the word being run, and it's dependencies) are finished.
1223 ---------------------------------------------------------------------*/
1224
invalid_opcode(CELL opcode)1225 void invalid_opcode(CELL opcode) {
1226 CELL a, i;
1227 printf("\nERROR (nga/execute): Invalid instruction!\n");
1228 printf("At %lld, opcode %lld\n", (long long)cpu.ip, (long long)opcode);
1229 printf("Instructions: ");
1230 a = opcode;
1231 for (i = 0; i < 4; i++) {
1232 printf("%lldd ", (long long)a & 0xFF);
1233 a = a >> 8;
1234 }
1235 printf("\n");
1236 exit(1);
1237 }
1238
execute(CELL cell)1239 void execute(CELL cell) {
1240 CELL token;
1241 CELL opcode;
1242 if (cpu.rp == 0)
1243 cpu.rp = 1;
1244 cpu.ip = cell;
1245 token = TIB;
1246 while (cpu.ip < IMAGE_SIZE) {
1247 if (perform_abort == 0) {
1248 if (cpu.ip == NotFound) {
1249 printf("\nERROR: Word Not Found: ");
1250 printf("`%s`\n\n", string_extract(token));
1251 }
1252 if (cpu.ip == interpret) {
1253 token = TOS;
1254 }
1255 opcode = memory[cpu.ip];
1256 if (validate_opcode_bundle(opcode) != 0) {
1257 process_opcode_bundle(opcode);
1258 } else {
1259 invalid_opcode(opcode);
1260 }
1261 if (cpu.sp < 0 || cpu.sp > STACK_DEPTH) {
1262 printf("\nERROR (nga/execute): Stack Limits Exceeded!\n");
1263 printf("At %lld, opcode %lld. sp = %lld\n", (long long)cpu.ip, (long long)opcode, (long long)cpu.sp);
1264 exit(1);
1265 }
1266 if (cpu.rp < 0 || cpu.rp > ADDRESSES) {
1267 printf("\nERROR (nga/execute): Address Stack Limits Exceeded!\n");
1268 printf("At %lld, opcode %lld. rp = %lld\n", (long long)cpu.ip, (long long)opcode, (long long)cpu.rp);
1269 exit(1);
1270 }
1271 cpu.ip++;
1272 if (cpu.rp == 0)
1273 cpu.ip = IMAGE_SIZE;
1274 } else {
1275 carry_out_abort();
1276 }
1277 }
1278 }
1279
1280
1281 /*---------------------------------------------------------------------
1282 RETRO's `interpret` word expects a token on the stack. This next
1283 function copies a token to the `TIB` (text input buffer) and then
1284 calls `interpret` to process it.
1285 ---------------------------------------------------------------------*/
1286
evaluate(char * s)1287 void evaluate(char *s) {
1288 if (strlen(s) == 0) return;
1289 string_inject(s, TIB);
1290 stack_push(TIB);
1291 execute(interpret);
1292 }
1293
1294
1295 /*---------------------------------------------------------------------
1296 `read_token` reads a token from the specified file. It will stop on
1297 a whitespace or newline. It also tries to handle backspaces, though
1298 the success of this depends on how your terminal is configured.
1299 ---------------------------------------------------------------------*/
1300
not_eol(int c)1301 int not_eol(int c) {
1302 return (c != 10) && (c != 13) && (c != 32) && (c != EOF) && (c != 0);
1303 }
1304
read_token(FILE * file,char * token_buffer)1305 void read_token(FILE *file, char *token_buffer) {
1306 int ch = getc(file);
1307 int count = 0;
1308 while (not_eol(ch)) {
1309 if ((ch == 8 || ch == 127) && count > 0) {
1310 count--;
1311 } else {
1312 token_buffer[count++] = ch;
1313 }
1314 ch = getc(file);
1315 }
1316 token_buffer[count] = '\0';
1317 }
1318
1319
1320 /*---------------------------------------------------------------------
1321 Display the Stack Contents
1322 ---------------------------------------------------------------------*/
1323
dump_stack()1324 void dump_stack() {
1325 CELL i;
1326 if (cpu.sp == 0) return;
1327 printf("\nStack: ");
1328 for (i = 1; i <= cpu.sp; i++) {
1329 if (i == cpu.sp)
1330 printf("[ TOS: %lld ]", (long long)cpu.data[i]);
1331 else
1332 printf("%lld ", (long long)cpu.data[i]);
1333 }
1334 printf("\n");
1335 }
1336
1337
1338 /*---------------------------------------------------------------------
1339 RRE is primarily intended to be used in a batch or scripting model.
1340 The `include_file()` function will be used to read the code in the
1341 file, evaluating it as encountered.
1342
1343 I enforce a literate model, with code in fenced blocks. E.g.,
1344
1345 # This is a test
1346
1347 Display "Hello, World!"
1348
1349 ~~~
1350 'Hello,_World! puts nl
1351 ~~~
1352
1353 RRE will ignore anything outside the `~~~` blocks. To identify if the
1354 current token is the start or end of a block, I provide a `fenced()`
1355 function.
1356 ---------------------------------------------------------------------*/
1357
1358 /* Check to see if a line is a fence boundary.
1359 This will check code blocks in all cases, and test blocks
1360 if tests_enabled is set to a non-zero value. */
1361
fence_boundary(char * buffer,int tests_enabled)1362 int fence_boundary(char *buffer, int tests_enabled) {
1363 int flag = 1;
1364 if (strcmp(buffer, code_start) == 0) { flag = -1; }
1365 if (strcmp(buffer, code_end) == 0) { flag = -1; }
1366 if (tests_enabled == 0) { return flag; }
1367 if (strcmp(buffer, test_start) == 0) { flag = -1; }
1368 if (strcmp(buffer, test_end) == 0) { flag = -1; }
1369 return flag;
1370 }
1371
1372
1373 /*---------------------------------------------------------------------
1374 And now for the actual `include_file()` function.
1375 ---------------------------------------------------------------------*/
1376
read_line(FILE * file,char * token_buffer)1377 void read_line(FILE *file, char *token_buffer) {
1378 int ch = getc(file);
1379 int count = 0;
1380 while ((ch != 10) && (ch != 13) && (ch != EOF) && (ch != 0)) {
1381 token_buffer[count++] = ch;
1382 ch = getc(file);
1383 }
1384 token_buffer[count] = '\0';
1385 }
1386
count_tokens(char * line)1387 int count_tokens(char *line) {
1388 int count = 1;
1389 while (*line++) {
1390 if (isspace(line[0]))
1391 count++;
1392 }
1393 return count;
1394 }
1395
include_file(char * fname,int run_tests)1396 void include_file(char *fname, int run_tests) {
1397 int inBlock = 0; /* Tracks status of in/out of block */
1398 char source[64 * 1024]; /* Token buffer [about 64K] */
1399 char line[64 * 1024]; /* Line buffer [about 64K] */
1400 char fence[33]; /* Used with `fence_boundary()` */
1401
1402 CELL ReturnStack[ADDRESSES];
1403 CELL arp, aip;
1404
1405 long offset = 0;
1406 CELL at = 0;
1407 int tokens = 0;
1408 FILE *fp; /* Open the file. If not found, */
1409 fp = fopen(fname, "r"); /* exit. */
1410 if (fp == NULL)
1411 return;
1412
1413 arp = cpu.rp;
1414 aip = cpu.ip;
1415 for(cpu.rp = 0; cpu.rp <= arp; cpu.rp++)
1416 ReturnStack[cpu.rp] = cpu.address[cpu.rp];
1417 cpu.rp = 0;
1418
1419 current_source++;
1420 strlcpy(scripting_sources[current_source], fname, 8192);
1421
1422 ignoreToEOF = 0;
1423
1424 while (!feof(fp) && (ignoreToEOF == 0)) { /* Loop through the file */
1425
1426 ignoreToEOL = 0;
1427
1428 offset = ftell(fp);
1429 read_line(fp, line);
1430 fseek(fp, offset, SEEK_SET);
1431
1432 tokens = count_tokens(line);
1433
1434 while (tokens > 0 && ignoreToEOL == 0) {
1435 tokens--;
1436 read_token(fp, source);
1437 strlcpy(fence, source, 32); /* Copy the first three characters */
1438 if (fence_boundary(fence, run_tests) == -1) {
1439 if (inBlock == 0)
1440 inBlock = 1;
1441 else
1442 inBlock = 0;
1443 } else {
1444 if (inBlock == 1) {
1445 currentLine = at;
1446 evaluate(source);
1447 currentLine = at;
1448 }
1449 }
1450 }
1451 if (ignoreToEOL == -1)
1452 read_line(fp, line);
1453 at++;
1454 }
1455
1456 current_source--;
1457 ignoreToEOF = 0;
1458 fclose(fp);
1459 if (perform_abort == -1) {
1460 carry_out_abort();
1461 }
1462 for(cpu.rp = 0; cpu.rp <= arp; cpu.rp++)
1463 cpu.address[cpu.rp] = ReturnStack[cpu.rp];
1464 cpu.rp = arp;
1465 cpu.ip = aip;
1466 }
1467
1468
1469 /*---------------------------------------------------------------------
1470 `initialize()` sets up Nga and loads the image (from the array in
1471 `image.c`) to memory.
1472 ---------------------------------------------------------------------*/
1473
initialize()1474 void initialize() {
1475 prepare_vm();
1476 load_embedded_image();
1477 }
1478
1479
1480 /*---------------------------------------------------------------------
1481 `arg_is()` exists to aid in readability. It compares the first actual
1482 command line argument to a string and returns a boolean flag.
1483 ---------------------------------------------------------------------*/
1484
arg_is(char * argv,char * t)1485 int arg_is(char *argv, char *t) {
1486 return strcmp(argv, t) == 0;
1487 }
1488
1489
1490 /* Main Entry Point ---------------------------------------------------*/
1491 enum flags {
1492 FLAG_HELP, FLAG_RUN_TESTS, FLAG_INCLUDE,
1493 FLAG_INTERACTIVE, FLAG_RUN,
1494 };
1495
main(int argc,char ** argv)1496 int main(int argc, char **argv) {
1497 int i;
1498 int modes[16];
1499 char *files[16];
1500 int fsp;
1501
1502 int run_tests;
1503
1504 initialize(); /* Initialize Nga & image */
1505
1506 register_device(io_output, query_output);
1507 register_device(io_keyboard, query_keyboard);
1508 register_device(io_filesystem, query_filesystem);
1509 register_device(io_image, query_image);
1510 #ifdef ENABLE_FLOATS
1511 register_device(io_floatingpoint, query_floatingpoint);
1512 #endif
1513 #ifdef ENABLE_UNIX
1514 register_device(io_unix, query_unix);
1515 #endif
1516 #ifdef ENABLE_CLOCK
1517 register_device(io_clock, query_clock);
1518 #endif
1519 register_device(io_scripting, query_scripting);
1520 #ifdef ENABLE_RNG
1521 register_device(io_rng, query_rng);
1522 #endif
1523 #ifdef ENABLE_SOCKETS
1524 register_device(io_socket, query_socket);
1525 #endif
1526
1527 strcpy(code_start, "~~~");
1528 strcpy(code_end, "~~~");
1529 strcpy(test_start, "```");
1530 strcpy(test_end, "```");
1531
1532 /* Setup variables related to the scripting device */
1533 currentLine = 0; /* Current Line # for script */
1534 current_source = 0; /* Current file being run */
1535 perform_abort = 0; /* Carry out abort procedure */
1536 sys_argc = argc; /* Point the global argc and */
1537 sys_argv = argv; /* argv to the actual ones */
1538 strlcpy(scripting_sources[0], "/dev/stdin", 8192);
1539 ignoreToEOL = 0;
1540 ignoreToEOF = 0;
1541
1542 if (argc >= 2 && argv[1][0] != '-') {
1543 update_rx();
1544 include_file(argv[1], 0); /* If no flags were passed, */
1545 if (cpu.sp >= 1) dump_stack(); /* load the file specified, */
1546 exit(0); /* and exit */
1547 }
1548
1549 /* Clear startup modes */
1550 for (i = 0; i < 16; i++)
1551 modes[i] = 0;
1552
1553 /* Clear startup files */
1554 for (i = 0; i < 16; i++)
1555 files[i] = "\0";
1556
1557 fsp = 0;
1558
1559 run_tests = 0;
1560
1561 if (argc <= 1) modes[FLAG_INTERACTIVE] = 1;
1562
1563 /* Process Arguments */
1564 for (i = 1; i < argc; i++) {
1565 if (strcmp(argv[i], "-i") == 0) {
1566 modes[FLAG_INTERACTIVE] = 1;
1567 } else if (strcmp(argv[i], "-f") == 0) {
1568 files[fsp] = argv[i + 1];
1569 fsp++;
1570 i++;
1571 } else if (strcmp(argv[i], "-u") == 0) {
1572 i++;
1573 load_image(argv[i]);
1574 } else if (strcmp(argv[i], "-r") == 0) {
1575 i++;
1576 load_image(argv[i]);
1577 modes[FLAG_RUN] = 1;
1578 } else if (strcmp(argv[i], "-t") == 0) {
1579 modes[FLAG_RUN_TESTS] = 1;
1580 run_tests = 1;
1581 } else if (arg_is(argv[i], "--code-start") || arg_is(argv[i], "-cs")) {
1582 i++;
1583 strcpy(code_start, argv[i]);
1584 } else if (arg_is(argv[i], "--code-end") || arg_is(argv[i], "-ce")) {
1585 i++;
1586 strcpy(code_end, argv[i]);
1587 } else if (arg_is(argv[i], "--test-start") || arg_is(argv[i], "-ts")) {
1588 i++;
1589 strcpy(test_start, argv[i]);
1590 } else if (arg_is(argv[i], "--test-end") || arg_is(argv[i], "-te")) {
1591 i++;
1592 strcpy(test_end, argv[i]);
1593 }
1594 }
1595
1596 update_rx();
1597
1598 /* Include Startup Files */
1599 for (i = 0; i < fsp; i++) {
1600 if (strcmp(files[i], "\0") != 0)
1601 include_file(files[i], run_tests);
1602 }
1603
1604 /* Run the Listener (if interactive mode was set) */
1605 if (modes[FLAG_INTERACTIVE] == 1 || modes[FLAG_RUN == 1]) {
1606 execute(0);
1607 }
1608 }
1609
1610
1611 /*=====================================================================*/
1612
1613
1614 /*---------------------------------------------------------------------
1615 Interfacing With The Image
1616 ---------------------------------------------------------------------*/
1617
1618 /*---------------------------------------------------------------------
1619 Stack push/pop is easy. I could avoid these, but it aids in keeping
1620 the code readable, so it's worth the slight overhead.
1621 ---------------------------------------------------------------------*/
1622
stack_pop()1623 CELL stack_pop() {
1624 cpu.sp--;
1625 return cpu.data[cpu.sp + 1];
1626 }
1627
stack_push(CELL value)1628 void stack_push(CELL value) {
1629 cpu.sp++;
1630 cpu.data[cpu.sp] = value;
1631 }
1632
1633
1634 /*---------------------------------------------------------------------
1635 Strings are next. RETRO uses C-style NULL terminated strings. So I
1636 can easily inject or extract a string. Injection iterates over the
1637 string, copying it into the image. This also takes care to ensure
1638 that the NULL terminator is added.
1639 ---------------------------------------------------------------------*/
1640
string_inject(char * str,CELL buffer)1641 CELL string_inject(char *str, CELL buffer) {
1642 CELL m, i;
1643 if (!str) {
1644 memory[buffer] = 0;
1645 return 0;
1646 }
1647 m = strlen(str);
1648 i = 0;
1649 while (m > 0) {
1650 memory[buffer + i] = (CELL)str[i];
1651 memory[buffer + i + 1] = 0;
1652 m--; i++;
1653 }
1654 return buffer;
1655 }
1656
1657
1658 /*---------------------------------------------------------------------
1659 Extracting a string is similar, but I have to iterate over the VM
1660 memory instead of a C string and copy the charaters into a buffer.
1661 This uses a static buffer (`string_data`) as I prefer to avoid using
1662 `malloc()`.
1663 ---------------------------------------------------------------------*/
1664
string_extract(CELL at)1665 char *string_extract(CELL at) {
1666 CELL starting = at;
1667 CELL i = 0;
1668 while(memory[starting] && i < 8192)
1669 string_data[i++] = (char)memory[starting++];
1670 string_data[i] = 0;
1671 return (char *)string_data;
1672 }
1673
1674
1675 /*---------------------------------------------------------------------
1676 Continuing along, I now define functions to access the dictionary.
1677
1678 RETRO's dictionary is a linked list. Each entry is setup like:
1679
1680 0000 Link to previous entry (NULL if this is the root entry)
1681 0001 Pointer to definition start
1682 0002 Pointer to class handler
1683 0003 Start of a NULL terminated string with the word name
1684
1685 First, functions to access each field. The offsets were defineed at
1686 the start of the file.
1687 ---------------------------------------------------------------------*/
1688
d_link(CELL dt)1689 CELL d_link(CELL dt) {
1690 return dt + D_OFFSET_LINK;
1691 }
1692
d_xt(CELL dt)1693 CELL d_xt(CELL dt) {
1694 return dt + D_OFFSET_XT;
1695 }
1696
d_class(CELL dt)1697 CELL d_class(CELL dt) {
1698 return dt + D_OFFSET_CLASS;
1699 }
1700
d_name(CELL dt)1701 CELL d_name(CELL dt) {
1702 return dt + D_OFFSET_NAME;
1703 }
1704
1705
1706 /*---------------------------------------------------------------------
1707 Next, a more complext word. This will walk through the entries to
1708 find one with a name that matches the specified name. This is *slow*,
1709 but works ok unless you have a really large dictionary. (I've not
1710 run into issues with this in practice).
1711 ---------------------------------------------------------------------*/
1712
d_lookup(CELL Dictionary,char * name)1713 CELL d_lookup(CELL Dictionary, char *name) {
1714 CELL dt = 0;
1715 CELL i = Dictionary;
1716 char *dname;
1717 while (memory[i] != 0 && i != 0) {
1718 dname = string_extract(d_name(i));
1719 if (strcmp(dname, name) == 0) {
1720 dt = i;
1721 i = 0;
1722 } else {
1723 i = memory[i];
1724 }
1725 }
1726 return dt;
1727 }
1728
1729
1730 /*---------------------------------------------------------------------
1731 My last dictionary related word returns the `xt` pointer for a word.
1732 This is used to help keep various important bits up to date.
1733 ---------------------------------------------------------------------*/
1734
d_xt_for(char * Name,CELL Dictionary)1735 CELL d_xt_for(char *Name, CELL Dictionary) {
1736 return memory[d_xt(d_lookup(Dictionary, Name))];
1737 }
1738
1739
1740 /*---------------------------------------------------------------------
1741 This interface tracks a few words and variables in the image. These
1742 are:
1743
1744 Dictionary - the latest dictionary header
1745 NotFound - called when a word is not found
1746 interpret - the heart of the interpreter/compiler
1747
1748 I have to call this periodically, as the Dictionary will change as
1749 new words are defined, and the user might write a new error handler
1750 or interpreter.
1751 ---------------------------------------------------------------------*/
1752
update_rx()1753 void update_rx() {
1754 Dictionary = memory[2];
1755 interpret = d_xt_for("interpret", Dictionary);
1756 NotFound = d_xt_for("err:notfound", Dictionary);
1757 Compiler = d_xt_for("Compiler", Compiler);
1758 }
1759
1760 /*=====================================================================*/
1761
register_device(void * handler,void * query)1762 void register_device(void *handler, void *query) {
1763 IO_deviceHandlers[devices] = handler;
1764 IO_queryHandlers[devices] = query;
1765 devices++;
1766 }
1767
load_embedded_image()1768 void load_embedded_image() {
1769 int i;
1770 for (i = 0; i < ngaImageCells; i++)
1771 memory[i] = ngaImage[i];
1772 }
1773
load_image(char * imageFile)1774 CELL load_image(char *imageFile) {
1775 FILE *fp;
1776 CELL imageSize = 0;
1777 long fileLen;
1778 if ((fp = fopen(imageFile, "rb")) != NULL) {
1779 /* Determine length (in cells) */
1780 fseek(fp, 0, SEEK_END);
1781 fileLen = ftell(fp) / sizeof(CELL);
1782 if (fileLen > IMAGE_SIZE) {
1783 fclose(fp);
1784 printf("\nERROR (nga/ngaLoadImage): Image is larger than alloted space!\n");
1785 exit(1);
1786 }
1787 rewind(fp);
1788 /* Read the file into memory */
1789 imageSize = fread(&memory, sizeof(CELL), fileLen, fp);
1790 fclose(fp);
1791 }
1792 return imageSize;
1793 }
1794
prepare_vm()1795 void prepare_vm() {
1796 cpu.ip = cpu.sp = cpu.rp = 0;
1797 for (cpu.ip = 0; cpu.ip < IMAGE_SIZE; cpu.ip++)
1798 memory[cpu.ip] = 0; /* NO - nop instruction */
1799 for (cpu.ip = 0; cpu.ip < STACK_DEPTH; cpu.ip++)
1800 cpu.data[cpu.ip] = 0;
1801 for (cpu.ip = 0; cpu.ip < ADDRESSES; cpu.ip++)
1802 cpu.address[cpu.ip] = 0;
1803 }
1804
inst_no()1805 void inst_no() {
1806 }
1807
inst_li()1808 void inst_li() {
1809 cpu.sp++;
1810 cpu.ip++;
1811 TOS = memory[cpu.ip];
1812 }
1813
inst_du()1814 void inst_du() {
1815 cpu.sp++;
1816 cpu.data[cpu.sp] = NOS;
1817 }
1818
inst_dr()1819 void inst_dr() {
1820 cpu.data[cpu.sp] = 0;
1821 cpu.sp--;
1822 }
1823
inst_sw()1824 void inst_sw() {
1825 CELL a;
1826 a = TOS;
1827 TOS = NOS;
1828 NOS = a;
1829 }
1830
inst_pu()1831 void inst_pu() {
1832 cpu.rp++;
1833 TORS = TOS;
1834 inst_dr();
1835 }
1836
inst_po()1837 void inst_po() {
1838 cpu.sp++;
1839 TOS = TORS;
1840 cpu.rp--;
1841 }
1842
inst_ju()1843 void inst_ju() {
1844 cpu.ip = TOS - 1;
1845 inst_dr();
1846 }
1847
inst_ca()1848 void inst_ca() {
1849 cpu.rp++;
1850 TORS = cpu.ip;
1851 cpu.ip = TOS - 1;
1852 inst_dr();
1853 }
1854
inst_cc()1855 void inst_cc() {
1856 CELL a, b;
1857 a = TOS; inst_dr(); /* Target */
1858 b = TOS; inst_dr(); /* Flag */
1859 if (b != 0) {
1860 cpu.rp++;
1861 TORS = cpu.ip;
1862 cpu.ip = a - 1;
1863 }
1864 }
1865
inst_re()1866 void inst_re() {
1867 cpu.ip = TORS;
1868 cpu.rp--;
1869 }
1870
inst_eq()1871 void inst_eq() {
1872 NOS = (NOS == TOS) ? -1 : 0;
1873 inst_dr();
1874 }
1875
inst_ne()1876 void inst_ne() {
1877 NOS = (NOS != TOS) ? -1 : 0;
1878 inst_dr();
1879 }
1880
inst_lt()1881 void inst_lt() {
1882 NOS = (NOS < TOS) ? -1 : 0;
1883 inst_dr();
1884 }
1885
inst_gt()1886 void inst_gt() {
1887 NOS = (NOS > TOS) ? -1 : 0;
1888 inst_dr();
1889 }
1890
inst_fe()1891 void inst_fe() {
1892 switch (TOS) {
1893 case -1: TOS = cpu.sp - 1; break;
1894 case -2: TOS = cpu.rp; break;
1895 case -3: TOS = IMAGE_SIZE; break;
1896 case -4: TOS = CELL_MIN; break;
1897 case -5: TOS = CELL_MAX; break;
1898 default: TOS = memory[TOS]; break;
1899 }
1900 }
1901
inst_st()1902 void inst_st() {
1903 memory[TOS] = NOS;
1904 inst_dr();
1905 inst_dr();
1906 }
1907
inst_ad()1908 void inst_ad() {
1909 NOS += TOS;
1910 inst_dr();
1911 }
1912
inst_su()1913 void inst_su() {
1914 NOS -= TOS;
1915 inst_dr();
1916 }
1917
inst_mu()1918 void inst_mu() {
1919 NOS *= TOS;
1920 inst_dr();
1921 }
1922
inst_di()1923 void inst_di() {
1924 CELL a, b;
1925 a = TOS;
1926 b = NOS;
1927 TOS = b / a;
1928 NOS = b % a;
1929 }
1930
inst_an()1931 void inst_an() {
1932 NOS = TOS & NOS;
1933 inst_dr();
1934 }
1935
inst_or()1936 void inst_or() {
1937 NOS = TOS | NOS;
1938 inst_dr();
1939 }
1940
inst_xo()1941 void inst_xo() {
1942 NOS = TOS ^ NOS;
1943 inst_dr();
1944 }
1945
inst_sh()1946 void inst_sh() {
1947 CELL y = TOS;
1948 CELL x = NOS;
1949 if (TOS < 0)
1950 NOS = NOS << (TOS * -1);
1951 else {
1952 if (x < 0 && y > 0)
1953 NOS = x >> y | ~(~0U >> y);
1954 else
1955 NOS = x >> y;
1956 }
1957 inst_dr();
1958 }
1959
inst_zr()1960 void inst_zr() {
1961 if (TOS == 0) {
1962 inst_dr();
1963 cpu.ip = TORS;
1964 cpu.rp--;
1965 }
1966 }
1967
inst_ha()1968 void inst_ha() {
1969 cpu.ip = IMAGE_SIZE;
1970 }
1971
inst_ie()1972 void inst_ie() {
1973 cpu.sp++;
1974 TOS = devices;
1975 }
1976
inst_iq()1977 void inst_iq() {
1978 CELL Device = TOS;
1979 inst_dr();
1980 IO_queryHandlers[Device]();
1981 }
1982
inst_ii()1983 void inst_ii() {
1984 CELL Device = TOS;
1985 inst_dr();
1986 IO_deviceHandlers[Device]();
1987 }
1988
1989 Handler instructions[] = {
1990 inst_no, inst_li, inst_du, inst_dr, inst_sw, inst_pu, inst_po,
1991 inst_ju, inst_ca, inst_cc, inst_re, inst_eq, inst_ne, inst_lt,
1992 inst_gt, inst_fe, inst_st, inst_ad, inst_su, inst_mu, inst_di,
1993 inst_an, inst_or, inst_xo, inst_sh, inst_zr, inst_ha, inst_ie,
1994 inst_iq, inst_ii
1995 };
1996
process_opcode(CELL opcode)1997 void process_opcode(CELL opcode) {
1998 #ifdef FAST
1999 switch (opcode) {
2000 case 0: break;
2001 case 1: inst_li(); break;
2002 case 2: inst_du(); break;
2003 case 3: inst_dr(); break;
2004 case 4: inst_sw(); break;
2005 case 5: inst_pu(); break;
2006 case 6: inst_po(); break;
2007 case 7: inst_ju(); break;
2008 case 8: inst_ca(); break;
2009 case 9: inst_cc(); break;
2010 case 10: inst_re(); break;
2011 case 11: inst_eq(); break;
2012 case 12: inst_ne(); break;
2013 case 13: inst_lt(); break;
2014 case 14: inst_gt(); break;
2015 case 15: inst_fe(); break;
2016 case 16: inst_st(); break;
2017 case 17: inst_ad(); break;
2018 case 18: inst_su(); break;
2019 case 19: inst_mu(); break;
2020 case 20: inst_di(); break;
2021 case 21: inst_an(); break;
2022 case 22: inst_or(); break;
2023 case 23: inst_xo(); break;
2024 case 24: inst_sh(); break;
2025 case 25: inst_zr(); break;
2026 case 26: inst_ha(); break;
2027 case 27: inst_ie(); break;
2028 case 28: inst_iq(); break;
2029 case 29: inst_ii(); break;
2030 default: break;
2031 }
2032 #else
2033 if (opcode != 0)
2034 instructions[opcode]();
2035 #endif
2036 }
2037
validate_opcode_bundle(CELL opcode)2038 int validate_opcode_bundle(CELL opcode) {
2039 CELL raw = opcode;
2040 CELL current;
2041 int valid = -1;
2042 int i;
2043 for (i = 0; i < 4; i++) {
2044 current = raw & 0xFF;
2045 if (!(current >= 0 && current <= 29))
2046 valid = 0;
2047 raw = raw >> 8;
2048 }
2049 return valid;
2050 }
2051
process_opcode_bundle(CELL opcode)2052 void process_opcode_bundle(CELL opcode) {
2053 CELL raw = opcode;
2054 int i;
2055 for (i = 0; i < 4; i++) {
2056 process_opcode(raw & 0xFF);
2057 raw = raw >> 8;
2058 }
2059 }
2060
2061 #ifdef NEEDS_STRL
2062 /*---------------------------------------------------------------------
2063 Copyright (c) 1998, 2015 Todd C. Miller <Todd.Miller@courtesan.com>
2064
2065 Permission to use, copy, modify, and distribute this software for any
2066 purpose with or without fee is hereby granted, provided that the above
2067 copyright notice and this permission notice appear in all copies.
2068
2069 THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
2070 WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
2071 MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
2072 ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
2073 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
2074 ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
2075 OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
2076 --------------------------------------------------------------------*/
2077
strlcat(char * dst,const char * src,size_t dsize)2078 size_t strlcat(char *dst, const char *src, size_t dsize) {
2079 const char *odst = dst;
2080 const char *osrc = src;
2081 size_t n = dsize;
2082 size_t dlen;
2083
2084 /* Find the end of dst and adjust bytes left but don't go past end. */
2085 while (n-- != 0 && *dst != '\0')
2086 dst++;
2087 dlen = dst - odst;
2088 n = dsize - dlen;
2089
2090 if (n-- == 0)
2091 return(dlen + strlen(src));
2092 while (*src != '\0') {
2093 if (n != 0) {
2094 *dst++ = *src;
2095 n--;
2096 }
2097 src++;
2098 }
2099 *dst = '\0';
2100 return(dlen + (src - osrc)); /* count does not include NUL */
2101 }
2102
strlcpy(char * dst,const char * src,size_t dsize)2103 size_t strlcpy(char *dst, const char *src, size_t dsize) {
2104 const char *osrc = src;
2105 size_t nleft = dsize;
2106
2107 /* Copy as many bytes as will fit. */
2108 if (nleft != 0) {
2109 while (--nleft != 0) {
2110 if ((*dst++ = *src++) == '\0')
2111 break;
2112 }
2113 }
2114
2115 /* Not enough room in dst, add NUL and traverse rest of src. */
2116 if (nleft == 0) {
2117 if (dsize != 0)
2118 *dst = '\0'; /* NUL-terminate dst */
2119 while (*src++)
2120 ;
2121 }
2122 return(src - osrc - 1); /* count does not include NUL */
2123 }
2124 #endif
2125