Merge pull request #102 from cmsc430/outlaw

Outlaw

Author: dvanhorn

.github/workflows/langs.yml

@@ -15,6 +15,10 @@ jobs:
       uses: actions/checkout@main
     - name: Install nasm
       run: sudo apt-get install nasm
+    - name: Install libunistring
+      run: |
+        sudo apt-get install libunistring2
+        sudo apt-get install libunistring-dev
     - name: Install Racket
       uses: Bogdanp/setup-racket@v1.5
       with:
@@ -29,4 +33,6 @@ jobs:
     - name: Install langs package
       run: raco pkg install langs/
     - name: Run tests
-      run: raco test -p langs
+      run: |
+        export LINK_DIR=/usr/lib/x86_64-linux-gnu
+        raco test -p langs

.github/workflows/macos.yml

@@ -1,5 +1,5 @@
 on:
-  - push
+  - workflow_dispatch
 
 jobs:
   build-and-test:

.github/workflows/push.yml

@@ -13,6 +13,7 @@ jobs:
         sudo dpkg -i pandoc.deb
         sudo apt-get install nasm
         sudo apt-get install fonts-stix
+        sudo apt-get install libunistring-dev
     - name: Install Racket
       uses: Bogdanp/setup-racket@v1.5
       with:
@@ -22,6 +23,7 @@ jobs:
         version: '8.1'
     - name: Build and test
       run: |
+        export LINK_DIR=/usr/lib/x86_64-linux-gnu
         raco pkg install langs/
         raco make www/main.scrbl
         raco test langs

langs/outlaw/Makefile

@@ -0,0 +1,50 @@
+# NOTES:
+# - You will need a static version of libunistring to link against; on Mac
+#   ld will always choose .dylib over .a to link, so either rename or remove
+#   the .dylib versions.
+
+UNAME := $(shell uname)
+.PHONY: test
+
+ifeq ($(UNAME), Darwin)
+  format=macho64
+else
+  format=elf64
+endif
+
+objs = \
+	main.o \
+	values.o \
+	print.o \
+	symbol.o \
+	string.o \
+	io.o \
+	error.o \
+	os.o \
+	stdlib.o
+
+default: runtime.o
+
+runtime.o: $(objs)
+	ld -r $(objs) -o runtime.o
+
+%.run: %.o runtime.o
+	gcc -lunistring runtime.o $< -o $@
+
+.c.o:
+	gcc -fPIC -c -g -o $@ $<
+
+.s.o:
+	nasm -g -f $(format) -o $@ $<
+
+stdlib.s: stdlib.rkt
+	cat stdlib.rkt | racket -t compile-library.rkt -m > stdlib.s
+
+%.s: %.rkt
+	cat $< | racket -t compile-stdin.rkt -m > $@
+
+clean:
+	rm *.o *.s *.run
+
+test: example.run
+	@test "$(shell ./example.run)" = "$(shell racket example.rkt)"

langs/outlaw/a86/ast.rkt

@@ -0,0 +1,100 @@
+#lang racket
+(provide (all-defined-out))
+
+(struct Text   ())
+(struct Data   ())
+
+(struct Global (x))
+(struct Label  (x))
+(struct Call   (x))
+(struct Ret    ())
+(struct Mov    (dst src))
+(struct Add    (dst src))
+(struct Sub    (dst src))
+(struct Cmp    (a1 a2))
+(struct Jmp    (x))
+(struct Je     (x))
+(struct Jne    (x))
+(struct Jl     (x))
+(struct Jle    (x))
+(struct Jg     (x))
+(struct Jge    (x))
+(struct And    (dst src))
+(struct Or     (dst src))
+(struct Xor    (dst src))
+(struct Sal    (dst i))
+(struct Sar    (dst i))
+(struct Push   (a1))
+(struct Pop    (a1))
+(struct Lea    (dst x))
+(struct Div    (den))
+
+(struct Offset (r i))
+(struct Extern (x))
+
+(struct Equ    (x v))
+(struct Const  (x))
+(struct Dd (x))
+(struct Dq (x))
+(struct Plus (e1 e2))
+
+;; (U Instruction Asm) ... -> Asm
+;; Convenient for sequencing instructions or groups of instructions
+(define (seq . xs)
+  (foldr (λ (x is)
+           (if (list? x)
+               (append x is)
+               (cons x is)))
+         '()
+         xs))
+
+(define (register? x)
+  (and (memq x '(cl eax rax rbx rcx rdx rbp rsp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))
+       #t))
+
+(define (exp? x)
+  (or (Offset? x)
+      (and (Plus? x)
+           (exp? (Plus-e1 x))
+           (exp? (Plus-e2 x)))
+      (symbol? x)
+      (integer? x)))
+
+(define offset? Offset?)
+
+(define (label? x)
+  (and (symbol? x)
+       (not (register? x))))
+
+(define (instruction? x)
+  (or (Text? x)
+      (Data? x)
+      (Global? x)
+      (Label? x)
+      (Extern? x)
+      (Call? x)
+      (Ret? x)
+      (Mov? x)
+      (Add? x)
+      (Sub? x)
+      (Cmp? x)
+      (Jmp? x)
+      (Je? x)
+      (Jne? x)
+      (Jl? x)
+      (Jle? x)
+      (Jg? x)
+      (Jge? x)
+      (And? x)
+      (Or? x)
+      (Xor? x)
+      (Sal? x)
+      (Sar? x)
+      (Push? x)
+      (Pop? x)
+      (Lea? x)
+      (Div? x)
+      ;(Comment? x)
+      (Equ? x)
+      (Dd? x)
+      (Dq? x)))

langs/outlaw/a86/callback.rkt

@@ -0,0 +1,46 @@
+#lang racket
+;; based on racket/draw/unsafe/callback
+(provide guard-foreign-escape)
+(require ffi/unsafe
+         ffi/unsafe/atomic)
+
+(define callback-atomic? (eq? 'chez-scheme (system-type 'vm)))
+
+(define-syntax-rule (guard-foreign-escape e0 e ...)
+  (call-guarding-foreign-escape (lambda () e0 e ...)))
+
+(define (call-guarding-foreign-escape thunk)
+  (if callback-atomic?
+      ((call-with-c-return
+        (lambda ()
+          (with-handlers ([(lambda (x) #t)
+                           (lambda (x)
+                             ;; Deliver an exception re-raise after returning back
+                             ;; from `call-with-c-return`:
+                             (lambda ()
+                               (when (in-atomic-mode?)
+                                 (end-atomic)) ; error happened during atomic mode
+                               ;(enable-interrupts) ; ... with interrupts disabled
+                               (void/reference-sink call-with-c-return-box)
+                               (raise x)))])
+            (let ([vs (call-with-values thunk list)])
+              ;; Deliver successful values after returning back from
+              ;; `call-with-c-return`:
+              (lambda ()
+                (void/reference-sink call-with-c-return-box)
+                (apply values vs)))))))
+      (thunk)))
+
+(define call-with-c-return-box (box #f))
+
+;; `call-with-c-return` looks like a foreign function, due to a cast
+;; to and from a callback, so returning from `call-with-c-return` will
+;; pop and C frame stacks (via longjmp internally) that were pushed
+;; since `call-with-c-return` was called.
+(define call-with-c-return
+  (and callback-atomic?
+       (cast (lambda (thunk) (thunk))
+             (_fun #:atomic? #t
+                   #:keep call-with-c-return-box
+                   _racket -> _racket)
+             (_fun _racket -> _racket))))