klisp

commit 850c4b89790ccacf06b115e9e2e042cce1d435a4
parent 0bf961b8ffadfa0f53c32fc222f2355b0c1c0a0f
Author: Oto Havle <havleoto@gmail.com>
Date:   Thu, 20 Oct 2011 15:36:03 +0200

Added support for unix script directive (#!).

Diffstat:
M
src/Makefile
 | 
2
+-
M
src/kgports.c
 | 
6
++++++
M
src/kscript.c
 | 
22
++++++++++++++++++++++
M
src/kscript.h
 | 
4
++++

4 files changed, 33 insertions(+), 1 deletion(-)
diff --git a/src/Makefile b/src/Makefile
@@ -187,7 +187,7 @@ kgpairs_lists.o: kgpairs_lists.c kstate.h klimits.h klisp.h kobject.h \
 kgports.o: kgports.c kstate.h klimits.h klisp.h kobject.h klispconf.h \
  ktoken.h kmem.h kport.h kenvironment.h kapplicative.h koperative.h \
  kcontinuation.h kpair.h kgc.h kerror.h ksymbol.h kstring.h kread.h \
- kwrite.h kghelpers.h kgports.h kgcontinuations.h kgcontrol.h kgkd_vars.h
+ kwrite.h kghelpers.h kgports.h kgcontinuations.h kgcontrol.h kgkd_vars.h kscript.h
 kgpromises.o: kgpromises.c kstate.h klimits.h klisp.h kobject.h \
  klispconf.h ktoken.h kmem.h kpromise.h kpair.h kgc.h kapplicative.h \
  koperative.h kcontinuation.h kerror.h kghelpers.h kenvironment.h \
diff --git a/src/kgports.c b/src/kgports.c
@@ -25,6 +25,8 @@
 #include "kwrite.h"
 #include "kpair.h"
 
+#include "kscript.h"
+
 #include "kghelpers.h"
 #include "kgports.h"
 #include "kgcontinuations.h" /* for guards */
@@ -329,6 +331,10 @@ void call_with_file(klisp_State *K, TValue *xparams, TValue ptree,
 /* GC: assume port is rooted */
 TValue read_all_expr(klisp_State *K, TValue port)
 {
+    /* support unix script directive #! */
+    int line_count = kscript_eat_directive(kport_file(port));
+    kport_line(port) += line_count;
+
     /* GC: root dummy and obj */
     TValue tail = kget_dummy1(K);
     TValue obj = KINERT;
diff --git a/src/kscript.c b/src/kscript.c
@@ -242,3 +242,25 @@ void kinit_script(klisp_State *K, int argc, char *argv[])
 #undef RSI
 #undef G
 }
+
+/* skips the unix script directive (#!), if present.
+   returns number of lines skipped */
+int kscript_eat_directive(FILE *fr)
+{
+  static const char pattern[] = "#! ";
+  int c, n = 0;
+
+  while (pattern[n] != '\0' && (c = getc(fr), c == pattern[n]))
+    n++;
+
+  if (pattern[n] == '\0') {
+    while (c = getc(fr), c != EOF && c != '\n')
+      ;
+    return 1;
+  } else {
+    ungetc(c, fr);
+    while (n > 0)
+      ungetc(pattern[--n], fr);
+    return 0;
+  }
+}
diff --git a/src/kscript.h b/src/kscript.h
@@ -7,6 +7,7 @@
 #ifndef kscript_h
 #define kscript_h
 
+#include <stdio.h>
 #include "klisp.h"
 #include "kstate.h"
 #include "kobject.h"
@@ -17,6 +18,9 @@ void kinit_script(klisp_State *K, int argc, char *argv[]);
 void do_script_exit(klisp_State *K, TValue *xparams, TValue obj);
 void do_script_error(klisp_State *K, TValue *xparams, TValue obj);
 
+/* unix script directive handling */
+int kscript_eat_directive(FILE *fr);
+
 /* default exit code in case of error according to SRFI-22 */
 
 #define KSCRIPT_DEFAULT_ERROR_EXIT_CODE   70