From 7537d41e26330c4402c785c04f55e05b4a761136 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 25 May 2015 22:59:38 -0400
Subject: [PATCH] WIP - (system)

---
 TODO      |  1 +
 cgen.scm  |  4 +++-
 eval.scm  |  1 +
 runtime.c | 10 ++++++++++
 runtime.h |  1 +
 trans.scm |  2 ++
 6 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/TODO b/TODO
index 30bb71c1..d5b5dbd1 100644
--- a/TODO
+++ b/TODO
@@ -15,6 +15,7 @@ Working TODO list:
    - quasiquote - will need to enhance the parser to support a second type of quote, at minimum
    - string<? - and related functions, too
    - (system) - not standard, but need to run gcc. See cyclone.scm for use
+     Almost done, need to add primitive to runtime
    - vectors - limited use in cgen module - make-vector, vector-set!, and vector-ref
 
  - Reduction in size of generated code
diff --git a/cgen.scm b/cgen.scm
index 1070a741..08b15bba 100644
--- a/cgen.scm
+++ b/cgen.scm
@@ -438,6 +438,7 @@
      ((eq? p 'string->symbol) "Cyc_string2symbol")
      ((eq? p 'symbol->string) "Cyc_symbol2string")
      ((eq? p 'number->string) "Cyc_number2string")
+     ((eq? p 'system)         "Cyc_system")
      ((eq? p 'assq)          "assq")
      ((eq? p 'assv)          "assq")
      ((eq? p 'assoc)         "assoc")
@@ -477,6 +478,7 @@
     ((eq? p 'open-input-file) "port_type")
     ((eq? p 'length) "integer_type")
     ((eq? p 'char->integer) "integer_type")
+    ((eq? p 'system) "integer_type")
     ((eq? p '+) "common_type")
     ((eq? p '-) "common_type")
     ((eq? p '*) "common_type")
@@ -495,7 +497,7 @@
     (and (prim? exp)
          (member exp '(
              current-input-port open-input-file
-             char->integer string->number string-append list->string string->list
+             char->integer system string->number string-append list->string string->list
              symbol->string number->string
              + - * / apply cons length cell))))
 
diff --git a/eval.scm b/eval.scm
index c3e20257..a044da0b 100644
--- a/eval.scm
+++ b/eval.scm
@@ -203,6 +203,7 @@
       (list 'apply apply)
       (list '%halt %halt)
       (list 'exit exit)
+      (list 'system system)
       (list 'error error)
       (list 'cons cons)
       (list 'cell-get cell-get)
diff --git a/runtime.c b/runtime.c
index 6f215820..996ac8c3 100644
--- a/runtime.c
+++ b/runtime.c
@@ -692,6 +692,16 @@ string_type Cyc_string_append_va_list(int argc, object str1, va_list ap) {
     return result;
 }
 
+integer_type Cyc_system(object cmd) {
+  if (nullp(cmd) || is_value_type(cmd) || type_of(cmd) != string_tag) {
+    make_int(n, -1);
+    return n;
+  } else {
+    make_int(n, system(((string_type *)cmd)->str));
+    return n;
+  }
+}
+
 integer_type Cyc_char2integer(object chr){
     make_int(n, obj_obj2char(chr));
     return n;
diff --git a/runtime.h b/runtime.h
index 72414cab..27e9ceca 100644
--- a/runtime.h
+++ b/runtime.h
@@ -90,6 +90,7 @@ common_type Cyc_string2number(object str);
 void dispatch_string_91append(int argc, object clo, object cont, object str1, ...);
 string_type Cyc_string_append(int argc, object str1, ...);
 string_type Cyc_string_append_va_list(int argc, object str1, va_list ap);
+integer_type Cyc_system(object cmd);
 integer_type Cyc_char2integer(object chr);
 object Cyc_integer2char(object n);
 void my_exit(closure) never_returns;
diff --git a/trans.scm b/trans.scm
index d2c591c1..d8051284 100644
--- a/trans.scm
+++ b/trans.scm
@@ -480,6 +480,7 @@
      apply
      %halt
      exit
+     system
      Cyc-default-exception-handler
      Cyc-current-exception-handler
      cons
@@ -548,6 +549,7 @@
                   apply
                   %halt
                   exit
+                  system
                   Cyc-default-exception-handler
                   Cyc-current-exception-handler
                   cell-get