From deecbb89a7d1ba43fe5f416ef67df037c0c29857 Mon Sep 17 00:00:00 2001 From: Yu Fang Date: Sun, 14 Mar 2021 08:26:40 +0000 Subject: [PATCH 1/3] implementation for ccall --- villain/compile.rkt | 60 ++++++++++++++++++++++++++++++--------------- villain/externs.rkt | 3 +++ 2 files changed, 43 insertions(+), 20 deletions(-) diff --git a/villain/compile.rkt b/villain/compile.rkt index 6ace6446..ac17b7e9 100644 --- a/villain/compile.rkt +++ b/villain/compile.rkt @@ -158,26 +158,28 @@ ;; Expr CEnv Boolean -> Asm (define (compile-e e c tail?) (match e - [(Int i) (compile-value i)] - [(Bool b) (compile-value b)] - [(Char c) (compile-value c)] - [(Flonum f) (compile-flonum f)] - [(Eof) (compile-value eof)] - [(Empty) (compile-value '())] - [(String s) (compile-string s)] - [(Symbol s) (compile-symbol s c)] - [(Vec ds) (compile-vector ds c)] - [(Var x) (compile-variable x c)] - [(App f es) (compile-app f es c tail?)] - [(Apply f e) (compile-apply f e c tail?)] - [(Prim0 p) (compile-prim0 p c)] - [(Prim1 p e) (compile-prim1 p e c)] - [(Prim2 p e1 e2) (compile-prim2 p e1 e2 c)] - [(Prim3 p e1 e2 e3) (compile-prim3 p e1 e2 e3 c)] - [(If e1 e2 e3) (compile-if e1 e2 e3 c tail?)] - [(Begin e1 e2) (compile-begin e1 e2 c tail?)] - [(Let x e1 e2) (compile-let x e1 e2 c tail?)] - [(Match e0 cs) (compile-match e0 cs c tail?)])) + [(Int i) (compile-value i)] + [(Bool b) (compile-value b)] + [(Char c) (compile-value c)] + [(Flonum f) (compile-flonum f)] + [(Eof) (compile-value eof)] + [(Empty) (compile-value '())] + [(String s) (compile-string s)] + [(Symbol s) (compile-symbol s c)] + [(Vec ds) (compile-vector ds c)] + [(Var x) (compile-variable x c)] + [(App 'ccall + (cons (String f) es)) (compile-ccall (string->symbol f) es c)] + [(App f es) (compile-app f es c tail?)] + [(Apply f e) (compile-apply f e c tail?)] + [(Prim0 p) (compile-prim0 p c)] + [(Prim1 p e) (compile-prim1 p e c)] + [(Prim2 p e1 e2) (compile-prim2 p e1 e2 c)] + [(Prim3 p e1 e2 e3) (compile-prim3 p e1 e2 e3 c)] + [(If e1 e2 e3) (compile-if e1 e2 e3 c tail?)] + [(Begin e1 e2) (compile-begin e1 e2 c tail?)] + [(Let x e1 e2) (compile-let x e1 e2 c tail?)] + [(Match e0 cs) (compile-match e0 cs c tail?)])) (define (compile-e-tail e c) (compile-e e c #t)) @@ -1027,6 +1029,24 @@ (Add rsp 16) (Jmp return))])])) +;; Symbol [Listof Expr] CEnv -> Asm +(define (compile-ccall f es c) + (let ([argc (length es)]) + (seq (compile-es (reverse es) c) ; push args in reverse order + ;; +-------------+ + ;; | c (argv[2]) | + ;; +-------------+ ^ + ;; | b (argv[1]) | | increasing addr + ;; +-------------+ | + ;; | a (argv[0]) | | + ;; +-------------+ <- rsp + (Mov rdi argc) ; argc + (Mov rsi rsp) ; argv + (pad-stack-call c argc) + (Call f) + (unpad-stack-call c argc) + (Add rsp (* 8 argc))))) ; pop args + ;; CEnv -> Asm ;; Pad the stack to be aligned for a call with stack arguments (define (pad-stack-call c i) diff --git a/villain/externs.rkt b/villain/externs.rkt index 8203350a..7efaa4dc 100644 --- a/villain/externs.rkt +++ b/villain/externs.rkt @@ -32,6 +32,9 @@ (define (externs-e e) (match e + [(App 'ccall + (cons (String f) es)) + (list (Extern (string->symbol f)))] [(App f es) (append (externs-f f) (externs-es es))] From 09e1e96cb571da66cef2087362774ced478396c3 Mon Sep 17 00:00:00 2001 From: Yu Fang Date: Sun, 14 Mar 2021 09:26:09 +0000 Subject: [PATCH 2/3] add libunistring c wrapper --- villain/Makefile | 9 ++++--- villain/capi.c | 21 +++++++++++++++ villain/compile.rkt | 23 ---------------- villain/externs.rkt | 11 +------- villain/lib/char.rkt | 21 +++++++++++++++ villain/parse.rkt | 1 - villain/unistring.c | 64 ++++++++++++++++++++++++++++++++++++++++++++ villain/villain.h | 10 +++++++ 8 files changed, 123 insertions(+), 37 deletions(-) create mode 100644 villain/capi.c create mode 100644 villain/lib/char.rkt create mode 100644 villain/unistring.c diff --git a/villain/Makefile b/villain/Makefile index eed98fcf..84b92e2c 100644 --- a/villain/Makefile +++ b/villain/Makefile @@ -1,12 +1,11 @@ UNAME := $(shell uname) .PHONY: test std default +libs='-lunistring' ifeq ($(UNAME), Darwin) format=macho64 - libs='-lunistring' else format=elf64 - libs='-l:libunistring.a' endif objs = \ @@ -17,7 +16,9 @@ objs = \ symbol.o \ str.o \ wrap.o \ - utf8.o + utf8.o \ + capi.o \ + unistring.o default: runtime.o @@ -27,6 +28,8 @@ char.o: villain.h utf8.h char.h io.o: runtime.h villain.h utf8.h symbol.o: str.h types.h villain.h str.o: types.h villain.h +capi.o: runtime.h villain.h +unistring.o: villain.h %.run: %.o @ racket -t formdps.rkt -m make $@ diff --git a/villain/capi.c b/villain/capi.c new file mode 100644 index 00000000..9b8a2184 --- /dev/null +++ b/villain/capi.c @@ -0,0 +1,21 @@ +/* capi.c: utility functions for C API */ +#include "villain.h" +#include "runtime.h" + +void vl_check_type(vl_val x, vl_type type) +{ + if (vl_typeof(x) != type) + error_handler(); +} + +void vl_check_arity(uint64_t argc, uint64_t arity) +{ + if (argc != arity) + error_handler(); +} + +void vl_check_varity(uint64_t argc, uint64_t min, uint64_t max) +{ + if (argc < min || argc > max) + error_handler(); +} diff --git a/villain/compile.rkt b/villain/compile.rkt index ac17b7e9..b035281a 100644 --- a/villain/compile.rkt +++ b/villain/compile.rkt @@ -387,29 +387,6 @@ (Sal rax char-shift) (Xor rax type-char))] ['eof-object? (eq-imm val-eof)] - [(or 'char-whitespace? 'char-alphabetic?) - (let ((l (gensym))) - (seq (assert-char rax c) - (pad-stack c) - (Sar rax char-shift) - (Mov rdi rax) - (Call (char-op->uc p)) - (unpad-stack c) - (Cmp rax 0) - (Mov rax val-true) - (Jne l) - (Mov rax val-false) - (Label l)))] - [(or 'char-upcase 'char-downcase 'char-titlecase) - (let ((l (gensym))) - (seq (assert-char rax c) - (pad-stack c) - (Sar rax char-shift) - (Mov rdi rax) - (Call (char-op->uc p)) - (unpad-stack c) - (Sal rax char-shift) - (Or rax type-char)))] ['write-byte (seq (assert-byte c) (pad-stack c) diff --git a/villain/externs.rkt b/villain/externs.rkt index 7efaa4dc..4ea0dd0f 100644 --- a/villain/externs.rkt +++ b/villain/externs.rkt @@ -1,5 +1,5 @@ #lang racket -(provide externs char-op->uc symbol->label) +(provide externs symbol->label) (require "ast.rkt" "externs-stdlib.rkt" a86/ast) (define (externs p) @@ -102,15 +102,6 @@ #;['string->symbol 'str_to_symbol] ;; always included now ['open-input-file 'open_input_file] ['close-input-port 'close_input_port] - [_ (char-op->uc o)])) - -(define (char-op->uc o) - (match o - ['char-alphabetic? 'uc_is_property_alphabetic] - ['char-whitespace? 'uc_is_property_white_space] - ['char-upcase 'uc_toupper] - ['char-downcase 'uc_tolower] - ['char-titlecase 'uc_totitle] [_ #f])) ;; Symbol -> Boolean diff --git a/villain/lib/char.rkt b/villain/lib/char.rkt new file mode 100644 index 00000000..a61518b5 --- /dev/null +++ b/villain/lib/char.rkt @@ -0,0 +1,21 @@ +#lang racket +(provide char-alphabetic? + char-whitespace? + char-upcase + char-downcase + char-titlecase) + +(define (char-alphabetic? c) + (ccall "char_alphabetic" c)) + +(define (char-whitespace? c) + (ccall "char_whitespace" c)) + +(define (char-upcase c) + (ccall "char_upcase" c)) + +(define (char-downcase c) + (ccall "char_downcase" c)) + +(define (char-titlecase c) + (ccall "char_titlecase" c)) diff --git a/villain/parse.rkt b/villain/parse.rkt index 4c3c9186..bb6bc020 100644 --- a/villain/parse.rkt +++ b/villain/parse.rkt @@ -141,7 +141,6 @@ '(add1 sub1 zero? char? write-byte write-char eof-object? integer->char char->integer box unbox empty? car cdr integer-length integer? - char-alphabetic? char-whitespace? char-upcase char-downcase char-titlecase string-length string? integer? flonum? symbol->string string->symbol symbol? diff --git a/villain/unistring.c b/villain/unistring.c new file mode 100644 index 00000000..673a0a17 --- /dev/null +++ b/villain/unistring.c @@ -0,0 +1,64 @@ +/* unistring.c: wrapper for libunistring functions */ +#include +#include +#include "villain.h" + +vl_val char_alphabetic(uint64_t argc, vl_val *argv) +{ + vl_char c; + + vl_check_arity(argc, 1); + vl_check_type(argv[0], VL_CHAR); + + c = vl_unwrap_char(argv[0]); + + return vl_wrap_bool(uc_is_property_alphabetic(c)); +} + +vl_val char_whitespace(uint64_t argc, vl_val *argv) +{ + vl_char c; + + vl_check_arity(argc, 1); + vl_check_type(argv[0], VL_CHAR); + + c = vl_unwrap_char(argv[0]); + + return vl_wrap_bool(uc_is_property_white_space(c)); +} + +vl_val char_upcase(uint64_t argc, vl_val *argv) +{ + vl_char c; + + vl_check_arity(argc, 1); + vl_check_type(argv[0], VL_CHAR); + + c = vl_unwrap_char(argv[0]); + + return vl_wrap_char(uc_toupper(c)); +} + +vl_val char_downcase(uint64_t argc, vl_val *argv) +{ + vl_char c; + + vl_check_arity(argc, 1); + vl_check_type(argv[0], VL_CHAR); + + c = vl_unwrap_char(argv[0]); + + return vl_wrap_char(uc_tolower(c)); +} + +vl_val char_titlecase(uint64_t argc, vl_val *argv) +{ + vl_char c; + + vl_check_arity(argc, 1); + vl_check_type(argv[0], VL_CHAR); + + c = vl_unwrap_char(argv[0]); + + return vl_wrap_char(uc_totitle(c)); +} diff --git a/villain/villain.h b/villain/villain.h index f812196e..f9e170b8 100644 --- a/villain/villain.h +++ b/villain/villain.h @@ -55,6 +55,16 @@ typedef struct vl_port { /* return the type of x */ vl_type vl_typeof(vl_val x); +/* check if type of x matches type. + * raise error on type mismatch. */ +void vl_check_type(vl_val x, vl_type type); +/* check if argc matches arity + * raise error on arity mismatch. */ +void vl_check_arity(uint64_t argc, uint64_t arity); +/* check if argc matches variable arity + * raise error on arity mismatch. */ +void vl_check_varity(uint64_t argc, uint64_t min, uint64_t max); + /** * Wrap/unwrap villain values * From 53ced473413185e315ddf1c9aa238c74dabec40c Mon Sep 17 00:00:00 2001 From: Yu Fang Date: Sun, 14 Mar 2021 09:26:34 +0000 Subject: [PATCH 3/3] static linking is no longer necessary --- README.md | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/README.md b/README.md index a35a893e..7ecc7c78 100644 --- a/README.md +++ b/README.md @@ -49,16 +49,6 @@ Code emitted by the compiler depends upon the following libraries: macOS (with Homebrew) or `apt-get install libunistring-dev` on Ubuntu, or you can download and compile the source code. - If you are using Arch Linux, the `libunistring` package does not come with - the static library of `libunistring` (suffixed `.a`). You need to build it - from source by - - ```console - $ curl -OL https://raw.githubusercontent.com/archlinux/svntogit-packages/packages/libunistring/trunk/PKGBUILD - $ echo "options=('staticlibs')" >> PKGBUILD - $ makepkg -si - ``` - ## Reference -- [standard libraries](stdlibs.md) \ No newline at end of file +- [standard libraries](stdlibs.md)