From f4582f951bf7346d90dd33d5d285581d88371f79 Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Wed, 23 Aug 1995 14:07:44 +0000 Subject: [PATCH] Added flonum cells. --- v8/src/compiler/midend/dbgred.scm | 15 ++++++- v8/src/compiler/midend/fakeprim.scm | 52 +++++++++++++++++++---- v8/src/compiler/midend/laterew.scm | 64 ++++++++++++++++++++++++++++- 3 files changed, 120 insertions(+), 11 deletions(-) diff --git a/v8/src/compiler/midend/dbgred.scm b/v8/src/compiler/midend/dbgred.scm index 1eb19835b..9b00042aa 100644 --- a/v8/src/compiler/midend/dbgred.scm +++ b/v8/src/compiler/midend/dbgred.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: dbgred.scm,v 1.14 1995/08/19 01:34:04 adams Exp $ +$Id: dbgred.scm,v 1.15 1995/08/23 14:07:05 adams Exp $ Copyright (c) 1994-1995 Massachusetts Institute of Technology @@ -614,6 +614,18 @@ reachable. (vector-index (quote/text layout) (quote/text name))) cell-path)))) + ((CALL/%flo:multicell-ref? expr) + (let ((cell-path + (reconstruct-expression (call/%flo:multicell-ref/cell expr))) + (layout (call/%flo:multicell-ref/layout expr)) + (name (call/%flo:multicell-ref/name expr))) + (and cell-path + (QUOTE/? layout) + (QUOTE/? name) + (cons (dbgred/FLONUM-CELL + (vector-index (quote/text layout) + (quote/text name))) + cell-path)))) ((or (CALL/%stack-closure-ref? expr) (CALL/%heap-closure-ref? expr)) (internal-error "DBG expression should have been compressed" expr)) @@ -683,6 +695,7 @@ reachable. (define dbgred/STACK (dbg-reduce/indexed-path 'STACK)) (define dbgred/CLOSURE (dbg-reduce/indexed-path 'CLOSURE)) (define dbgred/CELL (dbg-reduce/indexed-path 'CELL)) +(define dbgred/FLONUM-CELL (dbg-reduce/indexed-path 'FLONUM-CELL)) (define dbg-reduce/equivalent-operators (make-monotonic-strong-eq-hash-table)) diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm index f35b9094b..542f1db9e 100644 --- a/v8/src/compiler/midend/fakeprim.scm +++ b/v8/src/compiler/midend/fakeprim.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: fakeprim.scm,v 1.21 1995/08/19 01:36:13 adams Exp $ +$Id: fakeprim.scm,v 1.22 1995/08/23 14:07:44 adams Exp $ Copyright (c) 1994-1995 Massachusetts Institute of Technology @@ -696,7 +696,7 @@ MIT in each case. |# (define %make-multicell ;; (CALL ',%make-multicell '#F 'LAYOUT ...) (make-operator/simple "#[make-multicell]")) -(cookie-call %make-multicell '#F 'LAYOUT #!rest values) +;;(cookie-call %make-multicell '#F 'LAYOUT #!rest values) (define %multicell-ref ;; (CALL ',%multicell-ref '#F cell 'LAYOUT 'NAME) @@ -708,7 +708,23 @@ MIT in each case. |# ;; Note: ;; Always used in statement position - has no value. (make-operator/simple* "#[multicell-set!]" '(UNSPECIFIC-RESULT))) -(cookie-call %multicell-set! '#F cell value 'LAYOUT 'NAME) +;;(cookie-call %multicell-set! '#F cell value 'LAYOUT 'NAME) + +(define %flo:make-multicell + ;; (CALL ',%flo:make-multicell '#F 'LAYOUT ...) + (make-operator/simple "#[flo:make-multicell]")) +;;(cookie-call %make-multicell '#F 'LAYOUT #!rest values) + +(define %flo:multicell-ref + ;; (CALL ',%flo:multicell-ref '#F cell 'LAYOUT 'NAME) + (make-operator/effect-sensitive "#[flo:multicell-ref]" '(RESULT-TYPE FLONUM)) +(cookie-call %multicell-ref '#F cell 'LAYOUT 'NAME) + +(define %flo:multicell-set! + ;; (CALL ',%flo:multicell-set! '#F cell value 'LAYOUT 'NAME) + ;; Note: + ;; Always used in statement position - has no value. + (make-operator/simple* "#[flo:multicell-set!]" '(UNSPECIFIC-RESULT))) ;; Tuples are collections of values. Each slot is named. LAYOUT @@ -1013,14 +1029,23 @@ MIT in each case. |# fix:-1+ fix:1+ fix:+ fix:- fix:* fix:quotient fix:remainder ; fix:gcd fix:andc fix:and fix:or fix:xor fix:not fix:lsh - flo:+ flo:- flo:* flo:/ - flo:negate flo:abs flo:sqrt - flo:floor flo:ceiling flo:truncate flo:round - flo:exp flo:log flo:sin flo:cos flo:tan flo:asin - flo:acos flo:atan flo:atan2 flo:expt flo:floor->exact flo:ceiling->exact flo:truncate->exact flo:round->exact ascii->char integer->char char->ascii char-code char->integer)) + +(for-each + (lambda (simple-operator) + (define-operator-properties + simple-operator + (list '(SIMPLE) + '(SIDE-EFFECT-INSENSITIVE) + '(SIDE-EFFECT-FREE) + '(RESULT-TYPE FLONUM)))) + (list flo:+ flo:- flo:* flo:/ + flo:negate flo:abs flo:sqrt + flo:floor flo:ceiling flo:truncate flo:round + flo:exp flo:log flo:sin flo:cos flo:tan flo:asin + flo:acos flo:atan flo:atan2 flo:expt)) (for-each (lambda (simple-operator) @@ -1031,12 +1056,21 @@ MIT in each case. |# (list cell-contents car cdr %record-ref vector-ref string-ref - string-length vector-8b-ref flo:vector-ref + string-length vector-8b-ref system-pair-car system-pair-cdr system-hunk3-cxr0 system-hunk3-cxr1 system-hunk3-cxr2 (make-primitive-procedure 'PRIMITIVE-GET-FREE) (make-primitive-procedure 'PRIMITIVE-OBJECT-REF))) +(for-each + (lambda (simple-operator) + (define-operator-properties + simple-operator + (list '(SIMPLE) + '(SIDE-EFFECT-FREE) + '(RESULT-TYPE FLONUM)))) + (list flo:vector-ref)) + (for-each (lambda (operator) (define-operator-properties diff --git a/v8/src/compiler/midend/laterew.scm b/v8/src/compiler/midend/laterew.scm index ed0e1b650..b78ecf75d 100644 --- a/v8/src/compiler/midend/laterew.scm +++ b/v8/src/compiler/midend/laterew.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: laterew.scm,v 1.13 1995/08/19 15:30:43 adams Exp $ +$Id: laterew.scm,v 1.14 1995/08/23 14:07:19 adams Exp $ Copyright (c) 1994-1995 Massachusetts Institute of Technology @@ -365,6 +365,68 @@ MIT in each case. |# ((READ) `(CALL ',%vector-ref '#F ,cell ,(index))) ((WRITE) `(CALL ',%vector-set! '#F ,cell ,(index) ,value/s)) ((MAKE) `(CALL ',%vector '#F ,@value/s))))))) + +(define-rewrite/late %flo:make-multicell + (lambda (form rands) + (let ((cont (first rands)) + (layout (second rands)) + (values (cddr rands))) + (let ((name (and (QUOTE/? layout) + (= (vector-length (quote/text layout)) 1) + `(QUOTE ,(vector-ref (quote/text layout) 0))))) + (laterew/flo:multicell-operation cont layout name 'MAKE #F values))))) + +(define-rewrite/late %flo:multicell-ref + (lambda (form rands) + (let ((cont (first rands)) + (cell (second rands)) + (layout (third rands)) + (name (fourth rands))) + (laterew/flo:multicell-operation cont layout name 'READ cell #F)))) + +(define-rewrite/late %flo:multicell-set! + (lambda (form rands) + (let ((cont (first rands)) + (cell (second rands)) + (value (third rands)) + (layout (fourth rands)) + (name (fifth rands))) + (laterew/flo:multicell-operation cont layout name 'WRITE cell value)))) + +(define (laterew/flo:multicell-operation cont layout name operation cell value/s) + (if (not (equal? cont '(QUOTE #F))) + (internal-error "Bad continuation for Multicell operation" cont)) + (let ((layout + (if (QUOTE/? layout) + (quote/text layout) + (internal-error "Multicell operation needs constant LAYOUT" + layout))) + (name + (cond ((eq? name #F) #F) + ((QUOTE/? name) (quote/text name)) + (else (internal-error "Multicell operation needs constant NAME" + name))))) + (define (index) + (let ((value (vector-find-next-element layout name))) + (if value + `(QUOTE ,value) + (internal-error "Multicell operation: name not found" + name layout)))) + (case operation + ((READ) `(CALL ',flo:vector-ref '#F ,cell ,(index))) + ((WRITE) `(CALL ',flo:vector-set! '#F ,cell ,(index) ,value/s)) + ((MAKE) + (let ((cell (laterew/new-name 'FLONUM-VECTOR))) + `(LET ((,cell (CALL ',flo:vector-cons '#F ',(vector-length layout)))) + (BEGIN + ,@(map (lambda (index value) + `(CALL ',flo:vector-set! '#F + (LOOKUP ,cell) + (QUOTE ,index) + ,value/s)) + (iota (length values)) + values) + (LOOKUP ,cell)))))))) (define-rewrite/late %vector-check (let ((vector-tag (machine-tag 'VECTOR))) -- 2.25.1