Add system-type primitive.

Author: dvanhorn

langs/outlaw/Makefile

@@ -20,6 +20,7 @@ objs = \
 	string.o \
 	io.o \
 	error.o \
+	os.o \
 	stdlib.o
 
 default: runtime.o

langs/outlaw/a86/printer.rkt

@@ -18,15 +18,15 @@
 
 ;; Label -> String
 (define label-symbol->string
-  (match (system-type 'os)
+  (match (system-type)
     ['macosx
      (λ (s) (string-append "_" (symbol->string s)))]
     [_ symbol->string]))
 
 ;; Label -> String
 ;; prefix with _ for Mac
 (define label-symbol->string/rel
-  (match (system-type 'os)
+  (match (system-type)
     ['macosx
      (λ (s) (string-append "_" (symbol->string s)))]
     [_
@@ -76,7 +76,7 @@
 (define (external-label-shared? x)
   (and (label? x)
        (current-shared?)
-       (eq? 'unix (system-type 'os))
+       (eq? 'unix (system-type))
        (memq x (unbox external-labels))))
 
 (define (mov->string a1 a2)

langs/outlaw/compile-ops.rkt

@@ -12,6 +12,11 @@
                      (unpad-stack))]
     ['current-input-port ; hack, doesn't actually exist
      (seq (Mov rax val-void))]
+    ['system-type
+     (seq (pad-stack)
+          (Call 'system_type)
+          (Sal rax int-shift)
+          (unpad-stack))]
 
     ;; Op1
     ['add1

langs/outlaw/compile.rkt

@@ -102,7 +102,8 @@
          open_input_file
          read_byte_port
          peek_byte_port
-         is_char_alphabetic)))
+         is_char_alphabetic
+         system_type)))
 
 (define cons-function
   (let ((code (gensym 'cons_code))

langs/outlaw/parse.rkt

@@ -322,6 +322,7 @@
 (define op0
   '(read-byte void read-char peek-char
               current-input-port ; hack, doesn't actually exist
+              system-type
               ))
 
 (define op1

langs/outlaw/stdlib.rkt

@@ -9,7 +9,7 @@
          remove-duplicates remq* remove* remove
          andmap vector list->vector boolean? substring
          odd?
-         system-type ;; hard-coded
+         system-type
          not
          findf
          read-line
@@ -299,10 +299,13 @@
 (define (odd? x)
   (= (remainder x 2) 1))
 
-;; FIXME: hard-coded system type
-(define (system-type _)
-  'unix)
-;  'macosx)
+(define (system-type)
+  ;; the primitive system type returns 1 for mac, 0 otherwise;
+  ;; the fall through case is for when %system-type is implemented in Racket
+  (match (%system-type)
+    [1 'macosx]
+    [0 'unix]
+    [x x]))
 
 (define (not x)
   (if x #f #t))

langs/outlaw/test/test-runner.rkt

@@ -601,6 +601,7 @@
   (check-equal? (run '(let ((x 1)) x x)) 1)
   (check-equal? (run '(let ((x 1)) x x x)) 1)
   (check-equal? (run '(match 1 [1 2 3])) 3)
+  (check-equal? (run '(system-type)) (system-type))
   )