comparison ppc/lib.c @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:bfdcc3820b32
1 /* ppc/lib.c */
2
3 #include "obx.h"
4 #include <stdio.h>
5
6 /* Primitives that can be called from picoPascal programs */
7
8 unsigned prim_check = 0; /* Fake checksum for set of primitives */
9
10 #define args (bp + HEAD + 1)
11
12 static void _new(value *sp) {
13 value *bp = sp;
14 (*(args[0].p)).x = malloc(args[1].i);
15 }
16
17 static void _argc(value *sp) {
18 ob_res.i = saved_argc;
19 }
20
21 static void _argv(value *sp) {
22 value *bp = sp;
23 /* Buffer overflow waiting to happen */
24 strcpy((char *) args[1].x, saved_argv[args[0].i]);
25 }
26
27 static void _print_num(value *sp) {
28 value *bp = sp;
29 printf("%d", args[0].i);
30 }
31
32 static void _print_string(value *sp) {
33 value *bp = sp;
34 printf("%s", args[0].x);
35 }
36
37 static void _print_char(value *sp) {
38 value *bp = sp;
39 printf("%c", args[0].i);
40 }
41
42 static void _newline(value *sp) {
43 printf("\n");
44 }
45
46 static FILE *infile = NULL;
47
48 static void _open_in(value *sp) {
49 value *bp = sp;
50 FILE *f = fopen((char *) args[0].x, "r");
51 if (f == NULL) {
52 ob_res.i = 0; return;
53 }
54 if (infile != NULL) fclose(infile);
55 infile = f;
56 ob_res.i = 1;
57 }
58
59 static void _close_in(value *sp) {
60 if (infile == NULL) return;
61 fclose(infile);
62 infile = NULL;
63 }
64
65 static void _read_char(value *sp) {
66 value *bp = sp;
67 FILE *f = (infile == NULL ? stdin : infile);
68 int ch = fgetc(f);
69 *(args[0].x) = (ch == EOF ? 127 : ch);
70 }
71
72 static void _pexit(value *sp) {
73 value *bp = sp;
74 exit(args[0].i);
75 }
76
77 void dltrap(value *sp) {
78 fprintf(stderr, "Oops: dltrap called!\n");
79 exit(2);
80 }
81
82 primitive *primtab[] = {
83 interp, dltrap, _new, _open_in, _close_in, _read_char,
84 _print_num, _print_string, _print_char, _newline,
85 _argc, _argv, _pexit, NULL
86 };
87
88 char *primname[] = {
89 "INTERP", "DLTRAP", "_new", "_open_in", "_close_in",
90 "_read_char", "_print_num", "_print_string",
91 "_print_char", "_newline", "_argc", "_argv", "_pexit"
92 };
93