From 124c1379874aaedba0d603dd9bc22eeeda8042e7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 07:47:32 +0000 Subject: [PATCH 01/65] WIP --- cyclone.scm | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index 5e48e117..e4498d5d 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -216,6 +216,20 @@ (trace:info "---------------- after alpha conversion:") (trace:info input-program) ;pretty-print + ;; Identify native Scheme functions that can be inlined +; (define inlinable-scheme-fncs '()) +; (for-each +; (lambda (e) +; (when (inlinable-top-level-function? e) +; (set! inlinable-scheme-fncs +; (cons (define->var e) inlinable-scheme-fncs)) +; ;; TESTING, will not work yet +; (prim:add-udf! (define->var e) (define-c->inline-var e)) +; )) +; input-program) +; (trace:info "---------------- results of inlinable-top-level-function analysis: ") +; (trace:info inlinable-scheme-fncs) + ;; Convert some function calls to primitives, if possible (set! input-program (map @@ -224,13 +238,6 @@ input-program)) (trace:info "---------------- after func->primitive conversion:") (trace:info input-program) ;pretty-print - - (trace:info "---------------- results of inlinable-top-level-function analysis: ") - (for-each - (lambda (e) - (if (inlinable-top-level-function? e) - (trace:info (define->var e)))) - input-program) (let ((cps (map (lambda (expr) From 33ba61578bf855aff5be7c932b8010cd63eccc22 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 08:31:25 +0000 Subject: [PATCH 02/65] Remove unsafe code --- scheme/cyclone/transforms.sld | 1 - 1 file changed, 1 deletion(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 29fdf5f5..2652d58b 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -1234,7 +1234,6 @@ ;; Determine if the given top-level function can be freed from CPS, due ;; to it only containing calls to code that itself can be inlined. (define (inlinable-top-level-function? expr) - (define this-fnc-sym (define->var expr)) (define (scan expr fail) (cond ((string? expr) (fail)) From 547d1e218d6d9f87af29b67b2ec98c4a9813fab3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 09:02:44 +0000 Subject: [PATCH 03/65] Re-enable inline searching code --- cyclone.scm | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index e4498d5d..69afc748 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -217,18 +217,18 @@ (trace:info input-program) ;pretty-print ;; Identify native Scheme functions that can be inlined -; (define inlinable-scheme-fncs '()) -; (for-each -; (lambda (e) -; (when (inlinable-top-level-function? e) -; (set! inlinable-scheme-fncs -; (cons (define->var e) inlinable-scheme-fncs)) -; ;; TESTING, will not work yet -; (prim:add-udf! (define->var e) (define-c->inline-var e)) -; )) -; input-program) -; (trace:info "---------------- results of inlinable-top-level-function analysis: ") -; (trace:info inlinable-scheme-fncs) + (define inlinable-scheme-fncs '()) + (for-each + (lambda (e) + (when (inlinable-top-level-function? e) + (set! inlinable-scheme-fncs + (cons (define->var e) inlinable-scheme-fncs)) + ;; TESTING, will not work yet + ;(prim:add-udf! (define->var e) (define-c->inline-var e)) + )) + input-program) + (trace:info "---------------- results of inlinable-top-level-function analysis: ") + (trace:info inlinable-scheme-fncs) ;; Convert some function calls to primitives, if possible (set! input-program From d27b55d27bc5688711cf3ef3b0ae5303539f5500 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 09:54:13 +0000 Subject: [PATCH 04/65] Allow scheme inlines through, though C comp fails --- cyclone.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/cyclone.scm b/cyclone.scm index 69afc748..9eb5bdd3 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -224,7 +224,10 @@ (set! inlinable-scheme-fncs (cons (define->var e) inlinable-scheme-fncs)) ;; TESTING, will not work yet - ;(prim:add-udf! (define->var e) (define-c->inline-var e)) + (set! module-globals + (cons (define-c->inline-var e) module-globals)) + (prim:add-udf! (define->var e) (define-c->inline-var e)) + ;; END )) input-program) (trace:info "---------------- results of inlinable-top-level-function analysis: ") @@ -327,6 +330,9 @@ (trace:info "---------------- C headers: ") (trace:info c-headers) + (trace:info "---------------- module globals: ") + (trace:info module-globals) + (trace:info "---------------- C code:") (mta:code-gen input-program program? From 68b8e1fc38ab3b543d4e77fd5f42ad98fd22ae3e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 10:53:30 +0000 Subject: [PATCH 05/65] WIP --- scheme/cyclone/cgen.sld | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index e7d533b1..45d139ba 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -833,6 +833,17 @@ (c-compile-exp body append-preamble cont (st:add-function! trace var))) + + ;; Add inline global definition also, if applicable +; (if (and (lambda? body) +; (prim:udf? exp) +; (add-global +; (define-c->inline-var exp) +; (lambda? body) +; (c-compile-exp +; body append-preamble cont +; (st:add-function! trace var))) + (c-code/vars "" (list "")))) (define (c-compile-raw-global-lambda exp append-preamble cont trace . inline?) @@ -903,7 +914,7 @@ ;; once given a C name, produce a C function ;; definition with that name. -;; These procedures are stored up an eventually +;; These procedures are stored up and eventually ;; emitted. ; type lambda-id = natural @@ -922,8 +933,8 @@ id)) ; get-lambda : lambda-id -> (symbol -> string) -(define (get-lambda id) - (cdr (assv id lambdas))) +;(define (get-lambda id) +; (cdr (assv id lambdas))) (define (lambda->env exp) (let ((formals (lambda-formals->list exp))) From b27dab456d5fb2d9defd9f678e740a7cc7476a84 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 12:44:45 +0000 Subject: [PATCH 06/65] WIP --- scheme/cyclone/cgen.sld | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 45d139ba..6bf71876 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -814,6 +814,15 @@ (define (add-global-inline var-sym) (set! *global-inlines* (cons var-sym *global-inlines*))) +;; Add a global inlinable function that is written in Scheme. +;; This is more challenging than define-c forms since the +;; code must be compiled again to work without CPS. +(define *global-inline-scms* '()) +(define (add-global-inline-scm-lambda var-sym code) + (add-global-inline var-sym) + (set! *global-inline-scms* + (cons (list var-sym code) *global-inline-scms*))) + ;; Global compilation (define *globals* '()) (define *global-syms* '()) @@ -835,14 +844,23 @@ (st:add-function! trace var))) ;; Add inline global definition also, if applicable +; (trace:error `(JAE DEBUG ,var +; ,(lambda? body) +; ,(define-c->inline-var exp) +; ,(prim:udf? (define-c->inline-var exp)) +; )) ; (if (and (lambda? body) -; (prim:udf? exp) +; (prim:udf? (define-c->inline-var exp))) ; (add-global ; (define-c->inline-var exp) -; (lambda? body) -; (c-compile-exp -; body append-preamble cont -; (st:add-function! trace var))) +; #t ;; always a lambda +; (c-code/vars "TODO" (list "TODO")) ;; Temporary testing! +;; (c-compile-exp +;; body append-preamble cont +;; (st:add-function! trace var) +;; #t ;; inline --> requires passing new param everywhere, though +;; ) +; )) (c-code/vars "" (list "")))) From 9f26868ef0977b108d374bee4fe4241210510b8c Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 12:51:30 +0000 Subject: [PATCH 07/65] Exclude lib init from inlinable top level funcs --- cyclone.scm | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index 9eb5bdd3..fd2fc0a4 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -218,18 +218,20 @@ ;; Identify native Scheme functions that can be inlined (define inlinable-scheme-fncs '()) - (for-each - (lambda (e) - (when (inlinable-top-level-function? e) - (set! inlinable-scheme-fncs - (cons (define->var e) inlinable-scheme-fncs)) - ;; TESTING, will not work yet - (set! module-globals - (cons (define-c->inline-var e) module-globals)) - (prim:add-udf! (define->var e) (define-c->inline-var e)) - ;; END - )) - input-program) + (let ((lib-init-fnc (lib:name->symbol lib-name))) ;; safe to ignore for programs + (for-each + (lambda (e) + (when (and (not (equal? (define->var e) lib-init-fnc)) + (inlinable-top-level-function? e)) + (set! inlinable-scheme-fncs + (cons (define->var e) inlinable-scheme-fncs)) + ;; TESTING, will not work yet + (set! module-globals + (cons (define-c->inline-var e) module-globals)) + (prim:add-udf! (define->var e) (define-c->inline-var e)) + ;; END + )) + input-program)) (trace:info "---------------- results of inlinable-top-level-function analysis: ") (trace:info inlinable-scheme-fncs) From 2da2317a91c285b0cbcf6ea3f6d511a6b0f4c4f6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 13:21:19 +0000 Subject: [PATCH 08/65] Rename param to "cps?" --- scheme/cyclone/cgen.sld | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 6bf71876..3235795a 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -864,9 +864,9 @@ (c-code/vars "" (list "")))) -(define (c-compile-raw-global-lambda exp append-preamble cont trace . inline?) +(define (c-compile-raw-global-lambda exp append-preamble cont trace . cps?) (let* ((precompiled-sym - (if (equal? inline? '(#t)) + (if (equal? cps? '(#f)) 'precompiled-inline-lambda 'precompiled-lambda)) (lambda-data @@ -900,7 +900,7 @@ append-preamble cont trace - #t)))) ;; Inline this one + #f)))) ;; Inline this one; CPS will not be used ;; Add this define-c (add-global (define->var exp) From f50aafffe4f16fc84dd8099797e38c253d247324 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 13:49:34 +0000 Subject: [PATCH 09/65] WIP - starting to add cps parameter --- scheme/cyclone/cgen.sld | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 3235795a..05431796 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -305,7 +305,13 @@ ;; trace - trace information. presently a pair containing: ;; * source file ;; * function name (or NULL if none) -(define (c-compile-exp exp append-preamble cont trace) +;; cps? - Determine whether to compile using continuation passing style. +;; Normally this is always enabled, but sometimes a function has a +;; version that can be inlined (as an optimization), so this will +;; be set to false to change the type of compilation. +;; NOTE: this field is not passed everywhere because a lot of forms +;; require CPS, so this flag is not applicable to them. +(define (c-compile-exp exp append-preamble cont trace cps?) (cond ; Core forms: ((const? exp) (c-compile-const exp)) @@ -314,7 +320,7 @@ (c-code (string-append "primitive_" (mangle exp)))) ((ref? exp) (c-compile-ref exp)) ((quote? exp) (c-compile-quote exp)) - ((if? exp) (c-compile-if exp append-preamble cont trace)) + ((if? exp) (c-compile-if exp append-preamble cont trace cps?)) ; IR (2): ((tagged-list? '%closure exp) @@ -331,7 +337,7 @@ append-preamble cont trace)) ; Application: - ((app? exp) (c-compile-app exp append-preamble cont trace)) + ((app? exp) (c-compile-app exp append-preamble cont trace cps?)) (else (error "unknown exp in c-compile-exp: " exp)))) (define (c-compile-quote qexp) @@ -676,7 +682,7 @@ num-args))) ;; c-compile-app : app-exp (string -> void) -> string -(define (c-compile-app exp append-preamble cont trace) +(define (c-compile-app exp append-preamble cont trace cps?) ;(trace:debug `(c-compile-app: ,exp)) (let (($tmp (mangle (gensym 'tmp)))) (let* ((args (app->args exp)) @@ -793,7 +799,7 @@ (error `(Unsupported function application ,exp))))))) ; c-compile-if : if-exp -> string -(define (c-compile-if exp append-preamble cont trace) +(define (c-compile-if exp append-preamble cont trace cps?) (let* ((compile (lambda (exp) (c-compile-exp exp append-preamble cont trace))) (test (compile (if->condition exp))) @@ -858,7 +864,7 @@ ;; (c-compile-exp ;; body append-preamble cont ;; (st:add-function! trace var) -;; #t ;; inline --> requires passing new param everywhere, though +;; #f ;; inline, so disable CPS on this pass ;; ) ; )) From 021113ced45883aaba83e816946997005ab012e5 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 20 Apr 2017 17:57:59 -0400 Subject: [PATCH 10/65] Add cps param --- scheme/cyclone/cgen.sld | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 05431796..095f8c37 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -286,7 +286,7 @@ (let* ((preamble "") (append-preamble (lambda (s) (set! preamble (string-append preamble " " s "\n")))) - (body (c-compile-exp exp append-preamble "cont" (list src-file)))) + (body (c-compile-exp exp append-preamble "cont" (list src-file) #t))) ;(write `(DEBUG ,body)) (string-append preamble @@ -334,7 +334,7 @@ ((tagged-list? 'lambda exp) (c-compile-exp `(%closure ,exp) - append-preamble cont trace)) + append-preamble cont trace #t)) ; Application: ((app? exp) (c-compile-app exp append-preamble cont trace cps?)) @@ -660,7 +660,7 @@ (mangle exp)))) ; c-compile-args : list[exp] (string -> void) -> string -(define (c-compile-args args append-preamble prefix cont trace) +(define (c-compile-args args append-preamble prefix cont trace cps?) (letrec ((num-args 0) (_c-compile-args (lambda (args append-preamble prefix cont) @@ -673,7 +673,7 @@ (c:append/prefix prefix (c-compile-exp (car args) - append-preamble cont trace) + append-preamble cont trace cps?) (_c-compile-args (cdr args) append-preamble ", " cont))))))) (c:tuple/args @@ -698,7 +698,8 @@ append-preamble "" this-cont - trace)) + trace + cps?)) (num-cargs (c:num-args cgen))) (set-c-call-arity! num-cargs) (c-code @@ -713,7 +714,7 @@ (let* ((c-fun (c-compile-prim fun cont)) (c-args - (c-compile-args args append-preamble "" "" trace)) + (c-compile-args args append-preamble "" "" trace cps?)) (num-args (length args)) (num-args-str (string-append @@ -761,9 +762,9 @@ ;; TODO: may not be good enough, closure app could be from an element ((tagged-list? '%closure-ref fun) - (let* ((cfun (c-compile-args (list (car args)) append-preamble " " cont trace)) + (let* ((cfun (c-compile-args (list (car args)) append-preamble " " cont trace cps?)) (this-cont (c:body cfun)) - (cargs (c-compile-args (cdr args) append-preamble " " this-cont trace))) + (cargs (c-compile-args (cdr args) append-preamble " " this-cont trace cps?))) (set-c-call-arity! (c:num-args cargs)) (c-code (string-append @@ -781,7 +782,7 @@ fun append-preamble cont trace)) (this-cont (string-append "(closure)" (c:body cfun))) (cargs (c-compile-args - args append-preamble " " this-cont trace)) + args append-preamble " " this-cont trace cps?)) (num-cargs (c:num-args cargs))) (set-c-call-arity! num-cargs) (c-code @@ -801,7 +802,7 @@ ; c-compile-if : if-exp -> string (define (c-compile-if exp append-preamble cont trace cps?) (let* ((compile (lambda (exp) - (c-compile-exp exp append-preamble cont trace))) + (c-compile-exp exp append-preamble cont trace cps?))) (test (compile (if->condition exp))) (then (compile (if->then exp))) (els (compile (if->else exp)))) @@ -847,7 +848,7 @@ (lambda? body) (c-compile-exp body append-preamble cont - (st:add-function! trace var))) + (st:add-function! trace var) #t)) ;; Add inline global definition also, if applicable ; (trace:error `(JAE DEBUG ,var @@ -1148,7 +1149,8 @@ (car (lambda->exp exp)) ;; car ==> assume single expr in lambda body after CPS append-preamble (mangle env-closure) - trace))) + trace + #t))) (cons (lambda (name) (string-append "static void " name From bd9119c274cd7f71bea8ce8e194ea560fc03b0b6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 19:14:52 +0000 Subject: [PATCH 11/65] WIP --- scheme/cyclone/cgen.sld | 70 ++++++++++++++++++++++++++--------------- 1 file changed, 45 insertions(+), 25 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 095f8c37..25129a02 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -324,7 +324,7 @@ ; IR (2): ((tagged-list? '%closure exp) - (c-compile-closure exp append-preamble cont trace)) + (c-compile-closure exp append-preamble cont trace cps?)) ; Global definition ((define? exp) (c-compile-global exp append-preamble cont trace)) @@ -334,7 +334,7 @@ ((tagged-list? 'lambda exp) (c-compile-exp `(%closure ,exp) - append-preamble cont trace #t)) + append-preamble cont trace cps?)) ; Application: ((app? exp) (c-compile-app exp append-preamble cont trace cps?)) @@ -689,7 +689,7 @@ (fun (app->fun exp))) (cond ((lambda? fun) - (let* ((lid (allocate-lambda (c-compile-lambda fun trace))) ;; TODO: pass in free vars? may be needed to track closures + (let* ((lid (allocate-lambda (c-compile-lambda fun trace #t))) ;; TODO: pass in free vars? may be needed to track closures ;; properly, wait until this comes up in an example (this-cont (string-append "__lambda_" (number->string lid))) (cgen @@ -779,7 +779,7 @@ ((tagged-list? '%closure fun) (let* ((cfun (c-compile-closure - fun append-preamble cont trace)) + fun append-preamble cont trace cps?)) (this-cont (string-append "(closure)" (c:body cfun))) (cargs (c-compile-args args append-preamble " " this-cont trace cps?)) @@ -856,18 +856,17 @@ ; ,(define-c->inline-var exp) ; ,(prim:udf? (define-c->inline-var exp)) ; )) -; (if (and (lambda? body) -; (prim:udf? (define-c->inline-var exp))) -; (add-global -; (define-c->inline-var exp) -; #t ;; always a lambda -; (c-code/vars "TODO" (list "TODO")) ;; Temporary testing! -;; (c-compile-exp -;; body append-preamble cont -;; (st:add-function! trace var) -;; #f ;; inline, so disable CPS on this pass -;; ) -; )) + (if (and (lambda? body) + (prim:udf? (define-c->inline-var exp))) + (add-global + (define-c->inline-var exp) + #t ;; always a lambda + (c-compile-exp + body append-preamble cont + (st:add-function! trace var) + #f ;; inline, so disable CPS on this pass + ) + )) (c-code/vars "" (list "")))) @@ -949,12 +948,15 @@ ; lambdas : alist[lambda-id,string -> string] (define lambdas '()) +(define inline-lambdas '()) ; allocate-lambda : (string -> string) -> lambda-id -(define (allocate-lambda lam) +(define (allocate-lambda lam . cps?) (let ((id num-lambdas)) (set! num-lambdas (+ 1 num-lambdas)) (set! lambdas (cons (list id lam) lambdas)) + (if (equal? cps? '(#f)) + (set! inline-lambdas (cons id inline-lambdas))) id)) ; get-lambda : lambda-id -> (symbol -> string) @@ -1029,7 +1031,7 @@ ;; the closure. The closure conversion phase tags each access ;; to one with the corresponding index so `lambda` can use them. ;; -(define (c-compile-closure exp append-preamble cont trace) +(define (c-compile-closure exp append-preamble cont trace cps?) (let* ((lam (closure->lam exp)) (free-vars (map @@ -1042,7 +1044,7 @@ (mangle free-var))) (closure->fv exp))) ; Note these are not necessarily symbols, but in cc form (cv-name (mangle (gensym 'c))) - (lid (allocate-lambda (c-compile-lambda lam trace))) + (lid (allocate-lambda (c-compile-lambda lam trace cps?) cps?)) (macro? (assoc (st:->var trace) (get-macros))) (call/cc? (and (equal? (car trace) "scheme/base.sld") (equal? (st:->var trace) 'call/cc))) @@ -1120,18 +1122,28 @@ "")))))) ; c-compile-lambda : lamda-exp (string -> void) -> (string -> string) -(define (c-compile-lambda exp trace) +(define (c-compile-lambda exp trace cps?) (let* ((preamble "") (append-preamble (lambda (s) (set! preamble (string-append preamble " " s "\n"))))) (let* ((formals (c-compile-formals - (lambda->formals exp) + (if (not cps?) + ;; Ignore continuation (k) arg for non-CPS funcs + (cdr (lambda->formals exp)) + (lambda->formals exp)) (lambda-formals-type exp))) (tmp-ident (if (> (length (lambda-formals->list exp)) 0) (mangle (if (pair? (lambda->formals exp)) (car (lambda->formals exp)) (lambda->formals exp))) "")) + (return-type + (if cps? "void" "object")) + (arg-argc (if cps? "int argc, " "")) + (arg-closure + (if cps? + "closure _" + "object ptr")) (has-closure? (and (> (string-length tmp-ident) 3) @@ -1141,8 +1153,8 @@ (if has-closure? "" (if (equal? "" formals) - "closure _" ;; TODO: seems wrong, will GC be too aggressive - "closure _,")) ;; due to missing refs, with ignored closure? + arg-closure + (string-append arg-closure ","))) formals)) (env-closure (lambda->env exp)) (body (c-compile-exp @@ -1153,8 +1165,8 @@ #t))) (cons (lambda (name) - (string-append "static void " name - "(void *data, int argc, " + (string-append "static " return-type " " name + "(void *data, " arg-argc formals* ") {\n" preamble @@ -1330,6 +1342,12 @@ (number->string (car l)) (cadadr l) " ;")) + ((member (car l) inline-lambdas) + (emit* + "static object __lambda_" + (number->string (car l)) "(void *data, " + (cdadr l) + ") ;")) (else (emit* "static void __lambda_" @@ -1362,6 +1380,8 @@ (car (cddadr l)) " }" )) + ((member (car l) inline-lambdas) + (emit ((caadr l) (string-append "__lambda_" (number->string (car l)))))) (else (emit ((caadr l) (string-append "__lambda_" (number->string (car l)))))))) lambdas) From 506a7e61364f2c8f9ed867847727137a1f75615e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 20:36:05 +0000 Subject: [PATCH 12/65] Generate code using new return_copy macro --- scheme/cyclone/cgen.sld | 66 +++++++++++++++++++++++++++-------------- 1 file changed, 43 insertions(+), 23 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 25129a02..037b060a 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -765,17 +765,27 @@ (let* ((cfun (c-compile-args (list (car args)) append-preamble " " cont trace cps?)) (this-cont (c:body cfun)) (cargs (c-compile-args (cdr args) append-preamble " " this-cont trace cps?))) - (set-c-call-arity! (c:num-args cargs)) - (c-code - (string-append - (c:allocs->str (c:allocs cfun) "\n") - (c:allocs->str (c:allocs cargs) "\n") - "return_closcall" (number->string (c:num-args cargs)) - "(data," - this-cont - (if (> (c:num-args cargs) 0) "," "") - (c:body cargs) - ");")))) + (cond + ((not cps?) + (c-code + (string-append + (c:allocs->str (c:allocs cfun) "\n") + (c:allocs->str (c:allocs cargs) "\n") + "return_copy(ptr," + (c:body cargs) + ");"))) + (else + (set-c-call-arity! (c:num-args cargs)) + (c-code + (string-append + (c:allocs->str (c:allocs cfun) "\n") + (c:allocs->str (c:allocs cargs) "\n") + "return_closcall" (number->string (c:num-args cargs)) + "(data," + this-cont + (if (> (c:num-args cargs) 0) "," "") + (c:body cargs) + ");")))))) ((tagged-list? '%closure fun) (let* ((cfun (c-compile-closure @@ -784,17 +794,27 @@ (cargs (c-compile-args args append-preamble " " this-cont trace cps?)) (num-cargs (c:num-args cargs))) - (set-c-call-arity! num-cargs) - (c-code - (string-append - (c:allocs->str (c:allocs cfun) "\n") - (c:allocs->str (c:allocs cargs) "\n") - "return_closcall" (number->string num-cargs) - "(data," - this-cont - (if (> num-cargs 0) "," "") - (c:body cargs) - ");")))) + (cond + ((not cps?) + (c-code + (string-append + (c:allocs->str (c:allocs cfun) "\n") + (c:allocs->str (c:allocs cargs) "\n") + "return_copy(ptr," + (c:body cargs) + ");"))) + (else ;; CPS, IE normal behavior + (set-c-call-arity! num-cargs) + (c-code + (string-append + (c:allocs->str (c:allocs cfun) "\n") + (c:allocs->str (c:allocs cargs) "\n") + "return_closcall" (number->string num-cargs) + "(data," + this-cont + (if (> num-cargs 0) "," "") + (c:body cargs) + ");")))))) (else (error `(Unsupported function application ,exp))))))) @@ -1162,7 +1182,7 @@ append-preamble (mangle env-closure) trace - #t))) + cps?))) (cons (lambda (name) (string-append "static " return-type " " name From 5bc26c072ae7e67d7b53b8fe0e53ce006f8a1766 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 18 Apr 2017 23:20:51 +0000 Subject: [PATCH 13/65] Added the return_copy macro --- include/cyclone/types.h | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 9f0f02a0..1262cb7b 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -1040,6 +1040,34 @@ typedef union { bignum_type bignum_t; } common_type; +#define return_copy(ptr, obj) \ +{ \ + tag_type t; \ + if (is_value_type(obj)) \ + return obj; \ + t = type_of(obj); \ + if (t == boolean_tag || /* Pre-allocated */ \ + t == symbol_tag || /* Allocated in their own area */ \ + t == bignum_tag) { /* Always heap allocated */ \ + return obj; \ + } else if (t == pair_tag) { \ + ((common_type *)ptr)->pair_t.hdr.mark = gc_color_red; \ + ((common_type *)ptr)->pair_t.hdr.grayed = 0; \ + ((common_type *)ptr)->pair_t.tag = pair_tag; \ + ((common_type *)ptr)->pair_t.pair_car = car(obj); \ + ((common_type *)ptr)->pair_t.pair_cdr = cdr(obj); \ + return ptr; \ + } else if (t == double_tag) { \ + ((common_type *)ptr)->double_t.hdr.mark = gc_color_red; \ + ((common_type *)ptr)->double_t.hdr.grayed = 0; \ + ((common_type *)ptr)->double_t.tag = double_tag; \ + ((common_type *)ptr)->double_t.value = double_value(obj); \ + return ptr; \ + } else { \ + return obj; \ + } \ +} + /**@}*/ /**@}*/ From 0262beb351f4a8cc8797872d14242bb307904d3e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 19 Apr 2017 00:12:49 +0000 Subject: [PATCH 14/65] Do not try to inline large lambda bodies If a lambda body contains more than one expression it must be compiled using CPS, so the inline code must reject it as a possible candidate. --- scheme/cyclone/transforms.sld | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 2652d58b..b2411e5e 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -1272,11 +1272,17 @@ (equal? 'args:fixed (lambda-formals-type (car (define->exp expr))))) (call/cc (lambda (k) - (scan - (car (lambda->exp - (car (define->exp expr)))) - (lambda () (k #f))) ;; Fail with #f - (k #t)))) ;; Scanned fine, return #t + (let* ((define-body (car (define->exp expr))) + (lambda-body (lambda->exp define-body))) + (cond + ((> (length lambda-body) 1) + (k #f)) ;; Fail with more than one expression in lambda body, + ;; because CPS is required to compile that. + (else + (scan + (car lambda-body) + (lambda () (k #f))) ;; Fail with #f + (k #t))))))) ;; Scanned fine, return #t (else #f))) ;; ;; Helpers to syntax check primitive calls From 9b7a5e3cfe8edbf4e90518dfa9e4c6672785c2df Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 19 Apr 2017 00:25:47 +0000 Subject: [PATCH 15/65] Explicitly check for a (define) form --- cyclone.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cyclone.scm b/cyclone.scm index fd2fc0a4..fa12ddd5 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -221,7 +221,8 @@ (let ((lib-init-fnc (lib:name->symbol lib-name))) ;; safe to ignore for programs (for-each (lambda (e) - (when (and (not (equal? (define->var e) lib-init-fnc)) + (when (and (define? e) + (not (equal? (define->var e) lib-init-fnc)) (inlinable-top-level-function? e)) (set! inlinable-scheme-fncs (cons (define->var e) inlinable-scheme-fncs)) From 62559ee2c061b06dde4c1e9c7fb5123eb2bc92dc Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 19 Apr 2017 00:54:01 +0000 Subject: [PATCH 16/65] No extra comma for inlined scheme functions --- scheme/cyclone/cgen.sld | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 037b060a..431b5566 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -734,7 +734,9 @@ (if (prim/c-var-assign fun) ;; Add a comma if there were any args to the func added by comp-prim (if (or (str-ending? (car (c:allocs c-fun)) "(") - (prim:cont/no-args? fun)) + (prim:cont/no-args? fun) + (and (prim:udf? fun) + (zero? num-args))) "" ",") ",") From 045a86dc4450370dcd433f70a18c7644b029058e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 13:16:23 +0000 Subject: [PATCH 17/65] Do not inline functions w/mutating primitives --- scheme/cyclone/transforms.sld | 3 +++ 1 file changed, 3 insertions(+) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index b2411e5e..4efeac8f 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -1249,6 +1249,9 @@ ;; If function needs CPS, fail right away (if (or (not (prim? fnc)) ;; Eventually need to handle user functions, too (prim:cont? fnc) ;; Needs CPS + (prim:mutates? fnc) ;; This is too conservative, but basically + ;; there are restrictions about optimizing + ;; args to a mutator, so reject them for now ) (fail)) ;; Otherwise, check for valid args From 8b88b8d36d43f356391a7723f50db8cb52950846 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 14:55:57 +0000 Subject: [PATCH 18/65] Do not inline prims that create mutable objs --- scheme/cyclone/transforms.sld | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 4efeac8f..0c4b0175 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -1234,6 +1234,34 @@ ;; Determine if the given top-level function can be freed from CPS, due ;; to it only containing calls to code that itself can be inlined. (define (inlinable-top-level-function? expr) + ;; TODO: consolidate with same function in cps-optimizations module + (define (prim-creates-mutable-obj? prim) + (member + prim + '( + apply ;; ?? + cons + make-vector + make-bytevector + bytevector + bytevector-append + bytevector-copy + string->utf8 + number->string + symbol->string + list->string + utf8->string + read-line + string-append + string + substring + Cyc-installation-dir + Cyc-compilation-environment + Cyc-bytevector-copy + Cyc-utf8->string + Cyc-string->utf8 + list->vector + ))) (define (scan expr fail) (cond ((string? expr) (fail)) @@ -1252,6 +1280,8 @@ (prim:mutates? fnc) ;; This is too conservative, but basically ;; there are restrictions about optimizing ;; args to a mutator, so reject them for now + (prim-creates-mutable-obj? fnc) ;; Again, probably more conservative + ;; than necessary ) (fail)) ;; Otherwise, check for valid args From 7a7419a3f482a6f85173b00dee8f571806296b1c Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 16:16:00 +0000 Subject: [PATCH 19/65] Prevent null ref --- include/cyclone/types.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 1262cb7b..6ee4b688 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -1043,7 +1043,7 @@ typedef union { #define return_copy(ptr, obj) \ { \ tag_type t; \ - if (is_value_type(obj)) \ + if (!is_object_type(obj)) \ return obj; \ t = type_of(obj); \ if (t == boolean_tag || /* Pre-allocated */ \ From 4b35ff71df2f6f6c649a64cb28e37fda43fe63a9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 17:40:08 +0000 Subject: [PATCH 20/65] Do not copy pairs Already do not allow cons to be inlined, so it is (should be?) safe to pass any pairs directly through. Cannot make copies of any pairs except those between ptr and stack_top because that could cause equality checks to fail later on. --- include/cyclone/types.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 6ee4b688..50c9ae11 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -1050,7 +1050,7 @@ typedef union { t == symbol_tag || /* Allocated in their own area */ \ t == bignum_tag) { /* Always heap allocated */ \ return obj; \ - } else if (t == pair_tag) { \ + } else if (0 && t == pair_tag) { \ ((common_type *)ptr)->pair_t.hdr.mark = gc_color_red; \ ((common_type *)ptr)->pair_t.hdr.grayed = 0; \ ((common_type *)ptr)->pair_t.tag = pair_tag; \ From 0656756ab4ee9b3b6933762c6678b84b0df8611c Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 17:58:05 +0000 Subject: [PATCH 21/65] Simplify logic --- include/cyclone/types.h | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 50c9ae11..fafc703f 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -1046,18 +1046,7 @@ typedef union { if (!is_object_type(obj)) \ return obj; \ t = type_of(obj); \ - if (t == boolean_tag || /* Pre-allocated */ \ - t == symbol_tag || /* Allocated in their own area */ \ - t == bignum_tag) { /* Always heap allocated */ \ - return obj; \ - } else if (0 && t == pair_tag) { \ - ((common_type *)ptr)->pair_t.hdr.mark = gc_color_red; \ - ((common_type *)ptr)->pair_t.hdr.grayed = 0; \ - ((common_type *)ptr)->pair_t.tag = pair_tag; \ - ((common_type *)ptr)->pair_t.pair_car = car(obj); \ - ((common_type *)ptr)->pair_t.pair_cdr = cdr(obj); \ - return ptr; \ - } else if (t == double_tag) { \ + if (t == double_tag) { \ ((common_type *)ptr)->double_t.hdr.mark = gc_color_red; \ ((common_type *)ptr)->double_t.hdr.grayed = 0; \ ((common_type *)ptr)->double_t.tag = double_tag; \ From 24f965123292a53f0db7b0e339e597899c70e667 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 18:05:06 -0400 Subject: [PATCH 22/65] Cleanup networking examples --- examples/Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/examples/Makefile b/examples/Makefile index 280f2cd2..8e665bb1 100644 --- a/examples/Makefile +++ b/examples/Makefile @@ -48,3 +48,5 @@ clean: cd threading ; rm -rf *.o *.c *.meta cd game-of-life ; make clean cd hello-library ; make clean + cd networking ; rm -rf client.c server.c + From 0dafd88ed337c824b0e5227a84344259acd19c46 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 18:57:52 -0400 Subject: [PATCH 23/65] Check for inlinable functions after prim conv At this point there are more opportunities for inlining. --- cyclone.scm | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index fa12ddd5..9af66e21 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -216,6 +216,15 @@ (trace:info "---------------- after alpha conversion:") (trace:info input-program) ;pretty-print + ;; Convert some function calls to primitives, if possible + (set! input-program + (map + (lambda (expr) + (prim-convert expr)) + input-program)) + (trace:info "---------------- after func->primitive conversion:") + (trace:info input-program) ;pretty-print + ;; Identify native Scheme functions that can be inlined (define inlinable-scheme-fncs '()) (let ((lib-init-fnc (lib:name->symbol lib-name))) ;; safe to ignore for programs @@ -235,15 +244,6 @@ input-program)) (trace:info "---------------- results of inlinable-top-level-function analysis: ") (trace:info inlinable-scheme-fncs) - - ;; Convert some function calls to primitives, if possible - (set! input-program - (map - (lambda (expr) - (prim-convert expr)) - input-program)) - (trace:info "---------------- after func->primitive conversion:") - (trace:info input-program) ;pretty-print (let ((cps (map (lambda (expr) From 1c82f0e74a34a32b7d760b5281238b59b4655e4e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 22:08:15 +0000 Subject: [PATCH 24/65] Add Scheme inlines to global inline list --- scheme/cyclone/cgen.sld | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 431b5566..c10f3651 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -878,8 +878,10 @@ ; ,(define-c->inline-var exp) ; ,(prim:udf? (define-c->inline-var exp)) ; )) - (if (and (lambda? body) - (prim:udf? (define-c->inline-var exp))) + (when (and (lambda? body) + (prim:udf? (define-c->inline-var exp))) + (add-global-inline + (define-c->inline-var exp)) (add-global (define-c->inline-var exp) #t ;; always a lambda From 6e1073387ada250635300a1b4a46d75f1d7688b4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 23:03:09 +0000 Subject: [PATCH 25/65] Expose UDF inlines and original symbols --- scheme/cyclone/cgen.sld | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index c10f3651..c52b8570 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -840,17 +840,17 @@ ;; Global inlinable functions (define *global-inlines* '()) -(define (add-global-inline var-sym) - (set! *global-inlines* (cons var-sym *global-inlines*))) +(define (add-global-inline orig-sym inline-sym) + (set! *global-inlines* (cons (cons orig-sym inline-sym) *global-inlines*))) ;; Add a global inlinable function that is written in Scheme. ;; This is more challenging than define-c forms since the ;; code must be compiled again to work without CPS. -(define *global-inline-scms* '()) -(define (add-global-inline-scm-lambda var-sym code) - (add-global-inline var-sym) - (set! *global-inline-scms* - (cons (list var-sym code) *global-inline-scms*))) +;(define *global-inline-scms* '()) +;(define (add-global-inline-scm-lambda var-sym code) +; (add-global-inline var-sym ) +; (set! *global-inline-scms* +; (cons (list var-sym code) *global-inline-scms*))) ;; Global compilation (define *globals* '()) @@ -881,6 +881,7 @@ (when (and (lambda? body) (prim:udf? (define-c->inline-var exp))) (add-global-inline + var (define-c->inline-var exp)) (add-global (define-c->inline-var exp) @@ -924,7 +925,7 @@ (let ((fnc-sym (define-c->inline-var exp))) ;(trace:error `(JAE define-c inline detected ,fnc-sym)) - (add-global-inline fnc-sym) + (add-global-inline (define->var exp) fnc-sym) (c-compile-raw-global-lambda `(define-c ,fnc-sym ,@(cddddr exp)) append-preamble @@ -1418,14 +1419,10 @@ (head-pair #f)) (for-each (lambda (g) - (let ((cvar-sym (mangle (gensym 'cvar))) - (pair-sym (mangle (gensym 'pair)))) - (emits* - " make_cvar(" cvar-sym - ", (object *)&" (cgen:mangle-global g) ");") + (let ((pair-sym (mangle (gensym 'pair)))) (emits* - "make_pair(" pair-sym ", find_or_add_symbol(\"" (symbol->string g) - "\"), &" cvar-sym ");\n") + "make_pair(" pair-sym ", find_or_add_symbol(\"" (symbol->string (car g)) + "\"), find_or_add_symbol(\"" (symbol->string (cdr g)) "\"));\n") (set! pairs (cons pair-sym pairs)))) *global-inlines*) ;; Link the pairs From 998fb4efaa5734bcab9454301dc12a4327c5862d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 23:27:25 +0000 Subject: [PATCH 26/65] WIP --- cyclone.scm | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/cyclone.scm b/cyclone.scm index 9af66e21..7143bf56 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -216,6 +216,27 @@ (trace:info "---------------- after alpha conversion:") (trace:info input-program) ;pretty-print +;;; EXPERIMENTAL CODE +;;; assumes (scheme base) is available to compiler AND at runtime in the compiled module/program +;;; TODO: probably not good enough since inlines are not in export list +;(for-each +; (lambda (psyms) +; (let ((var (car psyms)) (inline (cdr psyms))) +; (prim:add-udf! var inline))) +; (eval '(c_schemebase_inlinable_lambdas))) +; ;(assoc 'quotient (c_schemebase_inlinable_lambdas)) +; ; (set! globals (append (lib:idb:ids imported-vars) module-globals)) +; +; ;; total hack to update export list +; (set! imported-vars +; (append +; imported-vars +; (map +; (lambda (psyms) +; (list (cdr psyms) 'scheme 'base)) +; (eval '(c_schemebase_inlinable_lambdas))))) +;;; END + ;; Convert some function calls to primitives, if possible (set! input-program (map @@ -225,7 +246,7 @@ (trace:info "---------------- after func->primitive conversion:") (trace:info input-program) ;pretty-print - ;; Identify native Scheme functions that can be inlined + ;; Identify native Scheme functions (from module being compiled) that can be inlined (define inlinable-scheme-fncs '()) (let ((lib-init-fnc (lib:name->symbol lib-name))) ;; safe to ignore for programs (for-each From 3d2fdb36d9449706d6e4b3e318257f470437c4b1 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 24 Apr 2017 23:30:27 +0000 Subject: [PATCH 27/65] WIP --- cyclone.scm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cyclone.scm b/cyclone.scm index 7143bf56..e87a4023 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -217,6 +217,12 @@ (trace:info input-program) ;pretty-print ;;; EXPERIMENTAL CODE +;;; TODO: extend this initially by, for each import, invoking that module's inlinable_lambdas function +;;; behind an exception handler (in case the compiler does not have that module loaded). +;;; +;;; Longer term, need to test if module is loaded (maybe do that in combo with exception handler above) +;;; and if not loaded, eval/import it and try again. +;;; ;;; assumes (scheme base) is available to compiler AND at runtime in the compiled module/program ;;; TODO: probably not good enough since inlines are not in export list ;(for-each From f88016eb3e245cabebf25e5b1c5382ce946fdfc4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 25 Apr 2017 06:22:40 +0000 Subject: [PATCH 28/65] WIP --- cyclone.scm | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index e87a4023..6863da8d 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -216,15 +216,30 @@ (trace:info "---------------- after alpha conversion:") (trace:info input-program) ;pretty-print -;;; EXPERIMENTAL CODE -;;; TODO: extend this initially by, for each import, invoking that module's inlinable_lambdas function -;;; behind an exception handler (in case the compiler does not have that module loaded). -;;; -;;; Longer term, need to test if module is loaded (maybe do that in combo with exception handler above) -;;; and if not loaded, eval/import it and try again. -;;; -;;; assumes (scheme base) is available to compiler AND at runtime in the compiled module/program -;;; TODO: probably not good enough since inlines are not in export list +;; EXPERIMENTAL CODE +;; TODO: extend this initially by, for each import, invoking that module's inlinable_lambdas function +;; behind an exception handler (in case the compiler does not have that module loaded). +;; +;; Longer term, need to test if module is loaded (maybe do that in combo with exception handler above) +;; and if not loaded, eval/import it and try again. +;; +;; assumes (scheme base) is available to compiler AND at runtime in the compiled module/program +;; TODO: probably not good enough since inlines are not in export list + +;(for-each +; (lambda (import) +; (let* ((lib-name-str (lib:name->string (lib:list->import-set import))) +; (inlinable-lambdas-fnc +; (string->symbol +; (string-append "c_" lib-name-str "_inlinable_lambdas")))) +;TODO: no, only import if not previously loaded. may need a new export for this +; #t ;(eval `(import ,import)) +; (%import import) +; ;(define vars/inlines (eval `( ,inlinable-lambdas-fnc ))) +; ;(trace:info `(DEBUG ,import ,vars/inlines)) +; )) +; imports) + ;(for-each ; (lambda (psyms) ; (let ((var (car psyms)) (inline (cdr psyms))) @@ -241,7 +256,7 @@ ; (lambda (psyms) ; (list (cdr psyms) 'scheme 'base)) ; (eval '(c_schemebase_inlinable_lambdas))))) -;;; END +;; END ;; Convert some function calls to primitives, if possible (set! input-program From e469f4d5a6cf6c696f166d22ffb2acb5f3daa3c3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 26 Apr 2017 17:22:33 -0400 Subject: [PATCH 29/65] Added (imported?) --- scheme/eval.sld | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/scheme/eval.sld b/scheme/eval.sld index 5ed800b4..05a3c4cf 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -23,6 +23,7 @@ setup-environment ; non-standard ;; Dynamic import %import + imported? ) (begin @@ -624,6 +625,10 @@ (set! *global-environment* (setup-environment *initial-environment*)) #t)) +;; Is the given library loaded? +(define (imported? lis) + (c:lib-loaded? (lib:name->unique-string (lib:list->import-set lis)))) + ;; Wrapper around the actual shared object import function (define-c c:import-shared-obj "(void *data, int argc, closure _, object k, object fn, object entry_fnc)" From 51a1a637005fee0a0fed2e58b628ffdc736a57fe Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 26 Apr 2017 17:35:58 -0400 Subject: [PATCH 30/65] Register built-in inlines --- cyclone.scm | 44 +++++++++++++++++++++++++++++++------------- 1 file changed, 31 insertions(+), 13 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index 6863da8d..26e00af6 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -226,19 +226,37 @@ ;; assumes (scheme base) is available to compiler AND at runtime in the compiled module/program ;; TODO: probably not good enough since inlines are not in export list -;(for-each -; (lambda (import) -; (let* ((lib-name-str (lib:name->string (lib:list->import-set import))) -; (inlinable-lambdas-fnc -; (string->symbol -; (string-append "c_" lib-name-str "_inlinable_lambdas")))) -;TODO: no, only import if not previously loaded. may need a new export for this -; #t ;(eval `(import ,import)) -; (%import import) -; ;(define vars/inlines (eval `( ,inlinable-lambdas-fnc ))) -; ;(trace:info `(DEBUG ,import ,vars/inlines)) -; )) -; imports) +(for-each + (lambda (import) + (let* ((lib-name-str (lib:name->string (lib:list->import-set import))) + (inlinable-lambdas-fnc + (string->symbol + (string-append "c_" lib-name-str "_inlinable_lambdas")))) + (cond + ((imported? import) + (let ((lib-name (lib:list->import-set import)) + (vars/inlines (eval `( ,inlinable-lambdas-fnc )))) + (trace:info `(DEBUG ,import ,vars/inlines)) + ;; Register inlines as user-defined primitives + (for-each + (lambda (v/i) + (let ((var (car v/i)) (inline (cdr v/i))) + (prim:add-udf! var inline))) + vars/inlines) + ;; Keep track of inline version of functions along with other imports + (set! imported-vars + (append + imported-vars + (map + (lambda (v/i) + (cons (cdr v/i) lib-name)) + vars/inlines))))) + (else + ;; TODO: try loading if not loaded (but need ex handler in case anything bad happens) #t ;(eval `(import ,import)) + ;;(%import import) + #f)) + )) + imports) ;(for-each ; (lambda (psyms) From c2929af7143e884ba7aaa0b8e7dac0dd1bc7dee6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 26 Apr 2017 18:08:07 -0400 Subject: [PATCH 31/65] Added exception handler --- cyclone.scm | 59 ++++++++++++++++++++++++++++------------------------- 1 file changed, 31 insertions(+), 28 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index 26e00af6..69154daa 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -228,34 +228,37 @@ (for-each (lambda (import) - (let* ((lib-name-str (lib:name->string (lib:list->import-set import))) - (inlinable-lambdas-fnc - (string->symbol - (string-append "c_" lib-name-str "_inlinable_lambdas")))) - (cond - ((imported? import) - (let ((lib-name (lib:list->import-set import)) - (vars/inlines (eval `( ,inlinable-lambdas-fnc )))) - (trace:info `(DEBUG ,import ,vars/inlines)) - ;; Register inlines as user-defined primitives - (for-each - (lambda (v/i) - (let ((var (car v/i)) (inline (cdr v/i))) - (prim:add-udf! var inline))) - vars/inlines) - ;; Keep track of inline version of functions along with other imports - (set! imported-vars - (append - imported-vars - (map - (lambda (v/i) - (cons (cdr v/i) lib-name)) - vars/inlines))))) - (else - ;; TODO: try loading if not loaded (but need ex handler in case anything bad happens) #t ;(eval `(import ,import)) - ;;(%import import) - #f)) - )) + (with-handler + (lambda (err) + #f) + (let* ((lib-name-str (lib:name->string (lib:list->import-set import))) + (inlinable-lambdas-fnc + (string->symbol + (string-append "c_" lib-name-str "_inlinable_lambdas")))) + (cond + ((imported? import) + (let ((lib-name (lib:list->import-set import)) + (vars/inlines (eval `( ,inlinable-lambdas-fnc )))) + (trace:info `(DEBUG ,import ,vars/inlines)) + ;; Register inlines as user-defined primitives + (for-each + (lambda (v/i) + (let ((var (car v/i)) (inline (cdr v/i))) + (prim:add-udf! var inline))) + vars/inlines) + ;; Keep track of inline version of functions along with other imports + (set! imported-vars + (append + imported-vars + (map + (lambda (v/i) + (cons (cdr v/i) lib-name)) + vars/inlines))))) + (else + ;; TODO: try loading if not loaded (but need ex handler in case anything bad happens) #t ;(eval `(import ,import)) + ;;(%import import) + ;; if this work is done, would need to consolidate inline reg code above + #f))))) imports) ;(for-each From 19e0346968dc30391a7499a8ff95cb104aa402ac Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 27 Apr 2017 18:11:57 -0400 Subject: [PATCH 32/65] Temporary workaround for name conflict A longer-term solution will need to address cases where a function is defined with the same name as an inlinable function from another library. These are effectively promoted to primitives, which are not renamed by alpha conversion. A possible workaround might be to allow a global in the module being compiled to "override" a primitive of the same name. TBD --- scheme/base.sld | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index 10358a46..e1d57af2 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -1261,7 +1261,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; syntax-rules (define identifier? symbol?) -(define (identifier->symbol obj) obj) +;(define (identifier->symbol obj) obj) (define (find-tail pred ls) (and (pair? ls) (if (pred (car ls)) ls (find-tail pred (cdr ls))))) @@ -1363,7 +1363,8 @@ (next-symbol (string-append (symbol->string - (identifier->symbol (car x))) + (car x)) + ;(identifier->symbol (car x))) "-ls"))) new-vars)) (once From 9b3a4769dc524d50b62fad87e40c7f6cb4d3940f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 27 Apr 2017 18:52:22 -0400 Subject: [PATCH 33/65] Avoid naming conflicts with user defined inlines Do not allow an inline if it conflicts with a global in the current module. This at least attempts to avoid obvious name conflicts. TBD if it is good enough or if additional fixes are necessary. --- cyclone.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/cyclone.scm b/cyclone.scm index 69154daa..3f1a15e1 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -238,7 +238,12 @@ (cond ((imported? import) (let ((lib-name (lib:list->import-set import)) - (vars/inlines (eval `( ,inlinable-lambdas-fnc )))) + (vars/inlines + (filter + (lambda (v/i) + ;; Try to avoid name conflicts + (not (member (car v/i) globals))) + (eval `( ,inlinable-lambdas-fnc ))))) (trace:info `(DEBUG ,import ,vars/inlines)) ;; Register inlines as user-defined primitives (for-each From 4ae3269373d4b2f0be2083a06ccec78d805e42df Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 27 Apr 2017 19:06:08 -0400 Subject: [PATCH 34/65] WIP --- cyclone.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cyclone.scm b/cyclone.scm index 3f1a15e1..c0ed0598 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -239,6 +239,8 @@ ((imported? import) (let ((lib-name (lib:list->import-set import)) (vars/inlines +TODO: if this filtering out too many (or all) the candidates?? +need to test this (filter) out more (filter (lambda (v/i) ;; Try to avoid name conflicts From 8d7bff212a5ceae58eb5ea4d5be4268cb5db10a2 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 28 Apr 2017 17:43:57 +0000 Subject: [PATCH 35/65] WIP --- cyclone.scm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index c0ed0598..697ccbbf 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -225,6 +225,8 @@ ;; ;; assumes (scheme base) is available to compiler AND at runtime in the compiled module/program ;; TODO: probably not good enough since inlines are not in export list +;; +;; TODO: later on, in cgen, only add inlinables that correspond to exported functions (for-each (lambda (import) @@ -239,14 +241,14 @@ ((imported? import) (let ((lib-name (lib:list->import-set import)) (vars/inlines -TODO: if this filtering out too many (or all) the candidates?? -need to test this (filter) out more (filter (lambda (v/i) - ;; Try to avoid name conflicts - (not (member (car v/i) globals))) + ;; Try to avoid name conflicts by not loading inlines + ;; that conflict with identifiers in this module. + ;; More of a band-aid than a true solution, though. + (not (member (car v/i) module-globals))) (eval `( ,inlinable-lambdas-fnc ))))) - (trace:info `(DEBUG ,import ,vars/inlines)) + (trace:info `(DEBUG ,import ,vars/inlines ,module-globals)) ;; Register inlines as user-defined primitives (for-each (lambda (v/i) From eb4fe2628417065243680ca6d01aa16a72682f86 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 28 Apr 2017 17:54:04 +0000 Subject: [PATCH 36/65] Relocated function --- cyclone.scm | 4 +- scheme/cyclone/cps-optimizations.sld | 89 ++++++++++++++++++++++++++++ 2 files changed, 91 insertions(+), 2 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index 697ccbbf..13e270cb 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -304,7 +304,7 @@ (lambda (e) (when (and (define? e) (not (equal? (define->var e) lib-init-fnc)) - (inlinable-top-level-function? e)) + (inlinable-top-level-lambda? e)) (set! inlinable-scheme-fncs (cons (define->var e) inlinable-scheme-fncs)) ;; TESTING, will not work yet @@ -314,7 +314,7 @@ ;; END )) input-program)) - (trace:info "---------------- results of inlinable-top-level-function analysis: ") + (trace:info "---------------- results of inlinable-top-level-lambda analysis: ") (trace:info inlinable-scheme-fncs) (let ((cps (map diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 18f48c97..fafb6323 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -16,6 +16,7 @@ (scheme cyclone transforms) (srfi 69)) (export + inlinable-top-level-lambda? optimize-cps analyze-cps opt:contract @@ -157,6 +158,94 @@ (callback fnc) (adb:set! id fnc))) +;; Determine if the given top-level function can be freed from CPS, due +;; to it only containing calls to code that itself can be inlined. +(define (inlinable-top-level-lambda? expr) + ;; TODO: consolidate with same function in cps-optimizations module + (define (prim-creates-mutable-obj? prim) + (member + prim + '( + apply ;; ?? + cons + make-vector + make-bytevector + bytevector + bytevector-append + bytevector-copy + string->utf8 + number->string + symbol->string + list->string + utf8->string + read-line + string-append + string + substring + Cyc-installation-dir + Cyc-compilation-environment + Cyc-bytevector-copy + Cyc-utf8->string + Cyc-string->utf8 + list->vector + ))) + (define (scan expr fail) + (cond + ((string? expr) (fail)) + ((bytevector? expr) (fail)) + ((const? expr) #t) ;; Good enough? what about large vectors or anything requiring alloca (strings, bytevectors, what else?) + ((ref? expr) #t) + ((if? expr) + (scan (if->condition expr) fail) + (scan (if->then expr) fail) + (scan (if->else expr) fail)) + ((app? expr) + (let ((fnc (car expr))) + ;; If function needs CPS, fail right away + (if (or (not (prim? fnc)) ;; Eventually need to handle user functions, too + (prim:cont? fnc) ;; Needs CPS + (prim:mutates? fnc) ;; This is too conservative, but basically + ;; there are restrictions about optimizing + ;; args to a mutator, so reject them for now + (prim-creates-mutable-obj? fnc) ;; Again, probably more conservative + ;; than necessary + ) + (fail)) + ;; Otherwise, check for valid args + (for-each + (lambda (e) + (scan e fail)) + (cdr expr)))) + ;; prim-app - OK only if prim does not require CPS. + ;; still need to check all its args + ;; app - same as prim, only OK if function does not require CPS. + ;; probably safe to return #t if calling self, since if no + ;; CPS it will be rejected anyway + ;; NOTE: would not be able to detect all functions in this module immediately. + ;; would probably have to find some, then run this function successively to find others. + ;; + ;; Reject everything else - define, set, lambda + (else (fail)))) + (cond + ((and (define? expr) + (lambda? (car (define->exp expr))) + (equal? 'args:fixed (lambda-formals-type (car (define->exp expr))))) + (call/cc + (lambda (k) + (let* ((define-body (car (define->exp expr))) + (lambda-body (lambda->exp define-body))) + (cond + ((> (length lambda-body) 1) + (k #f)) ;; Fail with more than one expression in lambda body, + ;; because CPS is required to compile that. + (else + (scan + (car lambda-body) + (lambda () (k #f))) ;; Fail with #f + (k #t))))))) ;; Scanned fine, return #t + (else #f))) + + ;; TODO: check app for const/const-value, also (for now) reset them ;; if the variable is modified via set/define (define (analyze exp lid) From fef4663f788432f3171d42ee8eefa9ccfeb3c6f1 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 28 Apr 2017 18:10:32 -0400 Subject: [PATCH 37/65] Remove old function --- scheme/cyclone/transforms.sld | 87 ----------------------------------- 1 file changed, 87 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 0c4b0175..fd5ab5db 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -105,7 +105,6 @@ pos-in-list closure-convert prim-convert - inlinable-top-level-function? ) (begin @@ -1231,92 +1230,6 @@ ast))) (conv expr)) -;; Determine if the given top-level function can be freed from CPS, due -;; to it only containing calls to code that itself can be inlined. -(define (inlinable-top-level-function? expr) - ;; TODO: consolidate with same function in cps-optimizations module - (define (prim-creates-mutable-obj? prim) - (member - prim - '( - apply ;; ?? - cons - make-vector - make-bytevector - bytevector - bytevector-append - bytevector-copy - string->utf8 - number->string - symbol->string - list->string - utf8->string - read-line - string-append - string - substring - Cyc-installation-dir - Cyc-compilation-environment - Cyc-bytevector-copy - Cyc-utf8->string - Cyc-string->utf8 - list->vector - ))) - (define (scan expr fail) - (cond - ((string? expr) (fail)) - ((bytevector? expr) (fail)) - ((const? expr) #t) ;; Good enough? what about large vectors or anything requiring alloca (strings, bytevectors, what else?) - ((ref? expr) #t) - ((if? expr) - (scan (if->condition expr) fail) - (scan (if->then expr) fail) - (scan (if->else expr) fail)) - ((app? expr) - (let ((fnc (car expr))) - ;; If function needs CPS, fail right away - (if (or (not (prim? fnc)) ;; Eventually need to handle user functions, too - (prim:cont? fnc) ;; Needs CPS - (prim:mutates? fnc) ;; This is too conservative, but basically - ;; there are restrictions about optimizing - ;; args to a mutator, so reject them for now - (prim-creates-mutable-obj? fnc) ;; Again, probably more conservative - ;; than necessary - ) - (fail)) - ;; Otherwise, check for valid args - (for-each - (lambda (e) - (scan e fail)) - (cdr expr)))) - ;; prim-app - OK only if prim does not require CPS. - ;; still need to check all its args - ;; app - same as prim, only OK if function does not require CPS. - ;; probably safe to return #t if calling self, since if no - ;; CPS it will be rejected anyway - ;; NOTE: would not be able to detect all functions in this module immediately. - ;; would probably have to find some, then run this function successively to find others. - ;; - ;; Reject everything else - define, set, lambda - (else (fail)))) - (cond - ((and (define? expr) - (lambda? (car (define->exp expr))) - (equal? 'args:fixed (lambda-formals-type (car (define->exp expr))))) - (call/cc - (lambda (k) - (let* ((define-body (car (define->exp expr))) - (lambda-body (lambda->exp define-body))) - (cond - ((> (length lambda-body) 1) - (k #f)) ;; Fail with more than one expression in lambda body, - ;; because CPS is required to compile that. - (else - (scan - (car lambda-body) - (lambda () (k #f))) ;; Fail with #f - (k #t))))))) ;; Scanned fine, return #t - (else #f))) ;; ;; Helpers to syntax check primitive calls ;; From f80da867126b5ccc0c02702e74ab3a248a34d129 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 28 Apr 2017 18:27:51 -0400 Subject: [PATCH 38/65] Do not inline functions with free vars --- scheme/cyclone/cps-optimizations.sld | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index fafb6323..67bf88ce 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -233,11 +233,20 @@ (call/cc (lambda (k) (let* ((define-body (car (define->exp expr))) - (lambda-body (lambda->exp define-body))) + (lambda-body (lambda->exp define-body)) + (fv (filter + (lambda (v) + (not (prim? v))) + (free-vars expr))) + ) +;(trace:error `(JAE DEBUG ,(define->var expr) ,fv)) (cond ((> (length lambda-body) 1) (k #f)) ;; Fail with more than one expression in lambda body, ;; because CPS is required to compile that. + ((> (length fv) 1) ;; Reject any free variables to attempt to prevent + (k #f)) ;; cases where there is a variable that may be + ;; mutated outside the scope of this function. (else (scan (car lambda-body) @@ -245,7 +254,6 @@ (k #t))))))) ;; Scanned fine, return #t (else #f))) - ;; TODO: check app for const/const-value, also (for now) reset them ;; if the variable is modified via set/define (define (analyze exp lid) From a2c0d8c511a54598ccebbe4b928f88676b1487a5 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 19:02:23 -0400 Subject: [PATCH 39/65] Debug traces --- scheme/cyclone/cps-optimizations.sld | 2 ++ 1 file changed, 2 insertions(+) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 67bf88ce..e34ce7cc 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -826,6 +826,7 @@ (if (not (adbv:inlinable var)) (set! fast-inline #f))))) ivars) +;(trace:error `(DEBUG inline-prim-call ,exp ,ivars ,args ,cannot-inline ,fast-inline)) (cond (cannot-inline #f) (else @@ -914,6 +915,7 @@ ;; If the code gets this far, assume we came from a place ;; that does not allow the var to be inlined. We need to ;; explicitly white-list variables that can be inlined. +; (trace:error `(DEBUG not inlinable ,exp ,args)) (with-var exp (lambda (var) (adbv:set-inlinable! var #f))))) ((ast:lambda? exp) From 9a98356589b4e0eaf2c84786ceb5cad12cebd6f0 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 30 Apr 2017 18:52:21 -0400 Subject: [PATCH 40/65] Added lib:inlines --- scheme/cyclone/libraries.sld | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/scheme/cyclone/libraries.sld b/scheme/cyclone/libraries.sld index dddc77c4..f41e1b04 100644 --- a/scheme/cyclone/libraries.sld +++ b/scheme/cyclone/libraries.sld @@ -35,6 +35,7 @@ lib:cond-expand-decls lib:includes lib:include-c-headers + lib:inlines lib:import-set:library-name? lib:import-set->import-set lib:import->library-name @@ -188,6 +189,15 @@ (tagged-list? 'include-c-header code)) (cddr ast)))) +(define (lib:inlines ast) + (map + (lambda (inc-lst) + (cadr inc-lst)) + (filter + (lambda (code) + (tagged-list? 'inline code)) + (cddr ast)))) + ;; TODO: include-ci, cond-expand ;TODO: maybe just want a function that will take a define-library expression and expand any top-level cond-expand expressions. From edccb56163519884108c744b22b47a70004001c6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 30 Apr 2017 19:03:44 -0400 Subject: [PATCH 41/65] bugfixes --- scheme/cyclone/libraries.sld | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/scheme/cyclone/libraries.sld b/scheme/cyclone/libraries.sld index f41e1b04..6f148614 100644 --- a/scheme/cyclone/libraries.sld +++ b/scheme/cyclone/libraries.sld @@ -190,13 +190,15 @@ (cddr ast)))) (define (lib:inlines ast) - (map - (lambda (inc-lst) - (cadr inc-lst)) - (filter - (lambda (code) - (tagged-list? 'inline code)) - (cddr ast)))) + (apply + append + (map + (lambda (inc-lst) + (cdr inc-lst)) + (filter + (lambda (code) + (tagged-list? 'inline code)) + (cddr ast))))) ;; TODO: include-ci, cond-expand From 8b6830ea497f4a0e215d10ebdffc0043fec88678 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 30 Apr 2017 19:04:53 -0400 Subject: [PATCH 42/65] WIP - explicit inlines --- cyclone.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/cyclone.scm b/cyclone.scm index 13e270cb..e96198e5 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -36,6 +36,7 @@ (define module-globals '()) ;; Globals defined by this module (define program? #t) ;; Are we building a program or a library? (define imports '()) + (define inlines '()) (define imported-vars '()) (define lib-name '()) (define lib-exports '()) @@ -55,6 +56,7 @@ (set! program? #f) (set! lib-name (lib:name (car input-program))) (set! c-headers (lib:include-c-headers (car input-program))) + (set! inlines (lib:inlines (car input-program))) (set! lib-exports (cons (lib:name->symbol lib-name) @@ -89,6 +91,17 @@ (set! imports (car reduction)) (set! input-program (cdr reduction))) + ;; Handle inline list, if present` + (let ((lis (lib:inlines `(dummy dummy ,@input-program)))) + (cond + ((not (null? lis)) + (set! inlines lis) + (set! input-program + (filter + (lambda (expr) + (not (tagged-list? 'inline expr))) + input-program))))) + ;; Handle any C headers (let ((headers (lib:include-c-headers `(dummy dummy ,@input-program)))) (cond @@ -101,6 +114,9 @@ input-program))))) )) + (trace:info "inline candidates:") + (trace:info inlines) + ;; Process library imports (trace:info "imports:") (trace:info imports) @@ -298,11 +314,13 @@ (trace:info input-program) ;pretty-print ;; Identify native Scheme functions (from module being compiled) that can be inlined +;; TODO: this will never work 100%. I suggest Scheme code needs to be able to make functions as inline, and the code below will run those functions through the inlinable-top-level-lambda? check below. (define inlinable-scheme-fncs '()) (let ((lib-init-fnc (lib:name->symbol lib-name))) ;; safe to ignore for programs (for-each (lambda (e) (when (and (define? e) + #f ;; TODO: replace with lookup check from user-specified inline list (not (equal? (define->var e) lib-init-fnc)) (inlinable-top-level-lambda? e)) (set! inlinable-scheme-fncs From dc42d5a1d49cd19e08b97055924e713cdc41b18e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 28 Apr 2017 21:28:30 +0000 Subject: [PATCH 43/65] Only inline specifically designated functions --- cyclone.scm | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index e96198e5..8c7a0084 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -314,26 +314,31 @@ (trace:info input-program) ;pretty-print ;; Identify native Scheme functions (from module being compiled) that can be inlined -;; TODO: this will never work 100%. I suggest Scheme code needs to be able to make functions as inline, and the code below will run those functions through the inlinable-top-level-lambda? check below. + ;; + ;; NOTE: There is a chicken-and-egg problem here that prevents this from + ;; automatically working 100%. Basically we need to know whether the inline logic will + ;; work for a given candidate. The problem is, the only way to do that is to run the + ;; code through CPS and by then we would have to go back and repeat many phases if a + ;; candidate fails the inline tests. At least for now, an alternative is to require + ;; user code to specify (via inline) what functions the compiler should try inlining. + ;; There is a small chance one of those inlines can pass these tests and still fail + ;; the subsequent inline checks though, which causes an error in the C compiler. (define inlinable-scheme-fncs '()) (let ((lib-init-fnc (lib:name->symbol lib-name))) ;; safe to ignore for programs (for-each (lambda (e) (when (and (define? e) - #f ;; TODO: replace with lookup check from user-specified inline list + (member (define->var e) inlines) ;; Primary check, did use request inline (not (equal? (define->var e) lib-init-fnc)) - (inlinable-top-level-lambda? e)) + (inlinable-top-level-lambda? e)) ;; Failsafe, reject if basic checks fail (set! inlinable-scheme-fncs (cons (define->var e) inlinable-scheme-fncs)) - ;; TESTING, will not work yet (set! module-globals (cons (define-c->inline-var e) module-globals)) - (prim:add-udf! (define->var e) (define-c->inline-var e)) - ;; END - )) - input-program)) - (trace:info "---------------- results of inlinable-top-level-lambda analysis: ") - (trace:info inlinable-scheme-fncs) + (prim:add-udf! (define->var e) (define-c->inline-var e)))) + input-program) + (trace:info "---------------- results of inlinable-top-level-lambda analysis: ") + (trace:info inlinable-scheme-fncs)) (let ((cps (map (lambda (expr) From 10569ddcfd31a5291f74325773c9a3855987fa2d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 00:46:47 +0000 Subject: [PATCH 44/65] Get root library name --- cyclone.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cyclone.scm b/cyclone.scm index 8c7a0084..5112c9c5 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -255,7 +255,8 @@ (string-append "c_" lib-name-str "_inlinable_lambdas")))) (cond ((imported? import) - (let ((lib-name (lib:list->import-set import)) + (let ((lib-name (lib:import->library-name + (lib:list->import-set import))) (vars/inlines (filter (lambda (v/i) From 75b9e7bf8ab5cc21ec76cd398dd93a90625e1384 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 01:18:39 +0000 Subject: [PATCH 45/65] Explicit inlines --- scheme/base.sld | 16 ++++++++++++++++ scheme/complex.sld | 3 +++ scheme/cyclone/cgen.sld | 7 +++++++ scheme/cyclone/libraries.sld | 4 ++++ scheme/cyclone/macros.sld | 2 ++ scheme/cyclone/transforms.sld | 21 +++++++++++++++++++++ scheme/cyclone/util.sld | 17 +++++++++++++++++ scheme/eval.sld | 18 ++++++++++++++++++ srfi/1.sld | 9 +++++++++ srfi/106.sld | 2 ++ srfi/128.sld | 2 ++ srfi/133.sld | 5 +++++ srfi/18.sld | 4 ++++ 13 files changed, 110 insertions(+) diff --git a/scheme/base.sld b/scheme/base.sld index e1d57af2..9fe1d30c 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -207,6 +207,22 @@ ; letrec-syntax ;;;; ) + (inline + square + quotient + numerator + denominator + truncate + negative? + positive? + zero? + not + string>=? + string>? + string<=? + stringvar + ) (begin (define (emit line) diff --git a/scheme/cyclone/libraries.sld b/scheme/cyclone/libraries.sld index 6f148614..9330e7e2 100644 --- a/scheme/cyclone/libraries.sld +++ b/scheme/cyclone/libraries.sld @@ -61,6 +61,10 @@ lib:idb:entry->library-name lib:idb:entry->library-id ) + (inline + lib:idb:entry->library-name + lib:import-set->import-set + ) (begin (define (library? ast) diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld index dc2d391f..1696248e 100644 --- a/scheme/cyclone/macros.sld +++ b/scheme/cyclone/macros.sld @@ -22,6 +22,8 @@ macro:get-env macro:get-defined-macros ) + (inline + macro:macro?) (begin ;; top-level macro environment (define *macro:env* '()) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index fd5ab5db..c0e0248e 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -106,6 +106,27 @@ closure-convert prim-convert ) + (inline + cell-get->cell + cell->value + set-cell!->value + set-cell!->cell + env-get->env + env-get->field + env-get->id + env-make->id + closure->fv + closure->env + closure->lam + begin->exps + app->args + app->fun + letrec->exp + letrec->bindings + let->exp + let->bindings + void + ) (begin ;; Container for built-in macros diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld index 8f292f43..b89d5a2b 100644 --- a/scheme/cyclone/util.sld +++ b/scheme/cyclone/util.sld @@ -83,6 +83,23 @@ string-replace-all take filter) + (inline + env:frame-values + env:frame-variables + env:first-frame + env:enclosing-environment + lambda->exp + lambda->formals + define->exp + set!->exp + set!->var + ref? + app? + if->else + if->then + if->condition + tagged-list? + ) (begin (define (tagged-list? tag exp) diff --git a/scheme/eval.sld b/scheme/eval.sld index 05a3c4cf..f3d0814e 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -25,6 +25,24 @@ %import imported? ) + (inline + primitive-implementation + procedure-environment + procedure-body + procedure-parameters + operands + operator + application? + if-alternative + if-consequent + if-predicate + lambda-body + lambda-parameters + definition-variable + assignment-value + assignment-variable + variable? + ) (begin ;; From r7rs: diff --git a/srfi/1.sld b/srfi/1.sld index bc80890e..9bd245b5 100644 --- a/srfi/1.sld +++ b/srfi/1.sld @@ -42,6 +42,15 @@ lset-union lset-intersection lset-difference lset-xor lset-diff+intersection lset-union! lset-intersection! lset-difference! lset-xor! lset-diff+intersection! ) + (inline + tenth + ninth + eighth + seventh + sixth + fifth + not-pair? + ) (include "1.scm") (begin) ) diff --git a/srfi/106.sld b/srfi/106.sld index 3a9315d0..e2b3ebda 100644 --- a/srfi/106.sld +++ b/srfi/106.sld @@ -36,6 +36,8 @@ *msg-peek* *msg-oob* *msg-waitall* *shut-rd* *shut-wr* *shut-rdwr* ) + (inline + socket->fd) (begin (define *socket-object-type* '%socket-object-type%) (define (socket->fd obj) (cdr obj)) diff --git a/srfi/128.sld b/srfi/128.sld index 8c947d06..9476378b 100644 --- a/srfi/128.sld +++ b/srfi/128.sld @@ -2,6 +2,8 @@ (import (scheme base)) (import (scheme case-lambda)) (import (scheme char) (scheme complex) (scheme inexact)) + (inline + booleanheap Cyc-minor-gc ) + (inline + thread-specific + thread-name + ) (begin ;; Threading (define (thread? obj) From 70c5212fd2b18c9d3a57f4522c4a154d92fec774 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 01:27:03 +0000 Subject: [PATCH 46/65] Added inlines back --- scheme/read.sld | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/scheme/read.sld b/scheme/read.sld index 8dbb9282..38b7f38e 100644 --- a/scheme/read.sld +++ b/scheme/read.sld @@ -16,6 +16,11 @@ include include-ci ) + (inline + in-port:get-cnum + in-port:get-lnum + in-port:get-buf + ) (begin (define-syntax include From 0d3ae68f87aec78a181a92efdab601b2628531bf Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 07:01:06 +0000 Subject: [PATCH 47/65] Reorganize allocated_bytes to try to speed it up --- gc.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/gc.c b/gc.c index a77b2482..d6d5a91b 100644 --- a/gc.c +++ b/gc.c @@ -775,17 +775,20 @@ size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r) t = type_of(obj); if (t == pair_tag) return gc_heap_align(sizeof(pair_type)); - if (t == macro_tag) - return gc_heap_align(sizeof(macro_type)); - if (t == closure0_tag) - return gc_heap_align(sizeof(closure0_type)); - if (t == closure1_tag) - return gc_heap_align(sizeof(closure1_type)); if (t == closureN_tag) { return gc_heap_align(sizeof(closureN_type) + sizeof(object) * ((closureN_type *) obj)->num_elements); } + if (t == double_tag) + return gc_heap_align(sizeof(double_type)); + if (t == closure0_tag) + return gc_heap_align(sizeof(closure0_type)); + if (t == closure1_tag) + return gc_heap_align(sizeof(closure1_type)); + if (t == string_tag) { + return gc_heap_align(sizeof(string_type) + string_len(obj) + 1); + } if (t == vector_tag) { return gc_heap_align(sizeof(vector_type) + sizeof(object) * ((vector_type *) obj)->num_elements); @@ -794,15 +797,10 @@ size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r) return gc_heap_align(sizeof(bytevector_type) + sizeof(char) * ((bytevector) obj)->len); } - if (t == string_tag) { - return gc_heap_align(sizeof(string_type) + string_len(obj) + 1); - } - if (t == integer_tag) - return gc_heap_align(sizeof(integer_type)); + if (t == macro_tag) + return gc_heap_align(sizeof(macro_type)); if (t == bignum_tag) return gc_heap_align(sizeof(bignum_type)); - if (t == double_tag) - return gc_heap_align(sizeof(double_type)); if (t == port_tag) return gc_heap_align(sizeof(port_type)); if (t == cvar_tag) @@ -813,6 +811,8 @@ size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r) return gc_heap_align(sizeof(mutex_type)); if (t == cond_var_tag) return gc_heap_align(sizeof(cond_var_type)); + if (t == integer_tag) + return gc_heap_align(sizeof(integer_type)); fprintf(stderr, "gc_allocated_bytes: unexpected object %p of type %d\n", obj, t); From 94fac5c512b4298ddf37b37168531de0fb9c7287 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 07:01:29 +0000 Subject: [PATCH 48/65] Expand number of inlined prims --- scheme/inexact.sld | 55 +++++++++++++++++++--------------------------- 1 file changed, 23 insertions(+), 32 deletions(-) diff --git a/scheme/inexact.sld b/scheme/inexact.sld index fca6a93d..11db3320 100644 --- a/scheme/inexact.sld +++ b/scheme/inexact.sld @@ -7,6 +7,7 @@ ;;;; This module contains the inexact library from r7rs. ;;;; (define-library (scheme inexact) + (import (scheme base)) (export acos asin @@ -22,6 +23,19 @@ tan ) (begin + (define-syntax define-inexact-op + (er-macro-transformer + (lambda (expr rename compare) + (let* ((fnc (cadr expr)) + (op (caddr expr))) + `(define-c ,fnc + "(void *data, int argc, closure _, object k, object z)" + ,(string-append + " return_inexact_double_op(data, k, " op ", z);") + "(void *data, object ptr, object z)" + ,(string-append + " return_inexact_double_op_no_cps(data, ptr, " op ", z);")))))) + (define-c nan? "(void *data, int argc, closure _, object k, object z)" " Cyc_check_num(data, z); @@ -46,41 +60,18 @@ return_closcall1(data, k, boolean_t);") (define (finite? z) (if (infinite? z) #f #t)) - (define-c acos - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, acos, z);") - (define-c asin - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, asin, z);") - (define-c atan - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, atan, z);") - (define-c cos - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, cos, z);") - (define-c exp - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, exp, z);") (define (log z1 . z2) (if (null? z2) (c-log z1) (let ((z2* (car z2))) (/ (c-log z1) (c-log z2*))))) - (define-c c-log - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, log, z);" - "(void *data, object ptr, object z)" - " return_inexact_double_op_no_cps(data, ptr, log, z);" - ) - (define-c sin - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, sin, z);" - "(void *data, object ptr, object z)" - " return_inexact_double_op_no_cps(data, ptr, sin, z);") - (define-c sqrt - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, sqrt, z);") - (define-c tan - "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, tan, z);") + (define-inexact-op c-log "log") + (define-inexact-op exp "exp") + (define-inexact-op sqrt "sqrt") + (define-inexact-op sin "sin") + (define-inexact-op cos "cos") + (define-inexact-op tan "tan") + (define-inexact-op asin "asin") + (define-inexact-op acos "acos") + (define-inexact-op atan "atan") )) From 2662a15622a279582926f656814279f395a1192d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 May 2017 18:55:01 -0400 Subject: [PATCH 49/65] Temporary test file --- array1-test.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 array1-test.scm diff --git a/array1-test.scm b/array1-test.scm new file mode 100644 index 00000000..e36b82f8 --- /dev/null +++ b/array1-test.scm @@ -0,0 +1,11 @@ +;;; ARRAY1 -- One of the Kernighan and Van Wyk benchmarks. + +(import (scheme base) (scheme read) (scheme write) (scheme time)) + +(define (create-x n) + (define result (make-vector n)) + (do ((i 0 (+ i 1))) + ((>= i n) result) ;; TODO: check generated code, can this >= be inlined??? + (vector-set! result i i))) + +(write (create-x 10)) From 7a90159109143df73fb910f2f10e73e9470c29c9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 May 2017 18:55:40 -0400 Subject: [PATCH 50/65] WIP --- array1-test.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/array1-test.scm b/array1-test.scm index e36b82f8..a1519458 100644 --- a/array1-test.scm +++ b/array1-test.scm @@ -1,4 +1,5 @@ -;;; ARRAY1 -- One of the Kernighan and Van Wyk benchmarks. +;;; A temporary test file, can inlining be done more efficiently here? +;; if this inline can be done, try with full-up array1 (import (scheme base) (scheme read) (scheme write) (scheme time)) From 79cde357b1e6d19a2e5032044f1e6b2baae2e185 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 11:02:58 +0000 Subject: [PATCH 51/65] Experimental change --- scheme/cyclone/cps-optimizations.sld | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index e34ce7cc..a629ef5c 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -959,6 +959,17 @@ (analyze:find-inlinable-vars e args))) (cdr exp))) ;(reverse (cdr exp)))) +;; If primitive mutates its args, ignore if ivar is not mutated (??) +;((and (prim? (car exp)) +; (prim:mutates? (car exp)) +; (> (length exp) 1)) +; (analyze:find-inlinable-vars (cadr exp) args) +; ;; First param is always mutated +; (for-each +; (lambda (e) +; (if (not (ref? e)) +; (analyze:find-inlinable-vars e args))) +; (cddr exp))) ((and (not (prim? (car exp))) (ref? (car exp))) (define ref-formals '()) From 7389417e392f2417d486753f765db4bd57159884 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 29 Apr 2017 11:13:50 +0000 Subject: [PATCH 52/65] If prim mutates args, ignore ivar if not mutated --- scheme/cyclone/cps-optimizations.sld | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index a629ef5c..2fd9fac7 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -959,17 +959,17 @@ (analyze:find-inlinable-vars e args))) (cdr exp))) ;(reverse (cdr exp)))) -;; If primitive mutates its args, ignore if ivar is not mutated (??) -;((and (prim? (car exp)) -; (prim:mutates? (car exp)) -; (> (length exp) 1)) -; (analyze:find-inlinable-vars (cadr exp) args) -; ;; First param is always mutated -; (for-each -; (lambda (e) -; (if (not (ref? e)) -; (analyze:find-inlinable-vars e args))) -; (cddr exp))) + ;; If primitive mutates its args, ignore ivar if it is not mutated + ((and (prim? (car exp)) + (prim:mutates? (car exp)) + (> (length exp) 1)) + (analyze:find-inlinable-vars (cadr exp) args) + ;; First param is always mutated + (for-each + (lambda (e) + (if (not (ref? e)) + (analyze:find-inlinable-vars e args))) + (cddr exp))) ((and (not (prim? (car exp))) (ref? (car exp))) (define ref-formals '()) From 8ef7060463e2d4cdd24dcf7a7b21a692c901724b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 3 May 2017 19:52:06 +0000 Subject: [PATCH 53/65] Storage for lambda side effects --- scheme/cyclone/cps-optimizations.sld | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 2fd9fac7..66577347 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -52,6 +52,7 @@ adb:function? adbf:simple adbf:set-simple! adbf:unused-params adbf:set-unused-params! + adbf:side-effects adbf:set-side-effects! ) (begin (define *adb* (make-hash-table)) @@ -115,15 +116,16 @@ (%adb:make-var '? '? #f #f '() #f #f 0 0 #t #f)) (define-record-type - (%adb:make-fnc simple unused-params assigned-to-var) + (%adb:make-fnc simple unused-params assigned-to-var side-effects) adb:function? (simple adbf:simple adbf:set-simple!) (unused-params adbf:unused-params adbf:set-unused-params!) (assigned-to-var adbf:assigned-to-var adbf:set-assigned-to-var!) + (side-effects adbf:side-effects adbf:set-side-effects!) ;; TODO: top-level-define ? ) (define (adb:make-fnc) - (%adb:make-fnc '? '? '())) + (%adb:make-fnc '? '? '() #f)) ;; A constant value that cannot be mutated ;; A variable only ever assigned to one of these could have all @@ -254,6 +256,11 @@ (k #t))))))) ;; Scanned fine, return #t (else #f))) + ;; Mark each lambda that has side effects. + ;; For nested lambdas, if a child has side effects also mark the parent + ;(define (analyze-lambda-side-effects exp lid) + + ;; TODO: check app for const/const-value, also (for now) reset them ;; if the variable is modified via set/define (define (analyze exp lid) From 6881285e0c472c48d4dadf6786b1c4f9e7d97f8e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 3 May 2017 20:30:19 +0000 Subject: [PATCH 54/65] Added analyze-find-lambdas --- scheme/cyclone/cps-optimizations.sld | 79 +++++++++++++++++++++++++--- 1 file changed, 73 insertions(+), 6 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 66577347..ffea5b6b 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -19,6 +19,7 @@ inlinable-top-level-lambda? optimize-cps analyze-cps + ;analyze-lambda-side-effects opt:contract opt:inline-prims adb:clear! @@ -63,12 +64,17 @@ (define (adb:get/default key default) (hash-table-ref/default *adb* key default)) (define (adb:set! key val) (hash-table-set! *adb* key val)) (define-record-type - (%adb:make-var global defined-by const const-value ref-by - reassigned assigned-value app-fnc-count app-arg-count - inlinable mutated-indirectly) + (%adb:make-var + global defined-by + defines-lambda-id + const const-value ref-by + reassigned assigned-value + app-fnc-count app-arg-count + inlinable mutated-indirectly) adb:variable? (global adbv:global? adbv:set-global!) (defined-by adbv:defined-by adbv:set-defined-by!) + (defines-lambda-id adbv:defines-lambda-id adbv:set-defines-lambda-id!) (const adbv:const? adbv:set-const!) (const-value adbv:const-value adbv:set-const-value!) (ref-by adbv:ref-by adbv:set-ref-by!) @@ -113,7 +119,7 @@ ) (define (adb:make-var) - (%adb:make-var '? '? #f #f '() #f #f 0 0 #t #f)) + (%adb:make-var '? '? #f #f #f '() #f #f 0 0 #t #f)) (define-record-type (%adb:make-fnc simple unused-params assigned-to-var side-effects) @@ -256,10 +262,70 @@ (k #t))))))) ;; Scanned fine, return #t (else #f))) + (define (analyze-find-lambdas exp lid) + (cond + ((ast:lambda? exp) + (let* ((id (ast:lambda-id exp)) + (fnc (adb:get/default id (adb:make-fnc)))) + (adb:set! id fnc) + (for-each + (lambda (expr) + (analyze-find-lambdas expr id)) + (ast:lambda-body exp)))) + ((const? exp) #f) + ((quote? exp) #f) + ((ref? exp) #f) + ((define? exp) + (let ((val (define->exp exp))) + (if (ast:lambda? (car val)) + (with-var! (define->var exp) (lambda (var) + (adbv:set-defines-lambda-id! + var (ast:lambda-id (car val))))))) + (analyze-find-lambdas (define->exp exp) lid)) + ((set!? exp) + (analyze-find-lambdas (set!->exp exp) lid)) + ((if? exp) + (analyze-find-lambdas (if->condition exp) lid) + (analyze-find-lambdas (if->then exp) lid) + (analyze-find-lambdas (if->else exp) lid)) + ((app? exp) + (for-each + (lambda (e) + (analyze-find-lambdas e lid)) + exp)) + (else + #f))) + ;; Mark each lambda that has side effects. ;; For nested lambdas, if a child has side effects also mark the parent - ;(define (analyze-lambda-side-effects exp lid) - + #;(define (analyze-lambda-side-effects exp lid) + (cond + ((ast:lambda? exp) + (let* ((id (ast:lambda-id exp)) + (fnc (adb:get/default id (adb:make-fnc)))) + (adb:set! id fnc) + (for-each + (lambda (expr) + (analyze-lambda-side-effects expr id)) + (ast:lambda-body exp)))) + ((const? exp) #f) + ((quote? exp) #f) + ((ref? exp) #f) + ((define? exp) + (analyze-lambda-side-effects (define->exp exp) lid)) + ((set!? exp) + (analyze-lambda-side-effects (set!->exp exp) lid)) + ((if? exp) + (analyze-lambda-side-effects (if->condition exp) lid) + (analyze-lambda-side-effects (if->then exp) lid) + (analyze-lambda-side-effects (if->else exp) lid)) + ((app? exp) + (for-each + (lambda (e) + (analyze-lambda-side-effects e lid)) + exp)) + (else + #f))) ;; TODO: check app for const/const-value, also (for now) reset them ;; if the variable is modified via set/define @@ -1018,6 +1084,7 @@ (error `(Unexpected expression passed to find inlinable vars ,exp))))) (define (analyze-cps exp) + (analyze-find-lambdas exp -1) (analyze exp -1) ;; Top-level is lambda ID -1 (analyze2 exp) ;; Second pass (analyze:find-inlinable-vars exp '()) ;; Identify variables safe to inline From 1a973cafd826d4285332efac161a9ab29d8abf5c Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 3 May 2017 21:54:51 +0000 Subject: [PATCH 55/65] Added lambda side effect analysis --- scheme/cyclone/cps-optimizations.sld | 33 +++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index ffea5b6b..470a01d4 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -298,7 +298,7 @@ ;; Mark each lambda that has side effects. ;; For nested lambdas, if a child has side effects also mark the parent - #;(define (analyze-lambda-side-effects exp lid) + (define (analyze-lambda-side-effects exp lid) (cond ((ast:lambda? exp) (let* ((id (ast:lambda-id exp)) @@ -307,23 +307,48 @@ (for-each (lambda (expr) (analyze-lambda-side-effects expr id)) - (ast:lambda-body exp)))) + (ast:lambda-body exp)) + ;; If id has side effects, mark parent lid, too + (if (and (> lid -1) + (adbf:side-effects fnc)) + (with-fnc! lid (lambda (f) + (adbf:set-side-effects! f #t)))))) ((const? exp) #f) ((quote? exp) #f) ((ref? exp) #f) ((define? exp) (analyze-lambda-side-effects (define->exp exp) lid)) ((set!? exp) + (with-fnc! lid (lambda (fnc) + (adbf:set-side-effects! fnc #t))) (analyze-lambda-side-effects (set!->exp exp) lid)) ((if? exp) (analyze-lambda-side-effects (if->condition exp) lid) (analyze-lambda-side-effects (if->then exp) lid) (analyze-lambda-side-effects (if->else exp) lid)) ((app? exp) + (let ((pure-ref #t)) + ;; Check if ref is pure. Note this may give wrong results + ;; if ref's lambda has not been scanned yet. One solution is + ;; to make 2 top-level passes of analyze-lambda-side-effects. + (if (ref? (car exp)) + (with-var (car exp) (lambda (var) + (if (adbv:defines-lambda-id var) + (with-fnc! (adbv:defines-lambda-id var) (lambda (fnc) + (if (adbf:side-effects fnc) + (set! pure-ref #f)))))))) + + ;; This lambda has side effects if it calls a mutating prim or + ;; a function not explicitly marked as having no side effects. + (if (or (prim:mutates? (car exp)) + (and (ref? (car exp)) + (not pure-ref))) + (with-fnc! lid (lambda (fnc) + (adbf:set-side-effects! fnc #t)))) (for-each (lambda (e) (analyze-lambda-side-effects e lid)) - exp)) + exp))) (else #f))) @@ -1085,6 +1110,8 @@ (define (analyze-cps exp) (analyze-find-lambdas exp -1) + (analyze-lambda-side-effects exp -1) + (analyze-lambda-side-effects exp -1) ;; 2nd pass guarantees lambda purity (analyze exp -1) ;; Top-level is lambda ID -1 (analyze2 exp) ;; Second pass (analyze:find-inlinable-vars exp '()) ;; Identify variables safe to inline From 8be8014a1b084021f36a71c67e28c6318615f742 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 3 May 2017 22:18:13 +0000 Subject: [PATCH 56/65] Allow inlining refs passed to pure lambdas --- scheme/cyclone/cps-optimizations.sld | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 470a01d4..54c95522 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1070,7 +1070,17 @@ (cddr exp))) ((and (not (prim? (car exp))) (ref? (car exp))) + (define pure-fnc #f) (define ref-formals '()) + ;; Does ref refer to a pure function (no side effects)? + (let ((var (adb:get/default (car exp) #f))) + (if var + (let ((lid (adbv:defines-lambda-id var))) + (if lid + (with-fnc! lid (lambda (fnc) + (if (not (adbf:side-effects fnc)) + (set! pure-fnc #t)))))))) + ;; (with-var (car exp) (lambda (var) (let ((val (adbv:assigned-value var))) (cond @@ -1083,6 +1093,15 @@ )))) ;(trace:error `(DEBUG ref app ,(car exp) ,(cdr exp) ,ref-formals)) (cond + (pure-fnc + (for-each + (lambda (e) + ;; Skip refs since fnc is pure and cannot change them + (if (not (ref? e)) + (analyze:find-inlinable-vars e args))) + exp)) + ;; TODO: how do you know if it is the same function, or just + ;; another function with the same formals? ((= (length ref-formals) (length (cdr exp))) (analyze:find-inlinable-vars (car exp) args) (for-each From b74213ec2dbfe7da026afca2e1348051ebec75e2 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 May 2017 05:11:23 +0000 Subject: [PATCH 57/65] Attempt 2 CPS optimization passes --- cyclone.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index 5112c9c5..e51a7d76 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -390,8 +390,15 @@ (when (> *optimization-level* 0) (set! input-program (optimize-cps input-program)) - (trace:info "---------------- after cps optimizations:") - (trace:info input-program)) + (trace:info "---------------- after cps optimizations (1):") + (trace:info input-program) + + (set! input-program + (optimize-cps input-program)) + (trace:info "---------------- after cps optimizations (2):") + (trace:info input-program) + + ) (set! input-program (map From c7aa3700ead4a52ff64bd96f4878fedfee89d718 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 May 2017 05:11:46 +0000 Subject: [PATCH 58/65] Also identify pure functions using assigned-var This identifies cases where a pure function exits but is defined inline rather than at the top-level. --- scheme/cyclone/cps-optimizations.sld | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 54c95522..50f7c074 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1075,11 +1075,18 @@ ;; Does ref refer to a pure function (no side effects)? (let ((var (adb:get/default (car exp) #f))) (if var - (let ((lid (adbv:defines-lambda-id var))) - (if lid - (with-fnc! lid (lambda (fnc) - (if (not (adbf:side-effects fnc)) - (set! pure-fnc #t)))))))) + (let ((lid (adbv:defines-lambda-id var)) + (assigned-val (adbv:assigned-value var))) + (cond + (lid + (with-fnc! lid (lambda (fnc) + (if (not (adbf:side-effects fnc)) + (set! pure-fnc #t))))) + ((ast:lambda? assigned-val) + (with-fnc! (ast:lambda-id assigned-val) (lambda (fnc) + (if (not (adbf:side-effects fnc)) + (set! pure-fnc #t))))) + )))) ;; (with-var (car exp) (lambda (var) (let ((val (adbv:assigned-value var))) From 3bd5d52671a7a09ad53f53eac766be00c0629271 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 May 2017 06:50:09 +0000 Subject: [PATCH 59/65] Keep track of lambda's with continuations --- scheme/cyclone/ast.sld | 15 ++++++++++----- scheme/cyclone/cps-optimizations.sld | 9 ++++++--- scheme/cyclone/transforms.sld | 6 ++++-- 3 files changed, 20 insertions(+), 10 deletions(-) diff --git a/scheme/cyclone/ast.sld b/scheme/cyclone/ast.sld index b1989d95..1c9cf628 100644 --- a/scheme/cyclone/ast.sld +++ b/scheme/cyclone/ast.sld @@ -21,16 +21,21 @@ ast:set-lambda-args! ast:lambda-body ast:set-lambda-body! + ast:lambda-has-cont + ast:set-lambda-has-cont! ) (begin (define *lambda-id* 0) (define-record-type - (ast:%make-lambda id args body) + (ast:%make-lambda id args body has-cont) ast:lambda? (id ast:lambda-id) (args ast:lambda-args ast:set-lambda-args!) - (body ast:lambda-body ast:set-lambda-body!)) - (define (ast:make-lambda args body) - (set! *lambda-id* (+ 1 *lambda-id*)) - (ast:%make-lambda *lambda-id* args body)) + (body ast:lambda-body ast:set-lambda-body!) + (has-cont ast:lambda-has-cont ast:set-lambda-has-cont!) + ) + (define (ast:make-lambda args body . opts) + (let ((has-cont (if (pair? opts) (car opts) #f))) + (set! *lambda-id* (+ 1 *lambda-id*)) + (ast:%make-lambda *lambda-id* args body has-cont))) )) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 50f7c074..0a4fcf9e 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -598,7 +598,8 @@ (ast:%make-lambda (ast:lambda-id exp) (ast:lambda-args exp) - (opt:contract (ast:lambda-body exp)))))) + (opt:contract (ast:lambda-body exp)) + (ast:lambda-has-cont exp))))) ((const? exp) exp) ((ref? exp) (let ((var (adb:get/default exp #f))) @@ -652,7 +653,8 @@ (ast:%make-lambda (ast:lambda-id fnc) (reverse new-params) - (ast:lambda-body fnc)) + (ast:lambda-body fnc) + (ast:lambda-has-cont fnc)) (map opt:contract (reverse new-args))))) @@ -683,7 +685,8 @@ (ast:%make-lambda (ast:lambda-id exp) (ast:lambda-args exp) - (map (lambda (b) (opt:inline-prims b refs)) (ast:lambda-body exp)))) + (map (lambda (b) (opt:inline-prims b refs)) (ast:lambda-body exp)) + (ast:lambda-has-cont exp))) ((const? exp) exp) ((quote? exp) exp) ((define? exp) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index c0e0248e..89f6d1a3 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -1300,7 +1300,8 @@ (let ((k (gensym 'k))) (list (ast:make-lambda (list k) - (list (xform k))) + (list (xform k)) + #t) cont-ast))))) ((prim-call? ast) @@ -1327,7 +1328,8 @@ (if (equal? ltype 'args:varargs) 'args:fixed-with-varargs ;; OK? promote due to k ltype)) - (list (cps-seq (cddr ast) k)))))) + (list (cps-seq (cddr ast) k)) + #t)))) ((app? ast) ;; Syntax check the function From 72c1bb9bea20bf5fdaa06710313f3eede7880bc6 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 May 2017 07:03:05 +0000 Subject: [PATCH 60/65] Keep track of which refs are continuations --- scheme/cyclone/cps-optimizations.sld | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index 0a4fcf9e..dbd2d8c0 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -70,7 +70,8 @@ const const-value ref-by reassigned assigned-value app-fnc-count app-arg-count - inlinable mutated-indirectly) + inlinable mutated-indirectly + cont) adb:variable? (global adbv:global? adbv:set-global!) (defined-by adbv:defined-by adbv:set-defined-by!) @@ -91,6 +92,7 @@ (inlinable adbv:inlinable adbv:set-inlinable!) ;; Is the variable mutated indirectly? (EG: set-car! of a cdr) (mutated-indirectly adbv:mutated-indirectly? adbv:set-mutated-indirectly!) + (cont adbv:cont? adbv:set-cont!) ) (define (adbv-set-assigned-value-helper! sym var value) @@ -119,7 +121,7 @@ ) (define (adb:make-var) - (%adb:make-var '? '? #f #f #f '() #f #f 0 0 #t #f)) + (%adb:make-var '? '? #f #f #f '() #f #f 0 0 #t #f #f)) (define-record-type (%adb:make-fnc simple unused-params assigned-to-var side-effects) @@ -268,6 +270,11 @@ (let* ((id (ast:lambda-id exp)) (fnc (adb:get/default id (adb:make-fnc)))) (adb:set! id fnc) + ;; Flag continuation variable, if present + (if (ast:lambda-has-cont exp) + (let ((k (car (ast:lambda-args exp)))) + (with-var! k (lambda (var) + (adbv:set-cont! var #t))))) (for-each (lambda (expr) (analyze-find-lambdas expr id)) From 93f87ac4c38188a3ac6c6e2d6f3bac74a2680d56 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 May 2017 08:22:01 +0000 Subject: [PATCH 61/65] Allow inlines if a var is passed to a continuation --- scheme/cyclone/cps-optimizations.sld | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld index dbd2d8c0..8c9fb409 100644 --- a/scheme/cyclone/cps-optimizations.sld +++ b/scheme/cyclone/cps-optimizations.sld @@ -1081,6 +1081,7 @@ ((and (not (prim? (car exp))) (ref? (car exp))) (define pure-fnc #f) + (define calling-cont #f) (define ref-formals '()) ;; Does ref refer to a pure function (no side effects)? (let ((var (adb:get/default (car exp) #f))) @@ -1096,6 +1097,10 @@ (with-fnc! (ast:lambda-id assigned-val) (lambda (fnc) (if (not (adbf:side-effects fnc)) (set! pure-fnc #t))))) + ;; Experimental - if a cont, execution will leave fnc anyway, + ;; so inlines there should be safe + ((adbv:cont? var) + (set! calling-cont #t)) )))) ;; (with-var (car exp) (lambda (var) @@ -1110,7 +1115,7 @@ )))) ;(trace:error `(DEBUG ref app ,(car exp) ,(cdr exp) ,ref-formals)) (cond - (pure-fnc + ((or pure-fnc calling-cont) (for-each (lambda (e) ;; Skip refs since fnc is pure and cannot change them From 1391186a6f7ce810c2ea9b44e97f9ab5ca82f2b1 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 May 2017 08:40:59 +0000 Subject: [PATCH 62/65] Inline (exact?) and (exact-integer?) --- scheme/base.sld | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/scheme/base.sld b/scheme/base.sld index 9fe1d30c..8fe662f7 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -208,6 +208,7 @@ ;;;; ) (inline + exact-integer? square quotient numerator @@ -1155,7 +1156,13 @@ if (obj_is_int(num) || type_of(num) == integer_tag || type_of(num) == bignum_tag) return_closcall1(data, k, boolean_t); - return_closcall1(data, k, boolean_f); ") + return_closcall1(data, k, boolean_f); " + "(void *data, object ptr, object num)" + " Cyc_check_num(data, num); + if (obj_is_int(num) || type_of(num) == integer_tag + || type_of(num) == bignum_tag) + return boolean_t; + return boolean_f;") (define (inexact? num) (not (exact? num))) (define complex? number?) (define rational? number?) From dfdd84d585fbdac33e1a4a0ecfce2f72d96e566f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 8 May 2017 18:44:29 -0400 Subject: [PATCH 63/65] Issue #198 - Remove custom "member" function --- scheme/cyclone/transforms.sld | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 89f6d1a3..26fe492d 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -183,17 +183,6 @@ ;; Utilities. -(cond-expand - (cyclone - ; member : symbol sorted-set[symbol] -> boolean - (define (member sym S) - (if (not (pair? S)) - #f - (if (eq? sym (car S)) - #t - (member sym (cdr S)))))) - (else #f)) - (cond-expand (cyclone ; void : -> void From 48ee3708d5ca87447d678be0121e122fd75efaa5 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 9 May 2017 12:44:42 +0000 Subject: [PATCH 64/65] Inline more define-c functions --- scheme/base.sld | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index 8fe662f7..c6839bb1 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -1082,11 +1082,14 @@ (define-c floor "(void *data, int argc, closure _, object k, object z)" - " return_exact_double_op(data, k, floor, z); ") + " return_exact_double_op(data, k, floor, z); " + "(void *data, object ptr, object z)" + " return_exact_double_op_no_cps(data, ptr, floor, z);") (define-c ceiling "(void *data, int argc, closure _, object k, object z)" - " return_exact_double_op(data, k, ceil, z); ") - ;TODO: working on define-c:inline macro to make it less verbose to do this + " return_exact_double_op(data, k, ceil, z); " + "(void *data, object ptr, object z)" + " return_exact_double_op_no_cps(data, ptr, ceil, z);") (define-c truncate "(void *data, int argc, closure _, object k, object z)" " return_exact_double_op(data, k, (int), z); " @@ -1094,11 +1097,15 @@ " return_exact_double_op_no_cps(data, ptr, (int), z);") (define-c round "(void *data, int argc, closure _, object k, object z)" - " return_exact_double_op(data, k, round, z); ") + " return_exact_double_op(data, k, round, z); " + "(void *data, object ptr, object z)" + " return_exact_double_op_no_cps(data, ptr, round, z);") (define exact truncate) (define-c inexact "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, (double), z); ") + " return_inexact_double_op(data, k, (double), z); " + "(void *data, object ptr, object z)" + " return_inexact_double_op_no_cps(data, ptr, (double), z);") (define-c abs "(void *data, int argc, closure _, object k, object num)" " Cyc_check_num(data, num); @@ -1147,7 +1154,9 @@ (values s r))) (define-c sqrt "(void *data, int argc, closure _, object k, object z)" - " return_inexact_double_op(data, k, sqrt, z);") + " return_inexact_double_op(data, k, sqrt, z);" + "(void *data, object ptr, object z)" + " return_inexact_double_op_no_cps(data, ptr, sqrt, z);") (define (exact-integer? num) (and (exact? num) (integer? num))) (define-c exact? @@ -1226,7 +1235,9 @@ " Cyc_expt(data, k, z1, z2); ") (define-c eof-object "(void *data, int argc, closure _, object k)" - " return_closcall1(data, k, Cyc_EOF); ") + " return_closcall1(data, k, Cyc_EOF); " + "(void *data, object ptr)" + " return Cyc_EOF;") (define-c input-port? "(void *data, int argc, closure _, object k, object port)" " port_type *p = (port_type *)port; From bd3b662bb980336110603b8063af3db1e9775c7d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 9 May 2017 12:58:01 +0000 Subject: [PATCH 65/65] Added 0.5.1 features section --- CHANGELOG.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 240c105c..5c80f11b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,14 @@ ## 0.5.1 - TBD +Features + +- Allow `define-c` function definitions to optionally provide an additional non-CPS form of the function. This form is typically more efficient and will be used by compiled code whenever possible. + +- Improved the compiler's CPS optimization phase to eliminate certain unnecessary function calls. This leads to a performance increase of about 5% when running ecraven's R7RS benchmark suite. + +Bug Fixes + - Prevent potential memory corruption when working with large vectors that cannot be allocated on the stack. ## 0.5 - April 14, 2017