From 6727ea075688d0ee78b184ff19327ce782850eef Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Fri, 26 Jul 1996 14:25:07 +0000 Subject: [PATCH] Initial revision --- v8/src/runtime/coerce.scm | 216 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 216 insertions(+) create mode 100644 v8/src/runtime/coerce.scm diff --git a/v8/src/runtime/coerce.scm b/v8/src/runtime/coerce.scm new file mode 100644 index 000000000..d3565984c --- /dev/null +++ b/v8/src/runtime/coerce.scm @@ -0,0 +1,216 @@ +#| -*-Scheme-*- + +$Id: coerce.scm,v 1.1 1996/07/26 14:25:07 adams Exp $ + +Copyright (c) 1996 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. |# + +;;;; Coerce-to-compiled-procedure +;;; package: (runtime coerce-to-compiled-procedure) + +;; This file must be syntaxed with teh 8.0 compiler loaded + +(declare (usual-integrations)) + +;; COERCE-TO-COMPILED-PROCEDURE +;; +;; This code is special. It uses several hooks into the 8.0 compiler in +;; order to generate efficient code. Care has to be taken to ensure +;; that none of the compiled code uses COERCE-TO-COMPILED-PROCEDURE, +;; otherwise we would have a loop. +;; + + +(define-macro (special-operator name) + `(QUOTE ,(environment-lookup (->environment '(COMPILER MIDEND)) name))) + +(define-macro (%funcall procedure . arguments) + `((special-operator %internal-apply-unchecked) + ,(+ (length arguments) 1) + ,procedure + ,@arguments)) + +;; (%compiled-entry? ) +;; (%compiled-entry-maximum-arity? ) + +(define-integrable %compiled-entry? (special-operator %compiled-entry?)) + +(define-integrable %compiled-entry-maximum-arity? + (special-operator %compiled-entry-maximum-arity?)) + + +(define (coerce-to-compiled-procedure/compiled object arity) + + (let ((xx ((lambda (#!optional xx) xx))) + (+ fix:+) + (= fix:=) + (< fix:<)) + + (define (use-microcode) + ((ucode-primitive coerce-to-compiled-procedure 2) object arity)) + + (define (default) + (use-microcode)) + + (define (mismatch) + (use-microcode)) + + (define (make-trampoline f arity min max) + (cond + ((= min max) + (mismatch)) + ((< max 128) + (case arity + ((1) + (case max + ((2) (lambda () (%funcall f xx))) + ((3) (lambda () (%funcall f xx xx))) + ((4) (lambda () (%funcall f xx xx xx))) + ((5) (lambda () (%funcall f xx xx xx xx))) + (else (default)))) + ((2) + (case max + ((3) (lambda (a1) (f a1 xx))) + ((4) (lambda (a1) (f a1 xx xx))) + ((5) (lambda (a1) (f a1 xx xx xx))) + (else (default)))) + ((3) + (case max + ((4) (lambda (a1 a2) (f a1 a2 xx))) + ((5) (lambda (a1 a2) (f a1 a2 xx xx))) + (else (default)))) + ((4) + (case max + ((5) (lambda (a1 a2 a3) (f a1 a2 a3 xx))) + (else (default)))) + (else (default)))) + (else;; max >= 128 + (make-listifying-trampoline f arity min max)))) + + (define (make-listifying-trampoline f arity min max) + (case arity + ((1) + (case min + ((1) + (case max + ((254) (lambda () (%funcall f '()))) + ((253) (lambda () (%funcall f xx '()))) + ((252) (lambda () (%funcall f xx xx '()))) + ((251) (lambda () (%funcall f xx xx xx '()))) + ((250) (lambda () (%funcall f xx xx xx xx '()))) + (else (default)))) + (else (default)))) + ((2) + (if (< (+ min max) 256) + (case max + ((254) (lambda (a1) (%funcall f (list a1)))) + ((253) (lambda (a1) (%funcall f a1 '()))) + ((252) (lambda (a1) (%funcall f a1 xx '()))) + ((251) (lambda (a1) (%funcall f a1 xx xx '()))) + ((250) (lambda (a1) (%funcall f a1 xx xx xx '()))) + (else (default))) + (default))) + ((3) + (if (< (+ min max) 256) + (case max + ((254) (lambda (a1 a2) (%funcall f (list a1 a2)))) + ((253) (lambda (a1 a2) (%funcall f a1 (list a2)))) + ((252) (lambda (a1 a2) (%funcall f a1 a2 '()))) + ((251) (lambda (a1 a2) (%funcall f a1 a2 xx '()))) + ((250) (lambda (a1 a2) (%funcall f a1 a2 xx xx '()))) + (else (default))) + (default))) + ((4) + (if (< (+ min max) 256) + (case max + ((254) (lambda (a1 a2 a3) (%funcall f (list a1 a2 a3)))) + ((253) (lambda (a1 a2 a3) (%funcall f a1 (list a2 a3)))) + ((252) (lambda (a1 a2 a3) (%funcall f a1 a2 (list a3)))) + ((251) (lambda (a1 a2 a3) (%funcall f a1 a2 a3 '()))) + ((250) (lambda (a1 a2 a3) (%funcall f a1 a2 a3 xx '()))) + (else (default))) + (default))) + ((5) + (if (< (+ min max) 256) + (case max + ((254) (lambda (a1 a2 a3 a4) (%funcall f (list a1 a2 a3 a4)))) + ((253) (lambda (a1 a2 a3 a4) (%funcall f a1 (list a2 a3 a4)))) + ((252) (lambda (a1 a2 a3 a4) (%funcall f a1 a2 (list a3 a4)))) + ((251) (lambda (a1 a2 a3 a4) (%funcall f a1 a2 a3 (list a4)))) + ((250) (lambda (a1 a2 a3 a4) (%funcall f a1 a2 a3 a4 '()))) + (else (default))) + (default))) + ((6) + (if (< (+ min max) 256) + (case max + ((254) (lambda (a1 a2 a3 a4 a5) + (%funcall f (list a1 a2 a3 a4 a5)))) + ((253) (lambda (a1 a2 a3 a4 a5) + (%funcall f a1 (list a2 a3 a4 a5)))) + ((252) (lambda (a1 a2 a3 a4 a5) + (%funcall f a1 a2 (list a3 a4 a5)))) + ((251) (lambda (a1 a2 a3 a4 a5) + (%funcall f a1 a2 a3 (list a4 a5)))) + ((250) (lambda (a1 a2 a3 a4 a5) + (%funcall f a1 a2 a3 a4 (list a5)))) + (else (default))) + (default))) + (else (default)))) + + (if (and (%compiled-entry? object) + (fixnum? arity)) + (if (and (%compiled-entry-maximum-arity? arity object) + (< arity 128)) + object + (let ((info ((ucode-primitive compiled-entry-kind 1) object))) + ;; max = (-1)^tail? * (1 + req + opt + tail?) + ;; min = (1 + req) + (let ((min (system-hunk3-cxr1 info)) + (max (system-hunk3-cxr2 info))) + (make-trampoline object arity min max)))) + (use-microcode)))) + + +(define (%compiled-entry-arity p) + (let ((info ((ucode-primitive compiled-entry-kind 1) p))) + ;; max = (-1)^tail? * (1 + req + opt + tail?) + ;; min = (1 + req) + (let ((min (system-hunk3-cxr1 info)) + (max (system-hunk3-cxr2 info))) + (cons min max)))) + +(define coerce-to-compiled-procedure) + +(define (initialize-package!) + (set! coerce-to-compiled-procedure + (if (compiled-procedure? coerce-to-compiled-procedure/compiled) + coerce-to-compiled-procedure/compiled + (ucode-primitive coerce-to-compiled-procedure))) + unspecific) -- 2.25.1