annotate ppc/lib.c @ 1:b5139af1a420 tip basis

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