History

port to plan 9

Sigrid Haflínudóttir committed 6 years ago

Commit f06dca91 parent 3efa0753 files · +61 −28Browse files

Unified · Split

3 files
  1. mkfile +14 −0
  2. src/fe.c +47 −25
  3. src/fe.h +0 −3
mkfile+14−0
@@ -0,0 +1,14 @@
1</$objtype/mkfile
2
3CFLAGS=$CFLAGS -p -D__plan9__ -DFE_STANDALONE -Isrc
4BIN=/$objtype/bin
5TARG=fe
6OFILES=\
7 fe.$O
8
9default:V: all
10
11</sys/src/cmd/mkone
12
13fe.$O: src/fe.c
14 $CC $CFLAGS $prereq
src/fe.c+47−25
@@ -20,14 +20,22 @@ · 19 unmodified lines
20** IN THE SOFTWARE.20** IN THE SOFTWARE.
21*/21*/
22 22
23#ifdef __plan9__
24#include <u.h>
25#include <libc.h>
26#define unused USED
27#else
23#include <string.h>28#include <string.h>
29#include <stdlib.h>
30#define unused(x) ( (void) (x) )
31#endif
32#include <stdio.h>
24#include "fe.h"33#include "fe.h"
25 34
26#define unused(x) ( (void) (x) )
27#define car(x) ( (x)->car.o )35#define car(x) ( (x)->car.o )
28#define cdr(x) ( (x)->cdr.o )36#define cdr(x) ( (x)->cdr.o )
29#define tag(x) ( (x)->car.c )37#define tag(x) ( (x)->car.c )
30#define isnil(x) ( (x) == &nil )38#define isnil(x) ( (x) == &Nil )
31#define type(x) ( tag(x) & 0x1 ? tag(x) >> 2 : FE_TPAIR )39#define type(x) ( tag(x) & 0x1 ? tag(x) >> 2 : FE_TPAIR )
32#define settype(x,t) ( tag(x) = (t) << 2 | 1 )40#define settype(x,t) ( tag(x) = (t) << 2 | 1 )
33#define number(x) ( (x)->cdr.n )41#define number(x) ( (x)->cdr.n )
@@ -74,7 +82,7 @@ struct fe_Context { · 40 unmodified lines
74 int nextchr;82 int nextchr;
75};83};
76 84
77static fe_Object nil = {{ (void*) (FE_TNIL << 2 | 1) }, { NULL }};85static fe_Object Nil = {{ (void*) (FE_TNIL << 2 | 1) }, { NULL }};
78 86
79 87
80fe_Handlers* fe_handlers(fe_Context *ctx) {88fe_Handlers* fe_handlers(fe_Context *ctx) {
@@ -85,7 +93,7 @@ fe_Handlers* fe_handlers(fe_Context *ctx) { · 4 unmodified lines
85void fe_error(fe_Context *ctx, const char *msg) {93void fe_error(fe_Context *ctx, const char *msg) {
86 fe_Object *cl = ctx->calllist;94 fe_Object *cl = ctx->calllist;
87 /* reset context state */95 /* reset context state */
88 ctx->calllist = &nil;96 ctx->calllist = &Nil;
89 /* do error handler */97 /* do error handler */
90 if (ctx->handlers.error) { ctx->handlers.error(ctx, msg, cl); }98 if (ctx->handlers.error) { ctx->handlers.error(ctx, msg, cl); }
91 /* error handler returned -- print error and traceback, exit */99 /* error handler returned -- print error and traceback, exit */
@@ -95,7 +103,11 @@ void fe_error(fe_Context *ctx, const char *msg) { · 3 unmodified lines
95 fe_tostring(ctx, car(cl), buf, sizeof(buf));103 fe_tostring(ctx, car(cl), buf, sizeof(buf));
96 fprintf(stderr, "=> %s\n", buf);104 fprintf(stderr, "=> %s\n", buf);
97 }105 }
106#ifdef __plan9__
107 exits("fail");
108#else
98 exit(EXIT_FAILURE);109 exit(EXIT_FAILURE);
110#endif
99}111}
100 112
101 113
@@ -248,7 +260,7 @@ fe_Object* fe_cons(fe_Context *ctx, fe_Object *car, fe_Object *cdr) { · 146 unmodified lines
248 260
249 261
250fe_Object* fe_bool(fe_Context *ctx, int b) {262fe_Object* fe_bool(fe_Context *ctx, int b) {
251 return b ? ctx->t : &nil;263 return b ? ctx->t : &Nil;
252}264}
253 265
254 266
@@ -262,7 +274,7 @@ fe_Object* fe_number(fe_Context *ctx, fe_Number n) { · 7 unmodified lines
262 274
263static fe_Object* buildstring(fe_Context *ctx, fe_Object *tail, int chr) {275static fe_Object* buildstring(fe_Context *ctx, fe_Object *tail, int chr) {
264 if (!tail || strbuf(tail)[STRBUFSIZE - 1] != '\0') {276 if (!tail || strbuf(tail)[STRBUFSIZE - 1] != '\0') {
265 fe_Object *obj = fe_cons(ctx, NULL, &nil);277 fe_Object *obj = fe_cons(ctx, NULL, &Nil);
266 settype(obj, FE_TSTRING);278 settype(obj, FE_TSTRING);
267 if (tail) {279 if (tail) {
268 cdr(tail) = obj;280 cdr(tail) = obj;
@@ -296,7 +308,7 @@ fe_Object* fe_symbol(fe_Context *ctx, const char *name) { · 27 unmodified lines
296 /* create new object, push to symlist and return */308 /* create new object, push to symlist and return */
297 obj = object(ctx);309 obj = object(ctx);
298 settype(obj, FE_TSYMBOL);310 settype(obj, FE_TSYMBOL);
299 cdr(obj) = fe_cons(ctx, fe_string(ctx, name), &nil);311 cdr(obj) = fe_cons(ctx, fe_string(ctx, name), &Nil);
300 ctx->symlist = fe_cons(ctx, obj, ctx->symlist);312 ctx->symlist = fe_cons(ctx, obj, ctx->symlist);
301 return obj;313 return obj;
302}314}
@@ -319,7 +331,7 @@ fe_Object* fe_ptr(fe_Context *ctx, void *ptr) { · 16 unmodified lines
319 331
320 332
321fe_Object* fe_list(fe_Context *ctx, fe_Object **objs, int n) {333fe_Object* fe_list(fe_Context *ctx, fe_Object **objs, int n) {
322 fe_Object *res = &nil;334 fe_Object *res = &Nil;
323 while (n--) {335 while (n--) {
324 res = fe_cons(ctx, objs[n], res);336 res = fe_cons(ctx, objs[n], res);
325 }337 }
@@ -447,7 +459,7 @@ static fe_Object* getbound(fe_Object *sym, fe_Object *env) { · 121 unmodified lines
447 459
448void fe_set(fe_Context *ctx, fe_Object *sym, fe_Object *v) {460void fe_set(fe_Context *ctx, fe_Object *sym, fe_Object *v) {
449 unused(ctx);461 unused(ctx);
450 cdr(getbound(sym, &nil)) = v;462 cdr(getbound(sym, &Nil)) = v;
451}463}
452 464
453 465
@@ -481,7 +493,7 @@ static fe_Object* read_(fe_Context *ctx, fe_ReadFn fn, void *udata) { · 27 unmodified lines
481 return &rparen;493 return &rparen;
482 494
483 case '(':495 case '(':
484 res = &nil;496 res = &Nil;
485 tail = &res;497 tail = &res;
486 gc = fe_savegc(ctx);498 gc = fe_savegc(ctx);
487 fe_pushgc(ctx, res); /* to cause error on too-deep nesting */499 fe_pushgc(ctx, res); /* to cause error on too-deep nesting */
@@ -492,7 +504,7 @@ static fe_Object* read_(fe_Context *ctx, fe_ReadFn fn, void *udata) { · 4 unmodified lines
492 *tail = fe_read(ctx, fn, udata);504 *tail = fe_read(ctx, fn, udata);
493 } else {505 } else {
494 /* proper pair */506 /* proper pair */
495 *tail = fe_cons(ctx, v, &nil);507 *tail = fe_cons(ctx, v, &Nil);
496 tail = &cdr(*tail);508 tail = &cdr(*tail);
497 }509 }
498 fe_restoregc(ctx, gc);510 fe_restoregc(ctx, gc);
@@ -503,7 +515,7 @@ static fe_Object* read_(fe_Context *ctx, fe_ReadFn fn, void *udata) { · 4 unmodified lines
503 case '\'':515 case '\'':
504 v = fe_read(ctx, fn, udata);516 v = fe_read(ctx, fn, udata);
505 if (!v) { fe_error(ctx, "stray '''"); }517 if (!v) { fe_error(ctx, "stray '''"); }
506 return fe_cons(ctx, fe_symbol(ctx, "quote"), fe_cons(ctx, v, &nil));518 return fe_cons(ctx, fe_symbol(ctx, "quote"), fe_cons(ctx, v, &Nil));
507 519
508 case '"':520 case '"':
509 res = buildstring(ctx, NULL, '\0');521 res = buildstring(ctx, NULL, '\0');
@@ -531,7 +543,7 @@ static fe_Object* read_(fe_Context *ctx, fe_ReadFn fn, void *udata) { · 21 unmodified lines
531 ctx->nextchr = chr;543 ctx->nextchr = chr;
532 n = strtod(buf, &p); /* try to read as number */544 n = strtod(buf, &p); /* try to read as number */
533 if (p != buf && strchr(delimiter, *p)) { return fe_number(ctx, n); }545 if (p != buf && strchr(delimiter, *p)) { return fe_number(ctx, n); }
534 if (!strcmp(buf, "nil")) { return &nil; }546 if (!strcmp(buf, "nil")) { return &Nil; }
535 return fe_symbol(ctx, buf);547 return fe_symbol(ctx, buf);
536 }548 }
537}549}
@@ -558,10 +570,10 @@ fe_Object* fe_readfp(fe_Context *ctx, FILE *fp) { · 20 unmodified lines
558static fe_Object* eval(fe_Context *ctx, fe_Object *obj, fe_Object *env, fe_Object **bind);570static fe_Object* eval(fe_Context *ctx, fe_Object *obj, fe_Object *env, fe_Object **bind);
559 571
560static fe_Object* evallist(fe_Context *ctx, fe_Object *lst, fe_Object *env) {572static fe_Object* evallist(fe_Context *ctx, fe_Object *lst, fe_Object *env) {
561 fe_Object *res = &nil;573 fe_Object *res = &Nil;
562 fe_Object **tail = &res;574 fe_Object **tail = &res;
563 while (!isnil(lst)) {575 while (!isnil(lst)) {
564 *tail = fe_cons(ctx, eval(ctx, fe_nextarg(ctx, &lst), env, NULL), &nil);576 *tail = fe_cons(ctx, eval(ctx, fe_nextarg(ctx, &lst), env, NULL), &Nil);
565 tail = &cdr(*tail);577 tail = &cdr(*tail);
566 }578 }
567 return res;579 return res;
@@ -569,7 +581,7 @@ static fe_Object* evallist(fe_Context *ctx, fe_Object *lst, fe_Object *env) { · 1 unmodified line
569 581
570 582
571static fe_Object* dolist(fe_Context *ctx, fe_Object *lst, fe_Object *env) {583static fe_Object* dolist(fe_Context *ctx, fe_Object *lst, fe_Object *env) {
572 fe_Object *res = &nil;584 fe_Object *res = &Nil;
573 int save = fe_savegc(ctx);585 int save = fe_savegc(ctx);
574 while (!isnil(lst)) {586 while (!isnil(lst)) {
575 fe_restoregc(ctx, save);587 fe_restoregc(ctx, save);
@@ -626,7 +638,7 @@ static fe_Object* eval(fe_Context *ctx, fe_Object *obj, fe_Object *env, fe_Objec · 50 unmodified lines
626 gc = fe_savegc(ctx);638 gc = fe_savegc(ctx);
627 fn = eval(ctx, car(obj), env, NULL);639 fn = eval(ctx, car(obj), env, NULL);
628 arg = cdr(obj);640 arg = cdr(obj);
629 res = &nil;641 res = &Nil;
630 642
631 switch (type(fn)) {643 switch (type(fn)) {
632 case FE_TPRIM:644 case FE_TPRIM:
@@ -777,7 +789,7 @@ static fe_Object* eval(fe_Context *ctx, fe_Object *obj, fe_Object *env, fe_Objec · 144 unmodified lines
777 789
778 790
779fe_Object* fe_eval(fe_Context *ctx, fe_Object *obj) {791fe_Object* fe_eval(fe_Context *ctx, fe_Object *obj) {
780 return eval(ctx, obj, &nil, NULL);792 return eval(ctx, obj, &Nil, NULL);
781}793}
782 794
783 795
@@ -796,9 +808,9 @@ fe_Context* fe_open(void *ptr, int size) { · 12 unmodified lines
796 ctx->object_count = size / sizeof(fe_Object);808 ctx->object_count = size / sizeof(fe_Object);
797 809
798 /* init lists */810 /* init lists */
799 ctx->calllist = &nil;811 ctx->calllist = &Nil;
800 ctx->freelist = &nil;812 ctx->freelist = &Nil;
801 ctx->symlist = &nil;813 ctx->symlist = &Nil;
802 814
803 /* populate freelist */815 /* populate freelist */
804 for (i = 0; i < ctx->object_count; i++) {816 for (i = 0; i < ctx->object_count; i++) {
@@ -829,26 +841,32 @@ fe_Context* fe_open(void *ptr, int size) { · 24 unmodified lines
829void fe_close(fe_Context *ctx) {841void fe_close(fe_Context *ctx) {
830 /* clear gcstack and symlist; makes all objects unreachable */842 /* clear gcstack and symlist; makes all objects unreachable */
831 ctx->gcstack_idx = 0;843 ctx->gcstack_idx = 0;
832 ctx->symlist = &nil;844 ctx->symlist = &Nil;
833 collectgarbage(ctx);845 collectgarbage(ctx);
834}846}
835 847
836 848
837#ifdef FE_STANDALONE849#ifdef FE_STANDALONE
838 850
851#ifndef __plan9__
839#include <setjmp.h>852#include <setjmp.h>
853#endif
840 854
841static jmp_buf toplevel;855static jmp_buf toplevel;
842static char buf[64000];856static char buf[64000];
843 857
844static void onerror(fe_Context *ctx, const char *msg, fe_Object *cl) {858static void onerror(fe_Context *ctx, const char *msg, fe_Object *cl) {
845 unused(ctx), unused(cl);859 unused(ctx); unused(cl);
846 fprintf(stderr, "error: %s\n", msg);860 fprintf(stderr, "error: %s\n", msg);
847 longjmp(toplevel, -1);861 longjmp(toplevel, -1);
848}862}
849 863
850 864#ifdef __plan9__
851int main(int argc, char **argv) {865void
866#else
867int
868#endif
869main(int argc, char **argv) {
852 int gc;870 int gc;
853 fe_Object *obj;871 fe_Object *obj;
854 FILE *volatile fp = stdin;872 FILE *volatile fp = stdin;
@@ -873,7 +891,11 @@ int main(int argc, char **argv) { · 18 unmodified lines
873 if (fp == stdin) { fe_writefp(ctx, obj, stdout); printf("\n"); }891 if (fp == stdin) { fe_writefp(ctx, obj, stdout); printf("\n"); }
874 }892 }
875 893
894#ifdef __plan9__
895 exits(nil);
896#else
876 return EXIT_SUCCESS;897 return EXIT_SUCCESS;
898#endif
877}899}
878 900
879#endif901#endif
src/fe.h+0−3
@@ -8,9 +8,6 @@ · 7 unmodified lines
8#ifndef FE_H8#ifndef FE_H
9#define FE_H9#define FE_H
10 10
11#include <stdlib.h>
12#include <stdio.h>
13
14#define FE_VERSION "1.0"11#define FE_VERSION "1.0"
15 12
16typedef float fe_Number;13typedef float fe_Number;

Keyboard shortcuts

General

Show keyboard shortcuts
?
Focus the current search
/

Issues and pull requests

Open filters
f

Issues, pull requests and Inbox

Select next item
j↓
Select previous item
k↑
Open selected item
Enter
Dismiss filters or clear selection
Esc

Repository code

Go to file
t